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       (let ((string (riece-format-identity identity))
 288             (start 0))
 289         ;; Escape % -> %%.
 290         (while (string-match "%" string start)
 291           (setq start (1+ (match-end 0))
 292                 string (replace-match "%%" nil nil string)))
 293         (format "%d:%s" index string))))
 294
 295 (defun riece-update-channel-list-indicator ()
 296   (if (and riece-current-channels
 297            ;; There is at least one channel.
 298            (delq nil (copy-sequence riece-current-channels)))
 299       (let ((index 1)
 300             pointer)
 301         (setq riece-channel-list-indicator
 302               (delq
 303                nil
 304                (mapcar
 305                 (lambda (channel)
 306                   (prog1
 307                       (if channel
 308                           (riece-format-identity-for-channel-list-indicator
 309                            index channel))
 310                     (setq index (1+ index))))
 311                 riece-current-channels))
 312               pointer riece-channel-list-indicator)
 313         (while pointer
 314           (if (cdr pointer)
 315               (setcdr pointer (cons "," (cdr pointer))))
 316           (setq pointer (cdr (cdr pointer)))))
 317     (setq riece-channel-list-indicator "No channel")))
 318
 319 (defun riece-update-status-indicators ()
 320   (if riece-current-channel
 321       (with-current-buffer riece-command-buffer
 322         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 323           (setq riece-away-indicator
 324                 (if (and riece-real-nickname
 325                          (riece-user-get-away riece-real-nickname))
 326                     "A"
 327                   "-")
 328                 riece-operator-indicator
 329                 (if (and riece-real-nickname
 330                          (riece-user-get-operator riece-real-nickname))
 331                     "O"
 332                   "-")
 333                 riece-user-indicator riece-real-nickname))))
 334   (setq riece-freeze-indicator
 335         (with-current-buffer (if (and riece-channel-buffer-mode
 336                                       riece-channel-buffer)
 337                                  riece-channel-buffer
 338                                riece-dialogue-buffer)
 339           (if (eq riece-freeze 'own)
 340               "f"
 341             (if riece-freeze
 342                 "F"
 343               "-")))))
 344
 345 (defun riece-update-buffers (&optional buffers)
 346   (unless buffers
 347     (setq buffers riece-buffer-list))
 348   (while buffers
 349     (save-excursion
 350       (set-buffer (car buffers))
 351       (run-hooks 'riece-update-buffer-functions))
 352     (setq buffers (cdr buffers)))
 353   (run-hooks 'riece-update-indicator-functions)
 354   (force-mode-line-update t)
 355   (run-hooks 'riece-update-buffer-hook))
 356
 357 (defun riece-channel-buffer-name (identity)
 358   (let ((channels (riece-identity-member identity riece-current-channels)))
 359     (if channels
 360         (setq identity (car channels))
 361       (if riece-debug
 362           (message "%S is not a member of riece-current-channels" identity)))
 363     (format riece-channel-buffer-format (riece-format-identity identity))))
 364
 365 (eval-when-compile
 366   (autoload 'riece-channel-mode "riece"))
 367 (defun riece-channel-buffer-create (identity)
 368   (with-current-buffer
 369       (riece-get-buffer-create (riece-channel-buffer-name identity)
 370                                'riece-channel-mode)
 371     (setq riece-channel-buffer-alist
 372           (cons (cons identity (current-buffer))
 373                 riece-channel-buffer-alist))
 374     (unless (eq major-mode 'riece-channel-mode)
 375       (riece-channel-mode)
 376       (let (buffer-read-only)
 377         (riece-insert-info (current-buffer)
 378                            (concat "Created on "
 379                                    (funcall riece-format-time-function
 380                                             (current-time))
 381                                    "\n"))
 382         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 383     (current-buffer)))
 384
 385 (defun riece-channel-buffer (identity)
 386   (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
 387
 388 (defun riece-switch-to-channel (identity)
 389   (let ((last riece-current-channel))
 390     (setq riece-current-channel identity
 391           riece-channel-buffer (riece-channel-buffer riece-current-channel))
 392     (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 393     (riece-emit-signal 'riece-switch-to-channel)))
 394
 395 (defun riece-join-channel (identity)
 396   (unless (riece-identity-member identity riece-current-channels)
 397     (setq riece-current-channels
 398           (riece-identity-assign-binding
 399            identity riece-current-channels
 400            (mapcar
 401             (lambda (channel)
 402               (if channel
 403                   (riece-parse-identity channel)))
 404             riece-default-channel-binding)))
 405     (riece-channel-buffer-create identity)))
 406
 407 (defun riece-switch-to-nearest-channel (pointer)
 408   (let ((start riece-current-channels)
 409         identity)
 410     (while (and start (not (eq start pointer)))
 411       (if (car start)
 412           (setq identity (car start)))
 413       (setq start (cdr start)))
 414     (unless identity
 415       (while (and pointer
 416                   (null (car pointer)))
 417         (setq pointer (cdr pointer)))
 418       (setq identity (car pointer)))
 419     (if identity
 420         (riece-switch-to-channel identity)
 421       (let ((last riece-current-channel))
 422         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 423         (setq riece-current-channel nil)
 424         (riece-emit-signal 'riece-switch-to-channel)))))
 425
 426 (defun riece-part-channel (identity)
 427   (let ((pointer (riece-identity-member identity riece-current-channels)))
 428     (if pointer
 429         (setcar pointer nil))
 430     (if (riece-identity-equal identity riece-current-channel)
 431         (riece-switch-to-nearest-channel pointer))))
 432
 433 (defun riece-redisplay-buffers (&optional force)
 434   (riece-update-buffers)
 435   (riece-redraw-layout force)
 436   (run-hooks 'riece-redisplay-buffers-hook))
 437
 438 (provide 'riece-display)
 439
 440 ;;; riece-display.el ends here