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   (with-current-buffer riece-command-buffer
 161     (force-mode-line-update)))
 162
 163 (defun riece-update-channel-list-indicator ()
 164   (if (and riece-current-channels
 165            ;; There is at least one channel.
 166            (delq nil (copy-sequence riece-current-channels)))
 167       (let ((index 1))
 168         (setq riece-channel-list-indicator
 169               (mapconcat
 170                #'identity
 171                (delq nil
 172                      (mapcar
 173                       (lambda (channel)
 174                         (prog1 (if channel
 175                                    (format "%d:%s" index channel))
 176                           (setq index (1+ index))))
 177                       riece-current-channels))
 178                ",")))
 179     (setq riece-channel-list-indicator "No channel")))
 180
 181 (defun riece-update-status-indicators ()
 182   (riece-with-server-buffer
 183    (setq riece-away-indicator
 184          (if (and riece-real-nickname
 185                   (riece-user-get-away riece-real-nickname))
 186              "A"
 187            "-"))
 188    (setq riece-operator-indicator
 189          (if (and riece-real-nickname
 190                   (riece-user-get-operator riece-real-nickname))
 191              "O"
 192            "-")))
 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-no-server
 238               identity riece-channel-buffer-alist))
 239         riece-user-list-buffer
 240         (cdr (riece-identity-assoc-no-server
 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-no-server
 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-no-server
 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-no-server
 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-no-server
 285                    identity riece-current-channels)))
 286     (if pointer
 287         (setcar pointer nil))
 288     ;;XXX
 289     (if (riece-identity-equal-no-server identity riece-current-channel)
 290         (riece-switch-to-nearest-channel pointer))))
 291
 292 (defun riece-configure-windows-predicate ()
 293   ;; The current channel is changed, and some buffers are visible.
 294   (unless (equal riece-last-channel riece-current-channel)
 295     (let ((buffers riece-buffer-list))
 296       (catch 'found
 297         (while buffers
 298           (if (and (buffer-live-p (car buffers))
 299                    (get-buffer-window (car buffers)))
 300               (throw 'found t)
 301             (setq buffers (cdr buffers))))))))
 302
 303 (defun riece-redisplay-buffers (&optional force)
 304   (riece-update-buffers)
 305   (if (or force
 306           (funcall riece-configure-windows-predicate))
 307       (funcall riece-configure-windows-function))
 308   (run-hooks 'riece-redisplay-buffers-hook))
 309
 310 (provide 'riece-display)
 311
 312 ;;; riece-display.el ends here