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 (require 'riece-layout)
  31
  32 (defvar riece-channel-buffer-format "*Channel:%s*"
  33   "Format of channel message buffer.")
  34 (defvar riece-channel-buffer-alist nil
  35   "An alist mapping identities to channel buffers.")
  36
  37 (defvar riece-update-buffer-functions nil
  38   "Functions to redisplay the buffer.
  39 Local to the buffer in `riece-buffer-list'.")
  40
  41 (defvar riece-update-indicator-functions
  42   '(riece-update-status-indicators
  43     riece-update-channel-indicator
  44     riece-update-long-channel-indicator
  45     riece-update-channel-list-indicator)
  46   "Functions to update modeline indicators.")
  47
  48 (defun riece-update-user-list-buffer ()
  49   (save-excursion
  50     (set-buffer riece-user-list-buffer)
  51     (if (and riece-current-channel
  52              (riece-channel-p (riece-identity-prefix riece-current-channel)))
  53         (let* ((users
  54                 (with-current-buffer (process-buffer (riece-server-process
  55                                                       (riece-identity-server
  56                                                        riece-current-channel)))
  57                   (riece-channel-get-users (riece-identity-prefix
  58                                             riece-current-channel))))
  59                (inhibit-read-only t)
  60                buffer-read-only)
  61           (erase-buffer)
  62           (while users
  63             (insert (if (memq ?o (cdr (car users)))
  64                         "@"
  65                       (if (memq ?v (cdr (car users)))
  66                           "+"
  67                         " "))
  68                     (riece-format-identity
  69                      (riece-make-identity (car (car users))
  70                                           (riece-identity-server
  71                                            riece-current-channel))
  72                      t)
  73                     "\n")
  74             (setq users (cdr users)))))))
  75
  76 (defun riece-update-channel-list-buffer ()
  77   (save-excursion
  78     (set-buffer riece-channel-list-buffer)
  79     (let ((inhibit-read-only t)
  80           buffer-read-only
  81           (index 1)
  82           (channels riece-current-channels))
  83       (erase-buffer)
  84       (while channels
  85         (if (car channels)
  86             (insert (riece-format-channel-list-line
  87                      index (car channels))))
  88         (setq index (1+ index)
  89               channels (cdr channels))))))
  90
  91 (defun riece-format-channel-list-line (index channel)
  92   (or (run-hook-with-args-until-success
  93        'riece-format-channel-list-line-functions index channel)
  94       (concat (format "%2d:%c" index
  95                       (if (riece-identity-equal channel riece-current-channel)
  96                           ?*
  97                         ? ))
  98               (riece-format-identity channel)
  99               "\n")))
 100
 101 (defun riece-update-channel-indicator ()
 102   (setq riece-channel-indicator
 103         (if riece-current-channel
 104             (riece-format-identity riece-current-channel)
 105           "None")))
 106
 107 (defun riece-update-long-channel-indicator ()
 108   (setq riece-long-channel-indicator
 109         (if riece-current-channel
 110             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
 111                 (riece-concat-channel-modes
 112                  riece-current-channel
 113                  (riece-concat-channel-topic
 114                   riece-current-channel
 115                   (riece-format-identity riece-current-channel)))
 116               (riece-format-identity riece-current-channel))
 117           "None")))
 118
 119 (defun riece-update-channel-list-indicator ()
 120   (if (and riece-current-channels
 121            ;; There is at least one channel.
 122            (delq nil (copy-sequence riece-current-channels)))
 123       (let ((index 1))
 124         (setq riece-channel-list-indicator
 125               (mapconcat
 126                #'identity
 127                (delq nil
 128                      (mapcar
 129                       (lambda (channel)
 130                         (prog1
 131                             (if channel
 132                                 (format "%d:%s" index
 133                                         (riece-format-identity channel)))
 134                           (setq index (1+ index))))
 135                       riece-current-channels))
 136                ",")))
 137     (setq riece-channel-list-indicator "No channel")))
 138
 139 (defun riece-update-status-indicators ()
 140   (if riece-current-channel
 141       (with-current-buffer riece-command-buffer
 142         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 143           (setq riece-away-indicator
 144                 (if (and riece-real-nickname
 145                          (riece-user-get-away riece-real-nickname))
 146                     "A"
 147                   "-")
 148                 riece-operator-indicator
 149                 (if (and riece-real-nickname
 150                          (riece-user-get-operator riece-real-nickname))
 151                     "O"
 152                   "-")
 153                 riece-user-indicator riece-real-nickname))))
 154   (setq riece-freeze-indicator
 155         (with-current-buffer (if (and riece-channel-buffer-mode
 156                                       riece-channel-buffer)
 157                                  riece-channel-buffer
 158                                riece-dialogue-buffer)
 159           (if (eq riece-freeze 'own)
 160               "f"
 161             (if riece-freeze
 162                 "F"
 163               "-")))))
 164
 165 (defun riece-update-buffers (&optional buffers)
 166   (unless buffers
 167     (setq buffers riece-buffer-list))
 168   (while buffers
 169     (save-excursion
 170       (set-buffer (car buffers))
 171       (run-hooks 'riece-update-buffer-functions))
 172     (setq buffers (cdr buffers)))
 173   (run-hooks 'riece-update-indicator-functions)
 174   (force-mode-line-update t)
 175   (run-hooks 'riece-update-buffer-hook))
 176
 177 (defun riece-channel-buffer-name (identity)
 178   (let ((channels (riece-identity-member identity riece-current-channels)))
 179     (if channels
 180         (setq identity (car channels))
 181       (if riece-debug
 182           (message "%S is not a member of riece-current-channels" identity)))
 183     (format riece-channel-buffer-format (riece-format-identity identity))))
 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 (riece-channel-buffer-name identity)
 190                                'riece-channel-mode)
 191     (setq riece-channel-buffer-alist
 192           (cons (cons identity (current-buffer))
 193                 riece-channel-buffer-alist))
 194     (unless (eq major-mode 'riece-channel-mode)
 195       (riece-channel-mode)
 196       (let (buffer-read-only)
 197         (riece-insert-info (current-buffer)
 198                            (concat "Created on "
 199                                    (funcall riece-format-time-function
 200                                             (current-time))
 201                                    "\n"))
 202         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 203     (current-buffer)))
 204
 205 (defun riece-channel-buffer (identity)
 206   (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
 207
 208 (defun riece-switch-to-channel (identity)
 209   (let ((last riece-current-channel))
 210     (setq riece-current-channel identity
 211           riece-channel-buffer (riece-channel-buffer riece-current-channel))
 212     (run-hook-with-args 'riece-after-switch-to-channel-functions last)))
 213
 214 (defun riece-join-channel (identity)
 215   (unless (riece-identity-member identity riece-current-channels)
 216     (setq riece-current-channels
 217           (riece-identity-assign-binding
 218            identity riece-current-channels
 219            (mapcar
 220             (lambda (channel)
 221               (if channel
 222                   (riece-parse-identity channel)))
 223             riece-default-channel-binding)))
 224     (riece-channel-buffer-create identity)))
 225
 226 (defun riece-switch-to-nearest-channel (pointer)
 227   (let ((start riece-current-channels)
 228         identity)
 229     (while (and start (not (eq start pointer)))
 230       (if (car start)
 231           (setq identity (car start)))
 232       (setq start (cdr start)))
 233     (unless identity
 234       (while (and pointer
 235                   (null (car pointer)))
 236         (setq pointer (cdr pointer)))
 237       (setq identity (car pointer)))
 238     (if identity
 239         (riece-switch-to-channel identity)
 240       (let ((last riece-current-channel))
 241         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 242         (setq riece-current-channel nil)))))
 243
 244 (defun riece-part-channel (identity)
 245   (let ((pointer (riece-identity-member identity riece-current-channels)))
 246     (if pointer
 247         (setcar pointer nil))
 248     (if (riece-identity-equal identity riece-current-channel)
 249         (riece-switch-to-nearest-channel pointer))))
 250
 251 (defun riece-redisplay-buffers (&optional force)
 252   (riece-update-buffers)
 253   (riece-redraw-layout force)
 254   (run-hooks 'riece-redisplay-buffers-hook))
 255
 256 (provide 'riece-display)
 257
 258 ;;; riece-display.el ends here