Mercurial > emacs
comparison lisp/erc/erc-list.el @ 68451:fc745b05e928
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-22
Creator: Michael Olson <mwolson@gnu.org>
Install ERC.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 29 Jan 2006 13:08:58 +0000 |
parents | |
children | 2de3fcf69715 |
comparison
equal
deleted
inserted
replaced
68450:a3ba4ef5d590 | 68451:fc745b05e928 |
---|---|
1 ;;; erc-list.el --- Provide a faster channel listing mechanism | |
2 | |
3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. | |
4 ;; Copyright (C) 2004 Brian Palmer | |
5 | |
6 ;; Author: Mario Lang <mlang@lexx.delysid.org> | |
7 ;; Keywords: comm | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
24 ;; Boston, MA 02110-1301, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This file provides a simple derived mode for viewing Channel lists. | |
29 ;; It also serves as a demonstration of how the new server hook facility | |
30 ;; can be used. | |
31 | |
32 ;;; Code: | |
33 | |
34 (require 'erc) | |
35 (require 'erc-nets) | |
36 (require 'sort) | |
37 (unless (fboundp 'make-overlay) | |
38 (require 'overlay)) | |
39 (eval-when-compile (require 'cl)) | |
40 | |
41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
42 ;; User customizable variables. | |
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
44 | |
45 (defgroup erc-list nil | |
46 "Display IRC channels in another window when using /LIST" | |
47 :group 'erc) | |
48 | |
49 (defcustom erc-chanlist-progress-message t | |
50 "*Show progress message while accumulating channel list." | |
51 :group 'erc-list | |
52 :type 'boolean) | |
53 | |
54 (defcustom erc-no-list-networks nil | |
55 "*A list of network names on which the /LIST command refuses to work." | |
56 :group 'erc-list | |
57 :type '(repeat string)) | |
58 | |
59 (defcustom erc-chanlist-frame-parameters nil | |
60 "*If nil, the channel list is displayed in a new window; if non-nil, | |
61 this variable holds the frame parameters used to make a frame to | |
62 display the channel list." | |
63 :group 'erc-list | |
64 :type 'list) | |
65 | |
66 (defcustom erc-chanlist-hide-modeline nil | |
67 "*If nil, the channel list buffer has a modeline, otherwise the modeline is hidden." | |
68 :group 'erc-list | |
69 :type 'boolean) | |
70 | |
71 (defface erc-chanlist-header-face '((t (:bold t))) | |
72 "Face used for the headers in erc's channel list." | |
73 :group 'erc-faces) | |
74 | |
75 (defface erc-chanlist-odd-line-face '((t (:inverse-video t))) | |
76 "Face used for the odd lines in erc's channel list." | |
77 :group 'erc-faces) | |
78 | |
79 (defface erc-chanlist-even-line-face '((t (:inverse-video nil))) | |
80 "Face used for the even lines in erc's channel list." | |
81 :group 'erc-faces) | |
82 | |
83 (defface erc-chanlist-highlight '((t (:foreground "red"))) | |
84 "Face used to highlight the current line in the channel list." | |
85 :group 'erc-faces) | |
86 | |
87 ;; This should perhaps be a defface that inherits values from the highlight face | |
88 ;; but xemacs does not support inheritance | |
89 (defcustom erc-chanlist-highlight-face 'erc-chanlist-highlight | |
90 "Face used for highlighting the current line in a list." | |
91 :type 'face | |
92 :group 'erc-faces) | |
93 | |
94 | |
95 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
96 ;; All variables below this line are for internal use only. | |
97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
98 | |
99 (defvar erc-chanlist-channel-line-regexp "^\\([#&\\*][^ \t\n]*\\)\\s-+[0-9]+" | |
100 "Regexp that matches a channel line in the channel list buffer.") | |
101 | |
102 (defvar erc-chanlist-buffer nil) | |
103 (make-variable-buffer-local 'erc-chanlist-buffer) | |
104 | |
105 (defvar erc-chanlist-last-time 0 | |
106 "A time value used to throttle the progress indicator.") | |
107 | |
108 (defvar erc-chanlist-frame nil | |
109 "The frame displaying the most recent channel list buffer.") | |
110 | |
111 (defvar erc-chanlist-sort-state 'channel | |
112 "The sort mode of the channel list buffer. Either 'channel or 'users.") | |
113 (make-variable-buffer-local 'erc-chanlist-sort-state) | |
114 | |
115 (defvar erc-chanlist-highlight-overlay nil | |
116 "The overlay used for erc chanlist highlighting") | |
117 (make-variable-buffer-local 'erc-chanlist-highlight-overlay) | |
118 | |
119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
120 ;; Define erc-chanlist-mode. | |
121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
122 | |
123 (defcustom erc-chanlist-mode-hook nil | |
124 "Hook run by erc-chanlist-mode." | |
125 :group 'erc-list | |
126 :type 'hook) | |
127 | |
128 (define-derived-mode erc-chanlist-mode fundamental-mode "ERC Channel List" | |
129 "Mode for viewing a channel list of a particular server. | |
130 | |
131 \\{erc-chanlist-mode-map}" | |
132 (local-set-key "\C-c\C-j" 'erc-join-channel) | |
133 (local-set-key "j" 'erc-chanlist-join-channel) | |
134 (local-set-key "n" 'next-line) | |
135 (local-set-key "p" 'previous-line) | |
136 (local-set-key "q" 'erc-chanlist-quit) | |
137 (local-set-key "s" 'erc-chanlist-toggle-sort-state) | |
138 (local-set-key "t" 'toggle-truncate-lines) | |
139 (setq erc-chanlist-sort-state 'channel) | |
140 (setq truncate-lines t) | |
141 (add-hook 'post-command-hook 'erc-chanlist-post-command-hook 'append 'local)) | |
142 | |
143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
144 ;; Functions. | |
145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
146 | |
147 ;;;###autoload | |
148 (defun erc-cmd-LIST (&rest channel) | |
149 "Display a buffer containing a list of channels on the current server. | |
150 Optional argument CHANNEL specifies a single channel to list (instead of every | |
151 available channel)." | |
152 (interactive | |
153 (remove "" (split-string | |
154 (read-from-minibuffer "List channels (RET for all): ") " "))) | |
155 (if (and (null channel) | |
156 (erc-member-ignore-case (erc-network-name) erc-no-list-networks)) | |
157 (erc-display-line "ERC is configured not to allow the /LIST command on this network!" | |
158 (current-buffer)) | |
159 (erc-display-line (erc-make-notice (concat "Listing channel" | |
160 (if channel | |
161 "." | |
162 "s. This may take a while.")))) | |
163 (erc-chanlist channel)) | |
164 t) | |
165 | |
166 ;;;###autoload | |
167 (defun erc-chanlist (&optional channels) | |
168 "Show a channel listing of the current server in a special mode. | |
169 Please note that this function only works with IRC servers which conform | |
170 to RFC and send the LIST header (#321) at start of list transmission." | |
171 (interactive) | |
172 (with-current-buffer (erc-server-buffer) | |
173 (erc-once-with-server-event | |
174 321 | |
175 '(progn | |
176 (add-hook 'erc-server-322-functions 'erc-chanlist-322 nil t) | |
177 | |
178 (erc-once-with-server-event | |
179 323 | |
180 '(progn | |
181 (remove-hook 'erc-server-322-functions 'erc-chanlist-322 t) | |
182 (let ((buf erc-chanlist-buffer)) | |
183 (if (not (buffer-live-p buf)) | |
184 (error "`erc-chanlist-buffer' does not refer to a live buffer")) | |
185 | |
186 (set-buffer buf) | |
187 (buffer-disable-undo) | |
188 (let (buffer-read-only | |
189 (sort-fold-case t)) | |
190 (sort-lines nil (point-min) (point-max)) | |
191 (setq erc-chanlist-sort-state 'channel) | |
192 | |
193 (let ((sum (count-lines (point-min) (point-max)))) | |
194 (goto-char (point-min)) | |
195 (insert (substitute-command-keys | |
196 (concat "'\\[erc-chanlist-toggle-sort-state]' toggle sort mode.\n" | |
197 "'\\[erc-chanlist-quit]' kill this buffer.\n" | |
198 "'\\[toggle-truncate-lines]' toggle line truncation.\n" | |
199 "'\\[erc-chanlist-join-channel]' join the channel listed on the current line.\n\n"))) | |
200 (insert (format "%d channels (sorted by %s).\n\n" | |
201 sum (if (eq erc-chanlist-sort-state 'channel) | |
202 "channel name" | |
203 "number of users")))) | |
204 | |
205 (insert (format "%-25s%5s %s\n------------------------ ----- ----------------------------\n" | |
206 "Channel" | |
207 "Users" | |
208 "Topic")) | |
209 | |
210 ;; Display the channel list buffer. | |
211 (if erc-chanlist-frame-parameters | |
212 (progn | |
213 (if (or (null erc-chanlist-frame) | |
214 (not (frame-live-p erc-chanlist-frame))) | |
215 (setq erc-chanlist-frame | |
216 (make-frame `((name . ,(format "Channels on %s" | |
217 erc-session-server)) | |
218 ,@erc-chanlist-frame-parameters)))) | |
219 (select-frame erc-chanlist-frame) | |
220 (switch-to-buffer buf) | |
221 (erc-prettify-channel-list)) | |
222 (pop-to-buffer buf) | |
223 (erc-prettify-channel-list)))) | |
224 (goto-char (point-min)) | |
225 (search-forward-regexp "^------" nil t) | |
226 (forward-line 1) | |
227 (erc-chanlist-highlight-line) | |
228 (message "") | |
229 t)) | |
230 | |
231 (setq erc-chanlist-buffer (get-buffer-create | |
232 (format "*Channels on %s*" | |
233 (erc-response.sender parsed)))) | |
234 (with-current-buffer erc-chanlist-buffer | |
235 (setq buffer-read-only nil) | |
236 (erase-buffer) | |
237 (erc-chanlist-mode) | |
238 (setq erc-server-process proc) | |
239 (if erc-chanlist-hide-modeline | |
240 (setq mode-line-format nil)) | |
241 (setq buffer-read-only t)) | |
242 t)) | |
243 | |
244 ;; Now that we've setup our callbacks, pull the trigger. | |
245 (if (interactive-p) | |
246 (message "Collecting channel list for server %s" erc-session-server)) | |
247 (erc-server-send (if (null channels) | |
248 "LIST" | |
249 (concat "LIST " | |
250 (mapconcat #'identity channels ",")))))) | |
251 | |
252 (defun erc-chanlist-322 (proc parsed) | |
253 "Process an IRC 322 message. | |
254 | |
255 The message carries information about one channel for the LIST | |
256 command." | |
257 (multiple-value-bind (channel num-users) | |
258 (cdr (erc-response.command-args parsed)) | |
259 (let ((topic (erc-response.contents parsed))) | |
260 (with-current-buffer erc-chanlist-buffer | |
261 (save-excursion | |
262 (goto-char (point-max)) | |
263 (let (buffer-read-only) | |
264 (insert (format "%-26s%4s %s\n" (erc-controls-strip channel) | |
265 num-users | |
266 (erc-controls-strip topic)))) | |
267 | |
268 ;; Maybe display a progress indicator in the minibuffer. | |
269 (when (and erc-chanlist-progress-message | |
270 (> (erc-time-diff | |
271 erc-chanlist-last-time (erc-current-time)) | |
272 3)) | |
273 (setq erc-chanlist-last-time (erc-current-time)) | |
274 (message "Accumulating channel list ... %c" | |
275 (aref [?/ ?| ?\\ ?- ?! ?O ?o] (random 7)))) | |
276 | |
277 ;; Return success to prevent other hook functions from being run. | |
278 t))))) | |
279 | |
280 (defun erc-chanlist-post-command-hook () | |
281 "Keep the current line highlighted." | |
282 (ignore-errors | |
283 (save-excursion | |
284 (beginning-of-line) | |
285 (if (looking-at erc-chanlist-channel-line-regexp) | |
286 (erc-chanlist-highlight-line) | |
287 (erc-chanlist-dehighlight-line))))) | |
288 | |
289 (defun erc-chanlist-highlight-line () | |
290 "Highlight the current line." | |
291 (unless erc-chanlist-highlight-overlay | |
292 (setq erc-chanlist-highlight-overlay | |
293 (make-overlay (point-min) (point-min))) | |
294 ;; Detach it from the buffer. | |
295 (delete-overlay erc-chanlist-highlight-overlay) | |
296 (overlay-put erc-chanlist-highlight-overlay | |
297 'face erc-chanlist-highlight-face) | |
298 ;; Expressly put it at a higher priority than the text | |
299 ;; properties used for faces later on. Gnu emacs promises that | |
300 ;; right now overlays are higher priority than text properties, | |
301 ;; but why take chances? | |
302 (overlay-put erc-chanlist-highlight-overlay 'priority 1)) | |
303 (move-overlay erc-chanlist-highlight-overlay (point) (1+ (point-at-eol)))) | |
304 | |
305 (defun erc-chanlist-dehighlight-line () | |
306 "Remove the line highlighting." | |
307 (delete-overlay erc-chanlist-highlight-overlay)) | |
308 | |
309 (defun erc-prettify-channel-list () | |
310 "Make the channel list buffer look pretty. | |
311 When this function runs, the current buffer must be the channel | |
312 list buffer, or it does nothing." | |
313 (if (eq major-mode 'erc-chanlist-mode) | |
314 (save-excursion | |
315 (let ((inhibit-read-only t)) | |
316 (goto-char (point-min)) | |
317 (when (search-forward-regexp "^-------" nil t) | |
318 (add-text-properties | |
319 (point-min) (1+ (point-at-eol)) '(face erc-chanlist-header-face)) | |
320 (forward-line 1)) | |
321 | |
322 (while (not (eobp)) | |
323 (add-text-properties | |
324 (point) (1+ (point-at-eol)) '(face erc-chanlist-odd-line-face)) | |
325 (forward-line 1) | |
326 (unless (eobp) | |
327 (add-text-properties | |
328 (point) (1+ (point-at-eol)) '(face erc-chanlist-even-line-face))) | |
329 (forward-line 1)))))) | |
330 | |
331 (defun erc-chanlist-toggle-sort-state () | |
332 "Toggle the channel list buffer sorting method. | |
333 Either sort by channel names or by number of users in each channel." | |
334 (interactive) | |
335 (let ((inhibit-read-only t) | |
336 (sort-fold-case t)) | |
337 (save-excursion | |
338 (goto-char (point-min)) | |
339 (search-forward-regexp "^-----" nil t) | |
340 (forward-line 1) | |
341 (unless (eobp) | |
342 (if (eq erc-chanlist-sort-state 'channel) | |
343 (progn | |
344 (sort-numeric-fields 2 (point) (point-max)) | |
345 (reverse-region (point) (point-max)) | |
346 (setq erc-chanlist-sort-state 'users)) | |
347 (sort-lines nil (point) (point-max)) | |
348 (setq erc-chanlist-sort-state 'channel)) | |
349 | |
350 (goto-char (point-min)) | |
351 (if (search-forward-regexp "^[0-9]+ channels (sorted by \\(.*\\)).$" | |
352 nil t) | |
353 (replace-match (if (eq erc-chanlist-sort-state 'channel) | |
354 "channel name" | |
355 "number of users") | |
356 nil nil nil 1)) | |
357 | |
358 (goto-char (point-min)) | |
359 (search-forward-regexp "^-----" nil t) | |
360 (forward-line 1) | |
361 (recenter -1) | |
362 | |
363 (erc-prettify-channel-list))))) | |
364 | |
365 (defun erc-chanlist-quit () | |
366 "Quit Chanlist mode. | |
367 Kill the channel list buffer, window, and frame (if there's a frame | |
368 devoted to the channel list)." | |
369 (interactive) | |
370 (kill-buffer (current-buffer)) | |
371 (if (eq (selected-frame) erc-chanlist-frame) | |
372 (delete-frame) | |
373 (delete-window))) | |
374 | |
375 (defun erc-chanlist-join-channel () | |
376 "Join the channel listed on the current line of the channel list buffer. | |
377 Private channels, which are shown as asterisks (*), are ignored." | |
378 (interactive) | |
379 (save-excursion | |
380 (beginning-of-line) | |
381 (when (looking-at erc-chanlist-channel-line-regexp) | |
382 (let ((channel-name (match-string 1))) | |
383 (when (and (stringp channel-name) | |
384 (not (string= channel-name "*"))) | |
385 (run-at-time 0.5 nil 'erc-join-channel channel-name)))))) | |
386 | |
387 (provide 'erc-list) | |
388 | |
389 ;;; erc-list.el ends here | |
390 ;; | |
391 ;; Local Variables: | |
392 ;; indent-tabs-mode: t | |
393 ;; tab-width: 8 | |
394 ;; End: | |
395 | |
396 ;; arch-tag: 4a13196a-a61b-465a-9926-044dfbc7e5ff |