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 (defvar riece-redisplay-buffer nil
  41   "Non-nil means the buffer needs to be updated.
  42 Local to the buffers.")
  43
  44 (defun riece-update-user-list-buffer ()
  45   (save-excursion
  46     (set-buffer riece-user-list-buffer)
  47     (when (and riece-redisplay-buffer
  48                riece-current-channel
  49                (riece-channel-p (riece-identity-prefix riece-current-channel)))
  50       (let (users operators speakers)
  51         (with-current-buffer (process-buffer (riece-server-process
  52                                               (riece-identity-server
  53                                                riece-current-channel)))
  54           (setq users
  55                 (riece-channel-get-users
  56                  (riece-identity-prefix riece-current-channel))
  57                 operators
  58                 (riece-channel-get-operators
  59                  (riece-identity-prefix riece-current-channel))
  60                 speakers
  61                 (riece-channel-get-speakers
  62                  (riece-identity-prefix riece-current-channel))))
  63         (let ((inhibit-read-only t)
  64               buffer-read-only)
  65           (erase-buffer)
  66           (while users
  67             (if (member (car users) operators)
  68                 (insert "@" (car users) "\n")
  69               (if (member (car users) speakers)
  70                   (insert "+" (car users) "\n")
  71                 (insert " " (car users) "\n")))
  72             (setq users (cdr users)))))
  73       (setq riece-redisplay-buffer nil))))
  74
  75 (defun riece-update-channel-list-buffer ()
  76   (save-excursion
  77     (set-buffer riece-channel-list-buffer)
  78     (when riece-redisplay-buffer
  79       (let ((inhibit-read-only t)
  80             buffer-read-only
  81             (index 1)
  82             (channels riece-current-channels))
  83         (erase-buffer)
  84         (while channels
  85           (if (car channels)
  86               (let ((point (point)))
  87                 (insert (format "%2d: %s\n" index
  88                                 (riece-format-identity (car channels))))
  89                 (put-text-property point (point) 'riece-identity
  90                                    (car channels))))
  91           (setq index (1+ index)
  92                 channels (cdr channels))))
  93       (setq riece-redisplay-buffer nil))))
  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 (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   (setq riece-last-channel riece-current-channel
 186         riece-current-channel identity)
 187   (with-current-buffer riece-user-list-buffer
 188     (setq riece-redisplay-buffer t))
 189   (run-hooks 'riece-channel-switch-hook))
 190
 191 (defun riece-join-channel (identity)
 192   (unless (riece-identity-member identity riece-current-channels)
 193     (setq riece-current-channels
 194           (riece-identity-assign-binding identity riece-current-channels
 195                                          riece-default-channel-binding))
 196     (riece-channel-buffer-create identity)
 197     (with-current-buffer riece-channel-list-buffer
 198       (setq riece-redisplay-buffer t))))
 199
 200 (defun riece-switch-to-nearest-channel (pointer)
 201   (let ((start riece-current-channels)
 202         identity)
 203     (while (and start (not (eq start pointer)))
 204       (if (car start)
 205           (setq identity (car start)))
 206       (setq start (cdr start)))
 207     (unless identity
 208       (while (and pointer
 209                   (null (car pointer)))
 210         (setq pointer (cdr pointer)))
 211       (setq identity (car pointer)))
 212     (if identity
 213         (riece-switch-to-channel identity)
 214       (setq riece-last-channel riece-current-channel
 215             riece-current-channel nil))))
 216
 217 (defun riece-part-channel (identity)
 218   (let ((pointer (riece-identity-member identity riece-current-channels)))
 219     (if pointer
 220         (setcar pointer nil))
 221     (if (riece-identity-equal identity riece-current-channel)
 222         (riece-switch-to-nearest-channel pointer))
 223     (with-current-buffer riece-channel-list-buffer
 224       (setq riece-redisplay-buffer t))))
 225
 226 (defun riece-redisplay-buffers (&optional force)
 227   (riece-update-buffers)
 228   (riece-redraw-layout force)
 229   (run-hooks 'riece-redisplay-buffers-hook))
 230
 231 (provide 'riece-display)
 232
 233 ;;; riece-display.el ends here