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 (autoload 'derived-mode-class "derived")
36 (defvar riece-channel-buffer-format "*Channel:%s*"
37 "Format of channel message buffer.")
38 (defvar riece-channel-buffer-alist nil
39 "An alist mapping identities to channel buffers.")
41 (defvar riece-update-buffer-functions nil
42 "Functions to redisplay the buffer.
43 Local to the buffer in `riece-buffer-list'.")
45 (defvar riece-update-indicator-functions
46 '(riece-update-status-indicators
47 riece-update-channel-status-indicator
48 riece-update-channel-indicator
49 riece-update-long-channel-indicator
50 riece-update-channel-list-indicator)
51 "Functions to update modeline indicators.")
53 (defun riece-display-connect-signals ()
56 (lambda (signal handback)
58 (set-buffer riece-channel-list-buffer)
59 (run-hooks 'riece-update-buffer-functions))
60 (riece-update-channel-list-indicator)))
63 (lambda (signal handback)
65 (set-buffer riece-user-list-buffer)
66 (run-hooks 'riece-update-buffer-functions)))
68 (and riece-current-channel
69 (riece-identity-equal (car (riece-signal-args signal))
70 riece-current-channel))))
73 (lambda (signal handback)
74 (riece-update-status-indicators)
75 (riece-update-channel-status-indicator)
76 (riece-update-channel-indicator)
77 (riece-update-long-channel-indicator)
78 (force-mode-line-update t)
79 (riece-emit-signal 'channel-list-changed)
80 (riece-emit-signal 'user-list-changed riece-current-channel)
82 (riece-redraw-layout))))
85 (lambda (signal handback)
86 (riece-emit-signal 'user-list-changed riece-current-channel))
88 (and riece-current-channel
89 (riece-identity-equal (nth 1 (riece-signal-args signal))
90 riece-current-channel)
91 (not (riece-identity-equal (car (riece-signal-args signal))
92 (riece-current-nickname))))))
95 (lambda (signal handback)
96 (riece-join-channel (nth 1 (riece-signal-args signal)))
97 (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
98 (setq riece-join-channel-candidate nil))
100 (riece-identity-equal (car (riece-signal-args signal))
101 (riece-current-nickname))))
102 (riece-connect-signal
104 (lambda (signal handback)
105 (riece-emit-signal 'user-list-changed riece-current-channel))
107 (and riece-current-channel
108 (riece-identity-equal (nth 1 (riece-signal-args signal))
109 riece-current-channel)
110 (not (riece-identity-equal (car (riece-signal-args signal))
111 (riece-current-nickname))))))
112 (riece-connect-signal
114 (lambda (signal handback)
115 (riece-part-channel (nth 1 (riece-signal-args signal))))
117 (riece-identity-equal (car (riece-signal-args signal))
118 (riece-current-nickname))))
119 (riece-connect-signal
121 (lambda (signal handback)
122 (riece-emit-signal 'user-list-changed riece-current-channel))
124 (and riece-current-channel
125 (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
126 (riece-identity-server riece-current-channel))
127 (riece-with-server-buffer (riece-identity-server
128 riece-current-channel)
129 (when (riece-channel-p (riece-identity-prefix
130 riece-current-channel))
131 (riece-identity-assoc
132 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
133 (riece-channel-get-users (riece-identity-prefix
134 riece-current-channel))
136 (riece-connect-signal
138 (lambda (signal handback)
139 (riece-update-status-indicators)
140 (riece-update-channel-indicator)
141 (force-mode-line-update t))
143 (riece-identity-equal (nth 1 (riece-signal-args signal))
144 (riece-current-nickname))))
145 (riece-connect-signal
147 (lambda (signal handback)
148 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
150 (and riece-current-channel
151 (riece-identity-equal (car (riece-signal-args signal))
152 riece-current-channel))))
153 (riece-connect-signal
155 (lambda (signal handback)
156 (let* ((old-identity (car (riece-signal-args signal)))
157 (new-identity (nth 1 (riece-signal-args signal)))
158 (pointer (riece-identity-member old-identity
159 riece-current-channels)))
160 ;; Rename the channel buffer.
162 (setcar pointer new-identity)
163 (with-current-buffer (riece-channel-buffer old-identity)
164 (rename-buffer (riece-channel-buffer-name new-identity) t)
165 (setq riece-channel-buffer-alist
166 (cons (cons new-identity (current-buffer))
167 (delq (riece-identity-assoc old-identity
168 riece-channel-buffer-alist)
169 riece-channel-buffer-alist))))))))
170 (riece-connect-signal
172 (lambda (signal handback)
173 (riece-update-status-indicators)
174 (force-mode-line-update t))
176 (riece-identity-equal (car (riece-signal-args signal))
177 (riece-current-nickname))))
178 (riece-connect-signal
179 'user-operator-changed
180 (lambda (signal handback)
181 (riece-update-status-indicators)
182 (force-mode-line-update t))
184 (riece-identity-equal (car (riece-signal-args signal))
185 (riece-current-nickname))))
186 (riece-connect-signal
187 'channel-topic-changed
188 (lambda (signal handback)
189 (riece-update-long-channel-indicator)
190 (force-mode-line-update t))
192 (and riece-current-channel
193 (riece-identity-equal (car (riece-signal-args signal))
194 riece-current-channel))))
195 (riece-connect-signal
196 'channel-modes-changed
197 (lambda (signal handback)
198 (riece-update-long-channel-indicator)
199 (force-mode-line-update t))
201 (and riece-current-channel
202 (riece-identity-equal (car (riece-signal-args signal))
203 riece-current-channel))))
204 (riece-connect-signal
205 'channel-operators-changed
206 (lambda (signal handback)
207 (riece-update-channel-status-indicator)
208 (riece-emit-signal 'user-list-changed riece-current-channel))
210 (and riece-current-channel
211 (riece-identity-equal (car (riece-signal-args signal))
212 riece-current-channel))))
213 (riece-connect-signal
214 'channel-speakers-changed
215 (lambda (signal handback)
216 (riece-update-channel-status-indicator)
217 (riece-emit-signal 'user-list-changed riece-current-channel))
219 (and riece-current-channel
220 (riece-identity-equal (car (riece-signal-args signal))
221 riece-current-channel))))
222 (riece-connect-signal
223 'buffer-freeze-changed
224 (lambda (signal handback)
225 (riece-update-status-indicators)
226 (force-mode-line-update t))))
228 (defun riece-update-user-list-buffer ()
230 (if (and riece-current-channel
231 (riece-channel-p (riece-identity-prefix riece-current-channel)))
233 (riece-with-server-buffer (riece-identity-server
234 riece-current-channel)
235 (riece-channel-get-users (riece-identity-prefix
236 riece-current-channel))))
237 (inhibit-read-only t)
240 (riece-kill-all-overlays)
242 (insert (if (memq ?o (cdr (car users)))
244 (if (memq ?v (cdr (car users)))
247 (riece-format-identity
248 (riece-make-identity (car (car users))
249 (riece-identity-server
250 riece-current-channel))
253 (setq users (cdr users)))))))
255 (defun riece-format-identity-for-channel-list-buffer (index identity)
256 (or (run-hook-with-args-until-success
257 'riece-format-identity-for-channel-list-buffer-functions index identity)
258 (concat (format "%2d:%c" index
259 (if (riece-identity-equal identity riece-current-channel)
262 (riece-format-identity identity))))
264 (defun riece-update-channel-list-buffer ()
266 (let ((inhibit-read-only t)
269 (channels riece-current-channels))
271 (riece-kill-all-overlays)
274 (insert (riece-format-identity-for-channel-list-buffer
275 index (car channels))
277 (setq index (1+ index)
278 channels (cdr channels))))))
280 (defun riece-update-channel-indicator ()
281 (setq riece-channel-indicator
282 (if riece-current-channel
283 (riece-format-identity riece-current-channel)
284 (riece-mcat "None"))))
286 (defun riece-update-long-channel-indicator ()
287 (setq riece-long-channel-indicator
288 (if riece-current-channel
289 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
290 (riece-concat-channel-topic
291 riece-current-channel
292 (riece-concat-channel-modes
293 riece-current-channel
294 (riece-format-identity riece-current-channel)))
295 (riece-format-identity riece-current-channel))
296 (riece-mcat "None"))))
298 (defun riece-format-identity-for-channel-list-indicator (index identity)
299 (or (run-hook-with-args-until-success
300 'riece-format-identity-for-channel-list-indicator-functions
302 (let ((string (riece-format-identity identity))
305 (while (string-match "%" string start)
306 (setq start (1+ (match-end 0))
307 string (replace-match "%%" nil nil string)))
308 (format "%d:%s" index string))))
310 (defun riece-update-channel-list-indicator ()
311 (if (and riece-current-channels
312 ;; There is at least one channel.
313 (delq nil (copy-sequence riece-current-channels)))
316 (setq riece-channel-list-indicator
323 (riece-format-identity-for-channel-list-indicator
325 (setq index (1+ index))))
326 riece-current-channels))
327 pointer riece-channel-list-indicator)
330 (setcdr pointer (cons "," (cdr pointer))))
331 (setq pointer (cdr (cdr pointer))))
332 (setq riece-channel-list-indicator
333 (riece-normalize-modeline-string riece-channel-list-indicator)))
334 (setq riece-channel-list-indicator (riece-mcat "No channel"))))
336 (defun riece-update-status-indicators ()
337 (let ((server-name (riece-current-server-name)))
339 (with-current-buffer riece-command-buffer
340 (riece-with-server-buffer server-name
341 (setq riece-away-indicator
342 (if (and riece-real-nickname
343 (riece-user-get-away riece-real-nickname))
346 riece-operator-indicator
347 (if (and riece-real-nickname
348 (riece-user-get-operator riece-real-nickname))
352 (riece-format-identity
353 (riece-make-identity riece-real-nickname riece-server-name)
357 (with-current-buffer (window-buffer window)
358 (if (eq (derived-mode-class major-mode)
359 'riece-dialogue-mode)
360 (setq riece-freeze-indicator
361 (if (eq riece-freeze 'own)
367 (defun riece-update-channel-status-indicator ()
368 (if (and riece-current-channel
369 (riece-channel-p (riece-identity-prefix riece-current-channel)))
371 (riece-with-server-buffer (riece-identity-server
372 riece-current-channel)
373 (riece-channel-get-users (riece-identity-prefix
374 riece-current-channel))))
376 (riece-with-server-buffer (riece-identity-server
377 riece-current-channel)
378 riece-real-nickname)))
379 (with-current-buffer riece-command-buffer
380 (setq riece-channel-status-indicator
382 (let ((user (cdr (riece-identity-assoc nickname users t))))
390 (defun riece-update-buffers (&optional buffers)
392 (setq buffers riece-buffer-list))
394 (if (buffer-live-p (car buffers))
396 (set-buffer (car buffers))
397 (run-hooks 'riece-update-buffer-functions)))
398 (setq buffers (cdr buffers)))
399 (run-hooks 'riece-update-indicator-functions)
400 (force-mode-line-update t)
401 (run-hooks 'riece-update-buffer-hook))
403 (defun riece-channel-buffer-name (identity)
404 (let ((channels (riece-identity-member identity riece-current-channels)))
406 (setq identity (car channels))
408 (riece-debug (format "%S is not a member of riece-current-channels"
410 (format riece-channel-buffer-format (riece-format-identity identity))))
413 (autoload 'riece-channel-mode "riece"))
414 (defun riece-channel-buffer-create (identity)
416 (riece-get-buffer-create (riece-channel-buffer-name identity)
418 (setq riece-channel-buffer-alist
419 (cons (cons identity (current-buffer))
420 riece-channel-buffer-alist))
421 (unless (eq major-mode 'riece-channel-mode)
423 (let (buffer-read-only)
424 (riece-insert-info (current-buffer)
425 (format (riece-mcat "Created on %s\n")
426 (funcall riece-format-time-function
428 (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
431 (defun riece-channel-buffer (identity)
432 (let ((entry (riece-identity-assoc identity riece-channel-buffer-alist)))
434 (if (buffer-live-p (cdr entry))
438 (format "riece-channel-buffer: nonexistent buffer: %s"
439 (riece-format-identity identity))))))))
441 (defun riece-switch-to-channel (identity)
442 (let ((last riece-current-channel)
444 (if (and riece-channel-buffer
445 (setq window (get-buffer-window riece-channel-buffer)))
446 (with-current-buffer riece-channel-buffer
447 (setq riece-channel-buffer-window-point (window-point window))))
448 (setq riece-current-channel identity
449 riece-channel-buffer (riece-channel-buffer riece-current-channel))
450 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
451 (riece-emit-signal 'channel-switched)))
453 (defun riece-join-channel (identity)
454 (unless (riece-identity-member identity riece-current-channels)
455 (setq riece-current-channels
456 (riece-identity-assign-binding
457 identity riece-current-channels
461 (riece-parse-identity channel)))
462 riece-default-channel-binding)))
463 (riece-channel-buffer-create identity)))
465 (defun riece-switch-to-nearest-channel (pointer)
466 (let ((start riece-current-channels)
468 (while (and start (not (eq start pointer)))
470 (setq identity (car start)))
471 (setq start (cdr start)))
474 (null (car pointer)))
475 (setq pointer (cdr pointer)))
476 (setq identity (car pointer)))
478 (riece-switch-to-channel identity)
479 (let ((last riece-current-channel))
480 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
481 (setq riece-current-channel nil)
482 (riece-emit-signal 'channel-switched)))))
484 (defun riece-part-channel (identity)
485 (let ((pointer (riece-identity-member identity riece-current-channels)))
487 (error "No such channel!"))
489 (if (riece-identity-equal identity riece-current-channel)
490 (riece-switch-to-nearest-channel pointer)
491 (riece-emit-signal 'channel-list-changed))
492 (funcall riece-buffer-dispose-function (riece-channel-buffer identity))))
494 (defun riece-redisplay-buffers (&optional force)
495 (riece-update-buffers)
496 (riece-redraw-layout force)
497 (run-hooks 'riece-redisplay-buffers-hook))
499 (provide 'riece-display)
501 ;;; riece-display.el ends here