7b7c5bdd18ef30d3c2d302c752af5ba4ec50e7c5
[riece] / lisp / riece-display.el
1 ;;; riece-display.el --- buffer arrangement
2 ;; Copyright (C) 1998-2003 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Created: 1998-09-28
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
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)
13 ;; any later version.
14
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.
19
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.
24
25 ;;; Code:
26
27 (require 'riece-options)
28 (require 'riece-channel)
29 (require 'riece-misc)
30
31 (defcustom riece-configure-windows-function #'riece-configure-windows
32   "Function to configure windows."
33   :type 'function
34   :group 'riece-looks)
35
36 (defcustom riece-configure-windows-predicate
37   #'riece-configure-windows-predicate
38   "Function to check whether window reconfiguration is needed."
39   :type 'function
40   :group 'riece-looks)
41
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))
49
50 (defvar riece-redisplay-buffer nil
51   "Non-nil means the buffer needs to be updated.
52 Local to the buffers.")
53
54 (defun riece-configure-windows ()
55   (let ((buffer (window-buffer))
56         (show-user-list
57          (and riece-user-list-buffer-mode
58               riece-current-channel
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))
64         (other-window 1))
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)
71               (progn
72                 (set-window-buffer (split-window)
73                                    riece-channel-list-buffer)
74                 (set-window-buffer (selected-window)
75                                    riece-user-list-buffer))
76             (if show-user-list
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)
87                              riece-channel-buffer)
88           (set-window-buffer (split-window rest-window 4)
89                              riece-others-buffer)
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)))))
103
104 (defun riece-configure-windows-top (&optional plist)
105   "Candidate of `riece-configure-windows-function'.
106 PLIST accept :command-height, :nick-width, and :channel-list-width."
107   (let ((command-height (or (plist-get plist :command-height) 5))
108         (nick-width (or (plist-get plist :nick-width) 13))
109         (channel-list-width (or (plist-get plist :channel-list-width) 25))
110         (buffer (window-buffer))
111         (show-user-list
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))
119       (other-window 1))
120     (delete-other-windows)
121     ;; top of frame
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)
128               show-user-list)
129       (let ((rest-window
130              (split-window (selected-window)
131                            (/ (* 5 (+ (window-height) command-height)) 8))))
132         (cond
133          ;; channel-buffer + user-list
134          ((and show-user-list
135                (and riece-current-channel riece-channel-buffer-mode))
136           (set-window-buffer
137            (split-window (selected-window) (- (window-width) nick-width) t)
138            riece-user-list-buffer)
139           (set-window-buffer (selected-window) riece-channel-buffer))
140          ;; only user-list
141          (show-user-list
142           (set-window-buffer (selected-window) riece-user-list-buffer))
143          ;; only channel-buffer
144          (riece-channel-buffer-mode
145           (set-window-buffer (selected-window) riece-channel-buffer)))
146         (select-window rest-window)))
147     ;; bottom of frame
148     (if (and riece-current-channel
149              riece-channel-list-buffer-mode)
150         (progn
151           (set-window-buffer
152            (split-window (selected-window)
153                          (- (window-width) channel-list-width) t)
154            riece-channel-list-buffer)
155           (set-window-buffer (selected-window) riece-others-buffer)
156           (with-current-buffer riece-channel-buffer
157             (setq truncate-partial-width-windows nil))
158           (with-current-buffer riece-others-buffer
159             (setq truncate-partial-width-windows nil)))
160       (set-window-buffer (selected-window) riece-dialogue-buffer))
161     (riece-set-window-points)
162     (select-window (or (get-buffer-window buffer)
163                        (get-buffer-window riece-command-buffer)))))
164
165 (defun riece-set-window-points ()
166   (if (get-buffer-window riece-user-list-buffer)
167       (with-current-buffer riece-user-list-buffer
168         (unless (riece-frozen riece-user-list-buffer)
169           (set-window-start (get-buffer-window riece-user-list-buffer)
170                             (point-min)))))
171   (if (get-buffer-window riece-channel-list-buffer)
172       (with-current-buffer riece-channel-list-buffer
173         (unless (riece-frozen riece-channel-list-buffer)
174           (set-window-start (get-buffer-window riece-channel-list-buffer)
175                             (point-min))))))
176
177 (defun riece-update-user-list-buffer ()
178   (save-excursion
179     (set-buffer riece-user-list-buffer)
180     (when (and riece-redisplay-buffer
181                riece-current-channel
182                (riece-channel-p (riece-identity-prefix riece-current-channel)))
183       (let (users operators speakers)
184         (with-current-buffer (process-buffer (riece-server-process
185                                               (riece-identity-server
186                                                riece-current-channel)))
187           (setq users
188                 (riece-channel-get-users
189                  (riece-identity-prefix riece-current-channel))
190                 operators
191                 (riece-channel-get-operators
192                  (riece-identity-prefix riece-current-channel))
193                 speakers
194                 (riece-channel-get-speakers
195                  (riece-identity-prefix riece-current-channel))))
196         (let ((inhibit-read-only t)
197               buffer-read-only)
198           (erase-buffer)
199           (while users
200             (if (member (car users) operators)
201                 (insert "@" (car users) "\n")
202               (if (member (car users) speakers)
203                   (insert "+" (car users) "\n")
204                 (insert " " (car users) "\n")))
205             (setq users (cdr users)))))
206       (setq riece-redisplay-buffer nil))))
207
208 (defun riece-update-channel-list-buffer ()
209   (save-excursion
210     (set-buffer riece-channel-list-buffer)
211     (when riece-redisplay-buffer
212       (let ((inhibit-read-only t)
213             buffer-read-only
214             (index 1)
215             (channels riece-current-channels))
216         (erase-buffer)
217         (while channels
218           (if (car channels)
219               (let ((point (point)))
220                 (insert (format "%2d: %s\n" index
221                                 (riece-format-identity (car channels))))
222                 (put-text-property point (point) 'riece-identity
223                                    (car channels))))
224           (setq index (1+ index)
225                 channels (cdr channels))))
226       (setq riece-redisplay-buffer nil))))
227
228 (defun riece-update-channel-indicator ()
229   (setq riece-channel-indicator
230         (if riece-current-channel
231             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
232                 (riece-concat-channel-modes
233                  riece-current-channel
234                  (riece-concat-channel-topic
235                   riece-current-channel
236                   (riece-format-identity riece-current-channel)))
237               (riece-format-identity riece-current-channel))
238           "None")))
239
240 (defun riece-update-short-channel-indicator ()
241   (setq riece-short-channel-indicator
242         (if riece-current-channel
243             (riece-format-identity riece-current-channel)
244           "None")))
245
246 (defun riece-update-channel-list-indicator ()
247   (if (and riece-current-channels
248            ;; There is at least one channel.
249            (delq nil (copy-sequence riece-current-channels)))
250       (let ((index 1))
251         (setq riece-channel-list-indicator
252               (mapconcat
253                #'identity
254                (delq nil
255                      (mapcar
256                       (lambda (channel)
257                         (prog1 (if channel
258                                    (format "%d:%s" index
259                                            (riece-format-identity channel)))
260                           (setq index (1+ index))))
261                       riece-current-channels))
262                ",")))
263     (setq riece-channel-list-indicator "No channel")))
264
265 (defun riece-update-status-indicators ()
266   (if riece-current-channel
267       (with-current-buffer riece-command-buffer
268         (riece-with-server-buffer (riece-identity-server riece-current-channel)
269           (setq riece-away-indicator
270                 (if (and riece-real-nickname
271                          (riece-user-get-away riece-real-nickname))
272                     "A"
273                   "-")
274                 riece-operator-indicator
275                 (if (and riece-real-nickname
276                          (riece-user-get-operator riece-real-nickname))
277                     "O"
278                   "-")
279                 riece-user-indicator riece-real-nickname))))
280   (setq riece-freeze-indicator
281         (with-current-buffer (if (and riece-channel-buffer-mode
282                                       riece-channel-buffer)
283                                  riece-channel-buffer
284                                riece-dialogue-buffer)
285           (if (eq riece-freeze 'own)
286               "f"
287             (if riece-freeze
288                 "F"
289               "-")))))
290
291 (defun riece-update-buffers ()
292   (if riece-current-channel
293       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
294                                               riece-current-channel))))
295   (run-hooks 'riece-update-buffer-functions)
296   (force-mode-line-update t))
297
298 (defun riece-channel-buffer-name (identity)
299   (format riece-channel-buffer-format (riece-format-identity identity)))
300
301 (eval-when-compile
302   (autoload 'riece-channel-mode "riece"))
303 (defun riece-channel-buffer-create (identity)
304   (with-current-buffer
305       (riece-get-buffer-create (riece-channel-buffer-name identity))
306     (unless (eq major-mode 'riece-channel-mode)
307       (riece-channel-mode)
308       (let (buffer-read-only)
309         (riece-insert-info (current-buffer)
310                            (concat "Created on "
311                                    (funcall riece-format-time-function
312                                             (current-time))
313                                    "\n"))
314         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
315     (current-buffer)))
316
317 (defun riece-switch-to-channel (identity)
318   (setq riece-last-channel riece-current-channel
319         riece-current-channel identity)
320   (with-current-buffer riece-user-list-buffer
321     (setq riece-redisplay-buffer t))
322   (run-hooks 'riece-channel-switch-hook))
323
324 (defun riece-join-channel (identity)
325   (unless (riece-identity-member identity riece-current-channels)
326     (setq riece-current-channels
327           (riece-identity-assign-binding identity riece-current-channels
328                                          riece-default-channel-binding))
329     (riece-channel-buffer-create identity)
330     (with-current-buffer riece-channel-list-buffer
331       (setq riece-redisplay-buffer t))))
332
333 (defun riece-switch-to-nearest-channel (pointer)
334   (let ((start riece-current-channels)
335         identity)
336     (while (and start (not (eq start pointer)))
337       (if (car start)
338           (setq identity (car start)))
339       (setq start (cdr start)))
340     (unless identity
341       (while (and pointer
342                   (null (car pointer)))
343         (setq pointer (cdr pointer)))
344       (setq identity (car pointer)))
345     (if identity
346         (riece-switch-to-channel identity)
347       (setq riece-last-channel riece-current-channel
348             riece-current-channel nil))))
349
350 (defun riece-part-channel (identity)
351   (let ((pointer (riece-identity-member identity riece-current-channels)))
352     (if pointer
353         (setcar pointer nil))
354     (if (riece-identity-equal identity riece-current-channel)
355         (riece-switch-to-nearest-channel pointer))
356     (with-current-buffer riece-channel-list-buffer
357       (setq riece-redisplay-buffer t))))
358
359 (defun riece-configure-windows-predicate ()
360   ;; The current channel is changed, and some buffers are visible.
361   (unless (equal riece-last-channel riece-current-channel)
362     (let ((buffers riece-buffer-list))
363       (catch 'found
364         (while buffers
365           (if (and (buffer-live-p (car buffers))
366                    (get-buffer-window (car buffers)))
367               (throw 'found t)
368             (setq buffers (cdr buffers))))))))
369
370 (defun riece-redisplay-buffers (&optional force)
371   (riece-update-buffers)
372   (if (or force
373           (funcall riece-configure-windows-predicate))
374       (funcall riece-configure-windows-function))
375   (run-hooks 'riece-redisplay-buffers-hook))
376
377 (provide 'riece-display)
378
379 ;;; riece-display.el ends here