lisp/erc/erc-speedbar.el

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