Commit | Line | Data |
---|---|---|
597993cf MB |
1 | ;;; erc-speedbar.el --- Speedbar support for ERC |
2 | ||
ff59d266 | 3 | ;; Copyright (C) 2001, 2002, 2003, 2004, 2006, |
49f70d46 | 4 | ;; 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
597993cf MB |
5 | |
6 | ;; Author: Mario Lang <mlang@delysid.org> | |
7 | ;; Contributor: Eric M. Ludlam <eric@siege-engine.com> | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
4ee57b2a | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
597993cf | 12 | ;; it under the terms of the GNU General Public License as published by |
4ee57b2a GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
597993cf MB |
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 | |
4ee57b2a | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
597993cf MB |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This module provides integration of ERC into the Speedbar. | |
27 | ||
28 | ;;; TODO / ideas: | |
29 | ||
30 | ;; * Write intelligent update function: | |
31 | ;; update-channel, update-nick, remove-nick-from-channel, ... | |
32 | ;; * Use indicator-strings for op/voice | |
33 | ;; * Extract/convert face notes field from bbdb if available and show | |
34 | ;; it using sb-image.el | |
35 | ;; | |
36 | ;;; Code: | |
37 | ||
38 | (require 'erc) | |
39 | (require 'speedbar) | |
40 | (condition-case nil (require 'dframe) (error nil)) | |
059e26cf | 41 | (eval-when-compile (require 'cl)) |
597993cf MB |
42 | |
43 | ;;; Customization: | |
44 | ||
45 | (defgroup erc-speedbar nil | |
46 | "Integration of ERC in the Speedbar" | |
47 | :group 'erc) | |
48 | ||
49 | (defcustom erc-speedbar-sort-users-type 'activity | |
50 | "How channel nicknames are sorted. | |
51 | ||
52 | 'activity - Sort users by channel activity | |
53 | 'alphabetical - Sort users alphabetically | |
54 | nil - Do not sort users" | |
55 | :group 'erc-speedbar | |
56 | :type '(choice (const :tag "Sort users by channel activity" activity) | |
57 | (const :tag "Sort users alphabetically" alphabetical) | |
58 | (const :tag "Do not sort users" nil))) | |
59 | ||
60 | (defvar erc-speedbar-key-map nil | |
61 | "Keymap used when in erc display mode.") | |
62 | ||
63 | (defun erc-install-speedbar-variables () | |
64 | "Install those variables used by speedbar to enhance ERC." | |
65 | (if erc-speedbar-key-map | |
66 | nil | |
67 | (setq erc-speedbar-key-map (speedbar-make-specialized-keymap)) | |
68 | ||
69 | ;; Basic tree features | |
70 | (define-key erc-speedbar-key-map "e" 'speedbar-edit-line) | |
71 | (define-key erc-speedbar-key-map "\C-m" 'speedbar-edit-line) | |
72 | (define-key erc-speedbar-key-map "+" 'speedbar-expand-line) | |
73 | (define-key erc-speedbar-key-map "=" 'speedbar-expand-line) | |
74 | (define-key erc-speedbar-key-map "-" 'speedbar-contract-line)) | |
75 | ||
76 | (speedbar-add-expansion-list '("ERC" erc-speedbar-menu-items | |
77 | erc-speedbar-key-map | |
78 | erc-speedbar-server-buttons)) | |
79 | (speedbar-add-mode-functions-list | |
80 | '("ERC" (speedbar-item-info . erc-speedbar-item-info)))) | |
81 | ||
82 | (defvar erc-speedbar-menu-items | |
83 | '(["Goto buffer" speedbar-edit-line t] | |
84 | ["Expand Node" speedbar-expand-line | |
85 | (save-excursion (beginning-of-line) | |
86 | (looking-at "[0-9]+: *.\\+. "))] | |
87 | ["Contract Node" speedbar-contract-line | |
88 | (save-excursion (beginning-of-line) | |
89 | (looking-at "[0-9]+: *.-. "))]) | |
90 | "Additional menu-items to add to speedbar frame.") | |
91 | ||
92 | ;; Make sure our special speedbar major mode is loaded | |
93 | (if (featurep 'speedbar) | |
94 | (erc-install-speedbar-variables) | |
95 | (add-hook 'speedbar-load-hook 'erc-install-speedbar-variables)) | |
96 | ||
97 | ;;; ERC hierarchy display method | |
98 | ;;;###autoload | |
99 | (defun erc-speedbar-browser () | |
100 | "Initialize speedbar to display an ERC browser. | |
101 | This will add a speedbar major display mode." | |
102 | (interactive) | |
103 | (require 'speedbar) | |
104 | ;; Make sure that speedbar is active | |
105 | (speedbar-frame-mode 1) | |
106 | ;; Now, throw us into Info mode on speedbar. | |
107 | (speedbar-change-initial-expansion-list "ERC") | |
108 | (speedbar-get-focus)) | |
109 | ||
110 | (defun erc-speedbar-buttons (buffer) | |
111 | "Create buttons for speedbar in BUFFER." | |
112 | (erase-buffer) | |
059e26cf | 113 | (let (serverp chanp queryp) |
597993cf | 114 | (with-current-buffer buffer |
ff59d266 | 115 | (setq serverp (erc-server-buffer-p)) |
597993cf MB |
116 | (setq chanp (erc-channel-p (erc-default-target))) |
117 | (setq queryp (erc-query-buffer-p))) | |
118 | (cond (serverp | |
119 | (erc-speedbar-channel-buttons nil 0 buffer)) | |
120 | (chanp | |
121 | (erc-speedbar-insert-target buffer 0) | |
122 | (forward-line -1) | |
123 | (erc-speedbar-expand-channel "+" buffer 0)) | |
124 | (queryp | |
125 | (erc-speedbar-insert-target buffer 0)) | |
126 | (t (ignore))))) | |
127 | ||
128 | (defun erc-speedbar-server-buttons (directory depth) | |
129 | "Insert the initial list of servers you are connected to." | |
130 | (let ((servers (erc-buffer-list | |
131 | (lambda () | |
132 | (eq (current-buffer) | |
133 | (process-buffer erc-server-process)))))) | |
134 | (when servers | |
135 | (speedbar-with-writable | |
136 | (dolist (server servers) | |
137 | (speedbar-make-tag-line | |
138 | 'bracket ?+ 'erc-speedbar-expand-server server | |
139 | (buffer-name server) 'erc-speedbar-goto-buffer server nil | |
140 | depth)) | |
141 | t)))) | |
142 | ||
143 | (defun erc-speedbar-expand-server (text server indent) | |
144 | (cond ((string-match "+" text) | |
145 | (speedbar-change-expand-button-char ?-) | |
146 | (if (speedbar-with-writable | |
147 | (save-excursion | |
148 | (end-of-line) (forward-char 1) | |
149 | (erc-speedbar-channel-buttons nil (1+ indent) server))) | |
150 | (speedbar-change-expand-button-char ?-) | |
151 | (speedbar-change-expand-button-char ??))) | |
152 | ((string-match "-" text) ;we have to contract this node | |
153 | (speedbar-change-expand-button-char ?+) | |
154 | (speedbar-delete-subblock indent)) | |
155 | (t (error "Ooops... not sure what to do"))) | |
156 | (speedbar-center-buffer-smartly)) | |
157 | ||
158 | (defun erc-speedbar-channel-buttons (directory depth server-buffer) | |
159 | (when (get-buffer server-buffer) | |
160 | (let* ((proc (with-current-buffer server-buffer erc-server-process)) | |
161 | (targets (erc-buffer-list | |
162 | (lambda () | |
163 | (not (eq (process-buffer erc-server-process) | |
164 | (current-buffer)))) | |
165 | proc))) | |
166 | (when targets | |
167 | (speedbar-with-writable | |
168 | (dolist (target targets) | |
169 | (erc-speedbar-insert-target target depth)) | |
170 | t))))) | |
171 | ||
172 | (defun erc-speedbar-insert-target (buffer depth) | |
173 | (if (with-current-buffer buffer | |
174 | (erc-channel-p (erc-default-target))) | |
175 | (speedbar-make-tag-line | |
176 | 'bracket ?+ 'erc-speedbar-expand-channel buffer | |
177 | (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil | |
178 | depth) | |
179 | ;; Query target | |
180 | (speedbar-make-tag-line | |
181 | nil nil nil nil | |
182 | (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil | |
183 | depth))) | |
184 | ||
185 | (defun erc-speedbar-expand-channel (text channel indent) | |
186 | "For the line matching TEXT, in CHANNEL, expand or contract a line. | |
187 | INDENT is the current indentation level." | |
188 | (cond | |
189 | ((string-match "+" text) | |
190 | (speedbar-change-expand-button-char ?-) | |
191 | (speedbar-with-writable | |
192 | (save-excursion | |
193 | (end-of-line) (forward-char 1) | |
194 | (let ((modes (with-current-buffer channel | |
195 | (concat (apply 'concat | |
196 | erc-channel-modes) | |
197 | (cond | |
198 | ((and erc-channel-user-limit | |
199 | erc-channel-key) | |
200 | (if erc-show-channel-key-p | |
201 | (format "lk %.0f %s" | |
202 | erc-channel-user-limit | |
203 | erc-channel-key) | |
204 | (format "kl %.0f" erc-channel-user-limit))) | |
205 | (erc-channel-user-limit | |
206 | ;; Emacs has no bignums | |
207 | (format "l %.0f" erc-channel-user-limit)) | |
208 | (erc-channel-key | |
209 | (if erc-show-channel-key-p | |
210 | (format "k %s" erc-channel-key) | |
211 | "k")) | |
212 | (t ""))))) | |
213 | (topic (erc-controls-interpret | |
214 | (with-current-buffer channel erc-channel-topic)))) | |
215 | (speedbar-make-tag-line | |
216 | 'angle ?i nil nil | |
217 | (concat "Modes: +" modes) nil nil nil | |
218 | (1+ indent)) | |
219 | (unless (string= topic "") | |
220 | (speedbar-make-tag-line | |
221 | 'angle ?i nil nil | |
222 | (concat "Topic: " topic) nil nil nil | |
223 | (1+ indent))) | |
224 | (let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical) | |
225 | (erc-sort-channel-users-alphabetically | |
226 | (with-current-buffer channel | |
227 | (erc-get-channel-user-list)))) | |
228 | ((eq erc-speedbar-sort-users-type 'activity) | |
229 | (erc-sort-channel-users-by-activity | |
230 | (with-current-buffer channel | |
231 | (erc-get-channel-user-list)))) | |
232 | (t (with-current-buffer channel | |
233 | (erc-get-channel-user-list)))))) | |
234 | (when names | |
235 | (speedbar-with-writable | |
236 | (dolist (entry names) | |
237 | (erc-speedbar-insert-user entry ?+ (1+ indent)))))))))) | |
238 | ((string-match "-" text) | |
239 | (speedbar-change-expand-button-char ?+) | |
240 | (speedbar-delete-subblock indent)) | |
241 | (t (error "Ooops... not sure what to do"))) | |
242 | (speedbar-center-buffer-smartly)) | |
243 | ||
244 | (defun erc-speedbar-insert-user (entry exp-char indent) | |
245 | "Insert one user based on the channel member list ENTRY. | |
246 | EXP-CHAR is the expansion character to use. | |
247 | INDENT is the current indentation level." | |
248 | (let* ((user (car entry)) | |
249 | (cuser (cdr entry)) | |
250 | (nick (erc-server-user-nickname user)) | |
251 | (host (erc-server-user-host user)) | |
252 | (info (erc-server-user-info user)) | |
253 | (login (erc-server-user-login user)) | |
254 | (name (erc-server-user-full-name user)) | |
255 | (voice (and cuser (erc-channel-user-voice cuser))) | |
256 | (op (and cuser (erc-channel-user-op cuser))) | |
257 | (nick-str (concat (if op "@" "") (if voice "+" "") nick)) | |
258 | (finger (concat login (when (or login host) "@") host)) | |
259 | (sbtoken (list finger name info))) | |
260 | (if (or login host name info) ; we want to be expandable | |
261 | (speedbar-make-tag-line | |
262 | 'bracket ?+ 'erc-speedbar-expand-user sbtoken | |
263 | nick-str nil sbtoken nil | |
264 | indent) | |
265 | (when (equal exp-char ?-) | |
266 | (forward-line -1) | |
267 | (erc-speedbar-expand-user "+" (list finger name info) indent)) | |
268 | (speedbar-make-tag-line | |
269 | 'statictag ?? nil nil | |
270 | nick-str nil nil nil | |
271 | indent)))) | |
272 | ||
273 | (defun erc-speedbar-update-channel (buffer) | |
274 | "Update the speedbar information about a ERC buffer. The update | |
275 | is only done when the channel is actually expanded already." | |
276 | ;; This is only a rude hack and doesn't care about multiserver usage | |
277 | ;; yet, consider this a brain storming, better ideas? | |
278 | (with-current-buffer speedbar-buffer | |
279 | (save-excursion | |
280 | (goto-char (point-min)) | |
281 | (when (re-search-forward (concat "^1: *.+. *" | |
282 | (regexp-quote (buffer-name buffer))) | |
283 | nil t) | |
284 | (beginning-of-line) | |
285 | (speedbar-delete-subblock 1) | |
286 | (erc-speedbar-expand-channel "+" buffer 1))))) | |
287 | ||
288 | (defun erc-speedbar-expand-user (text token indent) | |
289 | (cond ((string-match "+" text) | |
290 | (speedbar-change-expand-button-char ?-) | |
291 | (speedbar-with-writable | |
292 | (save-excursion | |
293 | (end-of-line) (forward-char 1) | |
294 | (let ((finger (nth 0 token)) | |
295 | (name (nth 1 token)) | |
296 | (info (nth 2 token))) | |
297 | (when finger | |
298 | (speedbar-make-tag-line | |
299 | nil nil nil nil | |
300 | finger nil nil nil | |
301 | (1+ indent))) | |
302 | (when name | |
303 | (speedbar-make-tag-line | |
304 | nil nil nil nil | |
305 | name nil nil nil | |
306 | (1+ indent))) | |
307 | (when info | |
308 | (speedbar-make-tag-line | |
309 | nil nil nil nil | |
310 | info nil nil nil | |
311 | (1+ indent))))))) | |
312 | ((string-match "-" text) | |
313 | (speedbar-change-expand-button-char ?+) | |
314 | (speedbar-delete-subblock indent)) | |
315 | (t (error "Ooops... not sure what to do"))) | |
316 | (speedbar-center-buffer-smartly)) | |
317 | ||
318 | (defun erc-speedbar-goto-buffer (text buffer indent) | |
319 | "When user clicks on TEXT, goto an ERC buffer. | |
320 | The INDENT level is ignored." | |
321 | (if (featurep 'dframe) | |
322 | (progn | |
323 | (dframe-select-attached-frame speedbar-frame) | |
324 | (let ((bwin (get-buffer-window buffer 0))) | |
325 | (if bwin | |
326 | (progn | |
327 | (select-window bwin) | |
328 | (raise-frame (window-frame bwin))) | |
329 | (if dframe-power-click | |
330 | (let ((pop-up-frames t)) | |
331 | (select-window (display-buffer buffer))) | |
332 | (dframe-select-attached-frame speedbar-frame) | |
333 | (switch-to-buffer buffer))))) | |
334 | (let ((bwin (get-buffer-window buffer 0))) | |
335 | (if bwin | |
336 | (progn | |
337 | (select-window bwin) | |
338 | (raise-frame (window-frame bwin))) | |
339 | (if speedbar-power-click | |
340 | (let ((pop-up-frames t)) (select-window (display-buffer buffer))) | |
059e26cf | 341 | (dframe-select-attached-frame speedbar-frame) |
597993cf MB |
342 | (switch-to-buffer buffer)))))) |
343 | ||
344 | (defun erc-speedbar-line-text () | |
345 | "Return the text for the item on the current line." | |
346 | (beginning-of-line) | |
347 | (when (re-search-forward "[]>] " nil t) | |
348 | (buffer-substring-no-properties (point) (point-at-eol)))) | |
349 | ||
350 | (defun erc-speedbar-item-info () | |
351 | "Display information about the current buffer on the current line." | |
352 | (let ((data (speedbar-line-token)) | |
353 | (txt (erc-speedbar-line-text))) | |
354 | (cond ((and data (listp data)) | |
355 | (message "%s: %s" txt (car data))) | |
356 | ((bufferp data) | |
357 | (message "Channel: %s" txt)) | |
358 | (t | |
359 | (message "%s" txt))))) | |
360 | ||
361 | (provide 'erc-speedbar) | |
362 | ;;; erc-speedbar.el ends here | |
363 | ;; | |
364 | ;; Local Variables: | |
365 | ;; indent-tabs-mode: t | |
366 | ;; tab-width: 8 | |
367 | ;; End: | |
368 | ||
369 | ;; arch-tag: 7a6558a4-3308-4bf5-a284-e1d042c933c6 |