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