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