lisp/erc/erc-list.el

   1 ;;; erc-list.el --- Provide a faster channel listing mechanism
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2004 Brian Palmer
   5
   6 ;; Author: Mario Lang <mlang@lexx.delysid.org>
   7 ;; Keywords: comm
   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 2, 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 file provides a simple derived mode for viewing Channel lists.
  29 ;; It also serves as a demonstration of how the new server hook facility
  30 ;; can be used.
  31
  32 ;;; Code:
  33
  34 (require 'erc)
  35 (require 'erc-networks)
  36 (require 'sort)
  37 (unless (fboundp 'make-overlay)
  38   (require 'overlay))
  39 (eval-when-compile (require 'cl))
  40
  41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42 ;; User customizable variables.
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44
  45 (defgroup erc-list nil
  46   "Display IRC channels in another window when using /LIST"
  47   :group 'erc)
  48
  49 (defcustom erc-chanlist-progress-message t
  50   "*Show progress message while accumulating channel list."
  51   :group 'erc-list
  52   :type 'boolean)
  53
  54 (defcustom erc-no-list-networks nil
  55   "*A list of network names on which the /LIST command refuses to work."
  56   :group 'erc-list
  57   :type '(repeat string))
  58
  59 (defcustom erc-chanlist-frame-parameters nil
  60   "*If nil, the channel list is displayed in a new window; if non-nil,
  61 this variable holds the frame parameters used to make a frame to
  62 display the channel list."
  63   :group 'erc-list
  64   :type 'list)
  65
  66 (defcustom erc-chanlist-hide-modeline nil
  67   "*If nil, the channel list buffer has a modeline, otherwise the modeline is hidden."
  68   :group 'erc-list
  69   :type 'boolean)
  70
  71 (defface erc-chanlist-header-face '((t (:bold t)))
  72   "Face used for the headers in erc's channel list."
  73   :group 'erc-faces)
  74
  75 (defface erc-chanlist-odd-line-face '((t (:inverse-video t)))
  76   "Face used for the odd lines in erc's channel list."
  77   :group 'erc-faces)
  78
  79 (defface erc-chanlist-even-line-face '((t (:inverse-video nil)))
  80   "Face used for the even lines in erc's channel list."
  81   :group 'erc-faces)
  82
  83 (defface erc-chanlist-highlight '((t (:foreground "red")))
  84   "Face used to highlight the current line in the channel list."
  85   :group 'erc-faces)
  86
  87 ;; This should perhaps be a defface that inherits values from the highlight face
  88 ;; but xemacs does not support inheritance
  89 (defcustom erc-chanlist-highlight-face 'erc-chanlist-highlight
  90   "Face used for highlighting the current line in a list."
  91   :type 'face
  92   :group 'erc-faces)
  93
  94
  95 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96 ;; All variables below this line are for internal use only.
  97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  98
  99 (defvar erc-chanlist-channel-line-regexp "^\\([#&\\*][^ \t\n]*\\)\\s-+[0-9]+"
 100   "Regexp that matches a channel line in the channel list buffer.")
 101
 102 (defvar erc-chanlist-buffer nil)
 103 (make-variable-buffer-local 'erc-chanlist-buffer)
 104
 105 (defvar erc-chanlist-last-time 0
 106   "A time value used to throttle the progress indicator.")
 107
 108 (defvar erc-chanlist-frame nil
 109   "The frame displaying the most recent channel list buffer.")
 110
 111 (defvar erc-chanlist-sort-state 'channel
 112   "The sort mode of the channel list buffer.  Either 'channel or 'users.")
 113 (make-variable-buffer-local 'erc-chanlist-sort-state)
 114
 115 (defvar erc-chanlist-highlight-overlay nil
 116   "The overlay used for erc chanlist highlighting")
 117 (make-variable-buffer-local 'erc-chanlist-highlight-overlay)
 118
 119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 120 ;; Define erc-chanlist-mode.
 121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 122
 123 (defcustom erc-chanlist-mode-hook nil
 124   "Hook run by erc-chanlist-mode."
 125   :group 'erc-list
 126   :type 'hook)
 127
 128 (define-derived-mode erc-chanlist-mode fundamental-mode "ERC Channel List"
 129   "Mode for viewing a channel list of a particular server.
 130
 131 \\{erc-chanlist-mode-map}"
 132   (local-set-key "\C-c\C-j" 'erc-join-channel)
 133   (local-set-key "j" 'erc-chanlist-join-channel)
 134   (local-set-key "n" 'next-line)
 135   (local-set-key "p" 'previous-line)
 136   (local-set-key "q" 'erc-chanlist-quit)
 137   (local-set-key "s" 'erc-chanlist-toggle-sort-state)
 138   (local-set-key "t" 'toggle-truncate-lines)
 139   (setq erc-chanlist-sort-state 'channel)
 140   (setq truncate-lines t)
 141   (add-hook 'post-command-hook 'erc-chanlist-post-command-hook 'append 'local))
 142
 143 ;; Define module:
 144 ;;;###autoload (autoload 'erc-list-mode "erc-list")
 145 (define-erc-module list nil
 146   "List channels nicely in a separate buffer."
 147   ((defalias 'erc-cmd-LIST 'erc-list-channels))
 148   ((defalias 'erc-cmd-LIST 'erc-list-channels-simple)))
 149
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151 ;; Functions.
 152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 153
 154 ;;;###autoload
 155 (defun erc-list-channels (&rest channel)
 156   "Display a buffer containing a list of channels on the current server.
 157 Optional argument CHANNEL specifies a single channel to list (instead of every
 158 available channel)."
 159   (interactive
 160    (remove "" (split-string
 161                (read-from-minibuffer "List channels (RET for all): ") " ")))
 162   (if (and (null channel)
 163            (erc-member-ignore-case (erc-network-name) erc-no-list-networks))
 164       (erc-display-line "ERC is configured not to allow the /LIST command on this network!"
 165                         (current-buffer))
 166     (erc-display-line (erc-make-notice (concat "Listing channel"
 167                                                (if channel
 168                                                    "."
 169                                                  "s.  This may take a while."))))
 170     (erc-chanlist channel))
 171   t)
 172
 173 (defun erc-list-channels-simple (&optional line)
 174   "Send the LIST command to the current server with optional channels LINE."
 175   (when (string-match "^\\s-*\\(.*\\)$" line)
 176     (let ((channels (match-string 1 line)))
 177       (erc-log (format "cmd: LIST: %s" channels))
 178       (erc-server-send
 179        (if (string= channels "")
 180            "LIST"
 181          (concat "LIST :" channels))))
 182     t))
 183 (put 'erc-list-channels-simple 'do-not-parse-args t)
 184
 185 ;;;###autoload
 186 (defun erc-chanlist (&optional channels)
 187   "Show a channel listing of the current server in a special mode.
 188 Please note that this function only works with IRC servers which conform
 189 to RFC and send the LIST header (#321) at start of list transmission."
 190   (interactive)
 191   (with-current-buffer (erc-server-buffer)
 192     (erc-once-with-server-event
 193      321
 194      '(progn
 195         (add-hook 'erc-server-322-functions 'erc-chanlist-322 nil t)
 196
 197         (erc-once-with-server-event
 198          323
 199          '(progn
 200             (remove-hook 'erc-server-322-functions 'erc-chanlist-322 t)
 201             (let ((buf erc-chanlist-buffer))
 202               (if (not (buffer-live-p buf))
 203                   (error "`erc-chanlist-buffer' does not refer to a live buffer"))
 204
 205               (set-buffer buf)
 206               (buffer-disable-undo)
 207               (let (buffer-read-only
 208                     (sort-fold-case t))
 209                 (sort-lines nil (point-min) (point-max))
 210                 (setq erc-chanlist-sort-state 'channel)
 211
 212                 (let ((sum (count-lines (point-min) (point-max))))
 213                   (goto-char (point-min))
 214                   (insert (substitute-command-keys
 215                            (concat "'\\[erc-chanlist-toggle-sort-state]' toggle sort mode.\n"
 216                                    "'\\[erc-chanlist-quit]' kill this buffer.\n"
 217                                    "'\\[toggle-truncate-lines]' toggle line truncation.\n"
 218                                    "'\\[erc-chanlist-join-channel]' join the channel listed on the current line.\n\n")))
 219                   (insert (format "%d channels (sorted by %s).\n\n"
 220                                   sum (if (eq erc-chanlist-sort-state 'channel)
 221                                           "channel name"
 222                                         "number of users"))))
 223
 224                 (insert (format "%-25s%5s %s\n------------------------ ----- ----------------------------\n"
 225                                 "Channel"
 226                                 "Users"
 227                                 "Topic"))
 228
 229                 ;; Display the channel list buffer.
 230                 (if erc-chanlist-frame-parameters
 231                     (progn
 232                       (if (or (null erc-chanlist-frame)
 233                               (not (frame-live-p erc-chanlist-frame)))
 234                           (setq erc-chanlist-frame
 235                                 (make-frame `((name . ,(format "Channels on %s"
 236                                                                erc-session-server))
 237                                               ,@erc-chanlist-frame-parameters))))
 238                       (select-frame erc-chanlist-frame)
 239                       (switch-to-buffer buf)
 240                       (erc-prettify-channel-list))
 241                   (pop-to-buffer buf)
 242                   (erc-prettify-channel-list))))
 243             (goto-char (point-min))
 244             (search-forward-regexp "^------" nil t)
 245             (forward-line 1)
 246             (erc-chanlist-highlight-line)
 247             (message "")
 248             t))
 249
 250         (setq erc-chanlist-buffer (get-buffer-create
 251                                    (format "*Channels on %s*"
 252                                            (erc-response.sender parsed))))
 253         (with-current-buffer erc-chanlist-buffer
 254           (setq buffer-read-only nil)
 255           (erase-buffer)
 256           (erc-chanlist-mode)
 257           (setq erc-server-process proc)
 258           (if erc-chanlist-hide-modeline
 259               (setq mode-line-format nil))
 260           (setq buffer-read-only t))
 261         t))
 262
 263     ;; Now that we've setup our callbacks, pull the trigger.
 264     (if (interactive-p)
 265         (message "Collecting channel list for server %s" erc-session-server))
 266     (erc-server-send (if (null channels)
 267                           "LIST"
 268                         (concat "LIST "
 269                                 (mapconcat #'identity channels ","))))))
 270
 271 (defun erc-chanlist-322 (proc parsed)
 272   "Process an IRC 322 message.
 273
 274 The message carries information about one channel for the LIST
 275 command."
 276   (multiple-value-bind (channel num-users)
 277       (cdr (erc-response.command-args parsed))
 278     (let ((topic (erc-response.contents parsed)))
 279       (with-current-buffer erc-chanlist-buffer
 280         (save-excursion
 281           (goto-char (point-max))
 282           (let (buffer-read-only)
 283             (insert (format "%-26s%4s %s\n" (erc-controls-strip channel)
 284                             num-users
 285                             (erc-controls-strip topic))))
 286
 287           ;; Maybe display a progress indicator in the minibuffer.
 288           (when (and erc-chanlist-progress-message
 289                      (> (erc-time-diff
 290                          erc-chanlist-last-time (erc-current-time))
 291                         3))
 292             (setq erc-chanlist-last-time (erc-current-time))
 293             (message "Accumulating channel list ... %c"
 294                      (aref [?/ ?| ?\\ ?- ?! ?O ?o] (random 7))))
 295
 296           ;; Return success to prevent other hook functions from being run.
 297           t)))))
 298
 299 (defun erc-chanlist-post-command-hook ()
 300   "Keep the current line highlighted."
 301   (ignore-errors
 302     (save-excursion
 303       (beginning-of-line)
 304       (if (looking-at erc-chanlist-channel-line-regexp)
 305           (erc-chanlist-highlight-line)
 306         (erc-chanlist-dehighlight-line)))))
 307
 308 (defun erc-chanlist-highlight-line ()
 309   "Highlight the current line."
 310   (unless erc-chanlist-highlight-overlay
 311     (setq erc-chanlist-highlight-overlay
 312           (make-overlay (point-min) (point-min)))
 313     ;; Detach it from the buffer.
 314     (delete-overlay erc-chanlist-highlight-overlay)
 315     (overlay-put erc-chanlist-highlight-overlay
 316                  'face erc-chanlist-highlight-face)
 317     ;; Expressly put it at a higher priority than the text
 318     ;; properties used for faces later on. Gnu emacs promises that
 319     ;; right now overlays are higher priority than text properties,
 320     ;; but why take chances?
 321     (overlay-put erc-chanlist-highlight-overlay 'priority 1))
 322   (move-overlay erc-chanlist-highlight-overlay (point) (1+ (point-at-eol))))
 323
 324 (defun erc-chanlist-dehighlight-line ()
 325   "Remove the line highlighting."
 326   (delete-overlay erc-chanlist-highlight-overlay))
 327
 328 (defun erc-prettify-channel-list ()
 329   "Make the channel list buffer look pretty.
 330 When this function runs, the current buffer must be the channel
 331 list buffer, or it does nothing."
 332   (if (eq major-mode 'erc-chanlist-mode)
 333       (save-excursion
 334         (let ((inhibit-read-only t))
 335           (goto-char (point-min))
 336           (when (search-forward-regexp "^-------" nil t)
 337             (add-text-properties
 338              (point-min) (1+ (point-at-eol)) '(face erc-chanlist-header-face))
 339             (forward-line 1))
 340
 341           (while (not (eobp))
 342             (add-text-properties
 343              (point) (1+ (point-at-eol)) '(face erc-chanlist-odd-line-face))
 344             (forward-line 1)
 345             (unless (eobp)
 346               (add-text-properties
 347                (point) (1+ (point-at-eol)) '(face erc-chanlist-even-line-face)))
 348             (forward-line 1))))))
 349
 350 (defun erc-chanlist-toggle-sort-state ()
 351   "Toggle the channel list buffer sorting method.
 352 Either sort by channel names or by number of users in each channel."
 353   (interactive)
 354   (let ((inhibit-read-only t)
 355         (sort-fold-case t))
 356     (save-excursion
 357       (goto-char (point-min))
 358       (search-forward-regexp "^-----" nil t)
 359       (forward-line 1)
 360       (unless (eobp)
 361         (if (eq erc-chanlist-sort-state 'channel)
 362             (progn
 363               (sort-numeric-fields 2 (point) (point-max))
 364               (reverse-region (point) (point-max))
 365               (setq erc-chanlist-sort-state 'users))
 366           (sort-lines nil (point) (point-max))
 367           (setq erc-chanlist-sort-state 'channel))
 368
 369         (goto-char (point-min))
 370         (if (search-forward-regexp "^[0-9]+ channels (sorted by \\(.*\\)).$"
 371                                    nil t)
 372             (replace-match (if (eq erc-chanlist-sort-state 'channel)
 373                                "channel name"
 374                              "number of users")
 375                            nil nil nil 1))
 376
 377         (goto-char (point-min))
 378         (search-forward-regexp "^-----" nil t)
 379         (forward-line 1)
 380         (recenter -1)
 381
 382         (erc-prettify-channel-list)))))
 383
 384 (defun erc-chanlist-quit ()
 385   "Quit Chanlist mode.
 386 Kill the channel list buffer, window, and frame (if there's a frame
 387 devoted to the channel list)."
 388   (interactive)
 389   (kill-buffer (current-buffer))
 390   (if (eq (selected-frame) erc-chanlist-frame)
 391       (delete-frame)
 392     (delete-window)))
 393
 394 (defun erc-chanlist-join-channel ()
 395   "Join the channel listed on the current line of the channel list buffer.
 396 Private channels, which are shown as asterisks (*), are ignored."
 397   (interactive)
 398   (save-excursion
 399     (beginning-of-line)
 400     (when (looking-at erc-chanlist-channel-line-regexp)
 401       (let ((channel-name (match-string 1)))
 402         (when (and (stringp channel-name)
 403                    (not (string= channel-name "*")))
 404           (run-at-time 0.5 nil 'erc-join-channel channel-name))))))
 405
 406 (provide 'erc-list)
 407
 408 ;;; erc-list.el ends here
 409 ;;
 410 ;; Local Variables:
 411 ;; indent-tabs-mode: t
 412 ;; tab-width: 8
 413 ;; End:
 414
 415 ;; arch-tag: 4a13196a-a61b-465a-9926-044dfbc7e5ff