lisp/gnusmisc.el

   1 ;;; Miscellaneous commands for GNUS newsreader
   2 ;; Copyright (C) 1989 Fujitsu Laboratories LTD.
   3 ;; Copyright (C) 1989, 1990 Masanobu UMEDA
   4 ;; $Header: gnusmisc.el,v 1.2 90/03/23 13:25:04 umerin Locked $
   5
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is distributed in the hope that it will be useful,
   9 ;; but WITHOUT ANY WARRANTY.  No author or distributor
  10 ;; accepts responsibility to anyone for the consequences of using it
  11 ;; or for whether it serves any particular purpose or works at all,
  12 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  13 ;; License for full details.
  14
  15 ;; Everyone is granted permission to copy, modify and redistribute
  16 ;; GNU Emacs, but only under the conditions described in the
  17 ;; GNU Emacs General Public License.   A copy of this license is
  18 ;; supposed to have been given to you along with GNU Emacs so you
  19 ;; can know your rights and responsibilities.  It should be in a
  20 ;; file named COPYING.  Among other things, the copyright notice
  21 ;; and this notice must be preserved on all copies.
  22
  23 (provide 'gnusmisc)
  24 (require 'gnus)
  25
  26 ;;;
  27 ;;; GNUS Browse-Killed Mode
  28 ;;;
  29
  30 ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath).
  31 ;; I'd like to thank him very much.
  32
  33 (defvar gnus-Browse-killed-mode-hook nil
  34   "*A hook for GNUS Browse-Killed Mode.")
  35
  36 (defvar gnus-Browse-killed-buffer "*Killed Newsgroup*")
  37 (defvar gnus-Browse-killed-mode-map nil)
  38 (defvar gnus-winconf-browse-killed nil)
  39
  40 (put 'gnus-Browse-killed-mode 'mode-class 'special)
  41
  42 ;; Make the buffer to be managed by GNUS.
  43
  44 (or (memq gnus-Browse-killed-buffer gnus-buffer-list)
  45     (setq gnus-buffer-list
  46           (cons gnus-Browse-killed-buffer gnus-buffer-list)))
  47
  48 (if gnus-Browse-killed-mode-map
  49     nil
  50   (setq gnus-Browse-killed-mode-map (make-keymap))
  51   (suppress-keymap gnus-Browse-killed-mode-map t)
  52   (define-key gnus-Browse-killed-mode-map " " 'gnus-Group-next-group)
  53   (define-key gnus-Browse-killed-mode-map "\177" 'gnus-Group-prev-group)
  54   (define-key gnus-Browse-killed-mode-map "\C-n" 'gnus-Group-next-group)
  55   (define-key gnus-Browse-killed-mode-map "\C-p" 'gnus-Group-prev-group)
  56   (define-key gnus-Browse-killed-mode-map "n" 'gnus-Group-next-group)
  57   (define-key gnus-Browse-killed-mode-map "p" 'gnus-Group-prev-group)
  58   (define-key gnus-Browse-killed-mode-map "y" 'gnus-Browse-killed-yank)
  59   (define-key gnus-Browse-killed-mode-map "\C-y" 'gnus-Browse-killed-yank)
  60   (define-key gnus-Browse-killed-mode-map "l" 'gnus-Browse-killed-groups)
  61   (define-key gnus-Browse-killed-mode-map "q" 'gnus-Browse-killed-exit)
  62   (define-key gnus-Browse-killed-mode-map "\C-c\C-c" 'gnus-Browse-killed-exit)
  63   (define-key gnus-Browse-killed-mode-map "\C-c\C-i" 'gnus-Info-find-node))
  64
  65 (defun gnus-Browse-killed-mode ()
  66   "Major mode for browsing the killed newsgroups.
  67 All normal editing commands are turned off.
  68 Instead, these commands are available:
  69 \\{gnus-Browse-killed-mode-map}
  70
  71 The killed newsgroups are saved in the quick startup file \".newsrc.el\"
  72 unless disabled inthe options line of the startup file \".newsrc\".
  73
  74 Entry to this mode calls `gnus-Browse-killed-mode-hook' with no arguments
  75 if that value is non-nil."
  76   (interactive)
  77   (kill-all-local-variables)
  78   ;; Gee.  Why don't you upgrade?
  79   (cond ((boundp 'mode-line-modified)
  80          (setq mode-line-modified "--- "))
  81         ((listp (default-value 'mode-line-format))
  82          (setq mode-line-format
  83                (cons "--- " (cdr (default-value 'mode-line-format)))))
  84         (t
  85          (setq mode-line-format
  86                "--- GNUS: Killed Newsgroups  %[(%m)%]----%3p-%-")))
  87   (setq major-mode 'gnus-Browse-killed-mode)
  88   (setq mode-name "Browse-Killed")
  89   (setq mode-line-buffer-identification "GNUS: Killed Newsgroups")
  90   (use-local-map gnus-Browse-killed-mode-map)
  91   (buffer-flush-undo (current-buffer))
  92   (setq buffer-read-only t)             ;Disable modification
  93   (run-hooks 'gnus-Browse-killed-mode-hook))
  94
  95 (defun gnus-Browse-killed-groups ()
  96   "Browse the killed newsgroups.
  97 \\<gnus-Browse-killed-mode-map>\\[gnus-Browse-killed-yank] yanks the newsgroup on the current line into the Newsgroups buffer."
  98   (interactive)
  99   (or gnus-killed-assoc
 100       (error "No killed newsgroups"))
 101   ;; Save current window configuration if this is first invocation..
 102   (or (get-buffer-window gnus-Browse-killed-buffer)
 103       (setq gnus-winconf-browse-killed
 104             (current-window-configuration)))
 105   ;; Prepare browsing buffer.
 106   (pop-to-buffer (get-buffer-create gnus-Browse-killed-buffer))
 107   (gnus-Browse-killed-mode)
 108   (let ((buffer-read-only nil)
 109         (killed-assoc gnus-killed-assoc))
 110     (erase-buffer)
 111     (while killed-assoc
 112       (insert (gnus-Group-prepare-line (car killed-assoc)))
 113       (setq killed-assoc (cdr killed-assoc)))
 114     (goto-char (point-min))
 115     ))
 116
 117 (defun gnus-Browse-killed-yank ()
 118   "Yank current newsgroup to Newsgroup buffer."
 119   (interactive)
 120   (let ((group (gnus-Group-group-name)))
 121     (if group
 122         (let* ((buffer-read-only nil)
 123                (killed (assoc group gnus-killed-assoc)))
 124           (pop-to-buffer gnus-Group-buffer) ;Needed to adjust point.
 125           (if killed
 126               (gnus-Group-insert-group killed))
 127           (pop-to-buffer gnus-Browse-killed-buffer)
 128           (beginning-of-line)
 129           (delete-region (point)
 130                          (progn (forward-line 1) (point)))
 131           )))
 132   (gnus-Browse-killed-check-buffer))
 133
 134 (defun gnus-Browse-killed-check-buffer ()
 135   "Exit if the buffer is empty by deleting the window and killing the buffer."
 136   (and (null gnus-killed-assoc)
 137        (get-buffer gnus-Browse-killed-buffer)
 138        (gnus-Browse-killed-exit)))
 139
 140 (defun gnus-Browse-killed-exit ()
 141   "Exit this mode by deleting the window and killing the buffer."
 142   (interactive)
 143   (and (get-buffer-window gnus-Browse-killed-buffer)
 144        (delete-window (get-buffer-window gnus-Browse-killed-buffer)))
 145   (kill-buffer gnus-Browse-killed-buffer)
 146   ;; Restore previous window configuration if available.
 147   (and gnus-winconf-browse-killed
 148        (set-window-configuration gnus-winconf-browse-killed))
 149   (setq gnus-winconf-browse-killed nil))
 150
 151 \f
 152 ;;;
 153 ;;; kill/yank newsgroup commands of GNUS Group Mode
 154 ;;;
 155
 156 (defun gnus-Group-kill-group (n)
 157   "Kill newsgroup on current line, repeated prefix argument N times.
 158 The killed newsgroups can be yanked by using \\[gnus-Group-yank-group]."
 159   (interactive "p")
 160   (let ((buffer-read-only nil)
 161         (group nil))
 162     (while (> n 0)
 163       (setq group (gnus-Group-group-name))
 164       (or group
 165           (signal 'end-of-buffer nil))
 166       (beginning-of-line)
 167       (delete-region (point)
 168                      (progn (forward-line 1) (point)))
 169       (gnus-kill-newsgroup group)
 170       (setq n (1- n))
 171       ;; Add to killed newsgroups in the buffer if exists.
 172       (if (get-buffer gnus-Browse-killed-buffer)
 173           (save-excursion
 174             (set-buffer gnus-Browse-killed-buffer)
 175             (let ((buffer-read-only nil))
 176               (goto-char (point-min))
 177               (insert (gnus-Group-prepare-line (car gnus-killed-assoc)))
 178               )))
 179       )
 180     (search-forward ":" nil t)
 181     ))
 182
 183 (defun gnus-Group-yank-group ()
 184   "Yank the last newsgroup killed with \\[gnus-Group-kill-group],
 185 inserting it before the newsgroup on the line containging point."
 186   (interactive)
 187   (gnus-Group-insert-group (car gnus-killed-assoc))
 188   ;; Remove killed newsgroups from the buffer if exists.
 189   (if (get-buffer gnus-Browse-killed-buffer)
 190       (save-excursion
 191         (set-buffer gnus-Browse-killed-buffer)
 192         (let ((buffer-read-only nil))
 193           (goto-char (point-min))
 194           (delete-region (point-min)
 195                          (progn (forward-line 1) (point)))
 196           )))
 197   (gnus-Browse-killed-check-buffer))
 198
 199 (defun gnus-Group-insert-group (info)
 200   "Insert newsgroup at current line using `gnus-newsrc-assoc' INFO."
 201   (if (null gnus-killed-assoc)
 202       (error "No killed newsgroups"))
 203   (if (not gnus-have-all-newsgroups)
 204       (error
 205        (substitute-command-keys
 206         "Not all newsgroups are displayed.  Type \\[gnus-Group-list-all-groups] to display all newsgroups.")))
 207   (let ((buffer-read-only nil)
 208         (group (gnus-Group-group-name)))
 209     (gnus-insert-newsgroup info group)
 210     (beginning-of-line)
 211     (insert (gnus-Group-prepare-line info))
 212     (forward-line -1)
 213     (search-forward ":" nil t)
 214     ))