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., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, 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 (riece-identity-assoc
129 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
130 (riece-channel-get-users (riece-identity-prefix
131 riece-current-channel))
133 (riece-connect-signal
135 (lambda (signal handback)
136 (riece-update-status-indicators)
137 (riece-update-channel-indicator)
138 (force-mode-line-update t))
140 (riece-identity-equal (nth 1 (riece-signal-args signal))
141 (riece-current-nickname))))
142 (riece-connect-signal
144 (lambda (signal handback)
145 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
147 (and riece-current-channel
148 (riece-identity-equal (car (riece-signal-args signal))
149 riece-current-channel))))
150 (riece-connect-signal
152 (lambda (signal handback)
153 (let* ((old-identity (car (riece-signal-args signal)))
154 (new-identity (nth 1 (riece-signal-args signal)))
155 (pointer (riece-identity-member old-identity
156 riece-current-channels)))
157 ;; Rename the channel buffer.
159 (setcar pointer new-identity)
160 (with-current-buffer (riece-channel-buffer old-identity)
161 (rename-buffer (riece-channel-buffer-name new-identity) t)
162 (setq riece-channel-buffer-alist
163 (cons (cons new-identity (current-buffer))
164 (delq (riece-identity-assoc old-identity
165 riece-channel-buffer-alist)
166 riece-channel-buffer-alist))))))))
167 (riece-connect-signal
169 (lambda (signal handback)
170 (riece-update-status-indicators)
171 (force-mode-line-update t))
173 (riece-identity-equal (car (riece-signal-args signal))
174 (riece-current-nickname))))
175 (riece-connect-signal
176 'user-operator-changed
177 (lambda (signal handback)
178 (riece-update-status-indicators)
179 (force-mode-line-update t))
181 (riece-identity-equal (car (riece-signal-args signal))
182 (riece-current-nickname))))
183 (riece-connect-signal
184 'channel-topic-changed
185 (lambda (signal handback)
186 (riece-update-long-channel-indicator)
187 (force-mode-line-update t))
189 (and riece-current-channel
190 (riece-identity-equal (car (riece-signal-args signal))
191 riece-current-channel))))
192 (riece-connect-signal
193 'channel-modes-changed
194 (lambda (signal handback)
195 (riece-update-long-channel-indicator)
196 (force-mode-line-update t))
198 (and riece-current-channel
199 (riece-identity-equal (car (riece-signal-args signal))
200 riece-current-channel))))
201 (riece-connect-signal
202 'channel-operators-changed
203 (lambda (signal handback)
204 (riece-update-channel-status-indicator)
205 (riece-emit-signal 'user-list-changed riece-current-channel))
207 (and riece-current-channel
208 (riece-identity-equal (car (riece-signal-args signal))
209 riece-current-channel))))
210 (riece-connect-signal
211 'channel-speakers-changed
212 (lambda (signal handback)
213 (riece-update-channel-status-indicator)
214 (riece-emit-signal 'user-list-changed riece-current-channel))
216 (and riece-current-channel
217 (riece-identity-equal (car (riece-signal-args signal))
218 riece-current-channel))))
219 (riece-connect-signal
220 'buffer-freeze-changed
221 (lambda (signal handback)
222 (riece-update-status-indicators)
223 (force-mode-line-update t))))
225 (defun riece-update-user-list-buffer ()
227 (if (and riece-current-channel
228 (riece-channel-p (riece-identity-prefix riece-current-channel)))
230 (riece-with-server-buffer (riece-identity-server
231 riece-current-channel)
232 (riece-channel-get-users (riece-identity-prefix
233 riece-current-channel))))
234 (inhibit-read-only t)
237 (riece-kill-all-overlays)
239 (insert (if (memq ?o (cdr (car users)))
241 (if (memq ?v (cdr (car users)))
244 (riece-format-identity
245 (riece-make-identity (car (car users))
246 (riece-identity-server
247 riece-current-channel))
250 (setq users (cdr users)))))))
252 (defun riece-format-identity-for-channel-list-buffer (index identity)
253 (or (run-hook-with-args-until-success
254 'riece-format-identity-for-channel-list-buffer-functions index identity)
255 (concat (format "%2d:%c" index
256 (if (riece-identity-equal identity riece-current-channel)
259 (riece-format-identity identity))))
261 (defun riece-update-channel-list-buffer ()
263 (let ((inhibit-read-only t)
266 (channels riece-current-channels))
268 (riece-kill-all-overlays)
271 (insert (riece-format-identity-for-channel-list-buffer
272 index (car channels))
274 (setq index (1+ index)
275 channels (cdr channels))))))
277 (defun riece-update-channel-indicator ()
278 (setq riece-channel-indicator
279 (if riece-current-channel
280 (riece-format-identity riece-current-channel)
283 (defun riece-update-long-channel-indicator ()
284 (setq riece-long-channel-indicator
285 (if riece-current-channel
286 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
287 (riece-concat-channel-topic
288 riece-current-channel
289 (riece-concat-channel-modes
290 riece-current-channel
291 (riece-format-identity riece-current-channel)))
292 (riece-format-identity riece-current-channel))
295 (defun riece-format-identity-for-channel-list-indicator (index identity)
296 (or (run-hook-with-args-until-success
297 'riece-format-identity-for-channel-list-indicator-functions
299 (let ((string (riece-format-identity identity))
302 (while (string-match "%" string start)
303 (setq start (1+ (match-end 0))
304 string (replace-match "%%" nil nil string)))
305 (format "%d:%s" index string))))
307 (defun riece-update-channel-list-indicator ()
308 (if (and riece-current-channels
309 ;; There is at least one channel.
310 (delq nil (copy-sequence riece-current-channels)))
313 (setq riece-channel-list-indicator
320 (riece-format-identity-for-channel-list-indicator
322 (setq index (1+ index))))
323 riece-current-channels))
324 pointer riece-channel-list-indicator)
327 (setcdr pointer (cons "," (cdr pointer))))
328 (setq pointer (cdr (cdr pointer)))))
329 (setq riece-channel-list-indicator "No channel")))
331 (defun riece-update-status-indicators ()
332 (let ((server-name (riece-current-server-name)))
334 (with-current-buffer riece-command-buffer
335 (riece-with-server-buffer server-name
336 (setq riece-away-indicator
337 (if (and riece-real-nickname
338 (riece-user-get-away riece-real-nickname))
341 riece-operator-indicator
342 (if (and riece-real-nickname
343 (riece-user-get-operator riece-real-nickname))
347 (riece-format-identity
348 (riece-make-identity riece-real-nickname riece-server-name)
352 (with-current-buffer (window-buffer window)
353 (if (eq (derived-mode-class major-mode)
354 'riece-dialogue-mode)
355 (setq riece-freeze-indicator
356 (if (eq riece-freeze 'own)
362 (defun riece-update-channel-status-indicator ()
363 (if (and riece-current-channel
364 (riece-channel-p (riece-identity-prefix riece-current-channel)))
366 (riece-with-server-buffer (riece-identity-server
367 riece-current-channel)
368 (riece-channel-get-users (riece-identity-prefix
369 riece-current-channel))))
371 (riece-with-server-buffer (riece-identity-server
372 riece-current-channel)
373 riece-real-nickname)))
374 (with-current-buffer riece-command-buffer
375 (setq riece-channel-status-indicator
377 (let ((user (cdr (riece-identity-assoc nickname users t))))
385 (defun riece-update-buffers (&optional buffers)
387 (setq buffers riece-buffer-list))
389 (if (buffer-live-p (car buffers))
391 (set-buffer (car buffers))
392 (run-hooks 'riece-update-buffer-functions)))
393 (setq buffers (cdr buffers)))
394 (run-hooks 'riece-update-indicator-functions)
395 (force-mode-line-update t)
396 (run-hooks 'riece-update-buffer-hook))
398 (defun riece-channel-buffer-name (identity)
399 (let ((channels (riece-identity-member identity riece-current-channels)))
401 (setq identity (car channels))
403 (message "%S is not a member of riece-current-channels" identity)))
404 (format riece-channel-buffer-format (riece-format-identity identity))))
407 (autoload 'riece-channel-mode "riece"))
408 (defun riece-channel-buffer-create (identity)
410 (riece-get-buffer-create (riece-channel-buffer-name identity)
412 (setq riece-channel-buffer-alist
413 (cons (cons identity (current-buffer))
414 riece-channel-buffer-alist))
415 (unless (eq major-mode 'riece-channel-mode)
417 (let (buffer-read-only)
418 (riece-insert-info (current-buffer)
419 (concat "Created on "
420 (funcall riece-format-time-function
423 (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
426 (defun riece-channel-buffer (identity)
427 (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
429 (defun riece-switch-to-channel (identity)
430 (let ((last riece-current-channel)
432 (if (and riece-channel-buffer
433 (setq window (get-buffer-window riece-channel-buffer)))
434 (with-current-buffer riece-channel-buffer
435 (setq riece-channel-buffer-window-point (window-point window))))
436 (setq riece-current-channel identity
437 riece-channel-buffer (riece-channel-buffer riece-current-channel))
438 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
439 (riece-emit-signal 'channel-switched)))
441 (defun riece-join-channel (identity)
442 (unless (riece-identity-member identity riece-current-channels)
443 (setq riece-current-channels
444 (riece-identity-assign-binding
445 identity riece-current-channels
449 (riece-parse-identity channel)))
450 riece-default-channel-binding)))
451 (riece-channel-buffer-create identity)))
453 (defun riece-switch-to-nearest-channel (pointer)
454 (let ((start riece-current-channels)
456 (while (and start (not (eq start pointer)))
458 (setq identity (car start)))
459 (setq start (cdr start)))
462 (null (car pointer)))
463 (setq pointer (cdr pointer)))
464 (setq identity (car pointer)))
466 (riece-switch-to-channel identity)
467 (let ((last riece-current-channel))
468 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
469 (setq riece-current-channel nil)
470 (riece-emit-signal 'channel-switched)))))
472 (defun riece-part-channel (identity)
473 (let ((pointer (riece-identity-member identity riece-current-channels)))
475 (setcar pointer nil))
476 (if (riece-identity-equal identity riece-current-channel)
477 (riece-switch-to-nearest-channel pointer))))
479 (defun riece-redisplay-buffers (&optional force)
480 (riece-update-buffers)
481 (riece-redraw-layout force)
482 (run-hooks 'riece-redisplay-buffers-hook))
484 (provide 'riece-display)
486 ;;; riece-display.el ends here