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