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 (defvar riece-channel-buffer-format "*Channel:%s*"
34 "Format of channel message buffer.")
35 (defvar riece-channel-buffer-alist nil
36 "An alist mapping identities to channel buffers.")
38 (defvar riece-update-buffer-functions nil
39 "Functions to redisplay the buffer.
40 Local to the buffer in `riece-buffer-list'.")
42 (defvar riece-update-indicator-functions
43 '(riece-update-status-indicators
44 riece-update-channel-indicator
45 riece-update-long-channel-indicator
46 riece-update-channel-list-indicator)
47 "Functions to update modeline indicators.")
49 (defun riece-display-connect-signals ()
52 (lambda (signal handback)
54 (set-buffer riece-channel-list-buffer)
55 (run-hooks 'riece-update-buffer-functions))
56 (riece-update-channel-list-indicator)))
59 (lambda (signal handback)
61 (set-buffer riece-user-list-buffer)
62 (run-hooks 'riece-update-buffer-functions)))
64 (and riece-current-channel
65 (riece-identity-equal (car (riece-signal-args signal))
66 riece-current-channel))))
69 (lambda (signal handback)
70 (riece-update-status-indicators)
71 (riece-update-channel-indicator)
72 (riece-update-long-channel-indicator)
73 (force-mode-line-update t)
74 (riece-emit-signal 'channel-list-changed)
75 (riece-emit-signal 'user-list-changed riece-current-channel)
77 (riece-redraw-layout))))
80 (lambda (signal handback)
81 (riece-emit-signal 'user-list-changed riece-current-channel))
83 (and riece-current-channel
84 (riece-identity-equal (nth 1 (riece-signal-args signal))
85 riece-current-channel)
86 (not (riece-identity-equal (car (riece-signal-args signal))
87 (riece-current-nickname))))))
90 (lambda (signal handback)
91 (riece-join-channel (nth 1 (riece-signal-args signal)))
92 (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
93 (setq riece-join-channel-candidate nil))
95 (riece-identity-equal (car (riece-signal-args signal))
96 (riece-current-nickname))))
99 (lambda (signal handback)
100 (riece-emit-signal 'user-list-changed riece-current-channel))
102 (and riece-current-channel
103 (riece-identity-equal (nth 1 (riece-signal-args signal))
104 riece-current-channel)
105 (not (riece-identity-equal (car (riece-signal-args signal))
106 (riece-current-nickname))))))
107 (riece-connect-signal
109 (lambda (signal handback)
110 (riece-part-channel (nth 1 (riece-signal-args signal))))
112 (riece-identity-equal (car (riece-signal-args signal))
113 (riece-current-nickname))))
114 (riece-connect-signal
116 (lambda (signal handback)
117 (riece-emit-signal 'user-list-changed riece-current-channel))
119 (and riece-current-channel
120 (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
121 (riece-identity-server riece-current-channel))
122 (riece-with-server-buffer (riece-identity-server
123 riece-current-channel)
124 (riece-identity-assoc
125 (riece-identity-prefix (nth 1 (riece-signal-args signal)))
126 (riece-channel-get-users (riece-identity-prefix
127 riece-current-channel))
129 (riece-connect-signal
131 (lambda (signal handback)
132 (riece-update-status-indicators)
133 (riece-update-channel-indicator)
134 (force-mode-line-update t))
136 (riece-identity-equal (nth 1 (riece-signal-args signal))
137 (riece-current-nickname))))
138 (riece-connect-signal
140 (lambda (signal handback)
141 (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
143 (and riece-current-channel
144 (riece-identity-equal (car (riece-signal-args signal))
145 riece-current-channel))))
146 (riece-connect-signal
148 (lambda (signal handback)
149 (let* ((old-identity (car (riece-signal-args signal)))
150 (new-identity (nth 1 (riece-signal-args signal)))
151 (pointer (riece-identity-member old-identity
152 riece-current-channels)))
153 ;; Rename the channel buffer.
155 (setcar pointer new-identity)
156 (with-current-buffer (riece-channel-buffer old-identity)
157 (rename-buffer (riece-channel-buffer-name new-identity) t)
158 (setq riece-channel-buffer-alist
159 (cons (cons new-identity (current-buffer))
160 (delq (riece-identity-assoc old-identity
161 riece-channel-buffer-alist)
162 riece-channel-buffer-alist))))))))
163 (riece-connect-signal
165 (lambda (signal handback)
166 (riece-update-status-indicators)
167 (force-mode-line-update t))
169 (riece-identity-equal (car (riece-signal-args signal))
170 (riece-current-nickname))))
171 (riece-connect-signal
172 'user-operator-changed
173 (lambda (signal handback)
174 (riece-update-status-indicators)
175 (force-mode-line-update t))
177 (riece-identity-equal (car (riece-signal-args signal))
178 (riece-current-nickname))))
179 (riece-connect-signal
180 'channel-topic-changed
181 (lambda (signal handback)
182 (riece-update-long-channel-indicator)
183 (force-mode-line-update t))
185 (and riece-current-channel
186 (riece-identity-equal (car (riece-signal-args signal))
187 riece-current-channel))))
188 (riece-connect-signal
189 'channel-modes-changed
190 (lambda (signal handback)
191 (riece-update-status-indicators)
192 (force-mode-line-update t))
194 (and riece-current-channel
195 (riece-identity-equal (car (riece-signal-args signal))
196 riece-current-channel))))
197 (riece-connect-signal
198 'channel-operators-changed
199 (lambda (signal handback)
200 (riece-emit-signal 'user-list-changed riece-current-channel))
202 (and riece-current-channel
203 (riece-identity-equal (car (riece-signal-args signal))
204 riece-current-channel))))
205 (riece-connect-signal
206 'channel-speakers-changed
207 (lambda (signal handback)
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 'buffer-freeze-changed
215 (lambda (signal handback)
216 (riece-update-status-indicators)
217 (force-mode-line-update t))))
219 (defun riece-update-user-list-buffer ()
221 (if (and riece-current-channel
222 (riece-channel-p (riece-identity-prefix riece-current-channel)))
224 (riece-with-server-buffer (riece-identity-server
225 riece-current-channel)
226 (riece-channel-get-users (riece-identity-prefix
227 riece-current-channel))))
228 (inhibit-read-only t)
231 (riece-kill-all-overlays)
233 (insert (if (memq ?o (cdr (car users)))
235 (if (memq ?v (cdr (car users)))
238 (riece-format-identity
239 (riece-make-identity (car (car users))
240 (riece-identity-server
241 riece-current-channel))
244 (setq users (cdr users)))))))
246 (defun riece-format-identity-for-channel-list-buffer (index identity)
247 (or (run-hook-with-args-until-success
248 'riece-format-identity-for-channel-list-buffer-functions index identity)
249 (concat (format "%2d:%c" index
250 (if (riece-identity-equal identity riece-current-channel)
253 (riece-format-identity identity))))
255 (defun riece-update-channel-list-buffer ()
257 (let ((inhibit-read-only t)
260 (channels riece-current-channels))
262 (riece-kill-all-overlays)
265 (insert (riece-format-identity-for-channel-list-buffer
266 index (car channels))
268 (setq index (1+ index)
269 channels (cdr channels))))))
271 (defun riece-update-channel-indicator ()
272 (setq riece-channel-indicator
273 (if riece-current-channel
274 (riece-format-identity riece-current-channel)
277 (defun riece-update-long-channel-indicator ()
278 (setq riece-long-channel-indicator
279 (if riece-current-channel
280 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
281 (riece-concat-channel-modes
282 riece-current-channel
283 (riece-concat-channel-topic
284 riece-current-channel
285 (riece-format-identity riece-current-channel)))
286 (riece-format-identity riece-current-channel))
289 (defun riece-format-identity-for-channel-list-indicator (index identity)
290 (or (run-hook-with-args-until-success
291 'riece-format-identity-for-channel-list-indicator-functions
293 (let ((string (riece-format-identity identity))
296 (while (string-match "%" string start)
297 (setq start (1+ (match-end 0))
298 string (replace-match "%%" nil nil string)))
299 (format "%d:%s" index string))))
301 (defun riece-update-channel-list-indicator ()
302 (if (and riece-current-channels
303 ;; There is at least one channel.
304 (delq nil (copy-sequence riece-current-channels)))
307 (setq riece-channel-list-indicator
314 (riece-format-identity-for-channel-list-indicator
316 (setq index (1+ index))))
317 riece-current-channels))
318 pointer riece-channel-list-indicator)
321 (setcdr pointer (cons "," (cdr pointer))))
322 (setq pointer (cdr (cdr pointer)))))
323 (setq riece-channel-list-indicator "No channel")))
325 (defun riece-update-status-indicators ()
326 (if riece-current-channel
327 (with-current-buffer riece-command-buffer
328 (riece-with-server-buffer (riece-identity-server riece-current-channel)
329 (setq riece-away-indicator
330 (if (and riece-real-nickname
331 (riece-user-get-away riece-real-nickname))
334 riece-operator-indicator
335 (if (and riece-real-nickname
336 (riece-user-get-operator riece-real-nickname))
339 riece-user-indicator riece-real-nickname))))
340 (setq riece-freeze-indicator
341 (with-current-buffer (if (and riece-channel-buffer-mode
342 riece-channel-buffer)
344 riece-dialogue-buffer)
345 (if (eq riece-freeze 'own)
351 (defun riece-update-buffers (&optional buffers)
353 (setq buffers riece-buffer-list))
356 (set-buffer (car buffers))
357 (run-hooks 'riece-update-buffer-functions))
358 (setq buffers (cdr buffers)))
359 (run-hooks 'riece-update-indicator-functions)
360 (force-mode-line-update t)
361 (run-hooks 'riece-update-buffer-hook))
363 (defun riece-channel-buffer-name (identity)
364 (let ((channels (riece-identity-member identity riece-current-channels)))
366 (setq identity (car channels))
368 (message "%S is not a member of riece-current-channels" identity)))
369 (format riece-channel-buffer-format (riece-format-identity identity))))
372 (autoload 'riece-channel-mode "riece"))
373 (defun riece-channel-buffer-create (identity)
375 (riece-get-buffer-create (riece-channel-buffer-name identity)
377 (setq riece-channel-buffer-alist
378 (cons (cons identity (current-buffer))
379 riece-channel-buffer-alist))
380 (unless (eq major-mode 'riece-channel-mode)
382 (let (buffer-read-only)
383 (riece-insert-info (current-buffer)
384 (concat "Created on "
385 (funcall riece-format-time-function
388 (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
391 (defun riece-channel-buffer (identity)
392 (cdr (riece-identity-assoc identity riece-channel-buffer-alist)))
394 (defun riece-switch-to-channel (identity)
395 (let ((last riece-current-channel))
396 (setq riece-current-channel identity
397 riece-channel-buffer (riece-channel-buffer riece-current-channel))
398 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
399 (riece-emit-signal 'channel-switched)))
401 (defun riece-join-channel (identity)
402 (unless (riece-identity-member identity riece-current-channels)
403 (setq riece-current-channels
404 (riece-identity-assign-binding
405 identity riece-current-channels
409 (riece-parse-identity channel)))
410 riece-default-channel-binding)))
411 (riece-channel-buffer-create identity)))
413 (defun riece-switch-to-nearest-channel (pointer)
414 (let ((start riece-current-channels)
416 (while (and start (not (eq start pointer)))
418 (setq identity (car start)))
419 (setq start (cdr start)))
422 (null (car pointer)))
423 (setq pointer (cdr pointer)))
424 (setq identity (car pointer)))
426 (riece-switch-to-channel identity)
427 (let ((last riece-current-channel))
428 (run-hook-with-args 'riece-after-switch-to-channel-functions last)
429 (setq riece-current-channel nil)
430 (riece-emit-signal 'channel-switched)))))
432 (defun riece-part-channel (identity)
433 (let ((pointer (riece-identity-member identity riece-current-channels)))
435 (setcar pointer nil))
436 (if (riece-identity-equal identity riece-current-channel)
437 (riece-switch-to-nearest-channel pointer))))
439 (defun riece-redisplay-buffers (&optional force)
440 (riece-update-buffers)
441 (riece-redraw-layout force)
442 (run-hooks 'riece-redisplay-buffers-hook))
444 (provide 'riece-display)
446 ;;; riece-display.el ends here