Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader |
2 | ||
b027f415 | 3 | ;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc. |
3a801d0c | 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 | ||
b027f415 | 35 | (defvar gnus-browse-killed-mode-hook nil |
f3a3445b JB |
36 | "*A hook for GNUS Browse-Killed Mode.") |
37 | ||
b027f415 RS |
38 | (defvar gnus-browse-killed-buffer "*Killed Newsgroup*") |
39 | (defvar gnus-browse-killed-mode-map nil) | |
f3a3445b JB |
40 | (defvar gnus-winconf-browse-killed nil) |
41 | ||
b027f415 RS |
42 | (autoload 'timezone-make-date-arpa-standard "timezone") |
43 | ||
44 | (put 'gnus-browse-killed-mode 'mode-class 'special) | |
45 | ||
46 | \f | |
47 | ;;; | |
48 | ;;; GNUS Browse-Killed Mode | |
49 | ;;; | |
50 | ||
51 | ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath). | |
52 | ;; I'd like to thank him very much. | |
f3a3445b JB |
53 | |
54 | ;; Make the buffer to be managed by GNUS. | |
55 | ||
b027f415 | 56 | (or (memq gnus-browse-killed-buffer gnus-buffer-list) |
f3a3445b | 57 | (setq gnus-buffer-list |
b027f415 | 58 | (cons gnus-browse-killed-buffer gnus-buffer-list))) |
f3a3445b | 59 | |
b027f415 | 60 | (if gnus-browse-killed-mode-map |
f3a3445b | 61 | nil |
b027f415 RS |
62 | (setq gnus-browse-killed-mode-map (make-keymap)) |
63 | (suppress-keymap gnus-browse-killed-mode-map t) | |
64 | (define-key gnus-browse-killed-mode-map " " 'gnus-group-next-group) | |
65 | (define-key gnus-browse-killed-mode-map "\177" 'gnus-group-prev-group) | |
66 | (define-key gnus-browse-killed-mode-map "\C-n" 'gnus-group-next-group) | |
67 | (define-key gnus-browse-killed-mode-map "\C-p" 'gnus-group-prev-group) | |
68 | (define-key gnus-browse-killed-mode-map "n" 'gnus-group-next-group) | |
69 | (define-key gnus-browse-killed-mode-map "p" 'gnus-group-prev-group) | |
70 | (define-key gnus-browse-killed-mode-map "y" 'gnus-browse-killed-yank) | |
71 | (define-key gnus-browse-killed-mode-map "\C-y" 'gnus-browse-killed-yank) | |
72 | (define-key gnus-browse-killed-mode-map "l" 'gnus-list-killed-groups) | |
73 | (define-key gnus-browse-killed-mode-map "q" 'gnus-browse-killed-exit) | |
74 | (define-key gnus-browse-killed-mode-map "\C-c\C-c" 'gnus-browse-killed-exit) | |
75 | (define-key gnus-browse-killed-mode-map "\C-c\C-i" 'gnus-info-find-node)) | |
76 | ||
77 | (defun gnus-browse-killed-mode () | |
f3a3445b JB |
78 | "Major mode for browsing the killed newsgroups. |
79 | All normal editing commands are turned off. | |
80 | Instead, these commands are available: | |
b027f415 | 81 | \\{gnus-browse-killed-mode-map} |
f3a3445b | 82 | |
b027f415 RS |
83 | The killed newsgroups are saved in the quick startup file (.newsrc.el) |
84 | unless it against the options line in the startup file (.newsrc). | |
f3a3445b | 85 | |
b027f415 | 86 | Entry to this mode calls gnus-browse-killed-mode-hook with no arguments, |
f3a3445b JB |
87 | if that value is non-nil." |
88 | (interactive) | |
89 | (kill-all-local-variables) | |
90 | ;; Gee. Why don't you upgrade? | |
91 | (cond ((boundp 'mode-line-modified) | |
92 | (setq mode-line-modified "--- ")) | |
93 | ((listp (default-value 'mode-line-format)) | |
94 | (setq mode-line-format | |
95 | (cons "--- " (cdr (default-value 'mode-line-format))))) | |
96 | (t | |
97 | (setq mode-line-format | |
98 | "--- GNUS: Killed Newsgroups %[(%m)%]----%3p-%-"))) | |
b027f415 | 99 | (setq major-mode 'gnus-browse-killed-mode) |
f3a3445b JB |
100 | (setq mode-name "Browse-Killed") |
101 | (setq mode-line-buffer-identification "GNUS: Killed Newsgroups") | |
b027f415 | 102 | (use-local-map gnus-browse-killed-mode-map) |
f3a3445b JB |
103 | (buffer-flush-undo (current-buffer)) |
104 | (setq buffer-read-only t) ;Disable modification | |
b027f415 | 105 | (run-hooks 'gnus-browse-killed-mode-hook)) |
f3a3445b | 106 | |
b027f415 RS |
107 | (defun gnus-list-killed-groups () |
108 | "List the killed newsgroups. | |
109 | The keys y and C-y yank the newsgroup on the current line into the | |
110 | Newsgroups buffer." | |
f3a3445b JB |
111 | (interactive) |
112 | (or gnus-killed-assoc | |
113 | (error "No killed newsgroups")) | |
114 | ;; Save current window configuration if this is first invocation.. | |
b027f415 | 115 | (or (get-buffer-window gnus-browse-killed-buffer) |
f3a3445b JB |
116 | (setq gnus-winconf-browse-killed |
117 | (current-window-configuration))) | |
118 | ;; Prepare browsing buffer. | |
b027f415 RS |
119 | (pop-to-buffer (get-buffer-create gnus-browse-killed-buffer)) |
120 | (gnus-browse-killed-mode) | |
f3a3445b JB |
121 | (let ((buffer-read-only nil) |
122 | (killed-assoc gnus-killed-assoc)) | |
123 | (erase-buffer) | |
124 | (while killed-assoc | |
b027f415 | 125 | (insert (gnus-group-prepare-line (car killed-assoc))) |
f3a3445b JB |
126 | (setq killed-assoc (cdr killed-assoc))) |
127 | (goto-char (point-min)) | |
128 | )) | |
129 | ||
b027f415 | 130 | (defun gnus-browse-killed-yank () |
f3a3445b JB |
131 | "Yank current newsgroup to Newsgroup buffer." |
132 | (interactive) | |
b027f415 | 133 | (let ((group (gnus-group-group-name))) |
f3a3445b JB |
134 | (if group |
135 | (let* ((buffer-read-only nil) | |
b027f415 RS |
136 | (killed (gnus-gethash group gnus-killed-hashtb))) |
137 | (pop-to-buffer gnus-group-buffer) ;Needed to adjust point. | |
f3a3445b | 138 | (if killed |
b027f415 RS |
139 | (gnus-group-insert-group killed)) |
140 | (pop-to-buffer gnus-browse-killed-buffer) | |
f3a3445b JB |
141 | (beginning-of-line) |
142 | (delete-region (point) | |
143 | (progn (forward-line 1) (point))) | |
144 | ))) | |
b027f415 | 145 | (gnus-browse-killed-check-buffer)) |
f3a3445b | 146 | |
b027f415 | 147 | (defun gnus-browse-killed-check-buffer () |
f3a3445b JB |
148 | "Exit if the buffer is empty by deleting the window and killing the buffer." |
149 | (and (null gnus-killed-assoc) | |
b027f415 RS |
150 | (get-buffer gnus-browse-killed-buffer) |
151 | (gnus-browse-killed-exit))) | |
f3a3445b | 152 | |
b027f415 | 153 | (defun gnus-browse-killed-exit () |
f3a3445b JB |
154 | "Exit this mode by deleting the window and killing the buffer." |
155 | (interactive) | |
b027f415 RS |
156 | (and (get-buffer-window gnus-browse-killed-buffer) |
157 | (delete-window (get-buffer-window gnus-browse-killed-buffer))) | |
158 | (kill-buffer gnus-browse-killed-buffer) | |
f3a3445b JB |
159 | ;; Restore previous window configuration if available. |
160 | (and gnus-winconf-browse-killed | |
161 | (set-window-configuration gnus-winconf-browse-killed)) | |
162 | (setq gnus-winconf-browse-killed nil)) | |
163 | ||
164 | \f | |
165 | ;;; | |
166 | ;;; kill/yank newsgroup commands of GNUS Group Mode | |
167 | ;;; | |
168 | ||
b027f415 RS |
169 | (defun gnus-group-transpose-groups (arg) |
170 | "Exchange current newsgroup and previous newsgroup. | |
171 | With argument ARG, takes previous newsgroup and moves it past ARG newsgroup." | |
172 | (interactive "p") | |
173 | ;; BUG: last newsgroup and the last but one cannot be transposed | |
174 | ;; since gnus-group-search-forward does not move forward beyond the | |
175 | ;; last. If we instead use forward-line, no problem, but I don't | |
176 | ;; want to use it for later extension. | |
177 | (while (> arg 0) | |
178 | (gnus-group-search-forward t t) | |
179 | (gnus-group-kill-group 1) | |
180 | (gnus-group-search-forward nil t) | |
181 | (gnus-group-yank-group) | |
182 | (gnus-group-search-forward nil t) | |
183 | (setq arg (1- arg)) | |
184 | )) | |
185 | ||
186 | (defun gnus-group-kill-region (begin end) | |
187 | "Kill newsgroups in current region (excluding current point). | |
188 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." | |
189 | (interactive "r") | |
190 | (let ((lines | |
191 | ;; Exclude a line where current point is on. | |
192 | (1- | |
193 | ;; Count lines. | |
194 | (save-excursion | |
195 | (count-lines | |
196 | (progn | |
197 | (goto-char begin) | |
198 | (beginning-of-line) | |
199 | (point)) | |
200 | (progn | |
201 | (goto-char end) | |
202 | (end-of-line) | |
203 | (point))))))) | |
204 | (goto-char begin) | |
205 | (beginning-of-line) ;Important when LINES < 1 | |
206 | (gnus-group-kill-group lines))) | |
207 | ||
208 | (defun gnus-group-kill-group (n) | |
f3a3445b | 209 | "Kill newsgroup on current line, repeated prefix argument N times. |
b027f415 | 210 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." |
f3a3445b JB |
211 | (interactive "p") |
212 | (let ((buffer-read-only nil) | |
213 | (group nil)) | |
214 | (while (> n 0) | |
b027f415 | 215 | (setq group (gnus-group-group-name)) |
f3a3445b JB |
216 | (or group |
217 | (signal 'end-of-buffer nil)) | |
218 | (beginning-of-line) | |
219 | (delete-region (point) | |
220 | (progn (forward-line 1) (point))) | |
221 | (gnus-kill-newsgroup group) | |
222 | (setq n (1- n)) | |
223 | ;; Add to killed newsgroups in the buffer if exists. | |
b027f415 | 224 | (if (get-buffer gnus-browse-killed-buffer) |
f3a3445b | 225 | (save-excursion |
b027f415 | 226 | (set-buffer gnus-browse-killed-buffer) |
f3a3445b JB |
227 | (let ((buffer-read-only nil)) |
228 | (goto-char (point-min)) | |
b027f415 | 229 | (insert (gnus-group-prepare-line (car gnus-killed-assoc))) |
f3a3445b JB |
230 | ))) |
231 | ) | |
232 | (search-forward ":" nil t) | |
233 | )) | |
234 | ||
b027f415 RS |
235 | (defun gnus-group-yank-group () |
236 | "Yank the last newsgroup killed with \\[gnus-group-kill-group], | |
f3a3445b JB |
237 | inserting it before the newsgroup on the line containging point." |
238 | (interactive) | |
b027f415 | 239 | (gnus-group-insert-group (car gnus-killed-assoc)) |
f3a3445b | 240 | ;; Remove killed newsgroups from the buffer if exists. |
b027f415 | 241 | (if (get-buffer gnus-browse-killed-buffer) |
f3a3445b | 242 | (save-excursion |
b027f415 | 243 | (set-buffer gnus-browse-killed-buffer) |
f3a3445b JB |
244 | (let ((buffer-read-only nil)) |
245 | (goto-char (point-min)) | |
246 | (delete-region (point-min) | |
247 | (progn (forward-line 1) (point))) | |
248 | ))) | |
b027f415 | 249 | (gnus-browse-killed-check-buffer)) |
f3a3445b | 250 | |
b027f415 RS |
251 | (defun gnus-group-insert-group (info) |
252 | "Insert newsgroup at current line using gnus-newsrc-assoc INFO." | |
f3a3445b JB |
253 | (if (null gnus-killed-assoc) |
254 | (error "No killed newsgroups")) | |
b027f415 RS |
255 | ;; Huuum. It this right? |
256 | ;;(if (not gnus-have-all-newsgroups) | |
257 | ;; (error | |
258 | ;; (substitute-command-keys | |
259 | ;; "Not all newsgroups are displayed. Type \\[gnus-group-list-all-groups] to display all newsgroups."))) | |
f3a3445b | 260 | (let ((buffer-read-only nil) |
b027f415 | 261 | (group (gnus-group-group-name))) |
f3a3445b JB |
262 | (gnus-insert-newsgroup info group) |
263 | (beginning-of-line) | |
b027f415 | 264 | (insert (gnus-group-prepare-line info)) |
f3a3445b JB |
265 | (forward-line -1) |
266 | (search-forward ":" nil t) | |
267 | )) | |
49116ac0 | 268 | |
b027f415 RS |
269 | \f |
270 | ;;; Rewrite Date: field in GMT to local | |
271 | ||
272 | (defun gnus-gmt-to-local () | |
273 | "Rewrite Date: field described in GMT to local in current buffer. | |
274 | The variable gnus-local-timezone is used for local time zone. | |
275 | Intended to be used with gnus-article-prepare-hook." | |
276 | (save-excursion | |
277 | (save-restriction | |
278 | (widen) | |
279 | (goto-char (point-min)) | |
280 | (narrow-to-region (point-min) | |
281 | (progn (search-forward "\n\n" nil 'move) (point))) | |
282 | (goto-char (point-min)) | |
283 | (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t) | |
284 | (let ((buffer-read-only nil) | |
285 | (date (buffer-substring (match-beginning 1) (match-end 1)))) | |
286 | (delete-region (match-beginning 1) (match-end 1)) | |
287 | (insert | |
288 | (timezone-make-date-arpa-standard date nil gnus-local-timezone)) | |
289 | )) | |
290 | ))) | |
291 | ||
49116ac0 | 292 | (provide 'gnusmisc) |
1a06eabd ER |
293 | |
294 | ;;; gnusmisc.el ends here |