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-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: %s\n" index
  84                                   (riece-format-identity (car channels))))
  85                   (put-text-property point (point) 'riece-identity
  86                                      (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 riece-channel-list-changed
 110       (if (and riece-current-channels
 111                ;; There is at least one channel.
 112                (delq nil (copy-sequence riece-current-channels)))
 113           (let ((index 1))
 114             (setq riece-channel-list-indicator
 115                   (mapconcat
 116                    #'identity
 117                    (delq nil
 118                          (mapcar
 119                           (lambda (channel)
 120                             (prog1
 121                                 (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   (setq riece-channel-list-changed nil)
 161   (force-mode-line-update t))
 162
 163 (defun riece-channel-buffer-name (identity)
 164   (format riece-channel-buffer-format (riece-format-identity identity)))
 165
 166 (eval-when-compile
 167   (autoload 'riece-channel-mode "riece"))
 168 (defun riece-channel-buffer-create (identity)
 169   (with-current-buffer
 170       (riece-get-buffer-create (riece-channel-buffer-name identity))
 171     (unless (eq major-mode 'riece-channel-mode)
 172       (riece-channel-mode)
 173       (let (buffer-read-only)
 174         (riece-insert-info (current-buffer)
 175                            (concat "Created on "
 176                                    (funcall riece-format-time-function
 177                                             (current-time))
 178                                    "\n"))
 179         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
 180     (current-buffer)))
 181
 182 (defun riece-switch-to-channel (identity)
 183   (let ((last riece-current-channel))
 184     (setq riece-current-channel identity)
 185     (run-hook-with-args 'riece-after-switch-to-channel-functions last)))
 186
 187 (defun riece-join-channel (identity)
 188   (unless (riece-identity-member identity riece-current-channels)
 189     (setq riece-current-channels
 190           (riece-identity-assign-binding
 191            identity riece-current-channels
 192            (mapcar
 193             (lambda (channel)
 194               (if channel
 195                   (riece-parse-identity channel)))
 196             riece-default-channel-binding)))
 197     (riece-channel-buffer-create identity)
 198     (setq riece-channel-list-changed 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       (let ((last riece-current-channel))
 215         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
 216         (setq riece-current-channel nil)))))
 217
 218 (defun riece-part-channel (identity)
 219   (let ((pointer (riece-identity-member identity riece-current-channels)))
 220     (if pointer
 221         (setcar pointer nil))
 222     (if (riece-identity-equal identity riece-current-channel)
 223         (riece-switch-to-nearest-channel pointer))
 224     (setq riece-channel-list-changed 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