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 (format "%2d:%c%s\n" index
  81                                 (if (riece-identity-equal
  82                                      (car channels)
  83                                      riece-current-channel)
  84                                     ?*
  85                                   ?\ )
  86                                 (riece-format-identity (car channels))))))
  87         (setq index (1+ index)
  88               channels (cdr channels))))))
  89
  90 (defun riece-update-channel-indicator ()
  91   (setq riece-channel-indicator
  92         (if riece-current-channel
  93             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
  94                 (riece-concat-channel-modes
  95                  riece-current-channel
  96                  (riece-concat-channel-topic
  97                   riece-current-channel
  98                   (riece-format-identity riece-current-channel)))
  99               (riece-format-identity riece-current-channel))
 100           "None")))
 101
 102 (defun riece-update-short-channel-indicator ()
 103   (setq riece-short-channel-indicator
 104         (if riece-current-channel
 105             (riece-format-identity riece-current-channel)
 106           "None")))
 107
 108 (defun riece-update-channel-list-indicator ()
 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 (if channel
 120                                    (format "%d:%s" index
 121                                            (riece-format-identity channel)))
 122                           (setq index (1+ index))))
 123                       riece-current-channels))
 124                ",")))
 125     (setq riece-channel-list-indicator "No channel")))
 126
 127 (defun riece-update-status-indicators ()
 128   (if riece-current-channel
 129       (with-current-buffer riece-command-buffer
 130         (riece-with-server-buffer (riece-identity-server riece-current-channel)
 131           (setq riece-away-indicator
 132                 (if (and riece-real-nickname
 133                          (riece-user-get-away riece-real-nickname))
 134                     "A"
 135                   "-")
 136                 riece-operator-indicator
 137                 (if (and riece-real-nickname
 138                          (riece-user-get-operator riece-real-nickname))
 139                     "O"
 140                   "-")
 141                 riece-user-indicator riece-real-nickname))))
 142   (setq riece-freeze-indicator
 143         (with-current-buffer (if (and riece-channel-buffer-mode
 144                                       riece-channel-buffer)
 145                                  riece-channel-buffer
 146                                riece-dialogue-buffer)
 147           (if (eq riece-freeze 'own)
 148               "f"
 149             (if riece-freeze
 150                 "F"
 151               "-")))))
 152
 153 (defun riece-update-buffers ()
 154   (if riece-current-channel
 155       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
 156                                               riece-current-channel))))
 157   (run-hooks 'riece-update-buffer-functions)
 158   (force-mode-line-update t))
 159
 160 (defun riece-channel-buffer-name (identity)
 161   (format riece-channel-buffer-format (riece-format-identity identity)))
 162
 163 (eval-when-compile
 164   (autoload 'riece-channel-mode "riece"))
 165 (defun riece-channel-buffer-create (identity)
 166   (with-current-buffer
 167       (riece-get-buffer-create (riece-channel-buffer-name identity))
 168     (unless (eq major-mode 'riece-channel-mode)
 169       (riece-channel-mode)
 170       (let (buffer-read-only)
 171         (riece-insert-info (current-buffer)
 172                            (concat "Created on "
 173                                    (funcall riece-format-time-function
 174                                             (current-time))
 175                                    "\n"))
 176         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 177     (current-buffer)))
 178
 179 (defun riece-switch-to-channel (identity)
 180   (setq riece-last-channel riece-current-channel
 181         riece-current-channel identity)
 182   (run-hooks 'riece-channel-switch-hook))
 183
 184 (defun riece-join-channel (identity)
 185   (unless (riece-identity-member identity riece-current-channels)
 186     (setq riece-current-channels
 187           (riece-identity-assign-binding
 188            identity riece-current-channels
 189            (mapcar
 190             (lambda (channel)
 191               (if channel
 192                   (riece-parse-identity channel)))
 193             riece-default-channel-binding)))
 194     (riece-channel-buffer-create identity)))
 195
 196 (defun riece-switch-to-nearest-channel (pointer)
 197   (let ((start riece-current-channels)
 198         identity)
 199     (while (and start (not (eq start pointer)))
 200       (if (car start)
 201           (setq identity (car start)))
 202       (setq start (cdr start)))
 203     (unless identity
 204       (while (and pointer
 205                   (null (car pointer)))
 206         (setq pointer (cdr pointer)))
 207       (setq identity (car pointer)))
 208     (if identity
 209         (riece-switch-to-channel identity)
 210       (setq riece-last-channel riece-current-channel
 211             riece-current-channel nil))))
 212
 213 (defun riece-part-channel (identity)
 214   (let ((pointer (riece-identity-member identity riece-current-channels)))
 215     (if pointer
 216         (setcar pointer nil))
 217     (if (riece-identity-equal identity riece-current-channel)
 218         (riece-switch-to-nearest-channel pointer))))
 219
 220 (defun riece-redisplay-buffers (&optional force)
 221   (riece-update-buffers)
 222   (riece-redraw-layout force)
 223   (run-hooks 'riece-redisplay-buffers-hook))
 224
 225 (provide 'riece-display)
 226
 227 ;;; riece-display.el ends here