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