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