lisp/erc/erc-speedbar.el

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