Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader |
2 | ||
e5167999 ER |
3 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
4 | ;; Last-Modified: 10 Jun 1992 | |
5 | ||
f3a3445b JB |
6 | ;; $Header: gnusmisc.el,v 1.2 90/03/23 13:25:04 umerin Locked $ |
7 | ||
e5167999 ER |
8 | ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. |
9 | ||
f3a3445b JB |
10 | ;; This file is part of GNU Emacs. |
11 | ||
08b684de RS |
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 | |
e5167999 | 14 | ;; the Free Software Foundation; either version 2, or (at your option) |
08b684de RS |
15 | ;; any later version. |
16 | ||
f3a3445b | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
08b684de RS |
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. | |
f3a3445b | 25 | |
e5167999 ER |
26 | ;;; Code: |
27 | ||
f3a3445b JB |
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 | )) | |
49116ac0 JB |
219 | |
220 | (provide 'gnusmisc) | |
1a06eabd ER |
221 | |
222 | ;;; gnusmisc.el ends here |