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)
33 (autoload 'derived-mode-class "derived")
35 (defvar riece-channel-buffer-format "*Channel:%s*"
36 "Format of channel message buffer.")
37 (defvar riece-channel-buffer-alist nil
38 "An alist mapping identities to channel buffers.")
40 (defvar riece-update-buffer-functions nil
41 "Functions to redisplay the buffer.
42 Local to the buffer in `riece-buffer-list'.")
44 (defvar riece-update-indicator-functions
45 '(riece-update-status-indicators
46 riece-update-channel-status-indicator
47 riece-update-channel-indicator
48 riece-update-long-channel-indicator
49 riece-update-channel-list-indicator)
50 "Functions to update modeline indicators.")
52 (defun riece-display-connect-signals ()
55 (lambda (signal handback)
57 (set-buffer riece-channel-list-buffer)
58 (run-hooks 'riece-update-buffer-functions))
59 (riece-update-channel-list-indicator)))
62 (lambda (signal handback)
64 (set-buffer riece-user-list-buffer)
65 (run-hooks 'riece-update-buffer-functions)))
67 (and riece-current-channel
68 (riece-identity-equal (car (riece-signal-args signal))
69 riece-current-channel))))
72 (lambda (signal handback)
73 (riece-update-status-indicators)
74 (riece-update-channel-status-indicator)
75 (riece-update-channel-indicator)
76 (riece-update-long-channel-indicator)
77 (force-mode-line-update t)
78 (riece-emit-signal 'channel-list-changed)
79 (riece-emit-signal 'user-list-changed riece-current-channel)
81 (riece-redraw-layout))))
84 (lambda (signal handback)
85 (riece-emit-signal 'user-list-changed riece-current-channel))
87 (and riece-current-channel
88 (riece-identity-equal (nth 1 (riece-signal-args signal))
89 riece-current-channel)
90 (not (riece-identity-equal (car (riece-signal-args signal))
91 (riece-current-nickname))))))
94 (lambda (signal handback)
95 (riece-join-channel (nth 1 (riece-signal-args signal)))
96 (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
97 (setq riece-join-channel-candidate nil))
99 (riece-identity-equal (car (riece-signal-args signal))
100 (riece-current-nickname))))
101 (riece-connect-signal
103 (lambda (signal handback)
104 (riece-emit-signal 'user-list-changed riece-current-channel))
106 (and riece-current-channel
107 (riece-identity-equal (nth 1 (riece-signal-args signal))
108 riece-current-channel)
109 (not (riece-identity-equal (car (riece-signal-args signal))
110 (riece-current-nickname))))))
111 (riece-connect-signal
113 (lambda (signal handback)
114 (riece-part-channel (nth 1 (riece-signal-args signal))))
116 (riece-identity-equal (car (riece-signal-args signal))
117 (riece-current-nickname))))
118 (riece-connect-signal
120 (lambda (signal handback)
121 (riece-emit-signal 'user-list-changed riece-current-channel))
123 (and riece-current-channel
124 (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
125 (riece-identity-server riece-current-channel))
126 (riece-with-server-buffer (riece-identity-server
127 riece-current-channel)
128 (when (riece-channel-p (riece-identity-prefix
129 riece-current-channel))
130 (riece-identity-assoc
131 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
132 (riece-channel-get-users (riece-identity-prefix
133 riece-current-channel))
135 (riece-connect-signal
137 (lambda (signal handback)
138 (riece-update-status-indicators)
139 (riece-update-channel-indicator)
140 (force-mode-line-update t))
142 (riece-identity-equal (nth 1 (riece-signal-args signal))
143 (riece-current-nickname))))
144 (riece-connect-signal
146 (lambda (signal handback)
147 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
149 (and riece-current-channel
150 (riece-identity-equal (car (riece-signal-args signal))
151 riece-current-channel))))
152 (riece-connect-signal
154 (lambda (signal handback)
155 (let* ((old-identity (car (riece-signal-args signal)))
156 (new-identity (nth 1 (riece-signal-args signal)))
157 (pointer (riece-identity-member old-identity
158 riece-current-channels)))
159 ;; Rename the channel buffer.
161 (setcar pointer new-identity)
162 (with-current-buffer (riece-channel-buffer old-identity)
163 (rename-buffer (riece-channel-buffer-name new-identity) t)
164 (setq riece-channel-buffer-alist
165 (cons (cons new-identity (current-buffer))
166 (delq (riece-identity-assoc old-identity
167 riece-channel-buffer-alist)
168 riece-channel-buffer-alist))))))))
169 (riece-connect-signal
171 (lambda (signal handback)
172 (riece-update-status-indicators)
173 (force-mode-line-update t))
175 (riece-identity-equal (car (riece-signal-args signal))
176 (riece-current-nickname))))
177 (riece-connect-signal
178 'user-operator-changed
179 (lambda (signal handback)
180 (riece-update-status-indicators)
181 (force-mode-line-update t))
183 (riece-identity-equal (car (riece-signal-args signal))
184 (riece-current-nickname))))
185 (riece-connect-signal
186 'channel-topic-changed
187 (lambda (signal handback)
188 (riece-update-long-channel-indicator)
189 (force-mode-line-update t))
191 (and riece-current-channel
192 (riece-identity-equal (car (riece-signal-args signal))
193 riece-current-channel))))
194 (riece-connect-signal
195 'channel-modes-changed
196 (lambda (signal handback)
197 (riece-update-long-channel-indicator)
198 (force-mode-line-update t))
200 (and riece-current-channel
201 (riece-identity-equal (car (riece-signal-args signal))
202 riece-current-channel))))
203 (riece-connect-signal
204 'channel-operators-changed
205 (lambda (signal handback)
206 (riece-update-channel-status-indicator)
207 (riece-emit-signal 'user-list-changed riece-current-channel))
209 (and riece-current-channel
210 (riece-identity-equal (car (riece-signal-args signal))
211 riece-current-channel))))
212 (riece-connect-signal
213 'channel-speakers-changed
214 (lambda (signal handback)
215 (riece-update-channel-status-indicator)
216 (riece-emit-signal 'user-list-changed riece-current-channel))
218 (and riece-current-channel
219 (riece-identity-equal (car (riece-signal-args signal))
220 riece-current-channel))))
221 (riece-connect-signal
222 'buffer-freeze-changed
223 (lambda (signal handback)
224 (riece-update-status-indicators)
225 (force-mode-line-update t))))
227 (defun riece-update-user-list-buffer ()
229 (if (and riece-current-channel
230 (riece-channel-p (riece-identity-prefix riece-current-channel)))
232 (riece-with-server-buffer (riece-identity-server
233 riece-current-channel)
234 (riece-channel-get-users (riece-identity-prefix
235 riece-current-channel))))
236 (inhibit-read-only t)
239 (riece-kill-all-overlays)
241 (insert (if (memq ?o (cdr (car users)))
243 (if (memq ?v (cdr (car users)))
246 (riece-format-identity
247 (riece-make-identity (car (car users))
248 (riece-identity-server
249 riece-current-channel))
252 (setq users (cdr users)))))))
254 (defun riece-format-identity-for-channel-list-buffer (index identity)
255 (or (run-hook-with-args-until-success
256 'riece-format-identity-for-channel-list-buffer-functions index identity)
257 (concat (format "%2d:%c" index
258 (if (riece-identity-equal identity riece-current-channel)
261 (riece-format-identity identity))))
263 (defun riece-update-channel-list-buffer ()
265 (let ((inhibit-read-only t)
268 (channels riece-current-channels))
270 (riece-kill-all-overlays)
273 (insert (riece-format-identity-for-channel-list-buffer
274 index (car channels))
276 (setq index (1+ index)
277 channels (cdr channels))))))
279 (defun riece-update-channel-indicator ()
280 (setq riece-channel-indicator
281 (if riece-current-channel
282 (riece-format-identity riece-current-channel)
285 (defun riece-update-long-channel-indicator ()
286 (setq riece-long-channel-indicator
287 (if riece-current-channel
288 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
289 (riece-concat-channel-topic
290 riece-current-channel
291 (riece-concat-channel-modes
292 riece-current-channel
293 (riece-format-identity riece-current-channel)))
294 (riece-format-identity riece-current-channel))
297 (defun riece-format-identity-for-channel-list-indicator (index identity)
298 (or (run-hook-with-args-until-success
299 'riece-format-identity-for-channel-list-indicator-functions
301 (let ((string (riece-format-identity identity))
304 (while (string-match "%" string start)
305 (setq start (1+ (match-end 0))
306 string (replace-match "%%" nil nil string)))
307 (format "%d:%s" index string))))
309 (defun riece-update-channel-list-indicator ()
310 (if (and riece-current-channels
311 ;; There is at least one channel.
312 (delq nil (copy-sequence riece-current-channels)))
315 (setq riece-channel-list-indicator
322 (riece-format-identity-for-channel-list-indicator
324 (setq index (1+ index))))
325 riece-current-channels))
326 pointer riece-channel-list-indicator)
329 (setcdr pointer (cons "," (cdr pointer))))
330 (setq pointer (cdr (cdr pointer))))
331 (setq riece-channel-list-indicator
332 (riece-normalize-modeline-string riece-channel-list-indicator)))
333 (setq riece-channel-list-indicator "No channel")))
335 (defun riece-update-status-indicators ()
336 (let ((server-name (riece-current-server-name)))
338 (with-current-buffer riece-command-buffer
339 (riece-with-server-buffer server-name
340 (setq riece-away-indicator
341 (if (and riece-real-nickname
342 (riece-user-get-away riece-real-nickname))
345 riece-operator-indicator
346 (if (and riece-real-nickname
347 (riece-user-get-operator riece-real-nickname))
351 (riece-format-identity
352 (riece-make-identity riece-real-nickname riece-server-name)
356 (with-current-buffer (window-buffer window)
357 (if (eq (derived-mode-class major-mode)
358 'riece-dialogue-mode)
359 (setq riece-freeze-indicator
360 (if (eq riece-freeze 'own)
366 (defun riece-update-channel-status-indicator ()
367 (if (and riece-current-channel
368 (riece-channel-p (riece-identity-prefix riece-current-channel)))
370 (riece-with-server-buffer (riece-identity-server
371 riece-current-channel)
372 (riece-channel-get-users (riece-identity-prefix
373 riece-current-channel))))
375 (riece-with-server-buffer (riece-identity-server
376 riece-current-channel)
377 riece-real-nickname)))
378 (with-current-buffer riece-command-buffer
379 (setq riece-channel-status-indicator
381 (let ((user (cdr (riece-identity-assoc nickname users t))))
389 (defun riece-update-buffers (&optional buffers)
391 (setq buffers riece-buffer-list))
393 (if (buffer-live-p (car buffers))
395 (set-buffer (car buffers))
396 (run-hooks 'riece-update-buffer-functions)))
397 (setq buffers (cdr buffers)))
398 (run-hooks 'riece-update-indicator-functions)
399 (force-mode-line-update t)
400 (run-hooks 'riece-update-buffer-hook))
402 (defun riece-channel-buffer-name (identity)
403 (let ((channels (riece-identity-member identity riece-current-channels)))
405 (setq identity (car channels))
407 (riece-debug (format "%S is not a member of riece-current-channels"
409 (format riece-channel-buffer-format (riece-format-identity identity))))
412 (autoload 'riece-channel-mode "riece"))
413 (defun riece-channel-buffer-create (identity)
415 (riece-get-buffer-create (riece-channel-buffer-name identity)
417 (setq riece-channel-buffer-alist
418 (cons (cons identity (current-buffer))
419 riece-channel-buffer-alist))
420 (unless (eq major-mode 'riece-channel-mode)
422 (let (buffer-read-only)
423 (riece-insert-info (current-buffer)
424 (concat "Created on "
425 (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