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