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-update-buffer-functions nil
  33   "Functions to redisplay the buffer.
  34 Local to the buffer in `riece-buffer-list'.")
  35
  36 (defvar riece-update-indicator-functions
  37   '(riece-update-status-indicators
  38     riece-update-channel-indicator
  39     riece-update-long-channel-indicator
  40     riece-update-channel-list-indicator)
  41   "Functions to update modeline indicators.")
  42
  43 (defun riece-update-user-list-buffer ()
  44   (save-excursion
  45     (set-buffer riece-user-list-buffer)
  46     (when (and riece-current-channel
  47                (riece-channel-p (riece-identity-prefix riece-current-channel)))
  48       (let (users operators speakers)
  49         (with-current-buffer (process-buffer (riece-server-process
  50                                               (riece-identity-server
  51                                                riece-current-channel)))
  52           (setq users
  53                 (riece-channel-get-users
  54                  (riece-identity-prefix riece-current-channel))
  55                 operators
  56                 (riece-channel-get-operators
  57                  (riece-identity-prefix riece-current-channel))
  58                 speakers
  59                 (riece-channel-get-speakers
  60                  (riece-identity-prefix riece-current-channel))))
  61         (let ((inhibit-read-only t)
  62               buffer-read-only)
  63           (erase-buffer)
  64           (while users
  65             (insert (if (member (car users) operators)
  66                         "@"
  67                       (if (member (car users) speakers)
  68                           "+"
  69                         " "))
  70                     (riece-format-identity
  71                      (riece-make-identity (car users)
  72                                           (riece-identity-server
  73                                            riece-current-channel))
  74                      t)
  75                     "\n")
  76             (setq users (cdr users))))))))
  77
  78 (defun riece-update-channel-list-buffer ()
  79   (save-excursion
  80     (set-buffer riece-channel-list-buffer)
  81     (let ((inhibit-read-only t)
  82           buffer-read-only
  83           (index 1)
  84           (channels riece-current-channels))
  85       (erase-buffer)
  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
 178 (defun riece-channel-buffer-name (identity)
 179   (let ((channels (riece-identity-member identity riece-current-channels)))
 180     (if channels
 181         (setq identity (car channels))
 182       (if riece-debug
 183           (message "%S is not a member of riece-current-channels" identity)))
 184     (format riece-channel-buffer-format (riece-format-identity identity))))
 185
 186 (eval-when-compile
 187   (autoload 'riece-channel-mode "riece"))
 188 (defun riece-channel-buffer-create (identity)
 189   (with-current-buffer
 190       (riece-get-buffer-create (riece-channel-buffer-name identity))
 191     (unless (eq major-mode 'riece-channel-mode)
 192       (riece-channel-mode)
 193       (let (buffer-read-only)
 194         (riece-insert-info (current-buffer)
 195                            (concat "Created on "
 196                                    (funcall riece-format-time-function
 197                                             (current-time))
 198                                    "\n"))
 199         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 200     (current-buffer)))
 201
 202 (defun riece-switch-to-channel (identity)
 203   (let ((last riece-current-channel))
 204     (setq riece-current-channel identity
 205           riece-channel-buffer (get-buffer (riece-channel-buffer-name
 206                                             riece-current-channel)))
 207     (run-hook-with-args 'riece-after-switch-to-channel-functions last)))
 208
 209 (defun riece-join-channel (identity)
 210   (unless (riece-identity-member identity riece-current-channels)
 211     (setq riece-current-channels
 212           (riece-identity-assign-binding
 213            identity riece-current-channels
 214            (mapcar
 215             (lambda (channel)
 216               (if channel
 217                   (riece-parse-identity channel)))
 218             riece-default-channel-binding)))
 219     (riece-channel-buffer-create identity)))
 220
 221 (defun riece-switch-to-nearest-channel (pointer)
 222   (let ((start riece-current-channels)
 223         identity)
 224     (while (and start (not (eq start pointer)))
 225       (if (car start)
 226           (setq identity (car start)))
 227       (setq start (cdr start)))
 228     (unless identity
 229       (while (and pointer
 230                   (null (car pointer)))
 231         (setq pointer (cdr pointer)))
 232       (setq identity (car pointer)))
 233     (if identity
 234         (riece-switch-to-channel identity)
 235       (let ((last riece-current-channel))
 236         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 237         (setq riece-current-channel nil)))))
 238
 239 (defun riece-part-channel (identity)
 240   (let ((pointer (riece-identity-member identity riece-current-channels)))
 241     (if pointer
 242         (setcar pointer nil))
 243     (if (riece-identity-equal identity riece-current-channel)
 244         (riece-switch-to-nearest-channel pointer))))
 245
 246 (defun riece-redisplay-buffers (&optional force)
 247   (riece-update-buffers)
 248   (riece-redraw-layout force)
 249   (run-hooks 'riece-redisplay-buffers-hook))
 250
 251 (provide 'riece-display)
 252
 253 ;;; riece-display.el ends here