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