* riece.el (riece-channel-list-mode): Initialize
[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 (require 'riece-layout)
31
32 (defvar riece-update-buffer-functions nil
33   "Functions to redisplay the buffer.
34 Local to the buffer in `riece-buffer-list'.")
35   
36 (defvar riece-update-indicator-functions
37   '(riece-update-status-indicators
38     riece-update-channel-indicator
39     riece-update-long-channel-indicator
40     riece-update-channel-list-indicator)
41   "Functions to update modeline indicators.")
42
43 (defun riece-update-user-list-buffer ()
44   (save-excursion
45     (set-buffer riece-user-list-buffer)
46     (when (and riece-current-channel
47                (riece-channel-p (riece-identity-prefix riece-current-channel)))
48       (let (users operators speakers)
49         (with-current-buffer (process-buffer (riece-server-process
50                                               (riece-identity-server
51                                                riece-current-channel)))
52           (setq users
53                 (riece-channel-get-users
54                  (riece-identity-prefix riece-current-channel))
55                 operators
56                 (riece-channel-get-operators
57                  (riece-identity-prefix riece-current-channel))
58                 speakers
59                 (riece-channel-get-speakers
60                  (riece-identity-prefix riece-current-channel))))
61         (let ((inhibit-read-only t)
62               buffer-read-only)
63           (erase-buffer)
64           (while users
65             (insert (if (member (car users) operators)
66                         "@"
67                       (if (member (car users) speakers)
68                           "+"
69                         " "))
70                     (riece-format-identity
71                      (riece-make-identity (car users)
72                                           (riece-identity-server
73                                            riece-current-channel))
74                      t)
75                     "\n")
76             (setq users (cdr users))))))))
77
78 (defun riece-update-channel-list-buffer ()
79   (save-excursion
80     (set-buffer riece-channel-list-buffer)
81     (let ((inhibit-read-only t)
82           buffer-read-only
83           (index 1)
84           (channels riece-current-channels))
85       (erase-buffer)
86       (while channels
87         (if (car channels)
88             (let ((point (point)))
89               (insert (riece-format-channel-list-line
90                        index (car channels)))))
91         (setq index (1+ index)
92               channels (cdr channels))))))
93
94 (defun riece-format-channel-list-line (index channel)
95   (or (run-hook-with-args-until-success
96        'riece-format-channel-list-line-functions index channel)
97       (concat (format "%2d:%c" index
98                       (if (riece-identity-equal channel riece-current-channel)
99                           ?*
100                         ? ))
101               (riece-format-identity channel)
102               "\n")))
103
104 (defun riece-update-channel-indicator ()
105   (setq riece-channel-indicator
106         (if riece-current-channel
107             (riece-format-identity riece-current-channel)
108           "None")))
109
110 (defun riece-update-long-channel-indicator ()
111   (setq riece-long-channel-indicator
112         (if riece-current-channel
113             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
114                 (riece-concat-channel-modes
115                  riece-current-channel
116                  (riece-concat-channel-topic
117                   riece-current-channel
118                   (riece-format-identity riece-current-channel)))
119               (riece-format-identity riece-current-channel))
120           "None")))
121
122 (defun riece-update-channel-list-indicator ()
123   (if (and riece-current-channels
124            ;; There is at least one channel.
125            (delq nil (copy-sequence riece-current-channels)))
126       (let ((index 1))
127         (setq riece-channel-list-indicator
128               (mapconcat
129                #'identity
130                (delq nil
131                      (mapcar
132                       (lambda (channel)
133                         (prog1
134                             (if channel
135                                 (format "%d:%s" index
136                                         (riece-format-identity channel)))
137                           (setq index (1+ index))))
138                       riece-current-channels))
139                ",")))
140     (setq riece-channel-list-indicator "No channel")))
141
142 (defun riece-update-status-indicators ()
143   (if riece-current-channel
144       (with-current-buffer riece-command-buffer
145         (riece-with-server-buffer (riece-identity-server riece-current-channel)
146           (setq riece-away-indicator
147                 (if (and riece-real-nickname
148                          (riece-user-get-away riece-real-nickname))
149                     "A"
150                   "-")
151                 riece-operator-indicator
152                 (if (and riece-real-nickname
153                          (riece-user-get-operator riece-real-nickname))
154                     "O"
155                   "-")
156                 riece-user-indicator riece-real-nickname))))
157   (setq riece-freeze-indicator
158         (with-current-buffer (if (and riece-channel-buffer-mode
159                                       riece-channel-buffer)
160                                  riece-channel-buffer
161                                riece-dialogue-buffer)
162           (if (eq riece-freeze 'own)
163               "f"
164             (if riece-freeze
165                 "F"
166               "-")))))
167
168 (defun riece-update-buffers (&optional buffers)
169   (unless buffers
170     (setq buffers riece-buffer-list))
171   (while buffers
172     (save-excursion
173       (set-buffer (car buffers))
174       (run-hooks 'riece-update-buffer-functions))
175     (setq buffers (cdr buffers)))
176   (run-hooks 'riece-update-indicator-functions)
177   (force-mode-line-update t))
178
179 (defun riece-channel-buffer-name (identity)
180   (let ((channels (riece-identity-member identity riece-current-channels)))
181     (if channels
182         (setq identity (car channels))
183       (if riece-debug
184           (message "%S is not a member of riece-current-channels" identity)))
185     (format riece-channel-buffer-format (riece-format-identity identity))))
186
187 (eval-when-compile
188   (autoload 'riece-channel-mode "riece"))
189 (defun riece-channel-buffer-create (identity)
190   (with-current-buffer
191       (riece-get-buffer-create (riece-channel-buffer-name identity))
192     (unless (eq major-mode 'riece-channel-mode)
193       (riece-channel-mode)
194       (let (buffer-read-only)
195         (riece-insert-info (current-buffer)
196                            (concat "Created on "
197                                    (funcall riece-format-time-function
198                                             (current-time))
199                                    "\n"))
200         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
201     (current-buffer)))
202
203 (defun riece-switch-to-channel (identity)
204   (let ((last riece-current-channel))
205     (setq riece-current-channel identity
206           riece-channel-buffer (get-buffer (riece-channel-buffer-name
207                                             riece-current-channel)))
208     (run-hook-with-args 'riece-after-switch-to-channel-functions last)))
209
210 (defun riece-join-channel (identity)
211   (unless (riece-identity-member identity riece-current-channels)
212     (setq riece-current-channels
213           (riece-identity-assign-binding
214            identity riece-current-channels
215            (mapcar
216             (lambda (channel)
217               (if channel
218                   (riece-parse-identity channel)))
219             riece-default-channel-binding)))
220     (riece-channel-buffer-create identity)))
221
222 (defun riece-switch-to-nearest-channel (pointer)
223   (let ((start riece-current-channels)
224         identity)
225     (while (and start (not (eq start pointer)))
226       (if (car start)
227           (setq identity (car start)))
228       (setq start (cdr start)))
229     (unless identity
230       (while (and pointer
231                   (null (car pointer)))
232         (setq pointer (cdr pointer)))
233       (setq identity (car pointer)))
234     (if identity
235         (riece-switch-to-channel identity)
236       (let ((last riece-current-channel))
237         (run-hook-with-args 'riece-after-switch-to-channel-functions last)
238         (setq riece-current-channel nil)))))
239
240 (defun riece-part-channel (identity)
241   (let ((pointer (riece-identity-member identity riece-current-channels)))
242     (if pointer
243         (setcar pointer nil))
244     (if (riece-identity-equal identity riece-current-channel)
245         (riece-switch-to-nearest-channel pointer))))
246
247 (defun riece-redisplay-buffers (&optional force)
248   (riece-update-buffers)
249   (riece-redraw-layout force)
250   (run-hooks 'riece-redisplay-buffers-hook))
251
252 (provide 'riece-display)
253
254 ;;; riece-display.el ends here