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