Source

erc / erc-list.el

Full commit
;;; erc-list.el --- Provide a faster channel listing mechanism

;; Copyright (C) 2002  Mario Lang

;; Author: Mario Lang <mlang@lexx.delysid.org>
;; Keywords: comm

;; This file 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.

;; This file 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, 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-nets)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User customizable variables.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defcustom erc-chanlist-progress-message t
  "*Show progress message while accumulating channel list."
  :group 'erc
  :type 'boolean)

(defcustom erc-no-list-networks nil
  "*A list of network names on which the /LIST command refuses to work."
  :group 'erc
  :type '(repeat string))

(defvar erc-chanlist-frame-parameters nil
  "If nil, the channel list is displayed in a new window, otherwise this
variable holds the frame parameters used to make a frame to display the channel
list.")

(defcustom erc-chanlist-hide-modeline nil
  "*If nil, the channel list buffer has a modeline, otherwise the modeline is hidden."
  :group 'erc
  :type 'boolean)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Faces.  There's really no good default value that we can set for the
;; foreground color of these faces, since we don't know the user's color scheme.
;; The user should modify these faces as desired.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(make-face 'erc-chanlist-header-face)
(defvar erc-chanlist-header-face 'erc-chanlist-header-face)
(set-face-foreground 'erc-chanlist-header-face nil)
(set-face-background 'erc-chanlist-header-face nil)

(make-face 'erc-chanlist-odd-line-face)
(defvar erc-chanlist-odd-line-face 'erc-chanlist-odd-line-face)
(set-face-foreground 'erc-chanlist-odd-line-face nil)
(set-face-background 'erc-chanlist-odd-line-face nil)

(make-face 'erc-chanlist-even-line-face)
(defvar erc-chanlist-even-line-face 'erc-chanlist-even-line-face)
(set-face-foreground 'erc-chanlist-even-line-face nil)
(set-face-background 'erc-chanlist-even-line-face nil)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; All variables below this line are for internal use only.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar erc-chanlist-channel-line-regexp "^\\([#&]\\S-+\\)\\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)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Define erc-chanlist-mode.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar erc-chanlist-mode-hook nil
  "A hook run by erc-chanlist-mode.")

(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)
  (run-hooks 'erc-chanlist-mode-hook))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;###autoload
(defun erc-cmd-LIST (&optional channel)
  "Displays 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)
  (if (and (null channel)
	   (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)

;;;###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-hook 'erc-chanlist-322 nil t)

	(erc-once-with-server-event
	 323
	 '(progn
	    (remove-hook 'erc-server-322-hook '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)
	      (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]' toggles sort mode.\n"
				   "'\\[erc-chanlist-quit]' kills this buffer.\n"
				   "'\\[toggle-truncate-lines]' toggles line truncation.\n"
				   "'\\[erc-chanlist-join-channel]' joins 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*" (aref parsed 1))))
	(with-current-buffer erc-chanlist-buffer
	  (setq buffer-read-only nil)
	  (erase-buffer)
	  (erc-chanlist-mode)
	  (setq erc-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-send-command (if (null channels)
			  "LIST"
			(concat "LIST "
                                (mapconcat #'identity channels ","))))))

(defun erc-chanlist-322 (proc parsed)
  "Processes an IRC 322 message, which carries information about one channel for
the LIST command."
  (let ((chnl (aref parsed 3))
	(nv (aref parsed 4))
	(topic (aref parsed 5)))
    (with-current-buffer erc-chanlist-buffer
      (save-excursion
	(goto-char (point-max))
	(let (buffer-read-only)
	  (insert (format "%-26s%4s %s\n" (erc-interpret-controls chnl) nv
			  (erc-interpret-controls 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 ()
  "Keeps the current line highlighted."
  (ignore-errors
    ;; First, restore all channel lines to their normal faces.
    (erc-prettify-channel-list)

    ;; Then, highlight the current line.
    ;;(sleep-for 2)
    (save-excursion
      (beginning-of-line)
      (when (looking-at erc-chanlist-channel-line-regexp)
	(erc-chanlist-highlight-line)))))

(defun erc-chanlist-highlight-line ()
  "Highlights the current line."
  (save-excursion
    (let ((bol (point))
	  (inhibit-read-only t))
      (end-of-line)
      (add-text-properties bol (point) `(face highlight)))))

(defun erc-prettify-channel-list ()
  "Makes the channel list buffer look pretty.  When this function runs, the
current buffer must be the channel list buffer, or it doesn't 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)
	    (end-of-line)
	    (add-text-properties (point-min) (point) '(face erc-chanlist-header-face))
	    (forward-line 1))

	  (while (not (eobp))
	    (let ((sol (point)))
	      (end-of-line)
	      (add-text-properties sol (point) '(face erc-chanlist-odd-line-face))
	      (forward-line 1)
	      (setq sol (point))
	      (when (not (eobp))
		(end-of-line)
		(add-text-properties sol (point) '(face erc-chanlist-even-line-face)))
	      (forward-line 1)))))))

(defun erc-chanlist-toggle-sort-state ()
  "Toggles the channel list buffer between sorting by channel names and sorting
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)
      (when (not (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 ()
  "Bound to 'q' in erc-chanlist-mode.  Kills 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 ()
  "Joins the channel listed on the current line of the channel list buffer."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (looking-at erc-chanlist-channel-line-regexp)
	(let ((channel-name (match-string 1)))
	  (if (stringp channel-name)
	      (run-at-time 0.5 nil 'erc-join-channel channel-name))))))

(provide 'erc-list)

;;; erc-list.el ends here