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