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