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