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