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 (require 'riece-signal)
  32
  33 (defvar riece-channel-buffer-format "*Channel:%s*"
  34   "Format of channel message buffer.")
  35 (defvar riece-channel-buffer-alist nil
  36   "An alist mapping identities to channel buffers.")
  37
  38 (defvar riece-update-buffer-functions nil
  39   "Functions to redisplay the buffer.
  40 Local to the buffer in `riece-buffer-list'.")
  41
  42 (defvar riece-update-indicator-functions
  43   '(riece-update-status-indicators
  44     riece-update-channel-indicator
  45     riece-update-long-channel-indicator
  46     riece-update-channel-list-indicator)
  47   "Functions to update modeline indicators.")
  48
  49 (defun riece-display-connect-signals ()
  50   (riece-connect-signal
  51    'riece-update-buffer
  52    (lambda (signal handback)
  53      (save-excursion
  54        (set-buffer (car (riece-signal-args signal)))
  55        (run-hooks 'riece-update-buffer-functions))))
  56   (riece-connect-signal
  57    'riece-switch-to-channel
  58    (lambda (signal handback)
  59      (riece-update-status-indicators)
  60      (riece-update-channel-indicator)
  61      (riece-update-long-channel-indicator)
  62      (riece-update-channel-list-indicator)
  63      (force-mode-line-update t)
  64      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer)
  65      (riece-emit-signal 'riece-update-buffer riece-channel-list-buffer)
  66      (save-excursion
  67        (riece-redraw-layout))))
  68   (riece-connect-signal
  69    'riece-naming-assert-channel-users
  70    (lambda (signal handback)
  71      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer)))
  72   (riece-connect-signal
  73    'riece-naming-assert-join
  74    (lambda (signal handback)
  75      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
  76    (lambda (signal)
  77      (and riece-current-channel
  78           (riece-identity-equal (nth 1 (riece-signal-args signal))
  79                                 riece-current-channel)
  80           (not (riece-identity-equal (car (riece-signal-args signal))
  81                                      (riece-current-nickname))))))
  82   (riece-connect-signal
  83    'riece-naming-assert-join
  84    (lambda (signal handback)
  85      (riece-join-channel (nth 1 (riece-signal-args signal)))
  86      (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
  87      (setq riece-join-channel-candidate nil))
  88    (lambda (signal)
  89      (riece-identity-equal (car (riece-signal-args signal))
  90                            (riece-current-nickname))))
  91   (riece-connect-signal
  92    'riece-naming-assert-part
  93    (lambda (signal handback)
  94      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
  95    (lambda (signal)
  96      (and riece-current-channel
  97           (riece-identity-equal (nth 1 (riece-signal-args signal))
  98                                 riece-current-channel)
  99           (not (riece-identity-equal (car (riece-signal-args signal))
 100                                      (riece-current-nickname))))))
 101   (riece-connect-signal
 102    'riece-naming-assert-part
 103    (lambda (signal handback)
 104      (riece-part-channel (nth 1 (riece-signal-args signal))))
 105    (lambda (signal)
 106      (riece-identity-equal (car (riece-signal-args signal))
 107                            (riece-current-nickname))))
 108   (riece-connect-signal
 109    'riece-naming-assert-rename
 110    (lambda (signal handback)
 111      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
 112    (lambda (signal)
 113      (and riece-current-channel
 114           (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
 115                  (riece-identity-server riece-current-channel))
 116           (riece-with-server-buffer (riece-identity-server
 117                                      riece-current-channel)
 118             (riece-identity-assoc
 119              (riece-identity-prefix (nth 1 (riece-signal-args signal)))
 120              (riece-channel-get-users (riece-identity-prefix
 121                                        riece-current-channel))
 122              t)))))
 123   (riece-connect-signal
 124    'riece-naming-assert-rename
 125    (lambda (signal handback)
 126      (riece-update-status-indicators)
 127      (riece-update-channel-indicator)
 128      (force-mode-line-update t))
 129    (lambda (signal)
 130      (riece-identity-equal (nth 1 (riece-signal-args signal))
 131                            (riece-current-nickname))))
 132   (riece-connect-signal
 133    'riece-naming-assert-rename
 134    (lambda (signal handback)
 135      (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
 136    (lambda (signal)
 137      (and riece-current-channel
 138           (riece-identity-equal (car (riece-signal-args signal))
 139                                 riece-current-channel))))
 140   (riece-connect-signal
 141    'riece-naming-assert-rename
 142    (lambda (signal handback)
 143      (let* ((old-identity (car (riece-signal-args signal)))
 144             (new-identity (nth 1 (riece-signal-args signal)))
 145             (pointer (riece-identity-member old-identity
 146                                             riece-current-channels)))
 147        ;; Rename the channel buffer.
 148        (when pointer
 149          (setcar pointer new-identity)
 150          (with-current-buffer (riece-channel-buffer old-identity)
 151            (rename-buffer (riece-channel-buffer-name new-identity) t)
 152            (setq riece-channel-buffer-alist
 153                  (cons (cons new-identity (current-buffer))
 154                        (delq (riece-identity-assoc old-identity
 155                                                    riece-channel-buffer-alist)
 156                              riece-channel-buffer-alist))))))))
 157   (riece-connect-signal
 158    'riece-user-toggle-away
 159    (lambda (signal handback)
 160      (riece-update-status-indicators)
 161      (force-mode-line-update t))
 162    (lambda (signal)
 163      (riece-identity-equal (car (riece-signal-args signal))
 164                            (riece-current-nickname))))
 165   (riece-connect-signal
 166    'riece-user-toggle-operator
 167    (lambda (signal handback)
 168      (riece-update-status-indicators)
 169      (force-mode-line-update t))
 170    (lambda (signal)
 171      (riece-identity-equal (car (riece-signal-args signal))
 172                            (riece-current-nickname))))
 173   (riece-connect-signal
 174    'riece-channel-set-topic
 175    (lambda (signal handback)
 176      (riece-update-long-channel-indicator)
 177      (force-mode-line-update t))
 178    (lambda (signal)
 179      (and riece-current-channel
 180           (riece-identity-equal (car (riece-signal-args signal))
 181                                 riece-current-channel))))
 182   (riece-connect-signal
 183    'riece-channel-set-modes
 184    (lambda (signal handback)
 185      (riece-update-status-indicators)
 186      (force-mode-line-update t))
 187    (lambda (signal)
 188      (and riece-current-channel
 189           (riece-identity-equal (car (riece-signal-args signal))
 190                                 riece-current-channel))))
 191   (riece-connect-signal
 192    'riece-channel-toggle-operator
 193    (lambda (signal handback)
 194      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
 195    (lambda (signal)
 196      (and riece-current-channel
 197           (riece-identity-equal (car (riece-signal-args signal))
 198                                 riece-current-channel))))
 199   (riece-connect-signal
 200    'riece-channel-toggle-speaker
 201    (lambda (signal handback)
 202      (riece-emit-signal 'riece-update-buffer riece-user-list-buffer))
 203    (lambda (signal)
 204      (and riece-current-channel
 205           (riece-identity-equal (car (riece-signal-args signal))
 206                                 riece-current-channel))))
 207   (riece-connect-signal
 208    'riece-buffer-toggle-freeze
 209    (lambda (signal handback)
 210      (riece-update-status-indicators)
 211      (force-mode-line-update t))))
 212
 213 (defun riece-update-user-list-buffer ()
 214   (save-excursion
 215     (if (and riece-current-channel
 216              (riece-channel-p (riece-identity-prefix riece-current-channel)))
 217         (let* ((users
 218                 (riece-with-server-buffer (riece-identity-server
 219                                            riece-current-channel)
 220                   (riece-channel-get-users (riece-identity-prefix
 221                                             riece-current-channel))))
 222                (inhibit-read-only t)
 223                buffer-read-only)
 224           (erase-buffer)
 225           (riece-kill-all-overlays)
 226           (while users
 227             (insert (if (memq ?o (cdr (car users)))
 228                         "@"
 229                       (if (memq ?v (cdr (car users)))
 230                           "+"
 231                         " "))
 232                     (riece-format-identity
 233                      (riece-make-identity (car (car users))
 234                                           (riece-identity-server
 235                                            riece-current-channel))
 236                      t)
 237                     "\n")
 238             (setq users (cdr users)))))))
 239
 240 (defun riece-format-identity-for-channel-list-buffer (index identity)
 241   (or (run-hook-with-args-until-success
 242        'riece-format-identity-for-channel-list-buffer-functions index identity)
 243       (concat (format "%2d:%c" index
 244                       (if (riece-identity-equal identity riece-current-channel)
 245                           ?*
 246                         ? ))
 247               (riece-format-identity identity))))
 248
 249 (defun riece-update-channel-list-buffer ()
 250   (save-excursion
 251     (let ((inhibit-read-only t)
 252           buffer-read-only
 253           (index 1)
 254           (channels riece-current-channels))
 255       (erase-buffer)
 256       (riece-kill-all-overlays)
 257       (while channels
 258         (if (car channels)
 259             (insert (riece-format-identity-for-channel-list-buffer
 260                      index (car channels))
 261                     "\n"))
 262         (setq index (1+ index)
 263               channels (cdr channels))))))
 264
 265 (defun riece-update-channel-indicator ()
 266   (setq riece-channel-indicator
 267         (if riece-current-channel
 268             (riece-format-identity riece-current-channel)
 269           "None")))
 270
 271 (defun riece-update-long-channel-indicator ()
 272   (setq riece-long-channel-indicator
 273         (if riece-current-channel
 274             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
 275                 (riece-concat-channel-modes
 276                  riece-current-channel
 277                  (riece-concat-channel-topic
 278                   riece-current-channel
 279                   (riece-format-identity riece-current-channel)))
 280               (riece-format-identity riece-current-channel))
 281           "None")))
 282
 283 (defun riece-format-identity-for-channel-list-indicator (index identity)
 284   (or (run-hook-with-args-until-success
 285        'riece-format-identity-for-channel-list-indicator-functions
 286        index identity)
 287       (format "%d:%s" index (riece-format-identity identity))))
 288
 289 (defun riece-update-channel-list-indicator ()
 290   (if (and riece-current-channels
 291            ;; There is at least one channel.
 292            (delq nil (copy-sequence riece-current-channels)))
 293       (let ((index 1))
 294         (setq riece-channel-list-indicator
 295               (mapconcat
 296                #'identity
 297                (delq
 298                 nil
 299                 (mapcar
 300                  (lambda (channel)
 301                    (prog1
 302                        (if channel
 303                            (riece-format-identity-for-channel-list-indicator
 304                             index channel))
 305                      (setq index (1+ index))))
 306                  riece-current-channels))
 307                ",")))
 308     (setq riece-channel-list-indicator "No channel")))
 309
 310 (defun riece-update-status-indicators ()
 311   (if riece-current-channel
 312       (with-current-buffer riece-command-buffer
 313         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 314           (setq riece-away-indicator
 315                 (if (and riece-real-nickname
 316                          (riece-user-get-away riece-real-nickname))
 317                     "A"
 318                   "-")
 319                 riece-operator-indicator
 320                 (if (and riece-real-nickname
 321                          (riece-user-get-operator riece-real-nickname))
 322                     "O"
 323                   "-")
 324                 riece-user-indicator riece-real-nickname))))
 325   (setq riece-freeze-indicator
 326         (with-current-buffer (if (and riece-channel-buffer-mode
 327                                       riece-channel-buffer)
 328                                  riece-channel-buffer
 329                                riece-dialogue-buffer)
 330           (if (eq riece-freeze 'own)
 331               "f"
 332             (if riece-freeze
 333                 "F"
 334               "-")))))
 335
 336 (defun riece-update-buffers (&optional buffers)
 337   (unless buffers
 338     (setq buffers riece-buffer-list))
 339   (while buffers
 340     (save-excursion
 341       (set-buffer (car buffers))
 342       (run-hooks 'riece-update-buffer-functions))
 343     (setq buffers (cdr buffers)))
 344   (run-hooks 'riece-update-indicator-functions)
 345   (force-mode-line-update t)
 346   (run-hooks 'riece-update-buffer-hook))
 347
 348 (defun riece-channel-buffer-name (identity)
 349   (let ((channels (riece-identity-member identity riece-current-channels)))
 350     (if channels
 351         (setq identity (car channels))
 352       (if riece-debug
 353           (message "%S is not a member of riece-current-channels" identity)))
 354     (format riece-channel-buffer-format (riece-format-identity identity))))
 355
 356 (eval-when-compile
 357   (autoload 'riece-channel-mode "riece"))
 358 (defun riece-channel-buffer-create (identity)
 359   (with-current-buffer
 360       (riece-get-buffer-create (riece-channel-buffer-name identity)
 361                                'riece-channel-mode)
 362     (setq riece-channel-buffer-alist
 363           (cons (cons identity (current-buffer))
 364                 riece-channel-buffer-alist))
 365     (unless (eq major-mode 'riece-channel-mode)
 366       (riece-channel-mode)
 367       (let (buffer-read-only)
 368         (riece-insert-info (current-buffer)
 369                            (concat "Created on "
 370                                    (funcall riece-format-time-function
 371                                             (current-time))
 372                                    "\n"))
 373         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 374     (current-buffer)))
 375
 376 (defun riece-channel-buffer (identity)
 377   (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
 378
 379 (defun riece-switch-to-channel (identity)
 380   (let ((last riece-current-channel))
 381     (setq riece-current-channel identity
 382           riece-channel-buffer (riece-channel-buffer riece-current-channel))
 383     (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 384     (riece-emit-signal 'riece-switch-to-channel)))
 385
 386 (defun riece-join-channel (identity)
 387   (unless (riece-identity-member identity riece-current-channels)
 388     (setq riece-current-channels
 389           (riece-identity-assign-binding
 390            identity riece-current-channels
 391            (mapcar
 392             (lambda (channel)
 393               (if channel
 394                   (riece-parse-identity channel)))
 395             riece-default-channel-binding)))
 396     (riece-channel-buffer-create identity)))
 397
 398 (defun riece-switch-to-nearest-channel (pointer)
 399   (let ((start riece-current-channels)
 400         identity)
 401     (while (and start (not (eq start pointer)))
 402       (if (car start)
 403           (setq identity (car start)))
 404       (setq start (cdr start)))
 405     (unless identity
 406       (while (and pointer
 407                   (null (car pointer)))
 408         (setq pointer (cdr pointer)))
 409       (setq identity (car pointer)))
 410     (if identity
 411         (riece-switch-to-channel identity)
 412       (let ((last riece-current-channel))
 413         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 414         (setq riece-current-channel nil)
 415         (riece-emit-signal 'riece-switch-to-channel)))))
 416
 417 (defun riece-part-channel (identity)
 418   (let ((pointer (riece-identity-member identity riece-current-channels)))
 419     (if pointer
 420         (setcar pointer nil))
 421     (if (riece-identity-equal identity riece-current-channel)
 422         (riece-switch-to-nearest-channel pointer))))
 423
 424 (defun riece-redisplay-buffers (&optional force)
 425   (riece-update-buffers)
 426   (riece-redraw-layout force)
 427   (run-hooks 'riece-redisplay-buffers-hook))
 428
 429 (provide 'riece-display)
 430
 431 ;;; riece-display.el ends here