lisp/gnusmisc.el

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