Mercurial > emacs
view lisp/erc/erc-list.el @ 73375:7f5141d05971
*** empty log message ***
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sun, 15 Oct 2006 20:32:52 +0000 |
parents | 7010bb070445 |
children |
line wrap: on
line source
;;; erc-list.el --- Provide a faster channel listing mechanism ;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 2004 Brian Palmer ;; Author: Mario Lang <mlang@lexx.delysid.org> ;; Keywords: comm ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This file provides a simple derived mode for viewing Channel lists. ;; It also serves as a demonstration of how the new server hook facility ;; can be used. ;;; Code: (require 'erc) (require 'erc-networks) (require 'sort) (unless (fboundp 'make-overlay) (require 'overlay)) (eval-when-compile (require 'cl)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User customizable variables. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgroup erc-list nil "Display IRC channels in another window when using /LIST" :group 'erc) (defcustom erc-chanlist-progress-message t "*Show progress message while accumulating channel list." :group 'erc-list :type 'boolean) (defcustom erc-no-list-networks nil "*A list of network names on which the /LIST command refuses to work." :group 'erc-list :type '(repeat string)) (defcustom erc-chanlist-frame-parameters nil "*If nil, the channel list is displayed in a new window; if non-nil, this variable holds the frame parameters used to make a frame to display the channel list." :group 'erc-list :type 'list) (defcustom erc-chanlist-hide-modeline nil "*If nil, the channel list buffer has a modeline, otherwise the modeline is hidden." :group 'erc-list :type 'boolean) (defface erc-chanlist-header-face '((t (:bold t))) "Face used for the headers in erc's channel list." :group 'erc-faces) (defface erc-chanlist-odd-line-face '((t (:inverse-video t))) "Face used for the odd lines in erc's channel list." :group 'erc-faces) (defface erc-chanlist-even-line-face '((t (:inverse-video nil))) "Face used for the even lines in erc's channel list." :group 'erc-faces) (defface erc-chanlist-highlight '((t (:foreground "red"))) "Face used to highlight the current line in the channel list." :group 'erc-faces) ;; This should perhaps be a defface that inherits values from the highlight face ;; but xemacs does not support inheritance (defcustom erc-chanlist-highlight-face 'erc-chanlist-highlight "Face used for highlighting the current line in a list." :type 'face :group 'erc-faces) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; All variables below this line are for internal use only. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar erc-chanlist-channel-line-regexp "^\\([#&\\*][^ \t\n]*\\)\\s-+[0-9]+" "Regexp that matches a channel line in the channel list buffer.") (defvar erc-chanlist-buffer nil) (make-variable-buffer-local 'erc-chanlist-buffer) (defvar erc-chanlist-last-time 0 "A time value used to throttle the progress indicator.") (defvar erc-chanlist-frame nil "The frame displaying the most recent channel list buffer.") (defvar erc-chanlist-sort-state 'channel "The sort mode of the channel list buffer. Either 'channel or 'users.") (make-variable-buffer-local 'erc-chanlist-sort-state) (defvar erc-chanlist-highlight-overlay nil "The overlay used for erc chanlist highlighting") (make-variable-buffer-local 'erc-chanlist-highlight-overlay) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Define erc-chanlist-mode. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom erc-chanlist-mode-hook nil "Hook run by erc-chanlist-mode." :group 'erc-list :type 'hook) (define-derived-mode erc-chanlist-mode fundamental-mode "ERC Channel List" "Mode for viewing a channel list of a particular server. \\{erc-chanlist-mode-map}" (local-set-key "\C-c\C-j" 'erc-join-channel) (local-set-key "j" 'erc-chanlist-join-channel) (local-set-key "n" 'next-line) (local-set-key "p" 'previous-line) (local-set-key "q" 'erc-chanlist-quit) (local-set-key "s" 'erc-chanlist-toggle-sort-state) (local-set-key "t" 'toggle-truncate-lines) (setq erc-chanlist-sort-state 'channel) (setq truncate-lines t) (add-hook 'post-command-hook 'erc-chanlist-post-command-hook 'append 'local)) ;; Define module: ;;;###autoload (autoload 'erc-list-mode "erc-list") (define-erc-module list nil "List channels nicely in a separate buffer." ((defalias 'erc-cmd-LIST 'erc-list-channels)) ((defalias 'erc-cmd-LIST 'erc-list-channels-simple))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;###autoload (defun erc-list-channels (&rest channel) "Display a buffer containing a list of channels on the current server. Optional argument CHANNEL specifies a single channel to list (instead of every available channel)." (interactive (remove "" (split-string (read-from-minibuffer "List channels (RET for all): ") " "))) (if (and (null channel) (erc-member-ignore-case (erc-network-name) erc-no-list-networks)) (erc-display-line "ERC is configured not to allow the /LIST command on this network!" (current-buffer)) (erc-display-line (erc-make-notice (concat "Listing channel" (if channel "." "s. This may take a while.")))) (erc-chanlist channel)) t) (defun erc-list-channels-simple (&optional line) "Send the LIST command to the current server with optional channels LINE." (when (string-match "^\\s-*\\(.*\\)$" line) (let ((channels (match-string 1 line))) (erc-log (format "cmd: LIST: %s" channels)) (erc-server-send (if (string= channels "") "LIST" (concat "LIST :" channels)))) t)) (put 'erc-list-channels-simple 'do-not-parse-args t) ;;;###autoload (defun erc-chanlist (&optional channels) "Show a channel listing of the current server in a special mode. Please note that this function only works with IRC servers which conform to RFC and send the LIST header (#321) at start of list transmission." (interactive) (with-current-buffer (erc-server-buffer) (erc-once-with-server-event 321 '(progn (add-hook 'erc-server-322-functions 'erc-chanlist-322 nil t) (erc-once-with-server-event 323 '(progn (remove-hook 'erc-server-322-functions 'erc-chanlist-322 t) (let ((buf erc-chanlist-buffer)) (if (not (buffer-live-p buf)) (error "`erc-chanlist-buffer' does not refer to a live buffer")) (set-buffer buf) (buffer-disable-undo) (let (buffer-read-only (sort-fold-case t)) (sort-lines nil (point-min) (point-max)) (setq erc-chanlist-sort-state 'channel) (let ((sum (count-lines (point-min) (point-max)))) (goto-char (point-min)) (insert (substitute-command-keys (concat "'\\[erc-chanlist-toggle-sort-state]' toggle sort mode.\n" "'\\[erc-chanlist-quit]' kill this buffer.\n" "'\\[toggle-truncate-lines]' toggle line truncation.\n" "'\\[erc-chanlist-join-channel]' join the channel listed on the current line.\n\n"))) (insert (format "%d channels (sorted by %s).\n\n" sum (if (eq erc-chanlist-sort-state 'channel) "channel name" "number of users")))) (insert (format "%-25s%5s %s\n------------------------ ----- ----------------------------\n" "Channel" "Users" "Topic")) ;; Display the channel list buffer. (if erc-chanlist-frame-parameters (progn (if (or (null erc-chanlist-frame) (not (frame-live-p erc-chanlist-frame))) (setq erc-chanlist-frame (make-frame `((name . ,(format "Channels on %s" erc-session-server)) ,@erc-chanlist-frame-parameters)))) (select-frame erc-chanlist-frame) (switch-to-buffer buf) (erc-prettify-channel-list)) (pop-to-buffer buf) (erc-prettify-channel-list)))) (goto-char (point-min)) (search-forward-regexp "^------" nil t) (forward-line 1) (erc-chanlist-highlight-line) (message "") t)) (setq erc-chanlist-buffer (get-buffer-create (format "*Channels on %s*" (erc-response.sender parsed)))) (with-current-buffer erc-chanlist-buffer (setq buffer-read-only nil) (erase-buffer) (erc-chanlist-mode) (setq erc-server-process proc) (if erc-chanlist-hide-modeline (setq mode-line-format nil)) (setq buffer-read-only t)) t)) ;; Now that we've setup our callbacks, pull the trigger. (if (interactive-p) (message "Collecting channel list for server %s" erc-session-server)) (erc-server-send (if (null channels) "LIST" (concat "LIST " (mapconcat #'identity channels ",")))))) (defun erc-chanlist-322 (proc parsed) "Process an IRC 322 message. The message carries information about one channel for the LIST command." (multiple-value-bind (channel num-users) (cdr (erc-response.command-args parsed)) (let ((topic (erc-response.contents parsed))) (with-current-buffer erc-chanlist-buffer (save-excursion (goto-char (point-max)) (let (buffer-read-only) (insert (format "%-26s%4s %s\n" (erc-controls-strip channel) num-users (erc-controls-strip topic)))) ;; Maybe display a progress indicator in the minibuffer. (when (and erc-chanlist-progress-message (> (erc-time-diff erc-chanlist-last-time (erc-current-time)) 3)) (setq erc-chanlist-last-time (erc-current-time)) (message "Accumulating channel list ... %c" (aref [?/ ?| ?\\ ?- ?! ?O ?o] (random 7)))) ;; Return success to prevent other hook functions from being run. t))))) (defun erc-chanlist-post-command-hook () "Keep the current line highlighted." (ignore-errors (save-excursion (beginning-of-line) (if (looking-at erc-chanlist-channel-line-regexp) (erc-chanlist-highlight-line) (erc-chanlist-dehighlight-line))))) (defun erc-chanlist-highlight-line () "Highlight the current line." (unless erc-chanlist-highlight-overlay (setq erc-chanlist-highlight-overlay (make-overlay (point-min) (point-min))) ;; Detach it from the buffer. (delete-overlay erc-chanlist-highlight-overlay) (overlay-put erc-chanlist-highlight-overlay 'face erc-chanlist-highlight-face) ;; Expressly put it at a higher priority than the text ;; properties used for faces later on. Gnu emacs promises that ;; right now overlays are higher priority than text properties, ;; but why take chances? (overlay-put erc-chanlist-highlight-overlay 'priority 1)) (move-overlay erc-chanlist-highlight-overlay (point) (1+ (point-at-eol)))) (defun erc-chanlist-dehighlight-line () "Remove the line highlighting." (delete-overlay erc-chanlist-highlight-overlay)) (defun erc-prettify-channel-list () "Make the channel list buffer look pretty. When this function runs, the current buffer must be the channel list buffer, or it does nothing." (if (eq major-mode 'erc-chanlist-mode) (save-excursion (let ((inhibit-read-only t)) (goto-char (point-min)) (when (search-forward-regexp "^-------" nil t) (add-text-properties (point-min) (1+ (point-at-eol)) '(face erc-chanlist-header-face)) (forward-line 1)) (while (not (eobp)) (add-text-properties (point) (1+ (point-at-eol)) '(face erc-chanlist-odd-line-face)) (forward-line 1) (unless (eobp) (add-text-properties (point) (1+ (point-at-eol)) '(face erc-chanlist-even-line-face))) (forward-line 1)))))) (defun erc-chanlist-toggle-sort-state () "Toggle the channel list buffer sorting method. Either sort by channel names or by number of users in each channel." (interactive) (let ((inhibit-read-only t) (sort-fold-case t)) (save-excursion (goto-char (point-min)) (search-forward-regexp "^-----" nil t) (forward-line 1) (unless (eobp) (if (eq erc-chanlist-sort-state 'channel) (progn (sort-numeric-fields 2 (point) (point-max)) (reverse-region (point) (point-max)) (setq erc-chanlist-sort-state 'users)) (sort-lines nil (point) (point-max)) (setq erc-chanlist-sort-state 'channel)) (goto-char (point-min)) (if (search-forward-regexp "^[0-9]+ channels (sorted by \\(.*\\)).$" nil t) (replace-match (if (eq erc-chanlist-sort-state 'channel) "channel name" "number of users") nil nil nil 1)) (goto-char (point-min)) (search-forward-regexp "^-----" nil t) (forward-line 1) (recenter -1) (erc-prettify-channel-list))))) (defun erc-chanlist-quit () "Quit Chanlist mode. Kill the channel list buffer, window, and frame (if there's a frame devoted to the channel list)." (interactive) (kill-buffer (current-buffer)) (if (eq (selected-frame) erc-chanlist-frame) (delete-frame) (delete-window))) (defun erc-chanlist-join-channel () "Join the channel listed on the current line of the channel list buffer. Private channels, which are shown as asterisks (*), are ignored." (interactive) (save-excursion (beginning-of-line) (when (looking-at erc-chanlist-channel-line-regexp) (let ((channel-name (match-string 1))) (when (and (stringp channel-name) (not (string= channel-name "*"))) (run-at-time 0.5 nil 'erc-join-channel channel-name)))))) (provide 'erc-list) ;;; erc-list.el ends here ;; ;; Local Variables: ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: ;; arch-tag: 4a13196a-a61b-465a-9926-044dfbc7e5ff