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