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