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)
56 (set-buffer riece-channel-list-buffer)
57 (run-hooks 'riece-update-buffer-functions))
58 (riece-update-channel-list-indicator)))
61 (lambda (signal handback)
63 (set-buffer riece-user-list-buffer)
64 (run-hooks 'riece-update-buffer-functions)))
66 (and riece-current-channel
67 (riece-identity-equal (car (riece-signal-args signal))
68 riece-current-channel))))
71 (lambda (signal handback)
72 (riece-update-status-indicators)
73 (riece-update-channel-status-indicator)
74 (riece-update-channel-indicator)
75 (riece-update-long-channel-indicator)
76 (force-mode-line-update t)
77 (riece-emit-signal 'channel-list-changed)
78 (riece-emit-signal 'user-list-changed riece-current-channel)
80 (riece-redraw-layout))))
83 (lambda (signal handback)
84 (riece-emit-signal 'user-list-changed riece-current-channel))
86 (and riece-current-channel
87 (riece-identity-equal (nth 1 (riece-signal-args signal))
88 riece-current-channel)
89 (not (riece-identity-equal (car (riece-signal-args signal))
90 (riece-current-nickname))))))
93 (lambda (signal handback)
94 (riece-join-channel (nth 1 (riece-signal-args signal)))
95 (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
96 (setq riece-join-channel-candidate nil))
98 (riece-identity-equal (car (riece-signal-args signal))
99 (riece-current-nickname))))
100 (riece-connect-signal
102 (lambda (signal handback)
103 (riece-emit-signal 'user-list-changed riece-current-channel))
105 (and riece-current-channel
106 (riece-identity-equal (nth 1 (riece-signal-args signal))
107 riece-current-channel)
108 (not (riece-identity-equal (car (riece-signal-args signal))
109 (riece-current-nickname))))))
110 (riece-connect-signal
112 (lambda (signal handback)
113 (riece-part-channel (nth 1 (riece-signal-args signal))))
115 (riece-identity-equal (car (riece-signal-args signal))
116 (riece-current-nickname))))
117 (riece-connect-signal
119 (lambda (signal handback)
120 (riece-emit-signal 'user-list-changed riece-current-channel))
122 (and riece-current-channel
123 (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
124 (riece-identity-server riece-current-channel))
125 (riece-with-server-buffer (riece-identity-server
126 riece-current-channel)
127 (when (riece-channel-p (riece-identity-prefix
128 riece-current-channel))
129 (riece-identity-assoc
130 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
131 (riece-channel-get-users (riece-identity-prefix
132 riece-current-channel))
134 (riece-connect-signal
136 (lambda (signal handback)
137 (riece-update-status-indicators)
138 (riece-update-channel-indicator)
139 (force-mode-line-update t))
141 (riece-identity-equal (nth 1 (riece-signal-args signal))
142 (riece-current-nickname))))
143 (riece-connect-signal
145 (lambda (signal handback)
146 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
148 (and riece-current-channel
149 (riece-identity-equal (car (riece-signal-args signal))
150 riece-current-channel))))
151 (riece-connect-signal
153 (lambda (signal handback)
154 (let* ((old-identity (car (riece-signal-args signal)))
155 (new-identity (nth 1 (riece-signal-args signal)))
156 (pointer (riece-identity-member old-identity
157 riece-current-channels)))
158 ;; Rename the channel buffer.
160 (setcar pointer new-identity)
161 (with-current-buffer (riece-channel-buffer old-identity)
162 (rename-buffer (riece-channel-buffer-name new-identity) t)
163 (setq riece-channel-buffer-alist
164 (cons (cons new-identity (current-buffer))
165 (delq (riece-identity-assoc old-identity
166 riece-channel-buffer-alist)
167 riece-channel-buffer-alist))))))))
168 (riece-connect-signal
170 (lambda (signal handback)
171 (riece-update-status-indicators)
172 (force-mode-line-update t))
174 (riece-identity-equal (car (riece-signal-args signal))
175 (riece-current-nickname))))
176 (riece-connect-signal
177 'user-operator-changed
178 (lambda (signal handback)
179 (riece-update-status-indicators)
180 (force-mode-line-update t))
182 (riece-identity-equal (car (riece-signal-args signal))
183 (riece-current-nickname))))
184 (riece-connect-signal
185 'channel-topic-changed
186 (lambda (signal handback)
187 (riece-update-long-channel-indicator)
188 (force-mode-line-update t))
190 (and riece-current-channel
191 (riece-identity-equal (car (riece-signal-args signal))
192 riece-current-channel))))
193 (riece-connect-signal
194 'channel-modes-changed
195 (lambda (signal handback)
196 (riece-update-long-channel-indicator)
197 (force-mode-line-update t))
199 (and riece-current-channel
200 (riece-identity-equal (car (riece-signal-args signal))
201 riece-current-channel))))
202 (riece-connect-signal
203 'channel-operators-changed
204 (lambda (signal handback)
205 (riece-update-channel-status-indicator)
206 (riece-emit-signal 'user-list-changed riece-current-channel))
208 (and riece-current-channel
209 (riece-identity-equal (car (riece-signal-args signal))
210 riece-current-channel))))
211 (riece-connect-signal
212 'channel-speakers-changed
213 (lambda (signal handback)
214 (riece-update-channel-status-indicator)
215 (riece-emit-signal 'user-list-changed riece-current-channel))
217 (and riece-current-channel
218 (riece-identity-equal (car (riece-signal-args signal))
219 riece-current-channel))))
220 (riece-connect-signal
221 'buffer-freeze-changed
222 (lambda (signal handback)
223 (riece-update-status-indicators)
224 (force-mode-line-update t))))
226 (defun riece-update-user-list-buffer ()
228 (if (and riece-current-channel
229 (riece-channel-p (riece-identity-prefix riece-current-channel)))
231 (riece-with-server-buffer (riece-identity-server
232 riece-current-channel)
233 (riece-channel-get-users (riece-identity-prefix
234 riece-current-channel))))
235 (inhibit-read-only t)
238 (riece-kill-all-overlays)
240 (insert (if (memq ?o (cdr (car users)))
242 (if (memq ?v (cdr (car users)))
245 (riece-format-identity
246 (riece-make-identity (car (car users))
247 (riece-identity-server
248 riece-current-channel))
251 (setq users (cdr users)))))))
253 (defun riece-format-identity-for-channel-list-buffer (index identity)
254 (or (run-hook-with-args-until-success
255 'riece-format-identity-for-channel-list-buffer-functions index identity)
256 (concat (format "%2d:%c" index
257 (if (riece-identity-equal identity riece-current-channel)
260 (riece-format-identity identity))))
262 (defun riece-update-channel-list-buffer ()
264 (let ((inhibit-read-only t)
267 (channels riece-current-channels))
269 (riece-kill-all-overlays)
272 (insert (riece-format-identity-for-channel-list-buffer
273 index (car channels))
275 (setq index (1+ index)
276 channels (cdr channels))))))
278 (defun riece-update-channel-indicator ()
279 (setq riece-channel-indicator
280 (if riece-current-channel
281 (riece-format-identity riece-current-channel)
282 (riece-mcat "None"))))
284 (defun riece-update-long-channel-indicator ()
285 (setq riece-long-channel-indicator
286 (if riece-current-channel
287 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
288 (riece-concat-channel-topic
289 riece-current-channel
290 (riece-concat-channel-modes
291 riece-current-channel
292 (riece-format-identity riece-current-channel)))
293 (riece-format-identity riece-current-channel))
294 (riece-mcat "None"))))
296 (defun riece-format-identity-for-channel-list-indicator (index identity)
297 (or (run-hook-with-args-until-success
298 'riece-format-identity-for-channel-list-indicator-functions
300 (let ((string (riece-format-identity identity))
303 (while (string-match "%" string start)
304 (setq start (1+ (match-end 0))
305 string (replace-match "%%" nil nil string)))
306 (format "%d:%s" index string))))
308 (defun riece-update-channel-list-indicator ()
309 (if (and riece-current-channels
310 ;; There is at least one channel.
311 (delq nil (copy-sequence riece-current-channels)))
314 (setq riece-channel-list-indicator
321 (riece-format-identity-for-channel-list-indicator
323 (setq index (1+ index))))
324 riece-current-channels))
325 pointer riece-channel-list-indicator)
328 (setcdr pointer (cons "," (cdr pointer))))
329 (setq pointer (cdr (cdr pointer))))
330 (setq riece-channel-list-indicator
331 (riece-normalize-modeline-string riece-channel-list-indicator)))
332 (setq riece-channel-list-indicator (riece-mcat "No channel"))))
334 (defun riece-update-status-indicators ()
335 (let ((server-name (riece-current-server-name)))
337 (with-current-buffer riece-command-buffer
338 (riece-with-server-buffer server-name
339 (setq riece-away-indicator
340 (if (and riece-real-nickname
341 (riece-user-get-away riece-real-nickname))
344 riece-operator-indicator
345 (if (and riece-real-nickname
346 (riece-user-get-operator riece-real-nickname))
350 (if riece-real-nickname
351 (setq riece-user-indicator
352 (riece-format-identity
353 (riece-make-identity riece-real-nickname
358 (with-current-buffer (window-buffer window)
359 (if (riece-derived-mode-p '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