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-set-window-points ()
 105   (if (get-buffer-window riece-user-list-buffer)
 106       (with-current-buffer riece-user-list-buffer
 107         (unless (riece-frozen riece-user-list-buffer)
 108           (set-window-start (get-buffer-window riece-user-list-buffer)
 109                             (point-min)))))
 110   (if (get-buffer-window riece-channel-list-buffer)
 111       (with-current-buffer riece-channel-list-buffer
 112         (unless (riece-frozen riece-channel-list-buffer)
 113           (set-window-start (get-buffer-window riece-channel-list-buffer)
 114                             (point-min))))))
 115
 116 (defun riece-update-user-list-buffer ()
 117   (save-excursion
 118     (set-buffer riece-user-list-buffer)
 119     (when (and riece-redisplay-buffer
 120                riece-current-channel
 121                (riece-channel-p (riece-identity-prefix riece-current-channel)))
 122       (let (users operators speakers)
 123         (with-current-buffer (process-buffer (riece-server-process
 124                                               (riece-identity-server
 125                                                riece-current-channel)))
 126           (setq users
 127                 (riece-channel-get-users
 128                  (riece-identity-prefix riece-current-channel))
 129                 operators
 130                 (riece-channel-get-operators
 131                  (riece-identity-prefix riece-current-channel))
 132                 speakers
 133                 (riece-channel-get-speakers
 134                  (riece-identity-prefix riece-current-channel))))
 135         (let ((inhibit-read-only t)
 136               buffer-read-only)
 137           (erase-buffer)
 138           (while users
 139             (if (member (car users) operators)
 140                 (insert "@" (car users) "\n")
 141               (if (member (car users) speakers)
 142                   (insert "+" (car users) "\n")
 143                 (insert " " (car users) "\n")))
 144             (setq users (cdr users)))))
 145       (setq riece-redisplay-buffer nil))))
 146
 147 (defun riece-update-channel-list-buffer ()
 148   (save-excursion
 149     (set-buffer riece-channel-list-buffer)
 150     (when riece-redisplay-buffer
 151       (let ((inhibit-read-only t)
 152             buffer-read-only
 153             (index 1)
 154             (channels riece-current-channels))
 155         (erase-buffer)
 156         (while channels
 157           (if (car channels)
 158               (let ((point (point)))
 159                 (insert (format "%2d: %s\n" index
 160                                 (riece-format-identity (car channels))))
 161                 (put-text-property point (point) 'riece-identity
 162                                    (car channels))))
 163           (setq index (1+ index)
 164                 channels (cdr channels))))
 165       (setq riece-redisplay-buffer nil))))
 166
 167 (defun riece-update-channel-indicator ()
 168   (setq riece-channel-indicator
 169         (if riece-current-channel
 170             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
 171                 (riece-concat-channel-modes
 172                  riece-current-channel
 173                  (riece-concat-channel-topic
 174                   riece-current-channel
 175                   (riece-format-identity riece-current-channel)))
 176               (riece-format-identity riece-current-channel))
 177           "None")))
 178
 179 (defun riece-update-short-channel-indicator ()
 180   (setq riece-short-channel-indicator
 181         (if riece-current-channel
 182             (riece-format-identity riece-current-channel)
 183           "None")))
 184
 185 (defun riece-update-channel-list-indicator ()
 186   (if (and riece-current-channels
 187            ;; There is at least one channel.
 188            (delq nil (copy-sequence riece-current-channels)))
 189       (let ((index 1))
 190         (setq riece-channel-list-indicator
 191               (mapconcat
 192                #'identity
 193                (delq nil
 194                      (mapcar
 195                       (lambda (channel)
 196                         (prog1 (if channel
 197                                    (format "%d:%s" index
 198                                            (riece-format-identity channel)))
 199                           (setq index (1+ index))))
 200                       riece-current-channels))
 201                ",")))
 202     (setq riece-channel-list-indicator "No channel")))
 203
 204 (defun riece-update-status-indicators ()
 205   (if riece-current-channel
 206       (with-current-buffer riece-command-buffer
 207         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 208           (setq riece-away-indicator
 209                 (if (and riece-real-nickname
 210                          (riece-user-get-away riece-real-nickname))
 211                     "A"
 212                   "-")
 213                 riece-operator-indicator
 214                 (if (and riece-real-nickname
 215                          (riece-user-get-operator riece-real-nickname))
 216                     "O"
 217                   "-")
 218                 riece-user-indicator riece-real-nickname))))
 219   (setq riece-freeze-indicator
 220         (with-current-buffer (if (and riece-channel-buffer-mode
 221                                       riece-channel-buffer)
 222                                  riece-channel-buffer
 223                                riece-dialogue-buffer)
 224           (if (eq riece-freeze 'own)
 225               "f"
 226             (if riece-freeze
 227                 "F"
 228               "-")))))
 229
 230 (defun riece-update-buffers ()
 231   (if riece-current-channel
 232       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
 233                                               riece-current-channel))))
 234   (run-hooks 'riece-update-buffer-functions)
 235   (force-mode-line-update t))
 236
 237 (defun riece-channel-buffer-name (identity)
 238   (format riece-channel-buffer-format (riece-format-identity identity)))
 239
 240 (eval-when-compile
 241   (autoload 'riece-channel-mode "riece"))
 242 (defun riece-channel-buffer-create (identity)
 243   (with-current-buffer
 244       (riece-get-buffer-create (riece-channel-buffer-name identity))
 245     (unless (eq major-mode 'riece-channel-mode)
 246       (riece-channel-mode)
 247       (let (buffer-read-only)
 248         (riece-insert-info (current-buffer)
 249                            (concat "Created on "
 250                                    (funcall riece-format-time-function
 251                                             (current-time))
 252                                    "\n"))
 253         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 254     (current-buffer)))
 255
 256 (defun riece-switch-to-channel (identity)
 257   (setq riece-last-channel riece-current-channel
 258         riece-current-channel identity)
 259   (with-current-buffer riece-user-list-buffer
 260     (setq riece-redisplay-buffer t))
 261   (run-hooks 'riece-channel-switch-hook))
 262
 263 (defun riece-join-channel (identity)
 264   (unless (riece-identity-member identity riece-current-channels)
 265     (setq riece-current-channels
 266           (riece-identity-assign-binding identity riece-current-channels
 267                                          riece-default-channel-binding))
 268     (riece-channel-buffer-create identity)
 269     (with-current-buffer riece-channel-list-buffer
 270       (setq riece-redisplay-buffer t))))
 271
 272 (defun riece-switch-to-nearest-channel (pointer)
 273   (let ((start riece-current-channels)
 274         identity)
 275     (while (and start (not (eq start pointer)))
 276       (if (car start)
 277           (setq identity (car start)))
 278       (setq start (cdr start)))
 279     (unless identity
 280       (while (and pointer
 281                   (null (car pointer)))
 282         (setq pointer (cdr pointer)))
 283       (setq identity (car pointer)))
 284     (if identity
 285         (riece-switch-to-channel identity)
 286       (setq riece-last-channel riece-current-channel
 287             riece-current-channel nil))))
 288
 289 (defun riece-part-channel (identity)
 290   (let ((pointer (riece-identity-member identity riece-current-channels)))
 291     (if pointer
 292         (setcar pointer nil))
 293     (if (riece-identity-equal identity riece-current-channel)
 294         (riece-switch-to-nearest-channel pointer))
 295     (with-current-buffer riece-channel-list-buffer
 296       (setq riece-redisplay-buffer t))))
 297
 298 (defun riece-configure-windows-predicate ()
 299   ;; The current channel is changed, and some buffers are visible.
 300   (unless (equal riece-last-channel riece-current-channel)
 301     (let ((buffers riece-buffer-list))
 302       (catch 'found
 303         (while buffers
 304           (if (and (buffer-live-p (car buffers))
 305                    (get-buffer-window (car buffers)))
 306               (throw 'found t)
 307             (setq buffers (cdr buffers))))))))
 308
 309 (defun riece-redisplay-buffers (&optional force)
 310   (riece-update-buffers)
 311   (if (or force
 312           (funcall riece-configure-windows-predicate))
 313       (funcall riece-configure-windows-function))
 314   (run-hooks 'riece-redisplay-buffers-hook))
 315
 316 (provide 'riece-display)
 317
 318 ;;; riece-display.el ends here