1 ;;; riece-display.el --- buffer arrangement
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
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)
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.
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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 (require 'riece-options)
28 (require 'riece-channel)
30 (require 'riece-layout)
31 (require 'riece-signal)
34 (defvar riece-channel-buffer-format "*Channel:%s*"
35 "Format of channel message buffer.")
36 (defvar riece-channel-buffer-alist nil
37 "An alist mapping identities to channel buffers.")
39 (defvar riece-update-buffer-functions nil
40 "Functions to redisplay the buffer.
41 Local to the buffer in `riece-buffer-list'.")
43 (defvar riece-update-indicator-functions
44 '(riece-update-status-indicators
45 riece-update-channel-status-indicator
46 riece-update-channel-indicator
47 riece-update-long-channel-indicator
48 riece-update-channel-list-indicator)
49 "Functions to update modeline indicators.")
51 (defun riece-display-connect-signals ()
54 (lambda (signal handback)
55 (with-current-buffer riece-channel-list-buffer
56 (run-hooks 'riece-update-buffer-functions))
57 (riece-update-channel-list-indicator)))
60 (lambda (signal handback)
61 (with-current-buffer riece-user-list-buffer
62 (run-hooks 'riece-update-buffer-functions)))
64 (and riece-current-channel
65 (riece-identity-equal (car (riece-signal-args signal))
66 riece-current-channel))))
69 (lambda (signal handback)
70 (riece-update-status-indicators)
71 (riece-update-channel-status-indicator)
72 (riece-update-channel-indicator)
73 (riece-update-long-channel-indicator)
74 (force-mode-line-update t)
75 (riece-emit-signal 'channel-list-changed)
76 (riece-emit-signal 'user-list-changed riece-current-channel)
78 (riece-redraw-layout))))
81 (lambda (signal handback)
82 (riece-emit-signal 'user-list-changed riece-current-channel))
84 (and riece-current-channel
85 (riece-identity-equal (nth 1 (riece-signal-args signal))
86 riece-current-channel)
87 (not (riece-identity-equal (car (riece-signal-args signal))
88 (riece-current-nickname))))))
91 (lambda (signal handback)
92 (riece-join-channel (nth 1 (riece-signal-args signal)))
93 (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
94 (setq riece-join-channel-candidate nil))
96 (riece-identity-equal (car (riece-signal-args signal))
97 (riece-current-nickname))))
100 (lambda (signal handback)
101 (riece-emit-signal 'user-list-changed riece-current-channel))
103 (and riece-current-channel
104 (riece-identity-equal (nth 1 (riece-signal-args signal))
105 riece-current-channel)
106 (not (riece-identity-equal (car (riece-signal-args signal))
107 (riece-current-nickname))))))
108 (riece-connect-signal
110 (lambda (signal handback)
111 (riece-part-channel (nth 1 (riece-signal-args signal))))
113 (riece-identity-equal (car (riece-signal-args signal))
114 (riece-current-nickname))))
115 (riece-connect-signal
117 (lambda (signal handback)
118 (riece-emit-signal 'user-list-changed riece-current-channel))
120 (and riece-current-channel
121 (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
122 (riece-identity-server riece-current-channel))
123 (riece-with-server-buffer (riece-identity-server
124 riece-current-channel)
125 (when (riece-channel-p (riece-identity-prefix
126 riece-current-channel))
127 (riece-identity-assoc
128 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
129 (riece-channel-get-users (riece-identity-prefix
130 riece-current-channel))
132 (riece-connect-signal
134 (lambda (signal handback)
135 (riece-update-status-indicators)
136 (riece-update-channel-indicator)
137 (force-mode-line-update t))
139 (riece-identity-equal (nth 1 (riece-signal-args signal))
140 (riece-current-nickname))))
141 (riece-connect-signal
143 (lambda (signal handback)
144 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
146 (and riece-current-channel
147 (riece-identity-equal (car (riece-signal-args signal))
148 riece-current-channel))))
149 (riece-connect-signal
151 (lambda (signal handback)
152 (let* ((old-identity (car (riece-signal-args signal)))
153 (new-identity (nth 1 (riece-signal-args signal)))
154 (pointer (riece-identity-member old-identity
155 riece-current-channels)))
156 ;; Rename the channel buffer.
158 (setcar pointer new-identity)
159 (with-current-buffer (riece-channel-buffer old-identity)
160 (rename-buffer (riece-channel-buffer-name new-identity) t)
161 (setq riece-channel-buffer-alist
162 (cons (cons new-identity (current-buffer))
163 (delq (riece-identity-assoc old-identity
164 riece-channel-buffer-alist)
165 riece-channel-buffer-alist))))))))
166 (riece-connect-signal
168 (lambda (signal handback)
169 (riece-update-status-indicators)
170 (force-mode-line-update t))
172 (riece-identity-equal (car (riece-signal-args signal))
173 (riece-current-nickname))))
174 (riece-connect-signal
175 'user-operator-changed
176 (lambda (signal handback)
177 (riece-update-status-indicators)
178 (force-mode-line-update t))
180 (riece-identity-equal (car (riece-signal-args signal))
181 (riece-current-nickname))))
182 (riece-connect-signal
183 'channel-topic-changed
184 (lambda (signal handback)
185 (riece-update-long-channel-indicator)
186 (force-mode-line-update t))
188 (and riece-current-channel
189 (riece-identity-equal (car (riece-signal-args signal))
190 riece-current-channel))))
191 (riece-connect-signal
192 'channel-modes-changed
193 (lambda (signal handback)
194 (riece-update-long-channel-indicator)
195 (force-mode-line-update t))
197 (and riece-current-channel
198 (riece-identity-equal (car (riece-signal-args signal))
199 riece-current-channel))))
200 (riece-connect-signal
201 'channel-operators-changed
202 (lambda (signal handback)
203 (riece-update-channel-status-indicator)
204 (riece-emit-signal 'user-list-changed riece-current-channel))
206 (and riece-current-channel
207 (riece-identity-equal (car (riece-signal-args signal))
208 riece-current-channel))))
209 (riece-connect-signal
210 'channel-speakers-changed
211 (lambda (signal handback)
212 (riece-update-channel-status-indicator)
213 (riece-emit-signal 'user-list-changed riece-current-channel))
215 (and riece-current-channel
216 (riece-identity-equal (car (riece-signal-args signal))
217 riece-current-channel))))
218 (riece-connect-signal
219 'buffer-freeze-changed
220 (lambda (signal handback)
221 (riece-update-status-indicators)
222 (force-mode-line-update t))))
224 (defun riece-update-user-list-buffer ()
226 (if (and riece-current-channel
227 (riece-channel-p (riece-identity-prefix riece-current-channel)))
229 (riece-with-server-buffer (riece-identity-server
230 riece-current-channel)
231 (riece-channel-get-users (riece-identity-prefix
232 riece-current-channel))))
233 (inhibit-read-only t)
236 (riece-kill-all-overlays)
238 (insert (if (memq ?o (cdr (car users)))
240 (if (memq ?v (cdr (car users)))
243 (riece-format-identity
244 (riece-make-identity (car (car users))
245 (riece-identity-server
246 riece-current-channel))
249 (setq users (cdr users)))))))
251 (defun riece-format-identity-for-channel-list-buffer (index identity)
252 (or (run-hook-with-args-until-success
253 'riece-format-identity-for-channel-list-buffer-functions index identity)
254 (concat (format "%2d:%c" index
255 (if (riece-identity-equal identity riece-current-channel)
258 (riece-format-identity identity))))
260 (defun riece-update-channel-list-buffer ()
262 (let ((inhibit-read-only t)
265 (channels riece-current-channels))
267 (riece-kill-all-overlays)
270 (insert (riece-format-identity-for-channel-list-buffer
271 index (car channels))
273 (setq index (1+ index)
274 channels (cdr channels))))))
276 (defun riece-update-channel-indicator ()
277 (setq riece-channel-indicator
278 (if riece-current-channel
279 (riece-format-identity riece-current-channel)
280 (riece-mcat "None"))))
282 (defun riece-update-long-channel-indicator ()
283 (setq riece-long-channel-indicator
284 (if riece-current-channel
285 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
286 (riece-concat-channel-topic
287 riece-current-channel
288 (riece-concat-channel-modes
289 riece-current-channel
290 (riece-format-identity riece-current-channel)))
291 (riece-format-identity riece-current-channel))
292 (riece-mcat "None"))))
294 (defun riece-format-identity-for-channel-list-indicator (index identity)
295 (or (run-hook-with-args-until-success
296 'riece-format-identity-for-channel-list-indicator-functions
298 (let ((string (riece-format-identity identity))
301 (while (string-match "%" string start)
302 (setq start (1+ (match-end 0))
303 string (replace-match "%%" nil nil string)))
304 (format "%d:%s" index string))))
306 (defun riece-update-channel-list-indicator ()
307 (if (and riece-current-channels
308 ;; There is at least one channel.
309 (delq nil (copy-sequence riece-current-channels)))
312 (setq riece-channel-list-indicator
319 (riece-format-identity-for-channel-list-indicator
321 (setq index (1+ index))))
322 riece-current-channels))
323 pointer riece-channel-list-indicator)
326 (setcdr pointer (cons "," (cdr pointer))))
327 (setq pointer (cdr (cdr pointer))))
328 (setq riece-channel-list-indicator
329 (riece-normalize-modeline-string riece-channel-list-indicator)))
330 (setq riece-channel-list-indicator (riece-mcat "No channel"))))
332 (defun riece-update-status-indicators ()
333 (let ((server-name (riece-current-server-name)))
335 (with-current-buffer riece-command-buffer
336 (riece-with-server-buffer server-name
337 (setq riece-away-indicator
338 (if (and riece-real-nickname
339 (riece-user-get-away riece-real-nickname))
342 riece-operator-indicator
343 (if (and riece-real-nickname
344 (riece-user-get-operator riece-real-nickname))
348 (if riece-real-nickname
349 (setq riece-user-indicator
350 (riece-format-identity
351 (riece-make-identity riece-real-nickname
356 (with-current-buffer (window-buffer window)
357 (if (riece-derived-mode-p 'riece-dialogue-mode)
358 (setq riece-freeze-indicator
359 (if (eq riece-freeze 'own)
365 (defun riece-update-channel-status-indicator ()
366 (if (and riece-current-channel
367 (riece-channel-p (riece-identity-prefix riece-current-channel)))
369 (riece-with-server-buffer (riece-identity-server
370 riece-current-channel)
371 (riece-channel-get-users (riece-identity-prefix
372 riece-current-channel))))
374 (riece-with-server-buffer (riece-identity-server
375 riece-current-channel)
376 riece-real-nickname)))
377 (with-current-buffer riece-command-buffer
378 (setq riece-channel-status-indicator
380 (let ((user (cdr (riece-identity-assoc nickname users t))))
388 (defun riece-update-buffers (&optional buffers)
390 (setq buffers riece-buffer-list))
392 (if (buffer-live-p (car buffers))
393 (with-current-buffer (car buffers)
394 (run-hooks 'riece-update-buffer-functions)))
395 (setq buffers (cdr buffers)))
396 (run-hooks 'riece-update-indicator-functions)
397 (force-mode-line-update t)
398 (run-hooks 'riece-update-buffer-hook))
400 (defun riece-channel-buffer-name (identity)
401 (let ((channels (riece-identity-member identity riece-current-channels)))
403 (setq identity (car channels))
405 (riece-debug (format "%S is not a member of riece-current-channels"
407 (format riece-channel-buffer-format (riece-format-identity identity))))
410 (autoload 'riece-channel-mode "riece"))
411 (defun riece-channel-buffer-create (identity)
413 (riece-get-buffer-create (riece-channel-buffer-name identity)
415 (setq riece-channel-buffer-alist
416 (cons (cons identity (current-buffer))
417 riece-channel-buffer-alist))
418 (unless (eq major-mode 'riece-channel-mode)
420 (let (buffer-read-only)
421 (riece-insert-info (current-buffer)
422 (format (riece-mcat "Created on %s\n")
423 (funcall riece-format-time-function
425 (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
428 (defun riece-channel-buffer (identity)
429 (let ((entry (riece-identity-assoc identity riece-channel-buffer-alist)))
431 (if (buffer-live-p (cdr entry))
435 (format "riece-channel-buffer: nonexistent buffer: %s"
436 (riece-format-identity identity))))))))
438 (defun riece-switch-to-channel (identity)
439 (let ((last riece-current-channel)
441 (if (and riece-channel-buffer
442 (setq window (get-buffer-window riece-channel-buffer)))
443 (with-current-buffer riece-channel-buffer
444 (setq riece-channel-buffer-window-point (window-point window))))
445 (setq riece-current-channel identity
446 riece-channel-buffer (riece-channel-buffer riece-current-channel))
447 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
448 (riece-emit-signal 'channel-switched)))
450 (defun riece-join-channel (identity)
451 (unless (riece-identity-member identity riece-current-channels)
452 (setq riece-current-channels
453 (riece-identity-assign-binding
454 identity riece-current-channels
458 (riece-parse-identity channel)))
459 riece-default-channel-binding)))
460 (riece-channel-buffer-create identity)))
462 (defun riece-switch-to-nearest-channel (pointer)
463 (let ((start riece-current-channels)
465 (while (and start (not (eq start pointer)))
467 (setq identity (car start)))
468 (setq start (cdr start)))
471 (null (car pointer)))
472 (setq pointer (cdr pointer)))
473 (setq identity (car pointer)))
475 (riece-switch-to-channel identity)
476 (let ((last riece-current-channel))
477 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
478 (setq riece-current-channel nil)
479 (riece-emit-signal 'channel-switched)))))
481 (defun riece-part-channel (identity)
482 (let ((pointer (riece-identity-member identity riece-current-channels)))
484 (error "No such channel!"))
486 (if (riece-identity-equal identity riece-current-channel)
487 (riece-switch-to-nearest-channel pointer)
488 (riece-emit-signal 'channel-list-changed))
489 (funcall riece-buffer-dispose-function (riece-channel-buffer identity))))
491 (defun riece-redisplay-buffers (&optional force)
492 (riece-update-buffers)
493 (riece-redraw-layout force)
494 (run-hooks 'riece-redisplay-buffers-hook))
496 (provide 'riece-display)
498 ;;; riece-display.el ends here