be5934cce3f9cc14dde8e12d4730d483aab87c32
[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-user-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         (setq riece-channel-buffer-alist
218               (cons (cons identity buffer)
219                     riece-channel-buffer-alist))))
220     (unless (riece-identity-assoc-no-server
221              identity riece-user-list-buffer-alist)
222       (let ((buffer (riece-user-list-buffer-create identity)))
223         (setq riece-user-list-buffer-alist
224               (cons (cons identity buffer)
225                     riece-user-list-buffer-alist))))))
226
227 (defun riece-switch-to-nearest-channel (pointer)
228   (let ((start riece-current-channels)
229         identity)
230     (while (and start (not (eq start pointer)))
231       (if (car start)
232           (setq identity (car start)))
233       (setq start (cdr start)))
234     (unless identity
235       (while (and pointer
236                   (null (car pointer)))
237         (setq pointer (cdr pointer)))
238       (setq identity (car pointer)))
239     (if identity
240         (riece-switch-to-channel identity)
241       (setq riece-last-channel riece-current-channel
242             riece-current-channel nil))))
243
244 (defun riece-part-channel (channel-name)
245   (let* ((identity (riece-make-identity channel-name))
246          (pointer (riece-identity-member-no-server
247                    identity riece-current-channels)))
248     (if pointer
249         (setcar pointer nil))
250     ;;XXX
251     (if (riece-identity-equal-no-server identity riece-current-channel)
252         (riece-switch-to-nearest-channel pointer))))
253
254 (defun riece-redisplay-buffers (&optional force)
255   (riece-update-buffers)
256   (if (or force
257           ;; The current channel is changed, and some buffers are visible.
258           (unless (equal riece-last-channel riece-current-channel)
259             (let ((buffers riece-buffer-list))
260               (catch 'found
261                 (while buffers
262                   (if (and (buffer-live-p (car buffers))
263                            (get-buffer-window (car buffers)))
264                       (throw 'found t)
265                     (setq buffers (cdr buffers))))))))
266       (funcall riece-configure-windows-function)))
267
268 (provide 'riece-display)