Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader |
2 | ||
3a801d0c ER |
3 | ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. |
4 | ||
e5167999 | 5 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
fd7fa35a | 6 | ;; Keywords: news |
e5167999 | 7 | |
f3a3445b JB |
8 | ;; This file is part of GNU Emacs. |
9 | ||
08b684de RS |
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 | |
e5167999 | 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
08b684de RS |
13 | ;; any later version. |
14 | ||
f3a3445b | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
08b684de RS |
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. | |
f3a3445b | 23 | |
e5167999 ER |
24 | ;;; Code: |
25 | ||
f3a3445b JB |
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 | )) | |
49116ac0 JB |
217 | |
218 | (provide 'gnusmisc) | |
1a06eabd ER |
219 | |
220 | ;;; gnusmisc.el ends here |