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