752494b4e73fcc871ed25de8f1b5ce57fbcfa984
[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 (format "%2d:%c%s\n" index
81                                 (if (riece-identity-equal
82                                      (car channels)
83                                      riece-current-channel)
84                                     ?*
85                                   ?\ )
86                                 (riece-format-identity (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 (and riece-current-channels
110            ;; There is at least one channel.
111            (delq nil (copy-sequence riece-current-channels)))
112       (let ((index 1))
113         (setq riece-channel-list-indicator
114               (mapconcat
115                #'identity
116                (delq nil
117                      (mapcar
118                       (lambda (channel)
119                         (prog1 (if channel
120                                    (format "%d:%s" index
121                                            (riece-format-identity channel)))
122                           (setq index (1+ index))))
123                       riece-current-channels))
124                ",")))
125     (setq riece-channel-list-indicator "No channel")))
126
127 (defun riece-update-status-indicators ()
128   (if riece-current-channel
129       (with-current-buffer riece-command-buffer
130         (riece-with-server-buffer (riece-identity-server riece-current-channel)
131           (setq riece-away-indicator
132                 (if (and riece-real-nickname
133                          (riece-user-get-away riece-real-nickname))
134                     "A"
135                   "-")
136                 riece-operator-indicator
137                 (if (and riece-real-nickname
138                          (riece-user-get-operator riece-real-nickname))
139                     "O"
140                   "-")
141                 riece-user-indicator riece-real-nickname))))
142   (setq riece-freeze-indicator
143         (with-current-buffer (if (and riece-channel-buffer-mode
144                                       riece-channel-buffer)
145                                  riece-channel-buffer
146                                riece-dialogue-buffer)
147           (if (eq riece-freeze 'own)
148               "f"
149             (if riece-freeze
150                 "F"
151               "-")))))
152
153 (defun riece-update-buffers ()
154   (if riece-current-channel
155       (setq riece-channel-buffer (get-buffer (riece-channel-buffer-name
156                                               riece-current-channel))))
157   (run-hooks 'riece-update-buffer-functions)
158   (force-mode-line-update t))
159
160 (defun riece-channel-buffer-name (identity)
161   (format riece-channel-buffer-format (riece-format-identity identity)))
162
163 (eval-when-compile
164   (autoload 'riece-channel-mode "riece"))
165 (defun riece-channel-buffer-create (identity)
166   (with-current-buffer
167       (riece-get-buffer-create (riece-channel-buffer-name identity))
168     (unless (eq major-mode 'riece-channel-mode)
169       (riece-channel-mode)
170       (let (buffer-read-only)
171         (riece-insert-info (current-buffer)
172                            (concat "Created on "
173                                    (funcall riece-format-time-function
174                                             (current-time))
175                                    "\n"))
176         (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
177     (current-buffer)))
178
179 (defun riece-switch-to-channel (identity)
180   (setq riece-last-channel riece-current-channel
181         riece-current-channel identity)
182   (run-hooks 'riece-channel-switch-hook))
183
184 (defun riece-join-channel (identity)
185   (unless (riece-identity-member identity riece-current-channels)
186     (setq riece-current-channels
187           (riece-identity-assign-binding
188            identity riece-current-channels
189            (mapcar
190             (lambda (channel)
191               (if channel
192                   (riece-parse-identity channel)))
193             riece-default-channel-binding)))
194     (riece-channel-buffer-create identity)))
195
196 (defun riece-switch-to-nearest-channel (pointer)
197   (let ((start riece-current-channels)
198         identity)
199     (while (and start (not (eq start pointer)))
200       (if (car start)
201           (setq identity (car start)))
202       (setq start (cdr start)))
203     (unless identity
204       (while (and pointer
205                   (null (car pointer)))
206         (setq pointer (cdr pointer)))
207       (setq identity (car pointer)))
208     (if identity
209         (riece-switch-to-channel identity)
210       (setq riece-last-channel riece-current-channel
211             riece-current-channel nil))))
212
213 (defun riece-part-channel (identity)
214   (let ((pointer (riece-identity-member identity riece-current-channels)))
215     (if pointer
216         (setcar pointer nil))
217     (if (riece-identity-equal identity riece-current-channel)
218         (riece-switch-to-nearest-channel pointer))))
219
220 (defun riece-redisplay-buffers (&optional force)
221   (riece-update-buffers)
222   (riece-redraw-layout force)
223   (run-hooks 'riece-redisplay-buffers-hook))
224
225 (provide 'riece-display)
226
227 ;;; riece-display.el ends here