cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-list.el

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