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-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-indicator)
74 (riece-update-long-channel-indicator)
75 (force-mode-line-update t)
76 (riece-emit-signal 'channel-list-changed)
77 (riece-emit-signal 'user-list-changed riece-current-channel)
79 (riece-redraw-layout))))
82 (lambda (signal handback)
83 (riece-emit-signal 'user-list-changed riece-current-channel))
85 (and riece-current-channel
86 (riece-identity-equal (nth 1 (riece-signal-args signal))
87 riece-current-channel)
88 (not (riece-identity-equal (car (riece-signal-args signal))
89 (riece-current-nickname))))))
92 (lambda (signal handback)
93 (riece-join-channel (nth 1 (riece-signal-args signal)))
94 (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
95 (setq riece-join-channel-candidate nil))
97 (riece-identity-equal (car (riece-signal-args signal))
98 (riece-current-nickname))))
101 (lambda (signal handback)
102 (riece-emit-signal 'user-list-changed riece-current-channel))
104 (and riece-current-channel
105 (riece-identity-equal (nth 1 (riece-signal-args signal))
106 riece-current-channel)
107 (not (riece-identity-equal (car (riece-signal-args signal))
108 (riece-current-nickname))))))
109 (riece-connect-signal
111 (lambda (signal handback)
112 (riece-part-channel (nth 1 (riece-signal-args signal))))
114 (riece-identity-equal (car (riece-signal-args signal))
115 (riece-current-nickname))))
116 (riece-connect-signal
118 (lambda (signal handback)
119 (riece-emit-signal 'user-list-changed riece-current-channel))
121 (and riece-current-channel
122 (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
123 (riece-identity-server riece-current-channel))
124 (riece-with-server-buffer (riece-identity-server
125 riece-current-channel)
126 (riece-identity-assoc
127 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
128 (riece-channel-get-users (riece-identity-prefix
129 riece-current-channel))
131 (riece-connect-signal
133 (lambda (signal handback)
134 (riece-update-status-indicators)
135 (riece-update-channel-indicator)
136 (force-mode-line-update t))
138 (riece-identity-equal (nth 1 (riece-signal-args signal))
139 (riece-current-nickname))))
140 (riece-connect-signal
142 (lambda (signal handback)
143 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
145 (and riece-current-channel
146 (riece-identity-equal (car (riece-signal-args signal))
147 riece-current-channel))))
148 (riece-connect-signal
150 (lambda (signal handback)
151 (let* ((old-identity (car (riece-signal-args signal)))
152 (new-identity (nth 1 (riece-signal-args signal)))
153 (pointer (riece-identity-member old-identity
154 riece-current-channels)))
155 ;; Rename the channel buffer.
157 (setcar pointer new-identity)
158 (with-current-buffer (riece-channel-buffer old-identity)
159 (rename-buffer (riece-channel-buffer-name new-identity) t)
160 (setq riece-channel-buffer-alist
161 (cons (cons new-identity (current-buffer))
162 (delq (riece-identity-assoc old-identity
163 riece-channel-buffer-alist)
164 riece-channel-buffer-alist))))))))
165 (riece-connect-signal
167 (lambda (signal handback)
168 (riece-update-status-indicators)
169 (force-mode-line-update t))
171 (riece-identity-equal (car (riece-signal-args signal))
172 (riece-current-nickname))))
173 (riece-connect-signal
174 'user-operator-changed
175 (lambda (signal handback)
176 (riece-update-status-indicators)
177 (force-mode-line-update t))
179 (riece-identity-equal (car (riece-signal-args signal))
180 (riece-current-nickname))))
181 (riece-connect-signal
182 'channel-topic-changed
183 (lambda (signal handback)
184 (riece-update-long-channel-indicator)
185 (force-mode-line-update t))
187 (and riece-current-channel
188 (riece-identity-equal (car (riece-signal-args signal))
189 riece-current-channel))))
190 (riece-connect-signal
191 'channel-modes-changed
192 (lambda (signal handback)
193 (riece-update-long-channel-indicator)
194 (force-mode-line-update t))
196 (and riece-current-channel
197 (riece-identity-equal (car (riece-signal-args signal))
198 riece-current-channel))))
199 (riece-connect-signal
200 'channel-operators-changed
201 (lambda (signal handback)
202 (riece-emit-signal 'user-list-changed riece-current-channel))
204 (and riece-current-channel
205 (riece-identity-equal (car (riece-signal-args signal))
206 riece-current-channel))))
207 (riece-connect-signal
208 'channel-speakers-changed
209 (lambda (signal handback)
210 (riece-emit-signal 'user-list-changed riece-current-channel))
212 (and riece-current-channel
213 (riece-identity-equal (car (riece-signal-args signal))
214 riece-current-channel))))
215 (riece-connect-signal
216 'buffer-freeze-changed
217 (lambda (signal handback)
218 (riece-update-status-indicators)
219 (force-mode-line-update t))))
221 (defun riece-update-user-list-buffer ()
223 (if (and riece-current-channel
224 (riece-channel-p (riece-identity-prefix riece-current-channel)))
226 (riece-with-server-buffer (riece-identity-server
227 riece-current-channel)
228 (riece-channel-get-users (riece-identity-prefix
229 riece-current-channel))))
230 (inhibit-read-only t)
233 (riece-kill-all-overlays)
235 (insert (if (memq ?o (cdr (car users)))
237 (if (memq ?v (cdr (car users)))
240 (riece-format-identity
241 (riece-make-identity (car (car users))
242 (riece-identity-server
243 riece-current-channel))
246 (setq users (cdr users)))))))
248 (defun riece-format-identity-for-channel-list-buffer (index identity)
249 (or (run-hook-with-args-until-success
250 'riece-format-identity-for-channel-list-buffer-functions index identity)
251 (concat (format "%2d:%c" index
252 (if (riece-identity-equal identity riece-current-channel)
255 (riece-format-identity identity))))
257 (defun riece-update-channel-list-buffer ()
259 (let ((inhibit-read-only t)
262 (channels riece-current-channels))
264 (riece-kill-all-overlays)
267 (insert (riece-format-identity-for-channel-list-buffer
268 index (car channels))
270 (setq index (1+ index)
271 channels (cdr channels))))))
273 (defun riece-update-channel-indicator ()
274 (setq riece-channel-indicator
275 (if riece-current-channel
276 (riece-format-identity riece-current-channel)
279 (defun riece-update-long-channel-indicator ()
280 (setq riece-long-channel-indicator
281 (if riece-current-channel
282 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
283 (riece-concat-channel-modes
284 riece-current-channel
285 (riece-concat-channel-topic
286 riece-current-channel
287 (riece-format-identity riece-current-channel)))
288 (riece-format-identity riece-current-channel))
291 (defun riece-format-identity-for-channel-list-indicator (index identity)
292 (or (run-hook-with-args-until-success
293 'riece-format-identity-for-channel-list-indicator-functions
295 (let ((string (riece-format-identity identity))
298 (while (string-match "%" string start)
299 (setq start (1+ (match-end 0))
300 string (replace-match "%%" nil nil string)))
301 (format "%d:%s" index string))))
303 (defun riece-update-channel-list-indicator ()
304 (if (and riece-current-channels
305 ;; There is at least one channel.
306 (delq nil (copy-sequence riece-current-channels)))
309 (setq riece-channel-list-indicator
316 (riece-format-identity-for-channel-list-indicator
318 (setq index (1+ index))))
319 riece-current-channels))
320 pointer riece-channel-list-indicator)
323 (setcdr pointer (cons "," (cdr pointer))))
324 (setq pointer (cdr (cdr pointer)))))
325 (setq riece-channel-list-indicator "No channel")))
327 (defun riece-update-status-indicators ()
328 (if riece-current-channel
329 (with-current-buffer riece-command-buffer
330 (riece-with-server-buffer (riece-identity-server riece-current-channel)
331 (setq riece-away-indicator
332 (if (and riece-real-nickname
333 (riece-user-get-away riece-real-nickname))
336 riece-operator-indicator
337 (if (and riece-real-nickname
338 (riece-user-get-operator riece-real-nickname))
341 riece-user-indicator riece-real-nickname))))
344 (with-current-buffer (window-buffer window)
345 (if (eq (derived-mode-class major-mode)
346 'riece-dialogue-mode)
347 (setq riece-freeze-indicator
348 (if (eq riece-freeze 'own)
354 (defun riece-update-buffers (&optional buffers)
356 (setq buffers riece-buffer-list))
359 (set-buffer (car buffers))
360 (run-hooks 'riece-update-buffer-functions))
361 (setq buffers (cdr buffers)))
362 (run-hooks 'riece-update-indicator-functions)
363 (force-mode-line-update t)
364 (run-hooks 'riece-update-buffer-hook))
366 (defun riece-channel-buffer-name (identity)
367 (let ((channels (riece-identity-member identity riece-current-channels)))
369 (setq identity (car channels))
371 (message "%S is not a member of riece-current-channels" identity)))
372 (format riece-channel-buffer-format (riece-format-identity identity))))
375 (autoload 'riece-channel-mode "riece"))
376 (defun riece-channel-buffer-create (identity)
378 (riece-get-buffer-create (riece-channel-buffer-name identity)
380 (setq riece-channel-buffer-alist
381 (cons (cons identity (current-buffer))
382 riece-channel-buffer-alist))
383 (unless (eq major-mode 'riece-channel-mode)
385 (let (buffer-read-only)
386 (riece-insert-info (current-buffer)
387 (concat "Created on "
388 (funcall riece-format-time-function
391 (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
394 (defun riece-channel-buffer (identity)
395 (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
397 (defun riece-switch-to-channel (identity)
398 (let ((last riece-current-channel)
400 (if (and riece-channel-buffer
401 (setq window (get-buffer-window riece-channel-buffer)))
402 (with-current-buffer riece-channel-buffer
403 (setq riece-channel-buffer-window-point (window-point window))))
404 (setq riece-current-channel identity
405 riece-channel-buffer (riece-channel-buffer riece-current-channel))
406 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
407 (riece-emit-signal 'channel-switched)))
409 (defun riece-join-channel (identity)
410 (unless (riece-identity-member identity riece-current-channels)
411 (setq riece-current-channels
412 (riece-identity-assign-binding
413 identity riece-current-channels
417 (riece-parse-identity channel)))
418 riece-default-channel-binding)))
419 (riece-channel-buffer-create identity)))
421 (defun riece-switch-to-nearest-channel (pointer)
422 (let ((start riece-current-channels)
424 (while (and start (not (eq start pointer)))
426 (setq identity (car start)))
427 (setq start (cdr start)))
430 (null (car pointer)))
431 (setq pointer (cdr pointer)))
432 (setq identity (car pointer)))
434 (riece-switch-to-channel identity)
435 (let ((last riece-current-channel))
436 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
437 (setq riece-current-channel nil)
438 (riece-emit-signal 'channel-switched)))))
440 (defun riece-part-channel (identity)
441 (let ((pointer (riece-identity-member identity riece-current-channels)))
443 (setcar pointer nil))
444 (if (riece-identity-equal identity riece-current-channel)
445 (riece-switch-to-nearest-channel pointer))))
447 (defun riece-redisplay-buffers (&optional force)
448 (riece-update-buffers)
449 (riece-redraw-layout force)
450 (run-hooks 'riece-redisplay-buffers-hook))
452 (provide 'riece-display)
454 ;;; riece-display.el ends here