;;; 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)
(unless (fboundp 'make-overlay)
  (require 'overlay))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))

(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
  :type '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)

(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 line sin erc's 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 '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 "^\\([#&]\\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)

(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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)
	   (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 (list 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-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)
	      (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*" (erc-response.sender parsed))))
	(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."
  (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-interpret-controls channel)
                            num-users
                            (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
    (save-excursion
      (beginning-of-line)
      (if (looking-at erc-chanlist-channel-line-regexp)
	  (erc-chanlist-highlight-line)
	(erc-chanlist-dehighlight-line)))))

(defun erc-chanlist-dehighlight-line ()
  "Make the currently highlighted line unhighlighted."
  (delete-overlay erc-chanlist-highlight-overlay))

(defun erc-chanlist-highlight-line ()
  "Highlights 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))

  (save-excursion
    (let ((bol (point))
	  (inhibit-read-only t))
      (end-of-line)
      (move-overlay erc-chanlist-highlight-overlay bol (point)))))

(defun erc-chanlist-dehighlight-line ()
  "Removes the line highlighting."
  (delete-overlay erc-chanlist-highlight-overlay))

(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
