e72fe27cc84c7c2fca0469e3378769e676aeb186
[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         (setq riece-channel-list-changed nil))))
90
91 (defun riece-update-channel-indicator ()
92   (setq riece-channel-indicator
93         (if riece-current-channel
94             (if (riece-channel-p (riece-identity-prefix riece-current-channel))
95                 (riece-concat-channel-modes
96                  riece-current-channel
97                  (riece-concat-channel-topic
98                   riece-current-channel
99                   (riece-format-identity riece-current-channel)))
100               (riece-format-identity riece-current-channel))
101           "None")))
102
103 (defun riece-update-short-channel-indicator ()
104   (setq riece-short-channel-indicator
105         (if riece-current-channel
106             (riece-format-identity riece-current-channel)
107           "None")))
108
109 (defun riece-update-channel-list-indicator ()
110   (if riece-channel-list-changed
111       (if (and riece-current-channels
112                ;; There is at least one channel.
113                (delq nil (copy-sequence riece-current-channels)))
114           (let ((index 1))
115             (setq riece-channel-list-indicator
116                   (mapconcat
117                    #'identity
118                    (delq nil
119                          (mapcar
120                           (lambda (channel)
121                             (prog1
122                                 (if channel
123                                     (format "%d:%s" index
124                                             (riece-format-identity channel)))
125                               (setq index (1+ index))))
126                           riece-current-channels))
127                    ",")))
128         (setq riece-channel-list-indicator "No channel"))))
129
130 (defun riece-update-status-indicators ()
131   (if riece-current-channel
132       (with-current-buffer riece-command-buffer
133         (riece-with-server-buffer (riece-identity-server riece-current-channel)
134           (setq riece-away-indicator
135                 (if (and riece-real-nickname
136                          (riece-user-get-away riece-real-nickname))
137                     "A"
138                   "-")
139                 riece-operator-indicator
140                 (if (and riece-real-nickname
141                          (riece-user-get-operator riece-real-nickname))
142                     "O"
143                   "-")
144                 riece-user-indicator riece-real-nickname))))
145   (setq riece-freeze-indicator
146         (with-current-buffer (if (and riece-channel-buffer-mode
147                                       riece-channel-buffer)
148                                  riece-channel-buffer
149                                riece-dialogue-buffer)
150           (if (eq riece-freeze 'own)
151               "f"
152             (if riece-freeze
153                 "F"
154               "-")))))
155
156 (defun riece-update-buffers ()
157   (if riece-current-channel
158       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
159                                               riece-current-channel))))
160   (run-hooks 'riece-update-buffer-functions)
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   (setq riece-last-channel riece-current-channel
184         riece-current-channel identity)
185   (run-hooks 'riece-channel-switch-hook))
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       (setq riece-last-channel riece-current-channel
215             riece-current-channel nil))))
216
217 (defun riece-part-channel (identity)
218   (let ((pointer (riece-identity-member identity riece-current-channels)))
219     (if pointer
220         (setcar pointer nil))
221     (if (riece-identity-equal identity riece-current-channel)
222         (riece-switch-to-nearest-channel pointer))
223     (setq riece-channel-list-changed t)))
224
225 (defun riece-redisplay-buffers (&optional force)
226   (riece-update-buffers)
227   (riece-redraw-layout force)
228   (run-hooks 'riece-redisplay-buffers-hook))
229
230 (provide 'riece-display)
231
232 ;;; riece-display.el ends here