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