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