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, :user-list-width, and :channel-list-width."
 107   (let ((command-height (or (plist-get plist :command-height) 4))
 108         (user-list-width (or (plist-get plist :user-list-width) (+ 9 1 1)))
 109         (channel-list-width (or (plist-get plist :channel-list-width) 18))
 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           (let ((user-list-window (split-window (selected-window) nil t)))
 137             (set-window-buffer (selected-window) riece-channel-buffer)
 138             (set-window-buffer user-list-window riece-user-list-buffer)
 139             (select-window user-list-window)
 140             (shrink-window-horizontally (- (window-width) user-list-width))))
 141          ;; only user-list
 142          (show-user-list
 143           (set-window-buffer (selected-window) riece-user-list-buffer))
 144          ;; only channel-buffer
 145          (riece-channel-buffer-mode
 146           (set-window-buffer (selected-window) riece-channel-buffer)))
 147         (select-window rest-window)))
 148     ;; bottom of frame
 149     (if (and riece-current-channel
 150              riece-channel-list-buffer-mode)
 151         (let ((channel-list-window (split-window (selected-window) nil t)))
 152           (set-window-buffer (selected-window) riece-others-buffer)
 153           (set-window-buffer channel-list-window riece-channel-list-buffer)
 154             (select-window channel-list-window)
 155             (shrink-window-horizontally (- (window-width) channel-list-width)))
 156       (set-window-buffer (selected-window) riece-dialogue-buffer))
 157     (riece-set-window-points)
 158     (select-window (or (get-buffer-window buffer)
 159                        (get-buffer-window riece-command-buffer)))))
 160
 161 (defun riece-set-window-points ()
 162   (if (get-buffer-window riece-user-list-buffer)
 163       (with-current-buffer riece-user-list-buffer
 164         (unless (riece-frozen riece-user-list-buffer)
 165           (set-window-start (get-buffer-window riece-user-list-buffer)
 166                             (point-min)))))
 167   (if (get-buffer-window riece-channel-list-buffer)
 168       (with-current-buffer riece-channel-list-buffer
 169         (unless (riece-frozen riece-channel-list-buffer)
 170           (set-window-start (get-buffer-window riece-channel-list-buffer)
 171                             (point-min))))))
 172
 173 (defun riece-update-user-list-buffer ()
 174   (save-excursion
 175     (set-buffer riece-user-list-buffer)
 176     (when (and riece-redisplay-buffer
 177                riece-current-channel
 178                (riece-channel-p (riece-identity-prefix riece-current-channel)))
 179       (let (users operators speakers)
 180         (with-current-buffer (process-buffer (riece-server-process
 181                                               (riece-identity-server
 182                                                riece-current-channel)))
 183           (setq users
 184                 (riece-channel-get-users
 185                  (riece-identity-prefix riece-current-channel))
 186                 operators
 187                 (riece-channel-get-operators
 188                  (riece-identity-prefix riece-current-channel))
 189                 speakers
 190                 (riece-channel-get-speakers
 191                  (riece-identity-prefix riece-current-channel))))
 192         (let ((inhibit-read-only t)
 193               buffer-read-only)
 194           (erase-buffer)
 195           (while users
 196             (if (member (car users) operators)
 197                 (insert "@" (car users) "\n")
 198               (if (member (car users) speakers)
 199                   (insert "+" (car users) "\n")
 200                 (insert " " (car users) "\n")))
 201             (setq users (cdr users)))))
 202       (setq riece-redisplay-buffer nil))))
 203
 204 (defun riece-update-channel-list-buffer ()
 205   (save-excursion
 206     (set-buffer riece-channel-list-buffer)
 207     (when riece-redisplay-buffer
 208       (let ((inhibit-read-only t)
 209             buffer-read-only
 210             (index 1)
 211             (channels riece-current-channels))
 212         (erase-buffer)
 213         (while channels
 214           (if (car channels)
 215               (let ((point (point)))
 216                 (insert (format "%2d: %s\n" index
 217                                 (riece-format-identity (car channels))))
 218                 (put-text-property point (point) 'riece-identity
 219                                    (car channels))))
 220           (setq index (1+ index)
 221                 channels (cdr channels))))
 222       (setq riece-redisplay-buffer nil))))
 223
 224 (defun riece-update-channel-indicator ()
 225   (setq riece-channel-indicator
 226         (if riece-current-channel
 227             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
 228                 (riece-concat-channel-modes
 229                  riece-current-channel
 230                  (riece-concat-channel-topic
 231                   riece-current-channel
 232                   (riece-format-identity riece-current-channel)))
 233               (riece-format-identity riece-current-channel))
 234           "None")))
 235
 236 (defun riece-update-short-channel-indicator ()
 237   (setq riece-short-channel-indicator
 238         (if riece-current-channel
 239             (riece-format-identity riece-current-channel)
 240           "None")))
 241
 242 (defun riece-update-channel-list-indicator ()
 243   (if (and riece-current-channels
 244            ;; There is at least one channel.
 245            (delq nil (copy-sequence riece-current-channels)))
 246       (let ((index 1))
 247         (setq riece-channel-list-indicator
 248               (mapconcat
 249                #'identity
 250                (delq nil
 251                      (mapcar
 252                       (lambda (channel)
 253                         (prog1 (if channel
 254                                    (format "%d:%s" index
 255                                            (riece-format-identity channel)))
 256                           (setq index (1+ index))))
 257                       riece-current-channels))
 258                ",")))
 259     (setq riece-channel-list-indicator "No channel")))
 260
 261 (defun riece-update-status-indicators ()
 262   (if riece-current-channel
 263       (with-current-buffer riece-command-buffer
 264         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 265           (setq riece-away-indicator
 266                 (if (and riece-real-nickname
 267                          (riece-user-get-away riece-real-nickname))
 268                     "A"
 269                   "-")
 270                 riece-operator-indicator
 271                 (if (and riece-real-nickname
 272                          (riece-user-get-operator riece-real-nickname))
 273                     "O"
 274                   "-")
 275                 riece-user-indicator riece-real-nickname))))
 276   (setq riece-freeze-indicator
 277         (with-current-buffer (if (and riece-channel-buffer-mode
 278                                       riece-channel-buffer)
 279                                  riece-channel-buffer
 280                                riece-dialogue-buffer)
 281           (if (eq riece-freeze 'own)
 282               "f"
 283             (if riece-freeze
 284                 "F"
 285               "-")))))
 286
 287 (defun riece-update-buffers ()
 288   (if riece-current-channel
 289       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
 290                                               riece-current-channel))))
 291   (run-hooks 'riece-update-buffer-functions)
 292   (force-mode-line-update t))
 293
 294 (defun riece-channel-buffer-name (identity)
 295   (format riece-channel-buffer-format (riece-format-identity identity)))
 296
 297 (eval-when-compile
 298   (autoload 'riece-channel-mode "riece"))
 299 (defun riece-channel-buffer-create (identity)
 300   (with-current-buffer
 301       (riece-get-buffer-create (riece-channel-buffer-name identity))
 302     (unless (eq major-mode 'riece-channel-mode)
 303       (riece-channel-mode)
 304       (let (buffer-read-only)
 305         (riece-insert-info (current-buffer)
 306                            (concat "Created on "
 307                                    (funcall riece-format-time-function
 308                                             (current-time))
 309                                    "\n"))
 310         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 311     (current-buffer)))
 312
 313 (defun riece-switch-to-channel (identity)
 314   (setq riece-last-channel riece-current-channel
 315         riece-current-channel identity)
 316   (with-current-buffer riece-user-list-buffer
 317     (setq riece-redisplay-buffer t))
 318   (run-hooks 'riece-channel-switch-hook))
 319
 320 (defun riece-join-channel (identity)
 321   (unless (riece-identity-member identity riece-current-channels)
 322     (setq riece-current-channels
 323           (riece-identity-assign-binding identity riece-current-channels
 324                                          riece-default-channel-binding))
 325     (riece-channel-buffer-create identity)
 326     (with-current-buffer riece-channel-list-buffer
 327       (setq riece-redisplay-buffer t))))
 328
 329 (defun riece-switch-to-nearest-channel (pointer)
 330   (let ((start riece-current-channels)
 331         identity)
 332     (while (and start (not (eq start pointer)))
 333       (if (car start)
 334           (setq identity (car start)))
 335       (setq start (cdr start)))
 336     (unless identity
 337       (while (and pointer
 338                   (null (car pointer)))
 339         (setq pointer (cdr pointer)))
 340       (setq identity (car pointer)))
 341     (if identity
 342         (riece-switch-to-channel identity)
 343       (setq riece-last-channel riece-current-channel
 344             riece-current-channel nil))))
 345
 346 (defun riece-part-channel (identity)
 347   (let ((pointer (riece-identity-member identity riece-current-channels)))
 348     (if pointer
 349         (setcar pointer nil))
 350     (if (riece-identity-equal identity riece-current-channel)
 351         (riece-switch-to-nearest-channel pointer))
 352     (with-current-buffer riece-channel-list-buffer
 353       (setq riece-redisplay-buffer t))))
 354
 355 (defun riece-configure-windows-predicate ()
 356   ;; The current channel is changed, and some buffers are visible.
 357   (unless (equal riece-last-channel riece-current-channel)
 358     (let ((buffers riece-buffer-list))
 359       (catch 'found
 360         (while buffers
 361           (if (and (buffer-live-p (car buffers))
 362                    (get-buffer-window (car buffers)))
 363               (throw 'found t)
 364             (setq buffers (cdr buffers))))))))
 365
 366 (defun riece-redisplay-buffers (&optional force)
 367   (riece-update-buffers)
 368   (if (or force
 369           (funcall riece-configure-windows-predicate))
 370       (funcall riece-configure-windows-function))
 371   (run-hooks 'riece-redisplay-buffers-hook))
 372
 373 (provide 'riece-display)
 374
 375 ;;; riece-display.el ends here