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