lisp/erc/erc-speedbar.el

   1 ;;; erc-speedbar.el --- Speedbar support for ERC
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2006,
   4 ;;   2007, 2008 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 3, 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
  56 nil           - 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.
 103 This 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.
 189 INDENT 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.
 248 EXP-CHAR is the expansion character to use.
 249 INDENT 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
 277 is 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.
 322 The 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