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 (defsubst 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
 181 (eval-when-compile
 182   (autoload 'riece-channel-mode "riece"))
 183 (defun riece-channel-buffer-create (identity)
 184   (with-current-buffer
 185       (riece-get-buffer-create (format riece-channel-buffer-format identity))
 186     (unless (eq major-mode 'riece-channel-mode)
 187       (riece-channel-mode)
 188       (let (buffer-read-only)
 189         (riece-insert-info (current-buffer)
 190                            (concat "Created on "
 191                                    (funcall riece-format-time-function
 192                                             (current-time))
 193                                    "\n"))))
 194     (current-buffer)))
 195
 196 (eval-when-compile
 197   (autoload 'riece-user-list-mode "riece"))
 198 (defun riece-user-list-buffer-create (identity)
 199   (with-current-buffer
 200       (riece-get-buffer-create (format riece-user-list-buffer-format identity))
 201     (unless (eq major-mode 'riece-user-list-mode)
 202       (riece-user-list-mode))
 203     (current-buffer)))
 204
 205 (defun riece-switch-to-channel (identity)
 206   (setq riece-last-channel riece-current-channel
 207         riece-current-channel identity
 208         riece-channel-buffer
 209         (cdr (riece-identity-assoc-no-server
 210               identity riece-channel-buffer-alist))
 211         riece-user-list-buffer
 212         (cdr (riece-identity-assoc-no-server
 213               identity riece-user-list-buffer-alist))))
 214
 215 (defun riece-join-channel (channel-name)
 216   (let ((identity (riece-make-identity channel-name)))
 217     (unless (riece-identity-member-no-server
 218              identity riece-current-channels)
 219       (setq riece-current-channels
 220             (riece-identity-assign-binding
 221              identity riece-current-channels
 222              riece-default-channel-binding)))
 223     (unless (riece-identity-assoc-no-server
 224              identity riece-channel-buffer-alist)
 225       (let ((buffer (riece-channel-buffer-create identity)))
 226         (setq riece-channel-buffer-alist
 227               (cons (cons identity buffer)
 228                     riece-channel-buffer-alist))))
 229     (unless (riece-identity-assoc-no-server
 230              identity riece-user-list-buffer-alist)
 231       (let ((buffer (riece-user-list-buffer-create identity)))
 232         (setq riece-user-list-buffer-alist
 233               (cons (cons identity buffer)
 234                     riece-user-list-buffer-alist))))))
 235
 236 (defun riece-switch-to-nearest-channel (pointer)
 237   (let ((start riece-current-channels)
 238         identity)
 239     (while (and start (not (eq start pointer)))
 240       (if (car start)
 241           (setq identity (car start)))
 242       (setq start (cdr start)))
 243     (unless identity
 244       (while (and pointer
 245                   (null (car pointer)))
 246         (setq pointer (cdr pointer)))
 247       (setq identity (car pointer)))
 248     (if identity
 249         (riece-switch-to-channel identity)
 250       (setq riece-last-channel riece-current-channel
 251             riece-current-channel nil))))
 252
 253 (defun riece-part-channel (channel-name)
 254   (let* ((identity (riece-make-identity channel-name))
 255          (pointer (riece-identity-member-no-server
 256                    identity riece-current-channels)))
 257     (if pointer
 258         (setcar pointer nil))
 259     ;;XXX
 260     (if (riece-identity-equal-no-server identity riece-current-channel)
 261         (riece-switch-to-nearest-channel pointer))))
 262
 263 (defun riece-configure-windows-predicate ()
 264   ;; The current channel is changed, and some buffers are visible.
 265   (unless (equal riece-last-channel riece-current-channel)
 266     (let ((buffers riece-buffer-list))
 267       (catch 'found
 268         (while buffers
 269           (if (and (buffer-live-p (car buffers))
 270                    (get-buffer-window (car buffers)))
 271               (throw 'found t)
 272             (setq buffers (cdr buffers))))))))
 273
 274 (defun riece-redisplay-buffers (&optional force)
 275   (riece-update-buffers)
 276   (if (or force
 277           (funcall riece-configure-windows-predicate))
 278       (funcall riece-configure-windows-function)))
 279
 280 (provide 'riece-display)