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
 330               (riece-normalize-modeline-string riece-channel-list-indicator)))
 331     (setq riece-channel-list-indicator "No channel")))
 332
 333 (defun riece-update-status-indicators ()
 334   (let ((server-name (riece-current-server-name)))
 335     (if server-name
 336         (with-current-buffer riece-command-buffer
 337           (riece-with-server-buffer server-name
 338             (setq riece-away-indicator
 339                   (if (and riece-real-nickname
 340                            (riece-user-get-away riece-real-nickname))
 341                       "A"
 342                     "-")
 343                   riece-operator-indicator
 344                   (if (and riece-real-nickname
 345                            (riece-user-get-operator riece-real-nickname))
 346                       "O"
 347                     "-")
 348                   riece-user-indicator
 349                   (riece-format-identity
 350                    (riece-make-identity riece-real-nickname riece-server-name)
 351                    t))))))
 352   (walk-windows
 353    (lambda (window)
 354      (with-current-buffer (window-buffer window)
 355        (if (eq (derived-mode-class major-mode)
 356                'riece-dialogue-mode)
 357            (setq riece-freeze-indicator
 358                  (if (eq riece-freeze 'own)
 359                      "f"
 360                    (if riece-freeze
 361                        "F"
 362                      "-"))))))))
 363
 364 (defun riece-update-channel-status-indicator ()
 365   (if (and riece-current-channel
 366            (riece-channel-p (riece-identity-prefix riece-current-channel)))
 367       (let ((users
 368              (riece-with-server-buffer (riece-identity-server
 369                                         riece-current-channel)
 370                (riece-channel-get-users (riece-identity-prefix
 371                                          riece-current-channel))))
 372             (nickname
 373              (riece-with-server-buffer (riece-identity-server
 374                                         riece-current-channel)
 375                riece-real-nickname)))
 376         (with-current-buffer riece-command-buffer
 377           (setq riece-channel-status-indicator
 378                 (if nickname
 379                     (let ((user (cdr (riece-identity-assoc nickname users t))))
 380                       (if (memq ?o user)
 381                           "@"
 382                         (if (memq ?v user)
 383                             "+"
 384                           "-")))
 385                   "-"))))))
 386
 387 (defun riece-update-buffers (&optional buffers)
 388   (unless buffers
 389     (setq buffers riece-buffer-list))
 390   (while buffers
 391     (if (buffer-live-p (car buffers))
 392         (save-excursion
 393           (set-buffer (car buffers))
 394           (run-hooks 'riece-update-buffer-functions)))
 395     (setq buffers (cdr buffers)))
 396   (run-hooks 'riece-update-indicator-functions)
 397   (force-mode-line-update t)
 398   (run-hooks 'riece-update-buffer-hook))
 399
 400 (defun riece-channel-buffer-name (identity)
 401   (let ((channels (riece-identity-member identity riece-current-channels)))
 402     (if channels
 403         (setq identity (car channels))
 404       (if riece-debug
 405           (message "%S is not a member of riece-current-channels" identity)))
 406     (format riece-channel-buffer-format (riece-format-identity identity))))
 407
 408 (eval-when-compile
 409   (autoload 'riece-channel-mode "riece"))
 410 (defun riece-channel-buffer-create (identity)
 411   (with-current-buffer
 412       (riece-get-buffer-create (riece-channel-buffer-name identity)
 413                                'riece-channel-mode)
 414     (setq riece-channel-buffer-alist
 415           (cons (cons identity (current-buffer))
 416                 riece-channel-buffer-alist))
 417     (unless (eq major-mode 'riece-channel-mode)
 418       (riece-channel-mode)
 419       (let (buffer-read-only)
 420         (riece-insert-info (current-buffer)
 421                            (concat "Created on "
 422                                    (funcall riece-format-time-function
 423                                             (current-time))
 424                                    "\n"))
 425         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 426     (current-buffer)))
 427
 428 (defun riece-channel-buffer (identity)
 429   (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
 430
 431 (defun riece-switch-to-channel (identity)
 432   (let ((last riece-current-channel)
 433         window)
 434     (if (and riece-channel-buffer
 435              (setq window (get-buffer-window riece-channel-buffer)))
 436         (with-current-buffer riece-channel-buffer
 437           (setq riece-channel-buffer-window-point (window-point window))))
 438     (setq riece-current-channel identity
 439           riece-channel-buffer (riece-channel-buffer riece-current-channel))
 440     (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 441     (riece-emit-signal 'channel-switched)))
 442
 443 (defun riece-join-channel (identity)
 444   (unless (riece-identity-member identity riece-current-channels)
 445     (setq riece-current-channels
 446           (riece-identity-assign-binding
 447            identity riece-current-channels
 448            (mapcar
 449             (lambda (channel)
 450               (if channel
 451                   (riece-parse-identity channel)))
 452             riece-default-channel-binding)))
 453     (riece-channel-buffer-create identity)))
 454
 455 (defun riece-switch-to-nearest-channel (pointer)
 456   (let ((start riece-current-channels)
 457         identity)
 458     (while (and start (not (eq start pointer)))
 459       (if (car start)
 460           (setq identity (car start)))
 461       (setq start (cdr start)))
 462     (unless identity
 463       (while (and pointer
 464                   (null (car pointer)))
 465         (setq pointer (cdr pointer)))
 466       (setq identity (car pointer)))
 467     (if identity
 468         (riece-switch-to-channel identity)
 469       (let ((last riece-current-channel))
 470         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 471         (setq riece-current-channel nil)
 472         (riece-emit-signal 'channel-switched)))))
 473
 474 (defun riece-part-channel (identity)
 475   (let ((pointer (riece-identity-member identity riece-current-channels)))
 476     (if pointer
 477         (setcar pointer nil))
 478     (if (riece-identity-equal identity riece-current-channel)
 479         (riece-switch-to-nearest-channel pointer))
 480     (funcall riece-buffer-dispose-function (riece-channel-buffer identity))))
 481
 482 (defun riece-redisplay-buffers (&optional force)
 483   (riece-update-buffers)
 484   (riece-redraw-layout force)
 485   (run-hooks 'riece-redisplay-buffers-hook))
 486
 487 (provide 'riece-display)
 488
 489 ;;; riece-display.el ends here