lisp/gnusmisc.el

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