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