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