diff lisp/erc/erc-speedbar.el @ 68451:fc745b05e928

Revision: [e-mail]/emacs--devo--0--patch-22 Creator: Michael Olson <[e-mail]> Install ERC.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/erc/erc-speedbar.el	Sun Jan 29 13:08:58 2006 +0000
@@ -0,0 +1,369 @@
+;;; erc-speedbar.el --- Speedbar support for ERC
+
+;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Mario Lang <[e-mail]>
+;; Contributor: Eric M. Ludlam <[e-mail]>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This module provides integration of ERC into the Speedbar.
+
+;;; TODO / ideas:
+
+;; * Write intelligent update function:
+;;   update-channel, update-nick, remove-nick-from-channel, ...
+;; * Use indicator-strings for op/voice
+;; * Extract/convert face notes field from bbdb if available and show
+;;   it using sb-image.el
+;;
+;;; Code:
+
+(require 'erc)
+(require 'speedbar)
+(condition-case nil (require 'dframe) (error nil))
+
+;;; Customization:
+
+(defgroup erc-speedbar nil
+  "Integration of ERC in the Speedbar"
+  :group 'erc)
+
+(defcustom erc-speedbar-sort-users-type 'activity
+  "How channel nicknames are sorted.
+
+'activity     - Sort users by channel activity
+'alphabetical - Sort users alphabetically
+nil           - Do not sort users"
+  :group 'erc-speedbar
+  :type '(choice (const :tag "Sort users by channel activity" activity)
+		 (const :tag "Sort users alphabetically" alphabetical)
+		 (const :tag "Do not sort users" nil)))
+
+(defvar erc-speedbar-key-map nil
+  "Keymap used when in erc display mode.")
+
+(defun erc-install-speedbar-variables ()
+  "Install those variables used by speedbar to enhance ERC."
+  (if erc-speedbar-key-map
+      nil
+    (setq erc-speedbar-key-map (speedbar-make-specialized-keymap))
+
+    ;; Basic tree features
+    (define-key erc-speedbar-key-map "e" 'speedbar-edit-line)
+    (define-key erc-speedbar-key-map "\C-m" 'speedbar-edit-line)
+    (define-key erc-speedbar-key-map "+" 'speedbar-expand-line)
+    (define-key erc-speedbar-key-map "=" 'speedbar-expand-line)
+    (define-key erc-speedbar-key-map "-" 'speedbar-contract-line))
+
+  (speedbar-add-expansion-list '("ERC" erc-speedbar-menu-items
+				 erc-speedbar-key-map
+				 erc-speedbar-server-buttons))
+  (speedbar-add-mode-functions-list
+   '("ERC" (speedbar-item-info . erc-speedbar-item-info))))
+
+(defvar erc-speedbar-menu-items
+  '(["Goto buffer" speedbar-edit-line t]
+    ["Expand Node" speedbar-expand-line
+     (save-excursion (beginning-of-line)
+		     (looking-at "[0-9]+: *.\\+. "))]
+    ["Contract Node" speedbar-contract-line
+     (save-excursion (beginning-of-line)
+		     (looking-at "[0-9]+: *.-. "))])
+  "Additional menu-items to add to speedbar frame.")
+
+;; Make sure our special speedbar major mode is loaded
+(if (featurep 'speedbar)
+    (erc-install-speedbar-variables)
+  (add-hook 'speedbar-load-hook 'erc-install-speedbar-variables))
+
+;;; ERC hierarchy display method
+;;;###autoload
+(defun erc-speedbar-browser ()
+  "Initialize speedbar to display an ERC browser.
+This will add a speedbar major display mode."
+  (interactive)
+  (require 'speedbar)
+  ;; Make sure that speedbar is active
+  (speedbar-frame-mode 1)
+  ;; Now, throw us into Info mode on speedbar.
+  (speedbar-change-initial-expansion-list "ERC")
+  (speedbar-get-focus))
+
+(defun erc-speedbar-buttons (buffer)
+  "Create buttons for speedbar in BUFFER."
+  (erase-buffer)
+  (let (serverp chanp)
+    (with-current-buffer buffer
+      (setq serverp (eq buffer (process-buffer erc-server-process)))
+      (setq chanp (erc-channel-p (erc-default-target)))
+      (setq queryp (erc-query-buffer-p)))
+    (cond (serverp
+	   (erc-speedbar-channel-buttons nil 0 buffer))
+	  (chanp
+	   (erc-speedbar-insert-target buffer 0)
+	   (forward-line -1)
+	   (erc-speedbar-expand-channel "+" buffer 0))
+	  (queryp
+	   (erc-speedbar-insert-target buffer 0))
+	  (t (ignore)))))
+
+(defun erc-speedbar-server-buttons (directory depth)
+  "Insert the initial list of servers you are connected to."
+  (let ((servers (erc-buffer-list
+		  (lambda ()
+		    (eq (current-buffer)
+			(process-buffer erc-server-process))))))
+    (when servers
+      (speedbar-with-writable
+	(dolist (server servers)
+	  (speedbar-make-tag-line
+	   'bracket ?+ 'erc-speedbar-expand-server server
+	   (buffer-name server) 'erc-speedbar-goto-buffer server nil
+	   depth))
+	t))))
+
+(defun erc-speedbar-expand-server (text server indent)
+  (cond ((string-match "+" text)
+	 (speedbar-change-expand-button-char ?-)
+	 (if (speedbar-with-writable
+	       (save-excursion
+		 (end-of-line) (forward-char 1)
+		 (erc-speedbar-channel-buttons nil (1+ indent) server)))
+	     (speedbar-change-expand-button-char ?-)
+	   (speedbar-change-expand-button-char ??)))
+	((string-match "-" text)	;we have to contract this node
+	 (speedbar-change-expand-button-char ?+)
+	 (speedbar-delete-subblock indent))
+	(t (error "Ooops... not sure what to do")))
+  (speedbar-center-buffer-smartly))
+
+(defun erc-speedbar-channel-buttons (directory depth server-buffer)
+  (when (get-buffer server-buffer)
+    (let* ((proc (with-current-buffer server-buffer erc-server-process))
+	   (targets (erc-buffer-list
+		     (lambda ()
+		       (not (eq (process-buffer erc-server-process)
+				(current-buffer))))
+		     proc)))
+      (when targets
+	(speedbar-with-writable
+	  (dolist (target targets)
+	    (erc-speedbar-insert-target target depth))
+	  t)))))
+
+(defun erc-speedbar-insert-target (buffer depth)
+  (if (with-current-buffer buffer
+	(erc-channel-p (erc-default-target)))
+      (speedbar-make-tag-line
+       'bracket ?+ 'erc-speedbar-expand-channel buffer
+       (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
+       depth)
+    ;; Query target
+    (speedbar-make-tag-line
+     nil nil nil nil
+     (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
+     depth)))
+
+(defun erc-speedbar-expand-channel (text channel indent)
+  "For the line matching TEXT, in CHANNEL, expand or contract a line.
+INDENT is the current indentation level."
+  (cond
+   ((string-match "+" text)
+    (speedbar-change-expand-button-char ?-)
+    (speedbar-with-writable
+     (save-excursion
+       (end-of-line) (forward-char 1)
+       (let ((modes (with-current-buffer channel
+		      (concat (apply 'concat
+				     erc-channel-modes)
+			      (cond
+			       ((and erc-channel-user-limit
+				     erc-channel-key)
+				(if erc-show-channel-key-p
+				    (format "lk %.0f %s"
+					    erc-channel-user-limit
+					    erc-channel-key)
+				  (format "kl %.0f" erc-channel-user-limit)))
+			       (erc-channel-user-limit
+				;; Emacs has no bignums
+				(format "l %.0f" erc-channel-user-limit))
+			       (erc-channel-key
+				(if erc-show-channel-key-p
+				    (format "k %s" erc-channel-key)
+				  "k"))
+			       (t "")))))
+	     (topic (erc-controls-interpret
+		     (with-current-buffer channel erc-channel-topic))))
+	 (speedbar-make-tag-line
+	  'angle ?i nil nil
+	  (concat "Modes: +" modes) nil nil nil
+	  (1+ indent))
+	 (unless (string= topic "")
+	   (speedbar-make-tag-line
+	    'angle ?i nil nil
+	    (concat "Topic: " topic) nil nil nil
+	    (1+ indent)))
+	 (let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical)
+			     (erc-sort-channel-users-alphabetically
+			      (with-current-buffer channel
+				(erc-get-channel-user-list))))
+			    ((eq erc-speedbar-sort-users-type 'activity)
+			     (erc-sort-channel-users-by-activity
+			      (with-current-buffer channel
+				(erc-get-channel-user-list))))
+			    (t (with-current-buffer channel
+				 (erc-get-channel-user-list))))))
+	   (when names
+	     (speedbar-with-writable
+	      (dolist (entry names)
+		(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
+   ((string-match "-" text)
+    (speedbar-change-expand-button-char ?+)
+    (speedbar-delete-subblock indent))
+   (t (error "Ooops... not sure what to do")))
+  (speedbar-center-buffer-smartly))
+
+(defun erc-speedbar-insert-user (entry exp-char indent)
+  "Insert one user based on the channel member list ENTRY.
+EXP-CHAR is the expansion character to use.
+INDENT is the current indentation level."
+  (let* ((user (car entry))
+	 (cuser (cdr entry))
+	 (nick (erc-server-user-nickname user))
+	 (host (erc-server-user-host user))
+	 (info (erc-server-user-info user))
+	 (login (erc-server-user-login user))
+	 (name (erc-server-user-full-name user))
+	 (voice (and cuser (erc-channel-user-voice cuser)))
+	 (op (and cuser (erc-channel-user-op cuser)))
+	 (nick-str (concat (if op "@" "") (if voice "+" "") nick))
+	 (finger (concat login (when (or login host) "@") host))
+	 (sbtoken (list finger name info)))
+    (if (or login host name info) ; we want to be expandable
+	(speedbar-make-tag-line
+	 'bracket ?+ 'erc-speedbar-expand-user sbtoken
+	 nick-str nil sbtoken nil
+	 indent)
+      (when (equal exp-char ?-)
+	(forward-line -1)
+	(erc-speedbar-expand-user "+" (list finger name info) indent))
+      (speedbar-make-tag-line
+       'statictag ?? nil nil
+       nick-str nil nil nil
+       indent))))
+
+(defun erc-speedbar-update-channel (buffer)
+  "Update the speedbar information about a ERC buffer. The update
+is only done when the channel is actually expanded already."
+  ;; This is only a rude hack and doesn't care about multiserver usage
+  ;; yet, consider this a brain storming, better ideas?
+  (with-current-buffer speedbar-buffer
+    (save-excursion
+      (goto-char (point-min))
+      (when (re-search-forward (concat "^1: *.+. *"
+				       (regexp-quote (buffer-name buffer)))
+			       nil t)
+	(beginning-of-line)
+	(speedbar-delete-subblock 1)
+	(erc-speedbar-expand-channel "+" buffer 1)))))
+
+(defun erc-speedbar-expand-user (text token indent)
+  (cond ((string-match "+" text)
+	 (speedbar-change-expand-button-char ?-)
+	 (speedbar-with-writable
+	   (save-excursion
+	     (end-of-line) (forward-char 1)
+	     (let ((finger (nth 0 token))
+		   (name (nth 1 token))
+		   (info (nth 2 token)))
+	       (when finger
+		 (speedbar-make-tag-line
+		  nil nil nil nil
+		  finger nil nil nil
+		  (1+ indent)))
+	       (when name
+		 (speedbar-make-tag-line
+		  nil nil nil nil
+		  name nil nil nil
+		  (1+ indent)))
+	       (when info
+		 (speedbar-make-tag-line
+		  nil nil nil nil
+		  info nil nil nil
+		  (1+ indent)))))))
+	((string-match "-" text)
+	 (speedbar-change-expand-button-char ?+)
+	 (speedbar-delete-subblock indent))
+	(t (error "Ooops... not sure what to do")))
+  (speedbar-center-buffer-smartly))
+
+(defun erc-speedbar-goto-buffer (text buffer indent)
+  "When user clicks on TEXT, goto an ERC buffer.
+The INDENT level is ignored."
+  (if (featurep 'dframe)
+      (progn
+	(dframe-select-attached-frame speedbar-frame)
+	(let ((bwin (get-buffer-window buffer 0)))
+	  (if bwin
+	      (progn
+		(select-window bwin)
+		(raise-frame (window-frame bwin)))
+	    (if dframe-power-click
+		(let ((pop-up-frames t))
+		  (select-window (display-buffer buffer)))
+	      (dframe-select-attached-frame speedbar-frame)
+	      (switch-to-buffer buffer)))))
+    (let ((bwin (get-buffer-window buffer 0)))
+      (if bwin
+	  (progn
+	    (select-window bwin)
+	    (raise-frame (window-frame bwin)))
+	(if speedbar-power-click
+	    (let ((pop-up-frames t)) (select-window (display-buffer buffer)))
+	  (select-frame speedbar-attached-frame)
+	  (switch-to-buffer buffer))))))
+
+(defun erc-speedbar-line-text ()
+  "Return the text for the item on the current line."
+  (beginning-of-line)
+  (when (re-search-forward "[]>] " nil t)
+    (buffer-substring-no-properties (point) (point-at-eol))))
+
+(defun erc-speedbar-item-info ()
+  "Display information about the current buffer on the current line."
+  (let ((data (speedbar-line-token))
+	(txt (erc-speedbar-line-text)))
+    (cond ((and data (listp data))
+	   (message "%s: %s" txt (car data)))
+	  ((bufferp data)
+	   (message "Channel: %s" txt))
+	  (t
+	   (message "%s" txt)))))
+
+(provide 'erc-speedbar)
+;;; erc-speedbar.el ends here
+;;
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
+
+;; arch-tag: 7a6558a4-3308-4bf5-a284-e1d042c933c6