;;; erc-speedbar.el --- Speedbar support for the Emacs IRC Client

;; Copyright (C) 2001,2002,2003,2004 Free Software Foundation, Inc.

;; Author: Mario Lang <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <eric@siege-engine.com>

;; This file 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.

;; This file 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, 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))

(defconst erc-speedbar-version "$Revision: 1.18 $"
  "ERC Speedbar version.")

;;; 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-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-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-process))
	   (targets (erc-buffer-list (lambda ()
				       (not (eq (process-buffer erc-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
					   channel-modes)
				    (cond ((and channel-user-limit channel-key)
					   (if erc-show-channel-key-p
					       (format "lk %.0f %s" channel-user-limit channel-key)
					     (format "kl %.0f" channel-user-limit)))
					  (channel-user-limit
					   ;; Emacs has no bignums
					   (format "l %.0f" channel-user-limit))
					  (channel-key
					   (if erc-show-channel-key-p
					       (format "k %s" channel-key)
					     "k"))
					  (t "")))))
		   (topic (erc-controls-interpret
			   (with-current-buffer channel 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
;; standard-indent: 4
;; End:
