404760484cccc676d0d0fbb4c1fd73b7206238ca
[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 (defvar riece-update-buffer-functions
32   '(riece-user-list-update-buffer
33     riece-channel-list-update-buffer
34     riece-update-channel-indicator
35     riece-update-channel-list-indicator))
36
37 (defcustom riece-configure-windows-function #'riece-configure-windows
38   "Function to configure windows."
39   :type 'function
40   :group 'riece-looks)
41
42 (defun riece-configure-windows ()
43   (let ((buffer (current-buffer))
44         (show-user-list
45          (and riece-channel-list-buffer-mode
46               riece-current-channel
47               ;; User list buffer is nuisance for private conversation.
48               (riece-channel-p riece-current-channel))))
49     (delete-other-windows)
50     (if (and riece-current-channel
51              (or show-user-list riece-channel-list-buffer-mode))
52         (let ((rest-window (split-window (selected-window)
53                                          (/ (window-width) 5) t)))
54           (if (and show-user-list riece-channel-list-buffer-mode)
55               (progn
56                 (set-window-buffer (split-window)
57                                    riece-channel-list-buffer)
58                 (set-window-buffer (selected-window)
59                                    riece-user-list-buffer))
60             (if show-user-list
61                 (set-window-buffer (selected-window)
62                                    riece-user-list-buffer)
63               (if riece-channel-list-buffer-mode
64                   (set-window-buffer (selected-window)
65                                      riece-channel-list-buffer))))
66           (select-window rest-window)))
67     (if (and riece-current-channel
68              riece-channel-buffer-mode)
69         (let ((rest-window (split-window)))
70           (set-window-buffer (selected-window)
71                              riece-channel-buffer)
72           (set-window-buffer (split-window rest-window 4)
73                              riece-others-buffer)
74           (with-current-buffer riece-channel-buffer
75             (setq truncate-partial-width-windows nil))
76           (with-current-buffer riece-others-buffer
77             (setq truncate-partial-width-windows nil))
78           (set-window-buffer rest-window
79                              riece-command-buffer))
80       (set-window-buffer (split-window (selected-window) 4)
81                          riece-dialogue-buffer)
82       (set-window-buffer (selected-window)
83                          riece-command-buffer))
84     (riece-set-window-points)
85     (select-window (or (get-buffer-window buffer)
86                        (get-buffer-window riece-command-buffer)))))
87
88 (defun riece-set-window-points ()
89   (if (and riece-user-list-buffer
90            (get-buffer-window riece-user-list-buffer))
91       (with-current-buffer riece-user-list-buffer
92         (unless (riece-frozen riece-user-list-buffer)
93           (set-window-start (get-buffer-window riece-user-list-buffer)
94                             (point-min)))))
95   (if (get-buffer-window riece-channel-list-buffer)
96       (with-current-buffer riece-channel-list-buffer
97         (unless (riece-frozen riece-channel-list-buffer)
98           (set-window-start (get-buffer-window riece-channel-list-buffer)
99                             (point-min))))))
100
101 (defun riece-user-list-update-buffer ()
102   (if (get-buffer riece-user-list-buffer)
103       (save-excursion
104         (set-buffer riece-user-list-buffer)
105         (when (and riece-current-channel
106                    (riece-channel-p riece-current-channel))
107           (let ((inhibit-read-only t)
108                 buffer-read-only
109                 (users (riece-channel-get-users riece-current-channel))
110                 (operators (riece-channel-get-operators riece-current-channel))
111                 (speakers (riece-channel-get-speakers riece-current-channel)))
112             (erase-buffer)
113             (while users
114               (if (member (car users) operators)
115                   (insert "@" (car users) "\n")
116                 (if (member (car users) speakers)
117                     (insert "+" (car users) "\n")
118                   (insert " " (car users) "\n")))
119               (setq users (cdr users))))))))
120
121 (defun riece-channel-list-update-buffer ()
122   (if (get-buffer riece-channel-list-buffer)
123       (save-excursion
124         (set-buffer riece-channel-list-buffer)
125         (let ((inhibit-read-only t)
126               buffer-read-only
127               (index 1)
128               (channels riece-current-channels))
129           (erase-buffer)
130           (while channels
131             (if (car channels)
132                 (insert (format "%2d:%s\n" index (car channels))))
133             (setq index (1+ index)
134                   channels (cdr channels)))))))
135
136 (defsubst riece-update-channel-indicator ()
137   (setq riece-channel-indicator
138         (if riece-current-channel
139             (riece-concat-current-channel-modes
140              (if (and riece-current-channel
141                       (riece-channel-p riece-current-channel)
142                       (riece-channel-get-topic riece-current-channel))
143                  (concat riece-current-channel ": "
144                          (riece-channel-get-topic riece-current-channel))
145                riece-current-channel))
146           "None"))
147   (with-current-buffer riece-command-buffer
148     (force-mode-line-update)))
149
150 (defun riece-update-channel-list-indicator ()
151   (if (and riece-current-channels
152            ;; There is at least one channel.
153            (delq nil (copy-sequence riece-current-channels)))
154       (let ((index 1))
155         (setq riece-channel-list-indicator
156               (mapconcat
157                #'identity
158                (delq nil
159                      (mapcar
160                       (lambda (channel)
161                         (prog1 (if channel
162                                    (format "%d:%s" index channel))
163                           (setq index (1+ index))))
164                       riece-current-channels))
165                ",")))
166     (setq riece-channel-list-indicator "No channel")))
167
168 (defun riece-update-buffers ()
169   (run-hooks 'riece-update-buffer-functions)
170   (force-mode-line-update t))
171
172 (eval-when-compile
173   (autoload 'riece-channel-mode "riece"))
174 (defun riece-channel-buffer-create (identity)
175   (with-current-buffer
176       (riece-get-buffer-create (format riece-channel-buffer-format identity))
177     (unless (eq major-mode 'riece-channel-mode)
178       (riece-channel-mode)
179       (let (buffer-read-only)
180         (riece-insert-info (current-buffer)
181                            (concat "Created on "
182                                    (funcall riece-format-time-function
183                                             (current-time))
184                                    "\n"))))
185     (current-buffer)))
186
187 (eval-when-compile
188   (autoload 'riece-user-list-mode "riece"))
189 (defun riece-user-list-buffer-create (identity)
190   (with-current-buffer
191       (riece-get-buffer-create (format riece-user-list-buffer-format identity))
192     (unless (eq major-mode 'riece-user-list-mode)
193       (riece-user-list-mode))
194     (current-buffer)))
195
196 (defun riece-switch-to-channel (identity)
197   (setq riece-last-channel riece-current-channel
198         riece-current-channel identity
199         riece-channel-buffer
200         (cdr (riece-identity-assoc-no-server
201               identity riece-channel-buffer-alist))
202         riece-user-list-buffer 
203         (cdr (riece-identity-assoc-no-server
204               identity riece-user-list-buffer-alist))))
205
206 (defun riece-join-channel (channel-name)
207   (let ((identity (riece-make-identity channel-name)))
208     (unless (riece-identity-member-no-server
209              identity riece-current-channels)
210       (setq riece-current-channels
211             (riece-identity-assign-binding
212              identity riece-current-channels
213              riece-default-channel-binding)))
214     (unless (riece-identity-assoc-no-server
215              identity riece-channel-buffer-alist)
216       (let ((buffer (riece-channel-buffer-create identity)))
217         (push (cons identity buffer) riece-channel-buffer-alist)))
218     (unless (riece-identity-assoc-no-server
219              identity riece-user-list-buffer-alist)
220       (let ((buffer (riece-user-list-buffer-create identity)))
221         (push (cons identity buffer) riece-user-list-buffer-alist)))))
222
223 (defun riece-switch-to-nearest-channel (pointer)
224   (let ((start riece-current-channels)
225         identity)
226     (while (and start (not (eq start pointer)))
227       (if (car start)
228           (setq identity (car start)))
229       (setq start (cdr start)))
230     (unless identity
231       (while (and pointer
232                   (null (car pointer)))
233         (setq pointer (cdr pointer)))
234       (setq identity (car pointer)))
235     (if identity
236         (riece-switch-to-channel identity)
237       (setq riece-last-channel riece-current-channel
238             riece-current-channel nil))))
239
240 (defun riece-part-channel (channel-name)
241   (let* ((identity (riece-make-identity channel-name))
242          (pointer (riece-identity-member-no-server
243                    identity riece-current-channels)))
244     (if pointer
245         (setcar pointer nil))
246     ;;XXX
247     (if (riece-identity-equal-no-server identity riece-current-channel)
248         (riece-switch-to-nearest-channel pointer))))
249
250 (defun riece-redisplay-buffers (&optional force)
251   (riece-update-buffers)
252   (if (or force
253           ;; The current channel is changed, and some buffers are visible.
254           (unless (equal riece-last-channel riece-current-channel)
255             (let ((buffers riece-buffer-list))
256               (catch 'found
257                 (while buffers
258                   (if (and (buffer-live-p (car buffers))
259                            (get-buffer-window (car buffers)))
260                       (throw 'found t)
261                     (setq buffers (cdr buffers))))))))
262       (funcall riece-configure-windows-function)))
263
264 (provide 'riece-display)