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
  31 (defcustom riece-configure-windows-function #'riece-configure-windows
  32   "Function to configure windows."
  33   :type 'function
  34   :group 'riece-looks)
  35
  36 (defcustom riece-configure-windows-predicate
  37   #'riece-configure-windows-predicate
  38   "Function to check whether window reconfiguration is needed."
  39   :type 'function
  40   :group 'riece-looks)
  41
  42 (defvar riece-update-buffer-functions
  43   '(riece-update-user-list-buffer
  44     riece-update-channel-list-buffer
  45     riece-update-status-indicators
  46     riece-update-channel-indicator
  47     riece-update-short-channel-indicator
  48     riece-update-channel-list-indicator))
  49
  50 (defvar riece-redisplay-buffer nil
  51   "Non-nil means the buffer needs to be updated.
  52 Local to the buffers.")
  53
  54 (defun riece-configure-windows ()
  55   (let ((buffer (window-buffer))
  56         (show-user-list
  57          (and riece-user-list-buffer-mode
  58               riece-current-channel
  59               ;; User list buffer is nuisance for private conversation.
  60               (riece-channel-p (riece-identity-prefix
  61                                 riece-current-channel)))))
  62     ;; Can't expand minibuffer to full frame.
  63     (if (eq (selected-window) (minibuffer-window))
  64         (other-window 1))
  65     (delete-other-windows)
  66     (if (and riece-current-channel
  67              (or show-user-list riece-channel-list-buffer-mode))
  68         (let ((rest-window (split-window (selected-window)
  69                                          (/ (window-width) 5) t)))
  70           (if (and show-user-list riece-channel-list-buffer-mode)
  71               (progn
  72                 (set-window-buffer (split-window)
  73                                    riece-channel-list-buffer)
  74                 (set-window-buffer (selected-window)
  75                                    riece-user-list-buffer))
  76             (if show-user-list
  77                 (set-window-buffer (selected-window)
  78                                    riece-user-list-buffer)
  79               (if riece-channel-list-buffer-mode
  80                   (set-window-buffer (selected-window)
  81                                      riece-channel-list-buffer))))
  82           (select-window rest-window)))
  83     (if (and riece-current-channel
  84              riece-channel-buffer-mode)
  85         (let ((rest-window (split-window)))
  86           (set-window-buffer (selected-window)
  87                              riece-channel-buffer)
  88           (set-window-buffer (split-window rest-window 4)
  89                              riece-others-buffer)
  90           (with-current-buffer riece-channel-buffer
  91             (setq truncate-partial-width-windows nil))
  92           (with-current-buffer riece-others-buffer
  93             (setq truncate-partial-width-windows nil))
  94           (set-window-buffer rest-window
  95                              riece-command-buffer))
  96       (set-window-buffer (split-window (selected-window) 4)
  97                          riece-dialogue-buffer)
  98       (set-window-buffer (selected-window)
  99                          riece-command-buffer))
 100     (riece-set-window-points)
 101     (select-window (or (get-buffer-window buffer)
 102                        (get-buffer-window riece-command-buffer)))))
 103
 104 (defun riece-configure-windows-top (&optional plist)
 105   "Candidate of `riece-configure-windows-function'.
 106 PLIST accept :command-height, :nick-width, and :channel-list-width."
 107   (let ((command-height (or (plist-get plist :command-height) 5))
 108         (nick-width (or (plist-get plist :nick-width) 13))
 109         (channel-list-width (or (plist-get plist :channel-list-width) 25))
 110         (buffer (window-buffer))
 111         (show-user-list
 112          (and riece-user-list-buffer-mode
 113               riece-current-channel
 114               ;; User list buffer is nuisance for private conversation.
 115               (riece-channel-p (riece-identity-prefix
 116                                 riece-current-channel)))))
 117     ;; Can't expand minibuffer to full frame.
 118     (when (eq (selected-window) (minibuffer-window))
 119       (other-window 1))
 120     (delete-other-windows)
 121     ;; top of frame
 122     (let ((rest-window (split-window (selected-window) command-height)))
 123       (set-window-buffer (selected-window)
 124                          riece-command-buffer)
 125       (select-window rest-window))
 126     ;; middle of frame (vertical-spilit when need)
 127     (when (or (and riece-current-channel riece-channel-buffer-mode)
 128               show-user-list)
 129       (let ((rest-window
 130              (split-window (selected-window)
 131                            (/ (* 5 (+ (window-height) command-height)) 8))))
 132         (cond
 133          ;; channel-buffer + user-list
 134          ((and show-user-list
 135                (and riece-current-channel riece-channel-buffer-mode))
 136           (set-window-buffer
 137            (split-window (selected-window) (- (window-width) nick-width) t)
 138            riece-user-list-buffer)
 139           (set-window-buffer (selected-window) riece-channel-buffer))
 140          ;; only user-list
 141          (show-user-list
 142           (set-window-buffer (selected-window) riece-user-list-buffer))
 143          ;; only channel-buffer
 144          (riece-channel-buffer-mode
 145           (set-window-buffer (selected-window) riece-channel-buffer)))
 146         (select-window rest-window)))
 147     ;; bottom of frame
 148     (if (and riece-current-channel
 149              riece-channel-list-buffer-mode)
 150         (progn
 151           (set-window-buffer
 152            (split-window (selected-window)
 153                          (- (window-width) channel-list-width) t)
 154            riece-channel-list-buffer)
 155           (set-window-buffer (selected-window) riece-others-buffer)
 156           (with-current-buffer riece-channel-buffer
 157             (setq truncate-partial-width-windows nil))
 158           (with-current-buffer riece-others-buffer
 159             (setq truncate-partial-width-windows nil)))
 160       (set-window-buffer (selected-window) riece-dialogue-buffer))
 161     (riece-set-window-points)
 162     (select-window (or (get-buffer-window buffer)
 163                        (get-buffer-window riece-command-buffer)))))
 164
 165 (defun riece-set-window-points ()
 166   (if (get-buffer-window riece-user-list-buffer)
 167       (with-current-buffer riece-user-list-buffer
 168         (unless (riece-frozen riece-user-list-buffer)
 169           (set-window-start (get-buffer-window riece-user-list-buffer)
 170                             (point-min)))))
 171   (if (get-buffer-window riece-channel-list-buffer)
 172       (with-current-buffer riece-channel-list-buffer
 173         (unless (riece-frozen riece-channel-list-buffer)
 174           (set-window-start (get-buffer-window riece-channel-list-buffer)
 175                             (point-min))))))
 176
 177 (defun riece-update-user-list-buffer ()
 178   (save-excursion
 179     (set-buffer riece-user-list-buffer)
 180     (when (and riece-redisplay-buffer
 181                riece-current-channel
 182                (riece-channel-p (riece-identity-prefix riece-current-channel)))
 183       (let (users operators speakers)
 184         (with-current-buffer (process-buffer (riece-server-process
 185                                               (riece-identity-server
 186                                                riece-current-channel)))
 187           (setq users
 188                 (riece-channel-get-users
 189                  (riece-identity-prefix riece-current-channel))
 190                 operators
 191                 (riece-channel-get-operators
 192                  (riece-identity-prefix riece-current-channel))
 193                 speakers
 194                 (riece-channel-get-speakers
 195                  (riece-identity-prefix riece-current-channel))))
 196         (let ((inhibit-read-only t)
 197               buffer-read-only)
 198           (erase-buffer)
 199           (while users
 200             (if (member (car users) operators)
 201                 (insert "@" (car users) "\n")
 202               (if (member (car users) speakers)
 203                   (insert "+" (car users) "\n")
 204                 (insert " " (car users) "\n")))
 205             (setq users (cdr users)))))
 206       (setq riece-redisplay-buffer nil))))
 207
 208 (defun riece-update-channel-list-buffer ()
 209   (save-excursion
 210     (set-buffer riece-channel-list-buffer)
 211     (when riece-redisplay-buffer
 212       (let ((inhibit-read-only t)
 213             buffer-read-only
 214             (index 1)
 215             (channels riece-current-channels))
 216         (erase-buffer)
 217         (while channels
 218           (if (car channels)
 219               (let ((point (point)))
 220                 (insert (format "%2d: %s\n" index
 221                                 (riece-format-identity (car channels))))
 222                 (put-text-property point (point) 'riece-identity
 223                                    (car channels))))
 224           (setq index (1+ index)
 225                 channels (cdr channels))))
 226       (setq riece-redisplay-buffer nil))))
 227
 228 (defun riece-update-channel-indicator ()
 229   (setq riece-channel-indicator
 230         (if riece-current-channel
 231             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
 232                 (riece-concat-channel-modes
 233                  riece-current-channel
 234                  (riece-concat-channel-topic
 235                   riece-current-channel
 236                   (riece-format-identity riece-current-channel)))
 237               (riece-format-identity riece-current-channel))
 238           "None")))
 239
 240 (defun riece-update-short-channel-indicator ()
 241   (setq riece-short-channel-indicator
 242         (if riece-current-channel
 243             (riece-format-identity riece-current-channel)
 244           "None")))
 245
 246 (defun riece-update-channel-list-indicator ()
 247   (if (and riece-current-channels
 248            ;; There is at least one channel.
 249            (delq nil (copy-sequence riece-current-channels)))
 250       (let ((index 1))
 251         (setq riece-channel-list-indicator
 252               (mapconcat
 253                #'identity
 254                (delq nil
 255                      (mapcar
 256                       (lambda (channel)
 257                         (prog1 (if channel
 258                                    (format "%d:%s" index
 259                                            (riece-format-identity channel)))
 260                           (setq index (1+ index))))
 261                       riece-current-channels))
 262                ",")))
 263     (setq riece-channel-list-indicator "No channel")))
 264
 265 (defun riece-update-status-indicators ()
 266   (if riece-current-channel
 267       (with-current-buffer riece-command-buffer
 268         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 269           (setq riece-away-indicator
 270                 (if (and riece-real-nickname
 271                          (riece-user-get-away riece-real-nickname))
 272                     "A"
 273                   "-")
 274                 riece-operator-indicator
 275                 (if (and riece-real-nickname
 276                          (riece-user-get-operator riece-real-nickname))
 277                     "O"
 278                   "-")
 279                 riece-user-indicator riece-real-nickname))))
 280   (setq riece-freeze-indicator
 281         (with-current-buffer (if (and riece-channel-buffer-mode
 282                                       riece-channel-buffer)
 283                                  riece-channel-buffer
 284                                riece-dialogue-buffer)
 285           (if (eq riece-freeze 'own)
 286               "f"
 287             (if riece-freeze
 288                 "F"
 289               "-")))))
 290
 291 (defun riece-update-buffers ()
 292   (if riece-current-channel
 293       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
 294                                               riece-current-channel))))
 295   (run-hooks 'riece-update-buffer-functions)
 296   (force-mode-line-update t))
 297
 298 (defun riece-channel-buffer-name (identity)
 299   (format riece-channel-buffer-format (riece-format-identity identity)))
 300
 301 (eval-when-compile
 302   (autoload 'riece-channel-mode "riece"))
 303 (defun riece-channel-buffer-create (identity)
 304   (with-current-buffer
 305       (riece-get-buffer-create (riece-channel-buffer-name identity))
 306     (unless (eq major-mode 'riece-channel-mode)
 307       (riece-channel-mode)
 308       (let (buffer-read-only)
 309         (riece-insert-info (current-buffer)
 310                            (concat "Created on "
 311                                    (funcall riece-format-time-function
 312                                             (current-time))
 313                                    "\n"))
 314         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 315     (current-buffer)))
 316
 317 (defun riece-switch-to-channel (identity)
 318   (setq riece-last-channel riece-current-channel
 319         riece-current-channel identity)
 320   (with-current-buffer riece-user-list-buffer
 321     (setq riece-redisplay-buffer t))
 322   (run-hooks 'riece-channel-switch-hook))
 323
 324 (defun riece-join-channel (identity)
 325   (unless (riece-identity-member identity riece-current-channels)
 326     (setq riece-current-channels
 327           (riece-identity-assign-binding identity riece-current-channels
 328                                          riece-default-channel-binding))
 329     (riece-channel-buffer-create identity)
 330     (with-current-buffer riece-channel-list-buffer
 331       (setq riece-redisplay-buffer t))))
 332
 333 (defun riece-switch-to-nearest-channel (pointer)
 334   (let ((start riece-current-channels)
 335         identity)
 336     (while (and start (not (eq start pointer)))
 337       (if (car start)
 338           (setq identity (car start)))
 339       (setq start (cdr start)))
 340     (unless identity
 341       (while (and pointer
 342                   (null (car pointer)))
 343         (setq pointer (cdr pointer)))
 344       (setq identity (car pointer)))
 345     (if identity
 346         (riece-switch-to-channel identity)
 347       (setq riece-last-channel riece-current-channel
 348             riece-current-channel nil))))
 349
 350 (defun riece-part-channel (identity)
 351   (let ((pointer (riece-identity-member identity riece-current-channels)))
 352     (if pointer
 353         (setcar pointer nil))
 354     (if (riece-identity-equal identity riece-current-channel)
 355         (riece-switch-to-nearest-channel pointer))
 356     (with-current-buffer riece-channel-list-buffer
 357       (setq riece-redisplay-buffer t))))
 358
 359 (defun riece-configure-windows-predicate ()
 360   ;; The current channel is changed, and some buffers are visible.
 361   (unless (equal riece-last-channel riece-current-channel)
 362     (let ((buffers riece-buffer-list))
 363       (catch 'found
 364         (while buffers
 365           (if (and (buffer-live-p (car buffers))
 366                    (get-buffer-window (car buffers)))
 367               (throw 'found t)
 368             (setq buffers (cdr buffers))))))))
 369
 370 (defun riece-redisplay-buffers (&optional force)
 371   (riece-update-buffers)
 372   (if (or force
 373           (funcall riece-configure-windows-predicate))
 374       (funcall riece-configure-windows-function))
 375   (run-hooks 'riece-redisplay-buffers-hook))
 376
 377 (provide 'riece-display)
 378
 379 ;;; riece-display.el ends here