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