253ae755683f0a52a1399b447d0f945ada4b4a83
[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 (require 'riece-signal)
32
33 (defvar riece-channel-buffer-format "*Channel:%s*"
34   "Format of channel message buffer.")
35 (defvar riece-channel-buffer-alist nil
36   "An alist mapping identities to channel buffers.")
37
38 (defvar riece-update-buffer-functions nil
39   "Functions to redisplay the buffer.
40 Local to the buffer in `riece-buffer-list'.")
41   
42 (defvar riece-update-indicator-functions
43   '(riece-update-status-indicators
44     riece-update-channel-indicator
45     riece-update-long-channel-indicator
46     riece-update-channel-list-indicator)
47   "Functions to update modeline indicators.")
48
49 (defun riece-display-connect-signals ()
50   (riece-connect-signal
51    'channel-list-changed
52    (lambda (signal handback)
53      (save-excursion
54        (set-buffer riece-channel-list-buffer)
55        (run-hooks 'riece-update-buffer-functions))
56      (riece-update-channel-list-indicator)))
57   (riece-connect-signal
58    'user-list-changed
59    (lambda (signal handback)
60      (save-excursion
61        (set-buffer riece-user-list-buffer)
62        (run-hooks 'riece-update-buffer-functions)))
63    (lambda (signal)
64      (and riece-current-channel
65           (riece-identity-equal (car (riece-signal-args signal))
66                                 riece-current-channel))))
67   (riece-connect-signal
68    'channel-switched
69    (lambda (signal handback)
70      (riece-update-status-indicators)
71      (riece-update-channel-indicator)
72      (riece-update-long-channel-indicator)
73      (force-mode-line-update t)
74      (riece-emit-signal 'channel-list-changed)
75      (riece-emit-signal 'user-list-changed riece-current-channel)
76      (save-excursion
77        (riece-redraw-layout))))
78   (riece-connect-signal
79    'user-joined-channel
80    (lambda (signal handback)
81      (riece-emit-signal 'user-list-changed riece-current-channel))
82    (lambda (signal)
83      (and riece-current-channel
84           (riece-identity-equal (nth 1 (riece-signal-args signal))
85                                 riece-current-channel)
86           (not (riece-identity-equal (car (riece-signal-args signal))
87                                      (riece-current-nickname))))))
88   (riece-connect-signal
89    'user-joined-channel
90    (lambda (signal handback)
91      (riece-join-channel (nth 1 (riece-signal-args signal)))
92      (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
93      (setq riece-join-channel-candidate nil))
94    (lambda (signal)
95      (riece-identity-equal (car (riece-signal-args signal))
96                            (riece-current-nickname))))
97   (riece-connect-signal
98    'user-left-channel
99    (lambda (signal handback)
100      (riece-emit-signal 'user-list-changed riece-current-channel))
101    (lambda (signal)
102      (and riece-current-channel
103           (riece-identity-equal (nth 1 (riece-signal-args signal))
104                                 riece-current-channel)
105           (not (riece-identity-equal (car (riece-signal-args signal))
106                                      (riece-current-nickname))))))
107   (riece-connect-signal
108    'user-left-channel
109    (lambda (signal handback)
110      (riece-part-channel (nth 1 (riece-signal-args signal))))
111    (lambda (signal)
112      (riece-identity-equal (car (riece-signal-args signal))
113                            (riece-current-nickname))))
114   (riece-connect-signal
115    'user-renamed
116    (lambda (signal handback)
117      (riece-emit-signal 'user-list-changed riece-current-channel))
118    (lambda (signal)
119      (and riece-current-channel
120           (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
121                  (riece-identity-server riece-current-channel))
122           (riece-with-server-buffer (riece-identity-server
123                                      riece-current-channel)
124             (riece-identity-assoc
125              (riece-identity-prefix (nth 1 (riece-signal-args signal)))
126              (riece-channel-get-users (riece-identity-prefix
127                                        riece-current-channel))
128              t)))))
129   (riece-connect-signal
130    'user-renamed
131    (lambda (signal handback)
132      (riece-update-status-indicators)
133      (riece-update-channel-indicator)
134      (force-mode-line-update t))
135    (lambda (signal)
136      (riece-identity-equal (nth 1 (riece-signal-args signal))
137                            (riece-current-nickname))))
138   (riece-connect-signal
139    'user-renamed
140    (lambda (signal handback)
141      (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
142    (lambda (signal)
143      (and riece-current-channel
144           (riece-identity-equal (car (riece-signal-args signal))
145                                 riece-current-channel))))
146   (riece-connect-signal
147    'user-renamed
148    (lambda (signal handback)
149      (let* ((old-identity (car (riece-signal-args signal)))
150             (new-identity (nth 1 (riece-signal-args signal)))
151             (pointer (riece-identity-member old-identity
152                                             riece-current-channels)))
153        ;; Rename the channel buffer.
154        (when pointer
155          (setcar pointer new-identity)
156          (with-current-buffer (riece-channel-buffer old-identity)
157            (rename-buffer (riece-channel-buffer-name new-identity) t)
158            (setq riece-channel-buffer-alist
159                  (cons (cons new-identity (current-buffer))
160                        (delq (riece-identity-assoc old-identity
161                                                    riece-channel-buffer-alist)
162                              riece-channel-buffer-alist))))))))
163   (riece-connect-signal
164    'user-away-changed
165    (lambda (signal handback)
166      (riece-update-status-indicators)
167      (force-mode-line-update t))
168    (lambda (signal)
169      (riece-identity-equal (car (riece-signal-args signal))
170                            (riece-current-nickname))))
171   (riece-connect-signal
172    'user-operator-changed
173    (lambda (signal handback)
174      (riece-update-status-indicators)
175      (force-mode-line-update t))
176    (lambda (signal)
177      (riece-identity-equal (car (riece-signal-args signal))
178                            (riece-current-nickname))))
179   (riece-connect-signal
180    'channel-topic-changed
181    (lambda (signal handback)
182      (riece-update-long-channel-indicator)
183      (force-mode-line-update t))
184    (lambda (signal)
185      (and riece-current-channel
186           (riece-identity-equal (car (riece-signal-args signal))
187                                 riece-current-channel))))
188   (riece-connect-signal
189    'channel-modes-changed
190    (lambda (signal handback)
191      (riece-update-long-channel-indicator)
192      (force-mode-line-update t))
193    (lambda (signal)
194      (and riece-current-channel
195           (riece-identity-equal (car (riece-signal-args signal))
196                                 riece-current-channel))))
197   (riece-connect-signal
198    'channel-operators-changed
199    (lambda (signal handback)
200      (riece-emit-signal 'user-list-changed riece-current-channel))
201    (lambda (signal)
202      (and riece-current-channel
203           (riece-identity-equal (car (riece-signal-args signal))
204                                 riece-current-channel))))
205   (riece-connect-signal
206    'channel-speakers-changed
207    (lambda (signal handback)
208      (riece-emit-signal 'user-list-changed riece-current-channel))
209    (lambda (signal)
210      (and riece-current-channel
211           (riece-identity-equal (car (riece-signal-args signal))
212                                 riece-current-channel))))
213   (riece-connect-signal
214    'buffer-freeze-changed
215    (lambda (signal handback)
216      (riece-update-status-indicators)
217      (force-mode-line-update t))))
218
219 (defun riece-update-user-list-buffer ()
220   (save-excursion
221     (if (and riece-current-channel
222              (riece-channel-p (riece-identity-prefix riece-current-channel)))
223         (let* ((users
224                 (riece-with-server-buffer (riece-identity-server
225                                            riece-current-channel)
226                   (riece-channel-get-users (riece-identity-prefix
227                                             riece-current-channel))))
228                (inhibit-read-only t)
229                buffer-read-only)
230           (erase-buffer)
231           (riece-kill-all-overlays)
232           (while users
233             (insert (if (memq ?o (cdr (car users)))
234                         "@"
235                       (if (memq ?v (cdr (car users)))
236                           "+"
237                         " "))
238                     (riece-format-identity
239                      (riece-make-identity (car (car users))
240                                           (riece-identity-server
241                                            riece-current-channel))
242                      t)
243                     "\n")
244             (setq users (cdr users)))))))
245
246 (defun riece-format-identity-for-channel-list-buffer (index identity)
247   (or (run-hook-with-args-until-success
248        'riece-format-identity-for-channel-list-buffer-functions index identity)
249       (concat (format "%2d:%c" index
250                       (if (riece-identity-equal identity riece-current-channel)
251                           ?*
252                         ? ))
253               (riece-format-identity identity))))
254
255 (defun riece-update-channel-list-buffer ()
256   (save-excursion
257     (let ((inhibit-read-only t)
258           buffer-read-only
259           (index 1)
260           (channels riece-current-channels))
261       (erase-buffer)
262       (riece-kill-all-overlays)
263       (while channels
264         (if (car channels)
265             (insert (riece-format-identity-for-channel-list-buffer
266                      index (car channels))
267                     "\n"))
268         (setq index (1+ index)
269               channels (cdr channels))))))
270
271 (defun riece-update-channel-indicator ()
272   (setq riece-channel-indicator
273         (if riece-current-channel
274             (riece-format-identity riece-current-channel)
275           "None")))
276
277 (defun riece-update-long-channel-indicator ()
278   (setq riece-long-channel-indicator
279         (if riece-current-channel
280             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
281                 (riece-concat-channel-modes
282                  riece-current-channel
283                  (riece-concat-channel-topic
284                   riece-current-channel
285                   (riece-format-identity riece-current-channel)))
286               (riece-format-identity riece-current-channel))
287           "None")))
288
289 (defun riece-format-identity-for-channel-list-indicator (index identity)
290   (or (run-hook-with-args-until-success
291        'riece-format-identity-for-channel-list-indicator-functions
292        index identity)
293       (let ((string (riece-format-identity identity))
294             (start 0))
295         ;; Escape % -> %%.
296         (while (string-match "%" string start)
297           (setq start (1+ (match-end 0))
298                 string (replace-match "%%" nil nil string)))
299         (format "%d:%s" index string))))
300
301 (defun riece-update-channel-list-indicator ()
302   (if (and riece-current-channels
303            ;; There is at least one channel.
304            (delq nil (copy-sequence riece-current-channels)))
305       (let ((index 1)
306             pointer)
307         (setq riece-channel-list-indicator
308               (delq
309                nil
310                (mapcar
311                 (lambda (channel)
312                   (prog1
313                       (if channel
314                           (riece-format-identity-for-channel-list-indicator
315                            index channel))
316                     (setq index (1+ index))))
317                 riece-current-channels))
318               pointer riece-channel-list-indicator)
319         (while pointer
320           (if (cdr pointer)
321               (setcdr pointer (cons "," (cdr pointer))))
322           (setq pointer (cdr (cdr pointer)))))
323     (setq riece-channel-list-indicator "No channel")))
324
325 (defun riece-update-status-indicators ()
326   (if riece-current-channel
327       (with-current-buffer riece-command-buffer
328         (riece-with-server-buffer (riece-identity-server riece-current-channel)
329           (setq riece-away-indicator
330                 (if (and riece-real-nickname
331                          (riece-user-get-away riece-real-nickname))
332                     "A"
333                   "-")
334                 riece-operator-indicator
335                 (if (and riece-real-nickname
336                          (riece-user-get-operator riece-real-nickname))
337                     "O"
338                   "-")
339                 riece-user-indicator riece-real-nickname))))
340   (setq riece-freeze-indicator
341         (with-current-buffer (if (and riece-channel-buffer-mode
342                                       riece-channel-buffer)
343                                  riece-channel-buffer
344                                riece-dialogue-buffer)
345           (if (eq riece-freeze 'own)
346               "f"
347             (if riece-freeze
348                 "F"
349               "-")))))
350
351 (defun riece-update-buffers (&optional buffers)
352   (unless buffers
353     (setq buffers riece-buffer-list))
354   (while buffers
355     (save-excursion
356       (set-buffer (car buffers))
357       (run-hooks 'riece-update-buffer-functions))
358     (setq buffers (cdr buffers)))
359   (run-hooks 'riece-update-indicator-functions)
360   (force-mode-line-update t)
361   (run-hooks 'riece-update-buffer-hook))
362
363 (defun riece-channel-buffer-name (identity)
364   (let ((channels (riece-identity-member identity riece-current-channels)))
365     (if channels
366         (setq identity (car channels))
367       (if riece-debug
368           (message "%S is not a member of riece-current-channels" identity)))
369     (format riece-channel-buffer-format (riece-format-identity identity))))
370
371 (eval-when-compile
372   (autoload 'riece-channel-mode "riece"))
373 (defun riece-channel-buffer-create (identity)
374   (with-current-buffer
375       (riece-get-buffer-create (riece-channel-buffer-name identity)
376                                'riece-channel-mode)
377     (setq riece-channel-buffer-alist
378           (cons (cons identity (current-buffer))
379                 riece-channel-buffer-alist))
380     (unless (eq major-mode 'riece-channel-mode)
381       (riece-channel-mode)
382       (let (buffer-read-only)
383         (riece-insert-info (current-buffer)
384                            (concat "Created on "
385                                    (funcall riece-format-time-function
386                                             (current-time))
387                                    "\n"))
388         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
389     (current-buffer)))
390
391 (defun riece-channel-buffer (identity)
392   (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
393
394 (defun riece-switch-to-channel (identity)
395   (let ((last riece-current-channel))
396     (setq riece-current-channel identity
397           riece-channel-buffer (riece-channel-buffer riece-current-channel))
398     (run-hook-with-args 'riece-after-switch-to-channel-functions last)
399     (riece-emit-signal 'channel-switched)))
400
401 (defun riece-join-channel (identity)
402   (unless (riece-identity-member identity riece-current-channels)
403     (setq riece-current-channels
404           (riece-identity-assign-binding
405            identity riece-current-channels
406            (mapcar
407             (lambda (channel)
408               (if channel
409                   (riece-parse-identity channel)))
410             riece-default-channel-binding)))
411     (riece-channel-buffer-create identity)))
412
413 (defun riece-switch-to-nearest-channel (pointer)
414   (let ((start riece-current-channels)
415         identity)
416     (while (and start (not (eq start pointer)))
417       (if (car start)
418           (setq identity (car start)))
419       (setq start (cdr start)))
420     (unless identity
421       (while (and pointer
422                   (null (car pointer)))
423         (setq pointer (cdr pointer)))
424       (setq identity (car pointer)))
425     (if identity
426         (riece-switch-to-channel identity)
427       (let ((last riece-current-channel))
428         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
429         (setq riece-current-channel nil)
430         (riece-emit-signal 'channel-switched)))))
431
432 (defun riece-part-channel (identity)
433   (let ((pointer (riece-identity-member identity riece-current-channels)))
434     (if pointer
435         (setcar pointer nil))
436     (if (riece-identity-equal identity riece-current-channel)
437         (riece-switch-to-nearest-channel pointer))))
438
439 (defun riece-redisplay-buffers (&optional force)
440   (riece-update-buffers)
441   (riece-redraw-layout force)
442   (run-hooks 'riece-redisplay-buffers-hook))
443
444 (provide 'riece-display)
445
446 ;;; riece-display.el ends here