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