code.delx.au - gnu-emacs/blob - lisp/erc/erc-list.el

   1 ;;; erc-list.el --- /list support for ERC
   2
   3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Tom Tromey <tromey@redhat.com>
   6 ;; Version: 0.1
   7 ;; Keywords: comm
   8
   9 ;; This file is part of ERC.
  10
  11 ;; ERC 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 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; ERC 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 ERC; 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 nice support for /list in ERC.
  29
  30 ;;; Code:
  31
  32 (require 'erc)
  33
  34 ;; This is implicitly the width of the channel name column.  Pick
  35 ;; something small enough that the topic has a chance of being
  36 ;; readable, but long enough that most channel names won't make for
  37 ;; strange formatting.
  38 (defconst erc-list-nusers-column 25)
  39
  40 ;; Width of the number-of-users column.
  41 (defconst erc-list-topic-column (+ erc-list-nusers-column 10))
  42
  43 ;; The list buffer.  This is buffer local in the server buffer.
  44 (defvar erc-list-buffer nil)
  45
  46 ;; The argument to the last "/list".  This is buffer local in the
  47 ;; server buffer.
  48 (defvar erc-list-last-argument nil)
  49
  50 ;; The server buffer corresponding to the list buffer.  This is buffer
  51 ;; local in the list buffer.
  52 (defvar erc-list-server-buffer nil)
  53
  54 ;; Define module:
  55 ;;;###autoload (autoload 'erc-list-mode "erc-list")
  56 (define-erc-module list nil
  57   "List channels nicely in a separate buffer."
  58   ((remove-hook 'erc-server-321-functions 'erc-server-321-message)
  59    (remove-hook 'erc-server-322-functions 'erc-server-322-message))
  60   ((erc-with-all-buffers-of-server nil
  61      #'erc-open-server-buffer-p
  62      (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))
  63    (add-hook 'erc-server-321-functions 'erc-server-321-message t)
  64    (add-hook 'erc-server-322-functions 'erc-server-322-message t)))
  65
  66 ;; Format a record for display.
  67 (defun erc-list-make-string (channel users topic)
  68   (concat
  69    channel
  70    (erc-propertize " "
  71                    'display (list 'space :align-to erc-list-nusers-column)
  72                    'face 'fixed-pitch)
  73    users
  74    (erc-propertize " "
  75                    'display (list 'space :align-to erc-list-topic-column)
  76                    'face 'fixed-pitch)
  77    topic))
  78
  79 ;; Insert a record into the list buffer.
  80 (defun erc-list-insert-item (channel users topic)
  81   (save-excursion
  82     (let ((buffer-read-only nil))
  83       (goto-char (point-max))
  84       (insert (erc-list-make-string channel users topic) "\n"))))
  85
  86 (defun erc-list-join ()
  87   "Join the irc channel named on this line."
  88   (interactive)
  89   (unless (eobp)
  90     (beginning-of-line)
  91     (unless (looking-at "\\([&#+!][^ \n]+\\)")
  92       (error "Not looking at channel name?"))
  93     (let ((chan (match-string 1)))
  94       (with-current-buffer erc-list-server-buffer
  95         (erc-join-channel chan)))))
  96
  97 (defun erc-list-kill ()
  98   "Kill the current ERC list buffer."
  99   (interactive)
 100   (kill-buffer (current-buffer)))
 101
 102 (defun erc-list-revert ()
 103   "Refresh the list of channels."
 104   (interactive)
 105   (with-current-buffer erc-list-server-buffer
 106     (erc-cmd-LIST erc-list-last-argument)))
 107
 108 (defun erc-list-menu-sort-by-column (&optional e)
 109   "Sort the channel list by the column clicked on."
 110   (interactive (list last-input-event))
 111   (if e (mouse-select-window e))
 112   (let* ((pos (event-start e))
 113          (obj (posn-object pos))
 114          (col (if obj
 115                   (get-text-property (cdr obj) 'column-number (car obj))
 116                 (get-text-property (posn-point pos) 'column-number))))
 117     (let ((buffer-read-only nil))
 118       (if (= col 1)
 119           (sort-fields col (point-min) (point-max))
 120         (sort-numeric-fields col (point-min) (point-max))))))
 121
 122 (defvar erc-list-menu-mode-map nil
 123   "Local keymap for `erc-list-mode' buffers.")
 124
 125 (unless erc-list-menu-mode-map
 126   (setq erc-list-menu-mode-map (make-keymap))
 127   (suppress-keymap erc-list-menu-mode-map)
 128   (define-key erc-list-menu-mode-map "k" 'erc-list-kill)
 129   (define-key erc-list-menu-mode-map "j" 'erc-list-join)
 130   (define-key erc-list-menu-mode-map "g" 'erc-list-revert)
 131   (define-key erc-list-menu-mode-map "n" 'next-line)
 132   (define-key erc-list-menu-mode-map "p" 'previous-line)
 133   (define-key erc-list-menu-mode-map "q" 'quit-window))
 134
 135 (defvar erc-list-menu-sort-button-map nil
 136   "Local keymap for ERC list menu mode sorting buttons.")
 137
 138 (unless erc-list-menu-sort-button-map
 139   (let ((map (make-sparse-keymap)))
 140     (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column)
 141     (define-key map [follow-link] 'mouse-face)
 142     (setq erc-list-menu-sort-button-map map)))
 143
 144 ;; Helper function that makes a buttonized column header.
 145 (defun erc-list-button (title column)
 146   (erc-propertize title
 147                   'column-number column
 148                   'help-echo "mouse-1: sort by column"
 149                   'mouse-face 'highlight
 150                   'keymap erc-list-menu-sort-button-map))
 151
 152 (define-derived-mode erc-list-menu-mode nil "ERC-List"
 153   "Major mode for editing a list of irc channels."
 154   (setq header-line-format
 155         (concat
 156          (erc-propertize " "
 157                          'display '(space :align-to 0)
 158                          'face 'fixed-pitch)
 159          (erc-list-make-string (erc-list-button "Channel" 1)
 160                                (erc-list-button "# Users" 2)
 161                                "Topic")))
 162   (setq truncate-lines t))
 163
 164 (put 'erc-list-menu-mode 'mode-class 'special)
 165
 166 ;; Handle a "322" response.  This response tells us about a single
 167 ;; channel.
 168 (defun erc-list-handle-322 (proc parsed)
 169   (let* ((args (cdr (erc-response.command-args parsed)))
 170          (channel (car args))
 171          (nusers (car (cdr args)))
 172          (topic (erc-response.contents parsed)))
 173     (when (buffer-live-p erc-list-buffer)
 174       (with-current-buffer erc-list-buffer
 175         (erc-list-insert-item channel nusers topic))))
 176   ;; Don't let another hook run.
 177   t)
 178
 179 ;; Helper function to install our 322 handler and make our buffer.
 180 (defun erc-list-install-322-handler (server-buffer)
 181   (with-current-buffer server-buffer
 182     ;; Arrange for 322 responses to insert into our buffer.
 183     (add-hook 'erc-server-322-functions 'erc-list-handle-322 t t)
 184     ;; Arrange for 323 (end of list) to end this.
 185     (erc-once-with-server-event
 186      323
 187      '(progn
 188         (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)))
 189     ;; Find the list buffer, empty it, and display it.
 190     (set (make-local-variable 'erc-list-buffer)
 191          (get-buffer-create (concat "*Channels of "
 192                                     erc-server-announced-name
 193                                     "*")))
 194     (with-current-buffer erc-list-buffer
 195       (erc-list-menu-mode)
 196       (setq buffer-read-only nil)
 197       (erase-buffer)
 198       (set (make-local-variable 'erc-list-server-buffer) server-buffer)
 199       (setq buffer-read-only t))
 200     (pop-to-buffer erc-list-buffer))
 201   t)
 202
 203 ;; The main entry point.
 204 (defun erc-cmd-LIST (&optional line)
 205   "Show a listing of channels on the current server in a separate window.
 206
 207 If LINE is specified, include it with the /LIST command.  It
 208 should usually be one or more channels, separated by commas.
 209
 210 Please note that this function only works with IRC servers which conform
 211 to RFC and send the LIST header (#321) at start of list transmission."
 212   (erc-with-server-buffer
 213     (set (make-local-variable 'erc-list-last-argument) line)
 214     (erc-once-with-server-event
 215      321
 216      (list 'progn
 217            (list 'erc-list-install-322-handler (current-buffer)))))
 218   (erc-server-send (concat "LIST :" (or (and line (substring line 1))
 219                                         ""))))
 220 (put 'erc-cmd-LIST 'do-not-parse-args t)
 221
 222 ;;; erc-list.el ends here
 223 ;;
 224 ;; Local Variables:
 225 ;; indent-tabs-mode: t
 226 ;; tab-width: 8
 227 ;; End:
 228
 229 ;; arch-tag: 99c5f9cb-6bac-4224-86bf-e394768cd1d0