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