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