lisp/riece-display.el

   1 ;;; riece-display.el --- buffer arrangement
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'riece-options)
  28 (require 'riece-channel)
  29 (require 'riece-misc)
  30 (require 'riece-layout)
  31
  32 (defvar riece-channel-buffer-format "*Channel:%s*"
  33   "Format of channel message buffer.")
  34 (defvar riece-channel-buffer-alist nil
  35   "An alist mapping identities to channel buffers.")
  36
  37 (defvar riece-update-buffer-functions nil
  38   "Functions to redisplay the buffer.
  39 Local to the buffer in `riece-buffer-list'.")
  40
  41 (defvar riece-update-indicator-functions
  42   '(riece-update-status-indicators
  43     riece-update-channel-indicator
  44     riece-update-long-channel-indicator
  45     riece-update-channel-list-indicator)
  46   "Functions to update modeline indicators.")
  47
  48 (defun riece-update-user-list-buffer ()
  49   (save-excursion
  50     (set-buffer riece-user-list-buffer)
  51     (if (and riece-current-channel
  52              (riece-channel-p (riece-identity-prefix riece-current-channel)))
  53         (let* ((channel
  54                 (with-current-buffer (process-buffer (riece-server-process
  55                                                       (riece-identity-server
  56                                                        riece-current-channel)))
  57                   (riece-get-channel (riece-identity-prefix
  58                                       riece-current-channel))))
  59                (users (riece-channel-users channel))
  60                (inhibit-read-only t)
  61                buffer-read-only)
  62           (erase-buffer)
  63           (while users
  64             (insert (if (riece-channel-operator-p channel (car users))
  65                         "@"
  66                       (if (riece-channel-speaker-p channel (car users))
  67                           "+"
  68                         " "))
  69                     (riece-format-identity
  70                      (riece-make-identity (car users)
  71                                           (riece-identity-server
  72                                            riece-current-channel))
  73                      t)
  74                     "\n")
  75             (setq users (cdr users)))))))
  76
  77 (defun riece-update-channel-list-buffer ()
  78   (save-excursion
  79     (set-buffer riece-channel-list-buffer)
  80     (let ((inhibit-read-only t)
  81           buffer-read-only
  82           (index 1)
  83           (channels riece-current-channels))
  84       (erase-buffer)
  85       (while channels
  86         (if (car channels)
  87             (insert (riece-format-channel-list-line
  88                      index (car channels))))
  89         (setq index (1+ index)
  90               channels (cdr channels))))))
  91
  92 (defun riece-format-channel-list-line (index channel)
  93   (or (run-hook-with-args-until-success
  94        'riece-format-channel-list-line-functions index channel)
  95       (concat (format "%2d:%c" index
  96                       (if (riece-identity-equal channel riece-current-channel)
  97                           ?*
  98                         ? ))
  99               (riece-format-identity channel)
 100               "\n")))
 101
 102 (defun riece-update-channel-indicator ()
 103   (setq riece-channel-indicator
 104         (if riece-current-channel
 105             (riece-format-identity riece-current-channel)
 106           "None")))
 107
 108 (defun riece-update-long-channel-indicator ()
 109   (setq riece-long-channel-indicator
 110         (if riece-current-channel
 111             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
 112                 (riece-concat-channel-modes
 113                  riece-current-channel
 114                  (riece-concat-channel-topic
 115                   riece-current-channel
 116                   (riece-format-identity riece-current-channel)))
 117               (riece-format-identity riece-current-channel))
 118           "None")))
 119
 120 (defun riece-update-channel-list-indicator ()
 121   (if (and riece-current-channels
 122            ;; There is at least one channel.
 123            (delq nil (copy-sequence riece-current-channels)))
 124       (let ((index 1))
 125         (setq riece-channel-list-indicator
 126               (mapconcat
 127                #'identity
 128                (delq nil
 129                      (mapcar
 130                       (lambda (channel)
 131                         (prog1
 132                             (if channel
 133                                 (format "%d:%s" index
 134                                         (riece-format-identity channel)))
 135                           (setq index (1+ index))))
 136                       riece-current-channels))
 137                ",")))
 138     (setq riece-channel-list-indicator "No channel")))
 139
 140 (defun riece-update-status-indicators ()
 141   (if riece-current-channel
 142       (with-current-buffer riece-command-buffer
 143         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 144           (setq riece-away-indicator
 145                 (if (and riece-real-nickname
 146                          (riece-user-get-away riece-real-nickname))
 147                     "A"
 148                   "-")
 149                 riece-operator-indicator
 150                 (if (and riece-real-nickname
 151                          (riece-user-get-operator riece-real-nickname))
 152                     "O"
 153                   "-")
 154                 riece-user-indicator riece-real-nickname))))
 155   (setq riece-freeze-indicator
 156         (with-current-buffer (if (and riece-channel-buffer-mode
 157                                       riece-channel-buffer)
 158                                  riece-channel-buffer
 159                                riece-dialogue-buffer)
 160           (if (eq riece-freeze 'own)
 161               "f"
 162             (if riece-freeze
 163                 "F"
 164               "-")))))
 165
 166 (defun riece-update-buffers (&optional buffers)
 167   (unless buffers
 168     (setq buffers riece-buffer-list))
 169   (while buffers
 170     (save-excursion
 171       (set-buffer (car buffers))
 172       (run-hooks 'riece-update-buffer-functions))
 173     (setq buffers (cdr buffers)))
 174   (run-hooks 'riece-update-indicator-functions)
 175   (force-mode-line-update t)
 176   (run-hooks 'riece-update-buffer-hook))
 177
 178 (defun riece-channel-buffer-name (identity)
 179   (let ((channels (riece-identity-member identity riece-current-channels)))
 180     (if channels
 181         (setq identity (car channels))
 182       (if riece-debug
 183           (message "%S is not a member of riece-current-channels" identity)))
 184     (format riece-channel-buffer-format (riece-format-identity identity))))
 185
 186 (eval-when-compile
 187   (autoload 'riece-channel-mode "riece"))
 188 (defun riece-channel-buffer-create (identity)
 189   (with-current-buffer
 190       (riece-get-buffer-create (riece-channel-buffer-name identity)
 191                                'riece-channel-mode)
 192     (setq riece-channel-buffer-alist
 193           (cons (cons identity (current-buffer))
 194                 riece-channel-buffer-alist))
 195     (unless (eq major-mode 'riece-channel-mode)
 196       (riece-channel-mode)
 197       (let (buffer-read-only)
 198         (riece-insert-info (current-buffer)
 199                            (concat "Created on "
 200                                    (funcall riece-format-time-function
 201                                             (current-time))
 202                                    "\n"))
 203         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 204     (current-buffer)))
 205
 206 (defun riece-channel-buffer (identity)
 207   (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
 208
 209 (defun riece-switch-to-channel (identity)
 210   (let ((last riece-current-channel))
 211     (setq riece-current-channel identity
 212           riece-channel-buffer (riece-channel-buffer riece-current-channel))
 213     (run-hook-with-args 'riece-after-switch-to-channel-functions last)))
 214
 215 (defun riece-join-channel (identity)
 216   (unless (riece-identity-member identity riece-current-channels)
 217     (setq riece-current-channels
 218           (riece-identity-assign-binding
 219            identity riece-current-channels
 220            (mapcar
 221             (lambda (channel)
 222               (if channel
 223                   (riece-parse-identity channel)))
 224             riece-default-channel-binding)))
 225     (riece-channel-buffer-create identity)))
 226
 227 (defun riece-switch-to-nearest-channel (pointer)
 228   (let ((start riece-current-channels)
 229         identity)
 230     (while (and start (not (eq start pointer)))
 231       (if (car start)
 232           (setq identity (car start)))
 233       (setq start (cdr start)))
 234     (unless identity
 235       (while (and pointer
 236                   (null (car pointer)))
 237         (setq pointer (cdr pointer)))
 238       (setq identity (car pointer)))
 239     (if identity
 240         (riece-switch-to-channel identity)
 241       (let ((last riece-current-channel))
 242         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 243         (setq riece-current-channel nil)))))
 244
 245 (defun riece-part-channel (identity)
 246   (let ((pointer (riece-identity-member identity riece-current-channels)))
 247     (if pointer
 248         (setcar pointer nil))
 249     (if (riece-identity-equal identity riece-current-channel)
 250         (riece-switch-to-nearest-channel pointer))))
 251
 252 (defun riece-redisplay-buffers (&optional force)
 253   (riece-update-buffers)
 254   (riece-redraw-layout force)
 255   (run-hooks 'riece-redisplay-buffers-hook))
 256
 257 (provide 'riece-display)
 258
 259 ;;; riece-display.el ends here