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