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