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)
31 (defcustom riece-configure-windows-function #'riece-configure-windows
32 "Function to configure windows."
36 (defcustom riece-configure-windows-predicate
37 #'riece-configure-windows-predicate
38 "Function to check whether window reconfiguration is needed."
42 (defvar riece-update-buffer-functions
43 '(riece-update-user-list-buffer
44 riece-update-channel-list-buffer
45 riece-update-status-indicators
46 riece-update-channel-indicator
47 riece-update-short-channel-indicator
48 riece-update-channel-list-indicator))
50 (defvar riece-redisplay-buffer nil
51 "Non-nil means the buffer needs to be updated.
52 Local to the buffers.")
54 (defun riece-configure-windows ()
55 (let ((buffer (window-buffer))
57 (and riece-user-list-buffer-mode
59 ;; User list buffer is nuisance for private conversation.
60 (riece-channel-p (riece-identity-prefix
61 riece-current-channel)))))
62 ;; Can't expand minibuffer to full frame.
63 (if (eq (selected-window) (minibuffer-window))
65 (delete-other-windows)
66 (if (and riece-current-channel
67 (or show-user-list riece-channel-list-buffer-mode))
68 (let ((rest-window (split-window (selected-window)
69 (/ (window-width) 5) t)))
70 (if (and show-user-list riece-channel-list-buffer-mode)
72 (set-window-buffer (split-window)
73 riece-channel-list-buffer)
74 (set-window-buffer (selected-window)
75 riece-user-list-buffer))
77 (set-window-buffer (selected-window)
78 riece-user-list-buffer)
79 (if riece-channel-list-buffer-mode
80 (set-window-buffer (selected-window)
81 riece-channel-list-buffer))))
82 (select-window rest-window)))
83 (if (and riece-current-channel
84 riece-channel-buffer-mode)
85 (let ((rest-window (split-window)))
86 (set-window-buffer (selected-window)
88 (set-window-buffer (split-window rest-window 4)
90 (with-current-buffer riece-channel-buffer
91 (setq truncate-partial-width-windows nil))
92 (with-current-buffer riece-others-buffer
93 (setq truncate-partial-width-windows nil))
94 (set-window-buffer rest-window
95 riece-command-buffer))
96 (set-window-buffer (split-window (selected-window) 4)
97 riece-dialogue-buffer)
98 (set-window-buffer (selected-window)
99 riece-command-buffer))
100 (riece-set-window-points)
101 (select-window (or (get-buffer-window buffer)
102 (get-buffer-window riece-command-buffer)))))
104 (defun riece-configure-windows-top (&optional plist)
105 "Candidate of `riece-configure-windows-function'.
106 PLIST accept :command-height, :user-list-width, and :channel-list-width."
107 (let ((command-height (or (plist-get plist :command-height) 4))
108 (user-list-width (or (plist-get plist :user-list-width) (+ 9 1 1)))
109 (channel-list-width (or (plist-get plist :channel-list-width) 18))
110 (buffer (window-buffer))
112 (and riece-user-list-buffer-mode
113 riece-current-channel
114 ;; User list buffer is nuisance for private conversation.
115 (riece-channel-p (riece-identity-prefix
116 riece-current-channel)))))
117 ;; Can't expand minibuffer to full frame.
118 (when (eq (selected-window) (minibuffer-window))
120 (delete-other-windows)
122 (let ((rest-window (split-window (selected-window) command-height)))
123 (set-window-buffer (selected-window)
124 riece-command-buffer)
125 (select-window rest-window))
126 ;; middle of frame (vertical-spilit when need)
127 (when (or (and riece-current-channel riece-channel-buffer-mode)
130 (split-window (selected-window)
131 (/ (* 5 (+ (window-height) command-height)) 8))))
133 ;; channel-buffer + user-list
135 (and riece-current-channel riece-channel-buffer-mode))
136 (let ((user-list-window (split-window (selected-window) nil t)))
137 (set-window-buffer (selected-window) riece-channel-buffer)
138 (set-window-buffer user-list-window riece-user-list-buffer)
139 (select-window user-list-window)
140 (shrink-window-horizontally (- (window-width) user-list-width))
141 (setq truncate-partial-width-windows nil)))
144 (set-window-buffer (selected-window) riece-user-list-buffer))
145 ;; only channel-buffer
146 (riece-channel-buffer-mode
147 (set-window-buffer (selected-window) riece-channel-buffer)))
148 (select-window rest-window)))
150 (if (and riece-current-channel
151 riece-channel-list-buffer-mode)
152 (let ((channel-list-window (split-window (selected-window) nil t)))
153 (set-window-buffer (selected-window) riece-others-buffer)
154 (set-window-buffer channel-list-window riece-channel-list-buffer)
155 (select-window channel-list-window)
156 (shrink-window-horizontally (- (window-width) channel-list-width))
157 (setq truncate-partial-width-windows nil))
158 (set-window-buffer (selected-window) riece-dialogue-buffer))
159 (riece-set-window-points)
160 (select-window (or (get-buffer-window buffer)
161 (get-buffer-window riece-command-buffer)))))
163 (defun riece-set-window-points ()
164 (if (get-buffer-window riece-user-list-buffer)
165 (with-current-buffer riece-user-list-buffer
166 (unless (riece-frozen riece-user-list-buffer)
167 (set-window-start (get-buffer-window riece-user-list-buffer)
169 (if (get-buffer-window riece-channel-list-buffer)
170 (with-current-buffer riece-channel-list-buffer
171 (unless (riece-frozen riece-channel-list-buffer)
172 (set-window-start (get-buffer-window riece-channel-list-buffer)
175 (defun riece-update-user-list-buffer ()
177 (set-buffer riece-user-list-buffer)
178 (when (and riece-redisplay-buffer
179 riece-current-channel
180 (riece-channel-p (riece-identity-prefix riece-current-channel)))
181 (let (users operators speakers)
182 (with-current-buffer (process-buffer (riece-server-process
183 (riece-identity-server
184 riece-current-channel)))
186 (riece-channel-get-users
187 (riece-identity-prefix riece-current-channel))
189 (riece-channel-get-operators
190 (riece-identity-prefix riece-current-channel))
192 (riece-channel-get-speakers
193 (riece-identity-prefix riece-current-channel))))
194 (let ((inhibit-read-only t)
198 (if (member (car users) operators)
199 (insert "@" (car users) "\n")
200 (if (member (car users) speakers)
201 (insert "+" (car users) "\n")
202 (insert " " (car users) "\n")))
203 (setq users (cdr users)))))
204 (setq riece-redisplay-buffer nil))))
206 (defun riece-update-channel-list-buffer ()
208 (set-buffer riece-channel-list-buffer)
209 (when riece-redisplay-buffer
210 (let ((inhibit-read-only t)
213 (channels riece-current-channels))
217 (let ((point (point)))
218 (insert (format "%2d: %s\n" index
219 (riece-format-identity (car channels))))
220 (put-text-property point (point) 'riece-identity
222 (setq index (1+ index)
223 channels (cdr channels))))
224 (setq riece-redisplay-buffer nil))))
226 (defun riece-update-channel-indicator ()
227 (setq riece-channel-indicator
228 (if riece-current-channel
229 (if (riece-channel-p (riece-identity-prefix riece-current-channel))
230 (riece-concat-channel-modes
231 riece-current-channel
232 (riece-concat-channel-topic
233 riece-current-channel
234 (riece-format-identity riece-current-channel)))
235 (riece-format-identity riece-current-channel))
238 (defun riece-update-short-channel-indicator ()
239 (setq riece-short-channel-indicator
240 (if riece-current-channel
241 (riece-format-identity riece-current-channel)
244 (defun riece-update-channel-list-indicator ()
245 (if (and riece-current-channels
246 ;; There is at least one channel.
247 (delq nil (copy-sequence riece-current-channels)))
249 (setq riece-channel-list-indicator
256 (format "%d:%s" index
257 (riece-format-identity channel)))
258 (setq index (1+ index))))
259 riece-current-channels))
261 (setq riece-channel-list-indicator "No channel")))
263 (defun riece-update-status-indicators ()
264 (if riece-current-channel
265 (with-current-buffer riece-command-buffer
266 (riece-with-server-buffer (riece-identity-server riece-current-channel)
267 (setq riece-away-indicator
268 (if (and riece-real-nickname
269 (riece-user-get-away riece-real-nickname))
272 riece-operator-indicator
273 (if (and riece-real-nickname
274 (riece-user-get-operator riece-real-nickname))
277 riece-user-indicator riece-real-nickname))))
278 (setq riece-freeze-indicator
279 (with-current-buffer (if (and riece-channel-buffer-mode
280 riece-channel-buffer)
282 riece-dialogue-buffer)
283 (if (eq riece-freeze 'own)
289 (defun riece-update-buffers ()
290 (if riece-current-channel
291 (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
292 riece-current-channel))))
293 (run-hooks 'riece-update-buffer-functions)
294 (force-mode-line-update t))
296 (defun riece-channel-buffer-name (identity)
297 (format riece-channel-buffer-format (riece-format-identity identity)))
300 (autoload 'riece-channel-mode "riece"))
301 (defun riece-channel-buffer-create (identity)
303 (riece-get-buffer-create (riece-channel-buffer-name identity))
304 (unless (eq major-mode 'riece-channel-mode)
306 (let (buffer-read-only)
307 (riece-insert-info (current-buffer)
308 (concat "Created on "
309 (funcall riece-format-time-function
312 (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
315 (defun riece-switch-to-channel (identity)
316 (setq riece-last-channel riece-current-channel
317 riece-current-channel identity)
318 (with-current-buffer riece-user-list-buffer
319 (setq riece-redisplay-buffer t))
320 (run-hooks 'riece-channel-switch-hook))
322 (defun riece-join-channel (identity)
323 (unless (riece-identity-member identity riece-current-channels)
324 (setq riece-current-channels
325 (riece-identity-assign-binding identity riece-current-channels
326 riece-default-channel-binding))
327 (riece-channel-buffer-create identity)
328 (with-current-buffer riece-channel-list-buffer
329 (setq riece-redisplay-buffer t))))
331 (defun riece-switch-to-nearest-channel (pointer)
332 (let ((start riece-current-channels)
334 (while (and start (not (eq start pointer)))
336 (setq identity (car start)))
337 (setq start (cdr start)))
340 (null (car pointer)))
341 (setq pointer (cdr pointer)))
342 (setq identity (car pointer)))
344 (riece-switch-to-channel identity)
345 (setq riece-last-channel riece-current-channel
346 riece-current-channel nil))))
348 (defun riece-part-channel (identity)
349 (let ((pointer (riece-identity-member identity riece-current-channels)))
351 (setcar pointer nil))
352 (if (riece-identity-equal identity riece-current-channel)
353 (riece-switch-to-nearest-channel pointer))
354 (with-current-buffer riece-channel-list-buffer
355 (setq riece-redisplay-buffer t))))
357 (defun riece-configure-windows-predicate ()
358 ;; The current channel is changed, and some buffers are visible.
359 (unless (equal riece-last-channel riece-current-channel)
360 (let ((buffers riece-buffer-list))
363 (if (and (buffer-live-p (car buffers))
364 (get-buffer-window (car buffers)))
366 (setq buffers (cdr buffers))))))))
368 (defun riece-redisplay-buffers (&optional force)
369 (riece-update-buffers)
371 (funcall riece-configure-windows-predicate))
372 (funcall riece-configure-windows-function))
373 (run-hooks 'riece-redisplay-buffers-hook))
375 (provide 'riece-display)
377 ;;; riece-display.el ends here