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