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