Mercurial > emacs
comparison lisp/=gnus-uu.el @ 6728:cee7995fefe5
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 07 Apr 1994 16:39:44 +0000 |
parents | |
children | 77494db73d5b |
comparison
equal
deleted
inserted
replaced
6727:dda4552eb031 | 6728:cee7995fefe5 |
---|---|
1 ;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus | |
2 ;; | |
3 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no> | |
4 ;; Created: 2 Oct 1993 | |
5 ;; Version: gnus-uu.el v 1.3.6 1994/04/07 | |
6 ;; Keyword: gnus | |
7 ;; | |
8 ;; For gnus 4.*. | |
9 ;; | |
10 ;; All gnus-uu commands start with `C-c C-v'. | |
11 ;; | |
12 ;; Typing `C-c C-v C-v' (gnus-uu-decode-and-view) in the summary | |
13 ;; buffer will try to find all articles in the same series, uudecode | |
14 ;; them and view the resulting file(s). | |
15 ;; | |
16 ;; gnus-uu guesses what articles are in the series according to the | |
17 ;; following simple rule: The subjects must be identical, except for | |
18 ;; the last two numbers of the line. | |
19 ;; | |
20 ;; For example: If you choose a subject called "cat.gif (2/3)" gnus-uu | |
21 ;; will find all the articles that matches "^cat.gif | |
22 ;; ([0-9]+/[0-9]+).*$". Subjects that are nonstandard, like "cat.gif | |
23 ;; (2/3) Part 6 of a series", will not be properly recognized by 'C-c | |
24 ;; C-v C-v', and you have to mark the articles manually with '#'. | |
25 ;; | |
26 ;; Typing `C-c C-v v' (gnus-uu-decode-and-save) will do the same as | |
27 ;; `C-c C-v C-v', except that it will not display the resulting file, but | |
28 ;; save it instead. | |
29 ;; | |
30 ;; Typing `C-c C-v s' (gnus-uu-shar-and-save) does the same as `C-c | |
31 ;; C-v v', and `C-c C-v C-s' (gnus-uu-shar-and-view) does the same as | |
32 ;; `C-c C-v C-v', except that they unshar files instead, i. e. run | |
33 ;; them through /bin/sh. Most shar files can be viewed and/or saved | |
34 ;; with the normal uudecode commands, which is much safer, as no | |
35 ;; foreign code is run. | |
36 ;; | |
37 ;; `#' (gnus-uu-mark-article) marks an article for later | |
38 ;; decoding/unsharing/saving/viewing. The files will be decoded in the | |
39 ;; sequence they were marked. To decode the files after you've marked | |
40 ;; the articles you are interested in, type the corresponding key | |
41 ;; strokes as the normal decoding commands, but put a `M-' in the last | |
42 ;; keystroke. For instance, to perform a standard uudecode and view, | |
43 ;; you would type `C-c C-v C-v'. To perform a marked uudecode and | |
44 ;; view, say `C-v C-v M-C-v'. All the other view and save commands are | |
45 ;; handled the same way; marked uudecode and save is then `C-c C-v | |
46 ;; M-v'. | |
47 ;; | |
48 ;; `M-#' (gnus-uu-unmark-article) will remove the mark from a | |
49 ;; previosly marked article. | |
50 ;; | |
51 ;; `C-c C-v C-u' (gnus-uu-unmark-all-articles) will remove the mark from | |
52 ;; all marked articles. | |
53 ;; | |
54 ;; `C-c C-v C-r' (gnus-uu-mark-by-regexp) will prompt for a regular | |
55 ;; expression and mark (forward) all articles matching that regular | |
56 ;; expression. | |
57 ;; | |
58 ;; There's an additional way to reach the decoding functions to make | |
59 ;; future expansions easier: `C-c C-v C-m' | |
60 ;; (gnus-uu-multi-decode-and-view) and the corresponding save, marked | |
61 ;; view and marked save keystrokes, `C-c C-v m', `C-c C-v M-C-m' and | |
62 ;; `C-c C-v M-m' respectively. You will be prompted for decoding | |
63 ;; method, like uudecode, shar, binhex or plain save. Note that | |
64 ;; methods like binhex and save doesn't have view modes; even if you | |
65 ;; issue a view command (`C-c C-v C-m' and "binhex"), gnus-uu will | |
66 ;; just save the resulting binhex file. | |
67 ;; | |
68 ;; `C-c C-v C-b' (gnus-uu-decode-and-show-in-buffer) will decode the | |
69 ;; current article and display the results in an emacs buffer. This | |
70 ;; might be useful if there's jsut some text in the current article | |
71 ;; that has been uuencoded by some perverse poster. | |
72 ;; | |
73 ;; `C-c C-v a' (gnus-uu-decode-and-save-all-articles) looks at all the | |
74 ;; articles in the current newsgroup and tries to uudecode everything | |
75 ;; it can find. The user will be prompted for a directory where the | |
76 ;; resulting files (if any) will be stored. `C-c C-v M-a' only looks | |
77 ;; at unread article. `C-c C-v w' does the same as `C-c C-v a', but | |
78 ;; also marks as read all articles it has peeked through, even if they | |
79 ;; weren't uuencoded articles. `C-c C-v M-w' is, as you might have | |
80 ;; guessed, similar to `C-c C-v M-a'. | |
81 ;; | |
82 ;; `C-c C-v C-l' (gnus-uu-edit-begin-line) lets you edit the begin | |
83 ;; line of the current buffer. Useful to change an incorrect suffix or | |
84 ;; an incorrect begin line. | |
85 ;; | |
86 ;; | |
87 ;; When using the view commands, `C-c C-v C-v' for instance, gnus-uu | |
88 ;; will (normally, see below) try to view the file according to the | |
89 ;; rules given in gnus-uu-default-view-rules and | |
90 ;; gnus-uu-user-view-rules. If it recognises the file, it will display | |
91 ;; it immediately. If the file is some sort of archive, gnus-uu will | |
92 ;; attempt to unpack the archive and see if any of the files in the | |
93 ;; archive can be viewed. For instance, if you have a gzipped tar file | |
94 ;; "pics.tar.gz" containing the files "pic1.jpg" and "pic2.gif", | |
95 ;; gnus-uu will uncompress and detar the main file, and then view the | |
96 ;; two pictures. This unpacking process is recursive, so if the | |
97 ;; archive contains archives of archives, it'll all be unpacked. | |
98 ;; | |
99 ;; If the view command doesn't recognise the file type, or can't view | |
100 ;; it because you don't have the viewer, or can't view *any* of the | |
101 ;; files in the archive, the user will be asked if she wishes to have | |
102 ;; the file saved somewhere. Note that if the decoded file is an | |
103 ;; archive, and gnus-uu manages to view some of the files in the | |
104 ;; archive, it won't tell the user that there were some files that | |
105 ;; were unviewable. See "Interactive view" for a different approach. | |
106 ;; | |
107 ;; | |
108 ;; Note that gnus-uu adds a function to `gnus-exit-group-hook' to | |
109 ;; clear the list of marked articles and check for any generated files | |
110 ;; that might have escaped deletion if the user typed `C-g'. | |
111 ;; | |
112 ;; | |
113 ;; `C-c C-v C-a' (gnus-uu-toggle-asynchronous) toggles the | |
114 ;; gnus-uu-asynchronous variable. See below for explanation. | |
115 ;; | |
116 ;; `C-c C-v C-q' (gnus-uu-toggle-query) toggles the | |
117 ;; gnus-uu-ask-before-view variable. See below for explanation. | |
118 ;; | |
119 ;; `C-c C-v C-p' (gnus-uu-toggle-always-ask) toggles the | |
120 ;; gnus-uu-view-and-save variable. See below for explanation. | |
121 ;; | |
122 ;; `C-c C-v C-k' (gnus-uu-toggle-kill-carriage-return) toggles the | |
123 ;; gnus-uu-kill-carriage-return variable. See below for explanation. | |
124 ;; | |
125 ;; `C-c C-v C-i' (gnus-uu-toggle-interactive-view) toggles interactive | |
126 ;; mode. If it is turned on, gnus-uu won't view files immediately but | |
127 ;; give you a buffer with the default commands and files and lets you | |
128 ;; edit the commands and execute them at leisure. | |
129 ;; | |
130 ;; `C-c C-v C-t' (gnus-uu-toggle-any-variable) is an interface to the | |
131 ;; five toggle commands listed above. | |
132 ;; | |
133 ;; gnus-uu-toggle-correct-stripped-articles toggles whether to check | |
134 ;; and correct uuencoded articles that may have had trailing spaces | |
135 ;; stripped by mailers. | |
136 ;; | |
137 ;; | |
138 ;; Customization | |
139 ;; | |
140 ;; To load this file when starting gnus, put sumething like the | |
141 ;; following in your .emacs file: | |
142 ;; | |
143 ;; (setq gnus-group-mode-hook | |
144 ;; '(lambda () (load "gnus-uu"))) | |
145 ;; | |
146 ;; To make gnus-uu use, for instance, "xli" to view JPEGs and GIFs, | |
147 ;; put this in your .emacs file: | |
148 ;; | |
149 ;; (setq gnus-uu-user-view-rules | |
150 ;; (list | |
151 ;; '("jpg$\\|gif$" "xli") | |
152 ;; )) | |
153 ;; | |
154 ;; This variable is a list where each list item is a list containing | |
155 ;; two strings. The first string is a regular expression. If the file | |
156 ;; name is matched by this expression, the command given in the | |
157 ;; second string is executed on this file. If the command contains | |
158 ;; "%s", the file will be inserted there in the command string. Eg. | |
159 ;; "giftoppm %s | xv -" will result in the file name being inserted at | |
160 ;; the "%s". | |
161 ;; | |
162 ;; If you don't want to display certain file types, like if you | |
163 ;; haven't got sound capabilities, you could put something like | |
164 ;; | |
165 ;; (setq gnus-uu-user-view-rules | |
166 ;; (list | |
167 ;; '("au$\\|voc$\\|wav$" nil) | |
168 ;; )) | |
169 ;; | |
170 ;; in your .emacs file. | |
171 ;; | |
172 ;; There's a similar variable called 'gnus-uu-user-archive-rules' | |
173 ;; which gives a list of unarcers to use when looking inside archives | |
174 ;; for files to display. | |
175 ;; | |
176 ;; If you don't want gnus-uu to look inside archives for files to | |
177 ;; display, say | |
178 ;; | |
179 ;; (setq gnus-uu-do-not-unpack-archives t) | |
180 ;; | |
181 ;; | |
182 ;; If you want gnus-uu to ask you if you want to save a file after | |
183 ;; viewing, say | |
184 ;; | |
185 ;; (setq gnus-uu-view-and-save t) | |
186 ;; | |
187 ;; | |
188 ;; If you don't want to wait for the viewing command to finish before | |
189 ;; returning to emacs, say | |
190 ;; | |
191 ;; (setq gnus-uu-asynchronous t) | |
192 ;; | |
193 ;; | |
194 ;; This can be useful if you're viewing long .mod files, for instance, | |
195 ;; which often takes several minutes. Note, however, that since | |
196 ;; gnus-uu doesn't ask, and if you are viewing an archive with lots of | |
197 ;; viewable files, you'll get them all up more or less at once, which | |
198 ;; can be confusing, to say the least. To get gnus-uu to ask you | |
199 ;; before viewing a file, say | |
200 ;; | |
201 ;; (setq gnus-uu-ask-before-view t) | |
202 ;; | |
203 ;; You can set this variable even if you're not using asynchronous | |
204 ;; viewing, of course. | |
205 ;; | |
206 ;; If the articles has been posted by some numbscull with a PC (isn't | |
207 ;; that a bit redundant, though?) and there's lots of carriage returns | |
208 ;; everywhere, say | |
209 ;; | |
210 ;; (setq gnus-uu-kill-carriage-return t) | |
211 ;; | |
212 ;; If you want gnus-uu to ignore the default file rules when viewing, | |
213 ;; for instance if there's several file types that you can't view, set | |
214 ;; `gnus-uu-ignore-default-view-rules' to `t'. There's a similar | |
215 ;; variable to disable the default unarchive rule list, | |
216 ;; `gnus-uu-ignore-default-archive-rules'. | |
217 ;; | |
218 ;; If you want a more interactive approach to file viewing, say | |
219 ;; | |
220 ;; (setq gnus-uu-use-interactive-view t) | |
221 ;; | |
222 ;; If this variable is set, whenever you type `C-c C-v C-v' (or any of | |
223 ;; the other view commands), gnus-uu will present you with a buffer | |
224 ;; with the default actions and file names after decoding. You can | |
225 ;; edit the command lines and execute them in a convenient fashion. | |
226 ;; The output from the commands will be displayed in a small window at | |
227 ;; the bottom of the emacs window. End interactive mode by typing `C-c | |
228 ;; C-c' in the view window. | |
229 ;; | |
230 ;; If you want gnus-uu to unmark articles that you have asked to | |
231 ;; decode, but can't be decoded (if, for instance, the articles aren't | |
232 ;; uuencoded files or the posting is incomplete), say | |
233 ;; | |
234 ;; (setq gnus-uu-unmark-articles-not-decoded t) | |
235 ;; | |
236 ;; | |
237 ;; History | |
238 ;; | |
239 ;; v1.0: First version released Oct 2 1992. | |
240 ;; | |
241 ;; v1.1: Changed `C-c C-r' to `C-c C-e' and `C-c C-p' to `C-c C-k'. | |
242 ;; Changed (setq gnus-exit-group-hook) to (add-hook). Removed | |
243 ;; checking for "Re:" for finding parts. | |
244 ;; | |
245 ;; v2.2: Fixed handling of currupted archives. Changed uudecoding to | |
246 ;; an asynchronous process to avoid loading tons of data into emacs | |
247 ;; buffers. No longer reads articles emacs already have aboard. Fixed | |
248 ;; a firmer support for shar files. Made regexp searches for files | |
249 ;; more convenient. Added `C-c C-l' for editing uucode begin | |
250 ;; lines. Added multi-system decoder entry point. Added interactive | |
251 ;; view mode. Added function for decoding and saving all uuencoded | |
252 ;; articles in the current newsgroup. | |
253 ;; | |
254 ;; v2.3: After suggestions I have changed all the gnus-uu key bindings | |
255 ;; to avoid hogging all the user keys (C-c LETTER). Also added | |
256 ;; (provide) and fixed some saving stuff. First posted version to | |
257 ;; gnu.emacs.sources. | |
258 ;; | |
259 ;; v2.4: Fixed some more in the save-all category. Automatic fixing of | |
260 ;; uucode "begin" lines: names on the form of "dir/file" are | |
261 ;; translated into "dir-file". Added a function for fixing stripped | |
262 ;; uucode articles. Added binhex save. | |
263 ;; | |
264 ;; | |
265 ;; Keymap overview: | |
266 ;; | |
267 ;; All commands start with `C-c C-v'. The difference is in the third | |
268 ;; keystroke. All view commands are `C-LETTER'. All save commands are | |
269 ;; just `LETTER'. All marked commands are the same as the unmarked | |
270 ;; commands, except that they have `M-' before in the last keystroke. | |
271 ;; | |
272 ;; `C-c C-v C-v' gnus-uu-decode-and-view | |
273 ;; `C-c C-v v' gnus-uu-decode-and-save | |
274 ;; `C-c C-v C-s' gnus-uu-shar-and-view | |
275 ;; `C-c C-v s' gnus-uu-shar-and-save | |
276 ;; `C-c C-v C-m' gnus-uu-multi-decode-and-view | |
277 ;; `C-c C-v m' gnus-uu-multi-decode-and-save | |
278 ;; | |
279 ;; `C-c C-v C-b' gnus-uu-decode-and-show-in-buffer | |
280 ;; `C-c C-v C-l' gnus-uu-edit-begin-line | |
281 ;; `C-c C-v M-a' gnus-uu-decode-and-save-all-unread-articles | |
282 ;; `C-c C-v a' gnus-uu-decode-and-save-all-articles | |
283 ;; `C-c C-v M-w' gnus-uu-decode-and-save-all-unread-articles-and-mark | |
284 ;; `C-c C-v w' gnus-uu-decode-and-save-all-articles-and-mark | |
285 ;; | |
286 ;; `#' gnus-uu-mark-article | |
287 ;; `M-#' gnus-uu-unmark-article | |
288 ;; `C-c C-v C-u' gnus-uu-unmark-all-articles | |
289 ;; `C-c C-v C-r' gnus-uu-mark-by-regexp | |
290 ;; `C-c C-v M-C-v' gnus-uu-marked-decode-and-view | |
291 ;; `C-c C-v M-v' gnus-uu-marked-decode-and-save | |
292 ;; `C-c C-v M-C-s' gnus-uu-marked-shar-and-view | |
293 ;; `C-c C-v M-s' gnus-uu-marked-shar-and-save | |
294 ;; `C-c C-v M-C-m' gnus-uu-marked-multi-decode-and-view | |
295 ;; `C-c C-v M-m' gnus-uu-marked-multi-decode-and-save | |
296 ;; | |
297 ;; `C-c C-v C-a' gnus-uu-toggle-asynchronous | |
298 ;; `C-c C-v C-q' gnus-uu-toggle-query | |
299 ;; `C-c C-v C-p' gnus-uu-toggle-always-ask | |
300 ;; `C-c C-v C-k' gnus-uu-toggle-kill-carriage-return | |
301 ;; `C-c C-v C-i' gnus-uu-toggle-interactive-view | |
302 ;; `C-c C-v C-t' gnus-uu-toggle-any-variable | |
303 | |
304 (require 'gnus) | |
305 | |
306 ;; Binding of keys to the gnus-uu functions. | |
307 | |
308 (defvar gnus-uu-ctl-map nil) | |
309 (define-prefix-command 'gnus-uu-ctl-map) | |
310 (define-key gnus-summary-mode-map "\C-c\C-v" gnus-uu-ctl-map) | |
311 | |
312 (define-key gnus-uu-ctl-map "\C-v" 'gnus-uu-decode-and-view) | |
313 (define-key gnus-uu-ctl-map "v" 'gnus-uu-decode-and-save) | |
314 (define-key gnus-uu-ctl-map "\C-s" 'gnus-uu-shar-and-view) | |
315 (define-key gnus-uu-ctl-map "s" 'gnus-uu-shar-and-save) | |
316 (define-key gnus-uu-ctl-map "\C-m" 'gnus-uu-multi-decode-and-view) | |
317 (define-key gnus-uu-ctl-map "m" 'gnus-uu-multi-decode-and-save) | |
318 | |
319 (define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer) | |
320 | |
321 (define-key gnus-summary-mode-map "#" 'gnus-uu-mark-article) | |
322 (define-key gnus-summary-mode-map "\M-#" 'gnus-uu-unmark-article) | |
323 (define-key gnus-uu-ctl-map "\C-u" 'gnus-uu-unmark-all-articles) | |
324 (define-key gnus-uu-ctl-map "\C-r" 'gnus-uu-mark-by-regexp) | |
325 | |
326 (define-key gnus-uu-ctl-map "\M-\C-v" 'gnus-uu-marked-decode-and-view) | |
327 (define-key gnus-uu-ctl-map "\M-v" 'gnus-uu-marked-decode-and-save) | |
328 (define-key gnus-uu-ctl-map "\M-\C-s" 'gnus-uu-marked-shar-and-view) | |
329 (define-key gnus-uu-ctl-map "\M-s" 'gnus-uu-marked-shar-and-save) | |
330 (define-key gnus-uu-ctl-map "\M-\C-m" 'gnus-uu-marked-multi-decode-and-view) | |
331 (define-key gnus-uu-ctl-map "\M-m" 'gnus-uu-marked-multi-decode-and-save) | |
332 | |
333 (define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-toggle-asynchronous) | |
334 (define-key gnus-uu-ctl-map "\C-q" 'gnus-uu-toggle-query) | |
335 (define-key gnus-uu-ctl-map "\C-p" 'gnus-uu-toggle-always-ask) | |
336 (define-key gnus-uu-ctl-map "\C-k" 'gnus-uu-toggle-kill-carriage-return) | |
337 (define-key gnus-uu-ctl-map "\C-i" 'gnus-uu-toggle-interactive-view) | |
338 (define-key gnus-uu-ctl-map "\C-t" 'gnus-uu-toggle-any-variable) | |
339 | |
340 (define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line) | |
341 | |
342 (define-key gnus-uu-ctl-map "\M-a" 'gnus-uu-decode-and-save-all-unread-articles) | |
343 (define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-articles) | |
344 (define-key gnus-uu-ctl-map "\M-w" 'gnus-uu-decode-and-save-all-unread-articles-and-mark) | |
345 (define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles-and-mark) | |
346 | |
347 ;(load "rnewspost") | |
348 ;(define-key news-reply-mode-map "\C-c\C-v" 'gnus-uu-uuencode-and-post) | |
349 | |
350 ;; Default viewing action rules | |
351 | |
352 (defconst gnus-uu-default-view-rules | |
353 (list | |
354 '("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") | |
355 '("\\.tga$" "tgatoppm %s | xv -") | |
356 '("\\.te?xt$\\|\\.doc$\\|read.*me" "xterm -e less") | |
357 '("\\.fli$" "xflick") | |
358 '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" | |
359 "sox -v .5 %s -t .au -u - > /dev/audio") | |
360 '("\\.au$" "cat %s > /dev/audio") | |
361 '("\\.mod$" "str32") | |
362 '("\\.ps$" "ghostview") | |
363 '("\\.dvi$" "xdvi") | |
364 '("\\.1$" "xterm -e man -l") | |
365 '("\\.html$" "xmosaic") | |
366 '("\\.mpe?g$" "mpeg_play") | |
367 '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\)$" | |
368 "gnus-uu-archive")) | |
369 | |
370 | |
371 "This constant is a list that gives the default actions to be taken | |
372 when the user asks to view a file. To change the behaviour, you can | |
373 either edit this constant or set 'gnus-uu-user-view-rules' to | |
374 something useful. To add a default \"end\" rule, edit the | |
375 'gnus-uu-user-view-rules-end' variable. | |
376 | |
377 For example: | |
378 | |
379 To make gnus-uu use 'xli' to display JPEG and GIF files, put the | |
380 following in your .emacs file | |
381 | |
382 (setq gnus-uu-user-view-rules (list '(\"jpg$\\\\|gif$\" \"xli\"))) | |
383 | |
384 Both these variables are lists of lists of strings, where the first | |
385 string is a regular expression. If the file name matches this regular | |
386 expression, the command in the second string is fed the file. | |
387 | |
388 If the command string contains \"%s\", the file name will be inserted | |
389 at that point in the command string. If there's no \"%s\" in the | |
390 command string, the file name will be appended to the command before | |
391 executing. ") | |
392 | |
393 (defvar gnus-uu-user-view-rules nil | |
394 "User variable. See explanation of the 'gnus-uu-default-view-rules' for | |
395 details.") | |
396 | |
397 (defvar gnus-uu-user-view-rules-end nil | |
398 "The user may use this variable to provide default viewing rules.") | |
399 | |
400 (defvar gnus-uu-user-interactive-view-rules nil | |
401 "If this variable is set and interactive mode is to be used, this | |
402 variable will be used instead of gnus-uu-user-view-rules.") | |
403 | |
404 (defvar gnus-uu-user-interactive-view-rules-end nil | |
405 "If this variable is set and interactive mode is to be used, this | |
406 variable will be used instead of gnus-uu-user-view-rules-end.") | |
407 | |
408 (defconst gnus-uu-default-interactive-view-rules-begin | |
409 (list | |
410 '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/ | |
411 //g") | |
412 '("\\.pas$" "cat %s | sed s/ | |
413 //g") | |
414 )) | |
415 | |
416 | |
417 ;; Default unpacking commands | |
418 | |
419 (defconst gnus-uu-default-archive-rules | |
420 (list '("\\.tar$" "tar xf") | |
421 '("\\.zip$" "unzip") | |
422 '("\\.ar$" "ar x") | |
423 '("\\.arj$" "unarj x") | |
424 '("\\.zoo$" "zoo -e") | |
425 '("\\.lzh$" "lha x") | |
426 '("\\.Z$" "uncompress") | |
427 '("\\.gz$" "gunzip") | |
428 '("\\.arc$" "arc -x")) | |
429 "*") | |
430 (defvar gnus-uu-user-archive-rules nil) | |
431 | |
432 | |
433 ;; Various variables users may set | |
434 | |
435 (defvar gnus-uu-tmp-dir "/tmp/" | |
436 "Variable saying where gnus-uu is to do its work. Default is \"/tmp/\".") | |
437 | |
438 (defvar gnus-uu-do-not-unpack-archives nil | |
439 "Set this variable if you don't want gnus-uu to look inside | |
440 archives for files to display. Default is `nil'.") | |
441 | |
442 (defvar gnus-uu-do-not-unpack-archives nil | |
443 "Set this variable if you don't want gnus-uu to look inside | |
444 archives for files to display. Default is `nil'.") | |
445 | |
446 (defvar gnus-uu-view-and-save nil | |
447 "Set this variable if you want to be asked if you want to save the | |
448 file after viewing. If this variable is nil, which is the default, | |
449 gnus-uu won't offer to save a file if viewing is successful. Default | |
450 is `nil'.") | |
451 | |
452 (defvar gnus-uu-asynchronous nil | |
453 "Set this variable to `t' if you don't want gnus-uu to wait until | |
454 the viewing command has ended before returning control to emacs. | |
455 Default is `nil'.") | |
456 | |
457 (defvar gnus-uu-ask-before-view nil | |
458 "Set this variable to `t' if you want gnus-uu to ask you before | |
459 viewing every file. Useful when `gnus-uu-asynchronous' is set. Default | |
460 is `nil'.") | |
461 | |
462 (defvar gnus-uu-ignore-default-view-rules nil | |
463 "Set this variable if you want gnus-uu to ignore the default viewing | |
464 rules and just use the rules given in gnus-uu-user-view-rules. Default | |
465 is `nil'.") | |
466 | |
467 (defvar gnus-uu-ignore-default-archive-rules nil | |
468 "Set this variable if you want gnus-uu to ignore the default archive | |
469 unpacking commands and just use the rules given in | |
470 gnus-uu-user-archive-rules. Default is `nil'.") | |
471 | |
472 (defvar gnus-uu-kill-carriage-return t | |
473 "Set this variable if you want to remove all carriage returns from | |
474 the mail articles. Default is `t'.") | |
475 | |
476 (defvar gnus-uu-unmark-articles-not-decoded nil | |
477 "If this variable is set, artciles that are unsuccessfully decoded | |
478 are marked as unread. Default is `nil'.") | |
479 | |
480 (defvar gnus-uu-output-window-height 20 | |
481 "This variable says how hight the output buffer window is to be when | |
482 using interactive view mode. Change it at your convenience. Default is 20.") | |
483 | |
484 (defvar gnus-uu-correct-stripped-uucode nil | |
485 "If this variable is set, gnus-uu will try to correct uuencoded files that | |
486 have had trailing spaces stripped by nosy mail saoftware. Default is `nil'.") | |
487 | |
488 (defvar gnus-uu-use-interactive-view nil | |
489 "If this variable is set, gnus-uu will create a special buffer where | |
490 the user may choose interactively which files to view and how. Default | |
491 is `nil'.") | |
492 | |
493 | |
494 ;; Internal variables | |
495 | |
496 (defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$" | |
497 "*") | |
498 (defconst gnus-uu-end-string "^end[ \t]*$") | |
499 (defconst gnus-uu-body-line | |
500 "^M.............................................................?$" "*") | |
501 (defconst gnus-uu-shar-begin-string "^#! */bin/sh" "*") | |
502 | |
503 (defvar gnus-uu-shar-file-name nil "*") | |
504 (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)" "*") | |
505 (defvar gnus-uu-shar-directory nil) | |
506 | |
507 (defvar gnus-uu-file-name nil) | |
508 (defconst gnus-uu-uudecode-process nil) | |
509 | |
510 (defvar gnus-uu-interactive-file-list nil) | |
511 (defvar gnus-uu-marked-article-list nil) | |
512 (defvar gnus-uu-generated-file-list nil) | |
513 | |
514 (defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*") | |
515 (defconst gnus-uu-output-buffer-name "*Gnus UU Output*") | |
516 (defconst gnus-uu-result-buffer "*Gnus UU Result Buffer*") | |
517 | |
518 | |
519 ;; Interactive functions | |
520 | |
521 ;; UUdecode and view | |
522 | |
523 (defun gnus-uu-decode-and-view () | |
524 "UUdecodes and 'views' (if possible) the resulting file. | |
525 'Viewing' can be any action at all, as defined in the | |
526 'gnus-uu-file-action-list' variable. Running 'xv' on gifs and | |
527 'play' on au files are popular actions. If the file can't be viewed, | |
528 the user is asked if she would like to save the file instead." | |
529 (interactive) | |
530 (gnus-uu-decode-and-view-or-save t nil)) | |
531 | |
532 (defun gnus-uu-decode-and-save () | |
533 "uudecodes and saves the resulting file." | |
534 (interactive) | |
535 (gnus-uu-decode-and-view-or-save nil nil)) | |
536 | |
537 (defun gnus-uu-marked-decode-and-view () | |
538 "The marked equivalent to gnus-uu-decode-and-view." | |
539 (interactive) | |
540 (gnus-uu-decode-and-view-or-save t t)) | |
541 | |
542 (defun gnus-uu-marked-decode-and-save () | |
543 "The marked equivalent to gnus-uu-decode-and-save." | |
544 (interactive) | |
545 (gnus-uu-decode-and-view-or-save nil t)) | |
546 | |
547 | |
548 ;; Unshar and view | |
549 | |
550 (defun gnus-uu-shar-and-view () | |
551 "Does the same as gnus-uu-decode-and-view for shar files." | |
552 (interactive) | |
553 (gnus-uu-unshar-and-view-or-save t nil)) | |
554 | |
555 (defun gnus-uu-shar-and-save () | |
556 "Does the same as gnus-uu-decode-and-save for shar files." | |
557 (interactive) | |
558 (gnus-uu-unshar-and-view-or-save nil nil)) | |
559 | |
560 (defun gnus-uu-marked-shar-and-view () | |
561 "The marked equivalent to gnus-uu-shar-and-view." | |
562 (interactive) | |
563 (gnus-uu-unshar-and-view-or-save t t)) | |
564 | |
565 (defun gnus-uu-marked-shar-and-save () | |
566 "The marked equivalent to gnus-uu-shar-and-save." | |
567 (interactive) | |
568 (gnus-uu-unshar-and-view-or-save nil t)) | |
569 | |
570 | |
571 ;; Decode and show in buffer | |
572 | |
573 (defun gnus-uu-decode-and-show-in-buffer () | |
574 "uudecodes the current article and displays the result in a buffer." | |
575 (interactive) | |
576 (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name)) | |
577 list-of-articles file-name) | |
578 (save-excursion | |
579 (and | |
580 (setq list-of-articles (list gnus-current-article)) | |
581 (gnus-uu-grab-articles list-of-articles 'gnus-uu-uustrip-article-as) | |
582 (setq file-name (gnus-uu-decode gnus-uu-tmp-dir)) | |
583 (progn | |
584 (save-excursion | |
585 (set-buffer uu-buffer) | |
586 (erase-buffer) | |
587 (insert-file-contents file-name)) | |
588 (set-window-buffer (get-buffer-window gnus-article-buffer) | |
589 uu-buffer) | |
590 (message (format "Showing file %s in buffer" file-name)) | |
591 (delete-file file-name)))))) | |
592 | |
593 | |
594 ;; Toggle commands | |
595 | |
596 (defun gnus-uu-toggle-asynchronous () | |
597 "This function toggles asynchronous viewing." | |
598 (interactive) | |
599 (if (setq gnus-uu-asynchronous (not gnus-uu-asynchronous)) | |
600 (message "gnus-uu will now view files asynchronously") | |
601 (message "gnus-uu will now view files synchronously"))) | |
602 | |
603 (defun gnus-uu-toggle-query () | |
604 "This function toggles whether to ask before viewing or not." | |
605 (interactive) | |
606 (if (setq gnus-uu-ask-before-view (not gnus-uu-ask-before-view)) | |
607 (message "gnus-uu will now ask before viewing") | |
608 (message "gnus-uu will now view without asking first"))) | |
609 | |
610 (defun gnus-uu-toggle-always-ask () | |
611 "This function toggles whether to ask saving a file even after successful | |
612 viewing." | |
613 (interactive) | |
614 (if (setq gnus-uu-view-and-save (not gnus-uu-view-and-save)) | |
615 (message "gnus-uu will now ask to save the file after viewing") | |
616 (message "gnus-uu will now not ask to save after successful viewing"))) | |
617 | |
618 (defun gnus-uu-toggle-interactive-view () | |
619 "This function toggles whether to use interactive view." | |
620 (interactive) | |
621 (if (setq gnus-uu-use-interactive-view (not gnus-uu-use-interactive-view)) | |
622 (message "gnus-uu will now use interactive view") | |
623 (message "gnus-uu will now use non-interactive view"))) | |
624 | |
625 (defun gnus-uu-toggle-unmark-undecoded () | |
626 "This function toggles whether to unmark articles not decoded." | |
627 (interactive) | |
628 (if (setq gnus-uu-unmark-articles-not-decoded | |
629 (not gnus-uu-unmark-articles-not-decoded)) | |
630 (message "gnus-uu will now unmark articles not decoded") | |
631 (message "gnus-uu will now not unmark articles not decoded"))) | |
632 | |
633 (defun gnus-uu-toggle-kill-carriage-return () | |
634 "This function toggles the stripping of carriage returns from the articles." | |
635 (interactive) | |
636 (if (setq gnus-uu-kill-carriage-return (not gnus-uu-kill-carriage-return)) | |
637 (message "gnus-uu will now strip carriage returns") | |
638 (message "gnus-uu won't strip carriage returns"))) | |
639 | |
640 (defun gnus-uu-toggle-correct-stripped-uucode () | |
641 "This function toggles whether to correct stripped uucode." | |
642 (interactive) | |
643 (if (setq gnus-uu-correct-stripped-uucode | |
644 (not gnus-uu-correct-stripped-uucode)) | |
645 (message "gnus-uu will now correct stripped uucode") | |
646 (message "gnus-uu won't check and correct stripped uucode"))) | |
647 | |
648 (defun gnus-uu-toggle-any-variable () | |
649 "This function ask what variable the user wants to toggle." | |
650 (interactive) | |
651 (let (rep) | |
652 (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteractive, (u)nmark, (c)orrect") | |
653 (setq rep (read-char)) | |
654 (if (= rep ?a) | |
655 (gnus-uu-toggle-asynchronous)) | |
656 (if (= rep ?q) | |
657 (gnus-uu-toggle-query)) | |
658 (if (= rep ?p) | |
659 (gnus-uu-toggle-always-ask)) | |
660 (if (= rep ?k) | |
661 (gnus-uu-toggle-kill-carriage-return)) | |
662 (if (= rep ?u) | |
663 (gnus-uu-toggle-unmark-undecoded)) | |
664 (if (= rep ?c) | |
665 (gnus-uu-toggle-correct-stripped-uucode)) | |
666 (if (= rep ?i) | |
667 (gnus-uu-toggle-interactive-view)))) | |
668 | |
669 | |
670 ;; Edit line | |
671 | |
672 (defun gnus-uu-edit-begin-line () | |
673 "Edit the begin line of the current article." | |
674 (interactive) | |
675 (let ((buffer-read-only nil) | |
676 begin b) | |
677 (save-excursion | |
678 (set-buffer gnus-article-buffer) | |
679 (goto-line 1) | |
680 (if (not (re-search-forward "begin " nil t)) | |
681 (progn (message "No begin line in the current article") (sit-for 2)) | |
682 (beginning-of-line) | |
683 (setq b (point)) | |
684 (end-of-line) | |
685 (setq begin (buffer-substring b (point))) | |
686 (setq begin (read-string "" begin)) | |
687 (setq buffer-read-only nil) | |
688 (delete-region b (point)) | |
689 (insert-string begin))))) | |
690 | |
691 ;; Multi functions | |
692 | |
693 (defun gnus-uu-multi-decode-and-view () | |
694 "This function lets the user decide what method to use for decoding. | |
695 Other than that, it's equivalent to the other decode-and-view functions." | |
696 (interactive) | |
697 (gnus-uu-multi-decode-and-view-or-save t nil)) | |
698 | |
699 (defun gnus-uu-multi-decode-and-save () | |
700 "This function lets the user decide what method to use for decoding. | |
701 Other than that, it's equivalent to the other decode-and-save functions." | |
702 (interactive) | |
703 (gnus-uu-multi-decode-and-view-or-save nil nil)) | |
704 | |
705 (defun gnus-uu-marked-multi-decode-and-view () | |
706 "This function lets the user decide what method to use for decoding. | |
707 Other than that, it's equivalent to the other marked decode-and-view | |
708 functions." | |
709 (interactive) | |
710 (gnus-uu-multi-decode-and-view-or-save t t)) | |
711 | |
712 (defun gnus-uu-marked-multi-decode-and-save () | |
713 "This function lets the user decide what method to use for decoding. | |
714 Other than that, it's equivalent to the other marked decode-and-save | |
715 functions." | |
716 (interactive) | |
717 (gnus-uu-multi-decode-and-view-or-save t t)) | |
718 | |
719 (defun gnus-uu-multi-decode-and-view-or-save (view marked) | |
720 (let (decode-type) | |
721 (message "(u)udecode, (s)har, s(a)ve, (b)inhex: ") | |
722 (setq decode-type (read-char)) | |
723 (if (= decode-type ? | |
724 ) (setq decode-type ?u)) | |
725 (if (= decode-type ?u) | |
726 (gnus-uu-decode-and-view-or-save view marked) | |
727 (if (= decode-type ?s) | |
728 (gnus-uu-unshar-and-view-or-save view marked) | |
729 (if (= decode-type ?b) | |
730 (gnus-uu-binhex-and-save view marked) | |
731 (if (= decode-type ?a) | |
732 (gnus-uu-save-articles view marked) | |
733 (message (format "Unknown decode method '%c'." decode-type)) | |
734 (sit-for 2))))))) | |
735 | |
736 | |
737 ;; uuencode and post | |
738 | |
739 (defun gnus-uu-news-inews () | |
740 "Send a news message using inews." | |
741 (interactive) | |
742 (let* (newsgroups subject | |
743 (case-fold-search nil)) | |
744 (save-excursion | |
745 (save-restriction | |
746 (goto-char (point-min)) | |
747 (search-forward (concat "\n" mail-header-separator "\n")) | |
748 (narrow-to-region (point-min) (point)) | |
749 (setq newsgroups (mail-fetch-field "newsgroups") | |
750 subject (mail-fetch-field "subject"))) | |
751 (widen) | |
752 (goto-char (point-min)) | |
753 ; (run-hooks 'news-inews-hook) | |
754 (goto-char (point-min)) | |
755 (search-forward (concat "\n" mail-header-separator "\n")) | |
756 (replace-match "\n\n") | |
757 (goto-char (point-max)) | |
758 ;; require a newline at the end for inews to append .signature to | |
759 (or (= (preceding-char) ?\n) | |
760 (insert ?\n)) | |
761 (message "Posting to USENET...") | |
762 (call-process-region (point-min) (point-max) | |
763 news-inews-program nil 0 nil | |
764 "-h") ; take all header lines! | |
765 ;@@ setting of subject and newsgroups still needed? | |
766 ;"-t" subject | |
767 ;"-n" newsgroups | |
768 (message "Posting to USENET... done") | |
769 (goto-char (point-min)) ;restore internal header separator | |
770 (search-forward "\n\n") | |
771 (replace-match (concat "\n" mail-header-separator "\n"))))) | |
772 | |
773 (autoload 'news-inews "rnewspost") | |
774 | |
775 (defun gnus-uu-post-buffer (&optional first) | |
776 (append-to-file 1 (point-max) "/tmp/gnusuutull") | |
777 ; (if first | |
778 ; (news-inews) | |
779 ; (gnus-uu-news-inews)) | |
780 (message "posted")) | |
781 | |
782 (defconst gnus-uu-uuencode-post-length 20) | |
783 | |
784 (defun gnus-uu-uuencode-and-post () | |
785 (interactive) | |
786 (let (file uubuf sendbuf short-file length parts header i end beg | |
787 beg-line minlen) | |
788 (setq file (read-file-name | |
789 "What file do you want to uuencode and post? " "~/Unrd.jpg")) | |
790 (if (not (file-exists-p file)) | |
791 (message "%s: No such file" file) | |
792 (save-excursion | |
793 (setq uubuf (get-buffer-create "*uuencode buffer*")) | |
794 (setq sendbuf (get-buffer-create "*uuencode send buffer*")) | |
795 (set-buffer uubuf) | |
796 (erase-buffer) | |
797 (if (string-match "^~/" file) | |
798 (setq file (concat "$HOME" (substring file 1)))) | |
799 (if (string-match "/[^/]*$" file) | |
800 (setq short-file (substring file (1+ (match-beginning 0)))) | |
801 (setq short-file file)) | |
802 (call-process "sh" nil uubuf nil "-c" | |
803 (format "uuencode %s %s" file short-file)) | |
804 (goto-char 1) | |
805 (forward-line 1) | |
806 (while (re-search-forward " " nil t) | |
807 (replace-match "`")) | |
808 (setq length (count-lines 1 (point-max))) | |
809 (setq parts (/ length gnus-uu-uuencode-post-length)) | |
810 (if (not (< (% length gnus-uu-uuencode-post-length) 4)) | |
811 (setq parts (1+ parts))) | |
812 (message "Det er %d parts" parts)) | |
813 (goto-char 1) | |
814 (search-forward mail-header-separator nil t) | |
815 (beginning-of-line) | |
816 (forward-line 1) | |
817 (setq header (buffer-substring 1 (point))) | |
818 (goto-char 1) | |
819 (if (re-search-forward "^Subject: " nil t) | |
820 (progn | |
821 (end-of-line) | |
822 (insert (format " (0/%d)" parts)))) | |
823 (gnus-uu-post-buffer t) | |
824 (save-excursion | |
825 (set-buffer sendbuf) | |
826 (setq i 1) | |
827 (setq beg 1) | |
828 (while (not (> i parts)) | |
829 (set-buffer sendbuf) | |
830 (erase-buffer) | |
831 (insert header) | |
832 (insert "\n") | |
833 (setq minlen (/ (- 62 (length (format " (%d/%d) " i parts))) 2)) | |
834 (setq beg-line (format "[ cut here %s (%d/%d) %s gnus-uu ]\n" | |
835 (make-string (- minlen 11) ?-) i parts | |
836 (make-string (- minlen 10) ?-))) | |
837 (insert beg-line) | |
838 (goto-char 1) | |
839 (if (re-search-forward "^Subject: " nil t) | |
840 (progn | |
841 (end-of-line) | |
842 (insert (format " (%d/%d)" i parts)))) | |
843 (goto-char (point-max)) | |
844 (save-excursion | |
845 (set-buffer uubuf) | |
846 (goto-char beg) | |
847 (if (= i parts) | |
848 (goto-char (point-max)) | |
849 (forward-line gnus-uu-uuencode-post-length)) | |
850 (setq end (point))) | |
851 (insert-buffer-substring uubuf beg end) | |
852 (insert beg-line) | |
853 (setq beg end) | |
854 (setq i (1+ i)) | |
855 (gnus-uu-post-buffer))) | |
856 ))) | |
857 | |
858 | |
859 | |
860 ;; Decode and all files | |
861 | |
862 (defconst gnus-uu-rest-of-articles nil) | |
863 (defconst gnus-uu-do-sloppy-uudecode nil) | |
864 (defvar gnus-uu-current-save-dir nil "*") | |
865 | |
866 (defun gnus-uu-decode-and-save-all-unread-articles () | |
867 "This function reads all unread articles in the current group and | |
868 sees whether it can uudecode the articles. The user will be prompted | |
869 for an directory to put the resulting (if any) files." | |
870 (interactive) | |
871 (gnus-uu-decode-and-save-articles t t)) | |
872 | |
873 (defun gnus-uu-decode-and-save-all-articles () | |
874 "Does the same as gnus-uu-decode-and-save-all-unread-articles, except | |
875 that it grabs all articles visible, unread or not." | |
876 (interactive) | |
877 (gnus-uu-decode-and-save-articles nil t)) | |
878 | |
879 (defun gnus-uu-decode-and-save-all-unread-articles-and-mark () | |
880 "Does the same as gnus-uu-decode-and-save-all-unread-articles, except that | |
881 it marks everything as read, even if it couldn't decode the articles." | |
882 (interactive) | |
883 (gnus-uu-decode-and-save-articles t nil)) | |
884 | |
885 (defun gnus-uu-decode-and-save-all-articles-and-mark () | |
886 "Does the same as gnus-uu-decode-and-save-all-articles, except that | |
887 it marks everything as read, even if it couldn't decode the articles." | |
888 (interactive) | |
889 (gnus-uu-decode-and-save-articles nil nil)) | |
890 | |
891 (defun gnus-uu-decode-and-save-articles (&optional unread unmark) | |
892 (let ((gnus-uu-unmark-articles-not-decoded unmark) | |
893 (filest "") | |
894 where dir did unmark saved-list) | |
895 (setq gnus-uu-do-sloppy-uudecode t) | |
896 (setq dir (gnus-uu-read-directory "Where do you want the files? ")) | |
897 (message "Grabbing...") | |
898 (setq gnus-uu-rest-of-articles | |
899 (gnus-uu-get-list-of-articles "^." nil unread)) | |
900 (setq gnus-uu-file-name nil) | |
901 (while (and gnus-uu-rest-of-articles | |
902 (gnus-uu-grab-articles gnus-uu-rest-of-articles | |
903 'gnus-uu-uustrip-article-as)) | |
904 (if gnus-uu-file-name | |
905 (progn | |
906 (setq saved-list (cons gnus-uu-file-name saved-list)) | |
907 (rename-file (concat gnus-uu-tmp-dir gnus-uu-file-name) | |
908 (concat dir gnus-uu-file-name) t) | |
909 (setq did t) | |
910 (setq gnus-uu-file-name nil)))) | |
911 (if (not did) | |
912 () | |
913 (while saved-list | |
914 (setq filest (concat filest " " (car saved-list))) | |
915 (setq saved-list (cdr saved-list))) | |
916 (message "Saved%s" filest))) | |
917 (setq gnus-uu-do-sloppy-uudecode nil)) | |
918 | |
919 | |
920 ;; Work functions | |
921 | |
922 (defun gnus-uu-decode-and-view-or-save (view marked) | |
923 (gnus-uu-initialize) | |
924 (let (file decoded) | |
925 (save-excursion | |
926 (if (gnus-uu-decode-and-strip nil marked) | |
927 (progn | |
928 (setq decoded t) | |
929 (setq file (concat gnus-uu-tmp-dir gnus-uu-file-name)) | |
930 (if view | |
931 (gnus-uu-view-file file) | |
932 (gnus-uu-save-file file))))) | |
933 | |
934 (gnus-uu-summary-next-subject) | |
935 | |
936 (if (and gnus-uu-use-interactive-view view decoded) | |
937 (gnus-uu-do-interactive)) | |
938 | |
939 (if (or (not gnus-uu-use-interactive-view) (not decoded)) | |
940 (gnus-uu-clean-up)))) | |
941 | |
942 | |
943 (defun gnus-uu-unshar-and-view-or-save (view marked) | |
944 "Unshars and views/saves marked/unmarked articles." | |
945 (gnus-uu-initialize) | |
946 (let (tar-file files decoded) | |
947 (save-excursion | |
948 (setq gnus-uu-shar-directory | |
949 (make-temp-name (concat gnus-uu-tmp-dir "gnusuush"))) | |
950 (make-directory gnus-uu-shar-directory) | |
951 (gnus-uu-add-file gnus-uu-shar-directory) | |
952 (if (gnus-uu-decode-and-strip t marked) | |
953 (progn | |
954 (setq decoded t) | |
955 (setq files (directory-files gnus-uu-shar-directory t)) | |
956 (setq gnus-uu-generated-file-list | |
957 (append files gnus-uu-generated-file-list)) | |
958 (if (> (length files) 3) | |
959 (progn | |
960 (setq tar-file | |
961 (concat | |
962 (make-temp-name (concat gnus-uu-tmp-dir "gnusuuar")) | |
963 ".tar")) | |
964 (gnus-uu-add-file tar-file) | |
965 (call-process "sh" nil | |
966 (get-buffer-create gnus-uu-output-buffer-name) | |
967 nil "-c" | |
968 (format "cd %s ; tar cf %s * ; cd .. ; rm -r %s" | |
969 gnus-uu-shar-directory | |
970 tar-file | |
971 gnus-uu-shar-directory)) | |
972 (if view | |
973 (gnus-uu-view-file tar-file) | |
974 (gnus-uu-save-file tar-file))) | |
975 (if view | |
976 (gnus-uu-view-file (elt files 2)) | |
977 (gnus-uu-save-file (elt files 2))))))) | |
978 | |
979 (gnus-uu-summary-next-subject) | |
980 | |
981 (if (and gnus-uu-use-interactive-view view decoded) | |
982 (gnus-uu-do-interactive)) | |
983 | |
984 (if (or (not gnus-uu-use-interactive-view) (not decoded)) | |
985 (gnus-uu-clean-up)))) | |
986 | |
987 | |
988 (defconst gnus-uu-saved-article-name nil) | |
989 (defun gnus-uu-save-articles (view marked) | |
990 (let (list-of-articles) | |
991 (save-excursion | |
992 (if (not marked) | |
993 (setq list-of-articles (gnus-uu-get-list-of-articles)) | |
994 (setq list-of-articles (reverse gnus-uu-marked-article-list)) | |
995 (setq gnus-uu-marked-article-list nil)) | |
996 (if (not list-of-articles) | |
997 (progn | |
998 (message "No list of articles") | |
999 (sit-for 2)) | |
1000 (setq gnus-uu-saved-article-name | |
1001 (concat gnus-uu-tmp-dir | |
1002 (read-file-name "Enter file name: " gnus-newsgroup-name | |
1003 gnus-newsgroup-name))) | |
1004 (gnus-uu-add-file gnus-uu-saved-article-name) | |
1005 (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article) | |
1006 (gnus-uu-save-file gnus-uu-saved-article-name)) | |
1007 )))) | |
1008 | |
1009 | |
1010 (defun gnus-uu-save-article (buffer in-state) | |
1011 (save-excursion | |
1012 (set-buffer buffer) | |
1013 (call-process-region | |
1014 1 (point-max) "sh" nil (get-buffer-create gnus-uu-output-buffer-name) | |
1015 nil "-c" (concat "cat >> " gnus-uu-saved-article-name))) | |
1016 'ok) | |
1017 | |
1018 | |
1019 ;; Binhex | |
1020 (defconst gnus-uu-binhex-body-line | |
1021 "^................................................................$") | |
1022 (defconst gnus-uu-binhex-begin-line | |
1023 "^:...............................................................$") | |
1024 (defconst gnus-uu-binhex-end-line | |
1025 ":$") | |
1026 (defvar gnus-uu-binhex-article-name nil) | |
1027 | |
1028 | |
1029 (defun gnus-uu-binhex-and-save (view marked) | |
1030 (let (list-of-articles) | |
1031 (save-excursion | |
1032 (if (not marked) | |
1033 (setq list-of-articles (gnus-uu-get-list-of-articles)) | |
1034 (setq list-of-articles (reverse gnus-uu-marked-article-list)) | |
1035 (setq gnus-uu-marked-article-list nil)) | |
1036 ' (setq gn-dummy-l list-of-articles) | |
1037 (if (not list-of-articles) | |
1038 (progn | |
1039 (message "No list of articles") | |
1040 (sit-for 2)) | |
1041 (setq gnus-uu-binhex-article-name | |
1042 (concat gnus-uu-tmp-dir | |
1043 (read-file-name "Enter binhex file name: " | |
1044 gnus-newsgroup-name | |
1045 gnus-newsgroup-name))) | |
1046 (gnus-uu-add-file gnus-uu-binhex-article-name) | |
1047 (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-binhex-article) | |
1048 (gnus-uu-save-file gnus-uu-binhex-article-name)) | |
1049 )))) | |
1050 | |
1051 | |
1052 (defun gnus-uu-binhex-article (buffer in-state) | |
1053 (let ((state 'ok) | |
1054 start-char) | |
1055 (save-excursion | |
1056 (set-buffer buffer) | |
1057 (goto-char 1) | |
1058 (if (not (re-search-forward (concat gnus-uu-binhex-begin-line "\\|" | |
1059 gnus-uu-binhex-body-line) nil t)) | |
1060 (setq state 'wrong-type) | |
1061 (beginning-of-line) | |
1062 (setq start-char (point)) | |
1063 (if (looking-at gnus-uu-binhex-begin-line) | |
1064 (setq state 'begin) | |
1065 (setq state 'middle)) | |
1066 (goto-char (point-max)) | |
1067 (re-search-backward (concat gnus-uu-binhex-body-line "\\|" | |
1068 gnus-uu-binhex-end-line) nil t) | |
1069 (if (looking-at gnus-uu-binhex-end-line) | |
1070 (if (eq state 'begin) | |
1071 (setq state 'begin-and-end) | |
1072 (setq state 'end))) | |
1073 (beginning-of-line) | |
1074 (forward-line 1) | |
1075 (append-to-file start-char (point) gnus-uu-binhex-article-name))) | |
1076 state)) | |
1077 | |
1078 | |
1079 ;; Internal view commands | |
1080 | |
1081 (defun gnus-uu-view-file (file-name &optional dont-ask) | |
1082 "This function takes two parameters. The first is name of the file to be | |
1083 viewed. gnus-uu-view-file will look for an action associated with the file | |
1084 type of the file. If it finds an appropriate action, the file will be | |
1085 attempted displayed. | |
1086 | |
1087 The second parameter specifies if the user is to be asked whether to | |
1088 save the file if viewing is unsuccessful. `t' means 'do not ask.' | |
1089 | |
1090 Note that the file given will be deleted by this function, one way or | |
1091 another. If `gnus-uu-asynchronous' is set, it won't be deleted right | |
1092 away, but sometime later. If the user is offered to save the file, it'll | |
1093 be moved to wherever the user wants it. | |
1094 | |
1095 gnus-uu-view-file returns `t' if viewing is successful." | |
1096 (let (action did-view | |
1097 (didnt-want t) | |
1098 (do-view t)) | |
1099 (setq action | |
1100 (gnus-uu-choose-action | |
1101 file-name | |
1102 (append | |
1103 (if (and gnus-uu-use-interactive-view | |
1104 gnus-uu-user-interactive-view-rules) | |
1105 gnus-uu-user-interactive-view-rules | |
1106 gnus-uu-user-view-rules) | |
1107 (if (or gnus-uu-ignore-default-view-rules | |
1108 (not gnus-uu-use-interactive-view)) | |
1109 () | |
1110 gnus-uu-default-interactive-view-rules-begin) | |
1111 (if gnus-uu-ignore-default-view-rules | |
1112 nil | |
1113 gnus-uu-default-view-rules) | |
1114 (if (and gnus-uu-use-interactive-view | |
1115 gnus-uu-user-interactive-view-rules-end) | |
1116 gnus-uu-user-interactive-view-rules-end | |
1117 gnus-uu-user-view-rules-end)))) | |
1118 | |
1119 (if (and gnus-uu-use-interactive-view | |
1120 (not (string= (or action "") "gnus-uu-archive"))) | |
1121 (gnus-uu-enter-interactive-file (or action "") file-name) | |
1122 | |
1123 (if action | |
1124 (if (string= action "gnus-uu-archive") | |
1125 (setq did-view (gnus-uu-treat-archive file-name)) | |
1126 | |
1127 (if gnus-uu-ask-before-view | |
1128 (setq didnt-want | |
1129 (or (not | |
1130 (setq do-view | |
1131 (y-or-n-p | |
1132 (format "Do you want to view %s? " | |
1133 file-name)))) | |
1134 didnt-want))) | |
1135 | |
1136 (if do-view | |
1137 (setq did-view | |
1138 (if gnus-uu-asynchronous | |
1139 (gnus-uu-call-asynchronous file-name action) | |
1140 (gnus-uu-call-synchronous file-name action)))))) | |
1141 | |
1142 (if (and (not dont-ask) (not gnus-uu-use-interactive-view)) | |
1143 (progn | |
1144 (if (and | |
1145 didnt-want | |
1146 (or (not action) | |
1147 (and (string= action "gnus-uu-archive") (not did-view)))) | |
1148 (progn | |
1149 (message (format "Could find no rule for %s" file-name)) | |
1150 (sit-for 2))) | |
1151 (and (or (not did-view) gnus-uu-view-and-save) | |
1152 (y-or-n-p | |
1153 (format "Do you want to save the file %s? " file-name)) | |
1154 (gnus-uu-save-file file-name)))) | |
1155 | |
1156 (if (and (file-exists-p file-name) | |
1157 (not gnus-uu-use-interactive-view) | |
1158 (or | |
1159 (not (and gnus-uu-asynchronous did-view)) | |
1160 (string= action "gnus-uu-archive"))) | |
1161 (delete-file file-name))) | |
1162 | |
1163 did-view)) | |
1164 | |
1165 | |
1166 (defun gnus-uu-call-synchronous (file-name action) | |
1167 "Takes two parameters: The name of the file to be displayed and | |
1168 the command to display it with. Returns `t' on success and `nil' if | |
1169 the file couldn't be displayed." | |
1170 (let (did-view command) | |
1171 (save-excursion | |
1172 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) | |
1173 (erase-buffer) | |
1174 (if (string-match "%s" action) | |
1175 (setq command (format action (concat "'" file-name "'"))) | |
1176 (setq command (concat action " " (concat "'" file-name "'")))) | |
1177 (message (format "Viewing with '%s'" command)) | |
1178 (if (not (= 0 (call-process "sh" nil t nil "-c" command))) | |
1179 (progn | |
1180 (goto-char 1) | |
1181 (while (re-search-forward "\n" nil t) | |
1182 (replace-match " ")) | |
1183 (message (concat "Error: " (buffer-substring 1 (point-max)))) | |
1184 (sit-for 2)) | |
1185 (message "") | |
1186 (setq did-view t))) | |
1187 did-view)) | |
1188 | |
1189 | |
1190 (defun gnus-uu-call-asynchronous (file-name action) | |
1191 "Takes two parameters: The name of the file to be displayed and | |
1192 the command to display it with. Since the view command is executed | |
1193 asynchronously, it's kinda hard to decide whether the command succeded | |
1194 or not, so this function always returns `t'. It also adds \"; rm -f | |
1195 file-name\" to the end of the execution string, so the file will be | |
1196 removed after viewing has ended." | |
1197 (let (command file tmp-file start) | |
1198 (while (string-match "/" file-name start) | |
1199 (setq start (1+ (match-beginning 0)))) | |
1200 (setq file (substring file-name start)) | |
1201 (setq tmp-file (concat gnus-uu-tmp-dir file)) | |
1202 (if (string= tmp-file file-name) | |
1203 () | |
1204 (rename-file file-name tmp-file t) | |
1205 (setq file-name tmp-file)) | |
1206 | |
1207 (if (string-match "%s" action) | |
1208 (setq command (format action file-name)) | |
1209 (setq command (concat action " " file-name))) | |
1210 (setq command (format "%s ; rm -f %s" command file-name)) | |
1211 (message (format "Viewing with %s" command)) | |
1212 (start-process "gnus-uu-view" | |
1213 nil "sh" "-c" command) | |
1214 t)) | |
1215 | |
1216 | |
1217 (defun gnus-uu-decode-and-strip (&optional shar use-marked) | |
1218 "This function does all the main work. It finds out what articles | |
1219 to grab, grabs them, strips the result and decodes. If any of | |
1220 these operations fail, it returns `nil', `t' otherwise. | |
1221 If shar is `t', it will pass this on to gnus-uu-grab-articles | |
1222 who will (probably) unshar the articles. If use-marked | |
1223 is non-nil, it won't try to find articles, but use the marked list." | |
1224 (let (list-of-articles) | |
1225 (save-excursion | |
1226 | |
1227 (if use-marked | |
1228 (progn (if (eq gnus-uu-marked-article-list ()) | |
1229 (message "No articles marked") | |
1230 (setq list-of-articles (reverse gnus-uu-marked-article-list)) | |
1231 (gnus-uu-unmark-all-articles))) | |
1232 (setq list-of-articles (gnus-uu-get-list-of-articles))) | |
1233 | |
1234 (and list-of-articles | |
1235 (gnus-uu-grab-articles list-of-articles | |
1236 (if shar | |
1237 'gnus-uu-unshar-article | |
1238 'gnus-uu-uustrip-article-as)))))) | |
1239 | |
1240 | |
1241 (defun gnus-uu-reginize-string (string) | |
1242 "Takes a string and puts a \\ in front of every special character; | |
1243 ignores any leading \"version numbers\" | |
1244 thingies that they use in the comp.binaries groups, and either replaces | |
1245 anything that looks like \"2/3\" with \"[0-9]+/[0-9]+\" or, if it can't find | |
1246 something like that, replaces the last two numbers with \"[0-9]+\". This, | |
1247 in my experience, should get most postings of a series." | |
1248 (let ((count 2) | |
1249 (vernum "v[0-9][0-9][a-z][0-9]+:") | |
1250 reg beg) | |
1251 (save-excursion | |
1252 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) | |
1253 (erase-buffer) | |
1254 (insert (regexp-quote string)) | |
1255 (setq beg 1) | |
1256 | |
1257 (setq case-fold-search nil) | |
1258 (goto-char 1) | |
1259 (if (looking-at vernum) | |
1260 (progn | |
1261 (replace-match vernum t t) | |
1262 (setq beg (length vernum)))) | |
1263 | |
1264 (goto-char beg) | |
1265 (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) | |
1266 (replace-match " [0-9]+/[0-9]+") | |
1267 | |
1268 (goto-char beg) | |
1269 (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) | |
1270 (replace-match "[0-9]+ of [0-9]+") | |
1271 | |
1272 (end-of-line) | |
1273 (while (and (re-search-backward "[0-9]" nil t) (> count 0)) | |
1274 (while (and | |
1275 (looking-at "[0-9]") | |
1276 (< 1 (goto-char (1- (point)))))) | |
1277 (re-search-forward "[0-9]+" nil t) | |
1278 (replace-match "[0-9]+") | |
1279 (backward-char 5) | |
1280 (setq count (1- count))))) | |
1281 | |
1282 (goto-char beg) | |
1283 (while (re-search-forward "[ \t]+" nil t) | |
1284 (replace-match "[ \t]*" t t)) | |
1285 | |
1286 (buffer-substring 1 (point-max))))) | |
1287 | |
1288 | |
1289 (defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread) | |
1290 "Finds all articles that matches the regular expression given. | |
1291 Returns the resulting list." | |
1292 (let (beg end reg-subject list-of-subjects list-of-numbers art-num) | |
1293 (save-excursion | |
1294 | |
1295 ; If the subject is not given, this function looks at the current subject | |
1296 ; and takes that. | |
1297 | |
1298 (if subject | |
1299 (setq reg-subject subject) | |
1300 (end-of-line) | |
1301 (setq end (point)) | |
1302 (beginning-of-line) | |
1303 (if (not (re-search-forward "\\] " end t)) | |
1304 (progn (message "No valid subject chosen") (sit-for 2)) | |
1305 (setq subject (buffer-substring (point) end)) | |
1306 (setq reg-subject | |
1307 (concat "\\[.*\\] " (gnus-uu-reginize-string subject))))) | |
1308 | |
1309 ; (message reg-subject)(sleep-for 2) | |
1310 | |
1311 (if reg-subject | |
1312 (progn | |
1313 | |
1314 ; Collect all subjects matching reg-subject. | |
1315 | |
1316 (let ((case-fold-search t)) | |
1317 (setq case-fold-search t) | |
1318 (goto-char 1) | |
1319 (while (re-search-forward reg-subject nil t) | |
1320 (beginning-of-line) | |
1321 (setq beg (point)) | |
1322 (if (or (not only-unread) (looking-at " \\|-")) | |
1323 (progn | |
1324 (end-of-line) | |
1325 (setq list-of-subjects (cons | |
1326 (buffer-substring beg (point)) | |
1327 list-of-subjects))) | |
1328 (end-of-line)))) | |
1329 | |
1330 ; Expand all numbers in all the subjects: (hi9 -> hi0009, etc). | |
1331 | |
1332 (setq list-of-subjects (gnus-uu-expand-numbers list-of-subjects)) | |
1333 | |
1334 ; Sort the subjects. | |
1335 | |
1336 (setq list-of-subjects (sort list-of-subjects 'gnus-uu-string<)) | |
1337 | |
1338 ; Get the article numbers from the sorted list of subjects. | |
1339 | |
1340 (while list-of-subjects | |
1341 (setq art-num (gnus-uu-article-number (car list-of-subjects))) | |
1342 (if mark-articles (gnus-summary-mark-as-read art-num ?#)) | |
1343 (setq list-of-numbers (cons art-num list-of-numbers)) | |
1344 (setq list-of-subjects (cdr list-of-subjects))) | |
1345 | |
1346 (setq list-of-numbers (nreverse list-of-numbers)) | |
1347 | |
1348 (if (not list-of-numbers) | |
1349 (progn | |
1350 (message (concat "No subjects matched " subject)) | |
1351 (sit-for 2))))) | |
1352 | |
1353 list-of-numbers))) | |
1354 | |
1355 | |
1356 (defun gnus-uu-expand-numbers (string-list) | |
1357 "Takes a list of strings and \"expands\" all numbers in all the strings. | |
1358 That is, this function makes all numbers equal length by prepending lots | |
1359 of zeroes before each number. This is to ease later sorting to find out | |
1360 what sequence the articles are supposed to be decoded in. Returns the list | |
1361 of expanded strings." | |
1362 (let (string out-list pos num) | |
1363 (save-excursion | |
1364 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) | |
1365 (while string-list | |
1366 (erase-buffer) | |
1367 (setq string (car string-list)) | |
1368 (setq string-list (cdr string-list)) | |
1369 (insert string) | |
1370 (goto-char 1) | |
1371 (while (re-search-forward "[ \t]+" nil t) | |
1372 (replace-match " ")) | |
1373 (goto-char 1) | |
1374 (while (re-search-forward "[A-Za-z]" nil t) | |
1375 (replace-match "a" t t)) | |
1376 | |
1377 (goto-char 1) | |
1378 (if (not (search-forward "] " nil t)) | |
1379 () | |
1380 (while (re-search-forward "[0-9]+" nil t) | |
1381 (replace-match | |
1382 (format "%06d" | |
1383 (string-to-int (buffer-substring | |
1384 (match-beginning 0) (match-end 0)))))) | |
1385 (setq string (buffer-substring 1 (point-max))) | |
1386 (setq out-list (cons string out-list))))) | |
1387 out-list)) | |
1388 | |
1389 | |
1390 (defun gnus-uu-string< (string1 string2) | |
1391 "Used in a sort for finding out what string is bigger, but ignoring | |
1392 everything before the subject part." | |
1393 (string< (substring string1 (string-match "\\] " string1)) | |
1394 (substring string2 (string-match "\\] " string2)))) | |
1395 | |
1396 | |
1397 ;; gnus-uu-grab-article | |
1398 ;; | |
1399 ;; This is the general multi-article treatment function. | |
1400 ;; It takes a list of articles to be grabbed and a function | |
1401 ;; to apply to each article. It puts the result in | |
1402 ;; gnus-uu-result-buffer. | |
1403 ;; | |
1404 ;; The function to be called should take two parameters. | |
1405 ;; The first is the buffer that has the article that should | |
1406 ;; be treated. The function should leave the result in this | |
1407 ;; buffer as well. This result is then appended on to the | |
1408 ;; gnus-uu-result-buffer. | |
1409 ;; The second parameter is the state of the list of articles, | |
1410 ;; and can have three values: 'start, 'middle and 'end. | |
1411 ;; The function can have several return values. | |
1412 ;; 'error if there was an error while treating. | |
1413 ;; 'end if the last article has been sighted. | |
1414 ;; 'begin-and-end if the article is both the beginning and | |
1415 ;; the end. All these three return values results in | |
1416 ;; gnus-uu-grab-articles stopping traversing of the list | |
1417 ;; of articles. | |
1418 ;; 'middle if the article is a "middle" article. | |
1419 ;; 'ok if everything is ok. | |
1420 | |
1421 (defvar gnus-uu-has-been-grabbed nil) | |
1422 | |
1423 (defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) | |
1424 (let (art) | |
1425 (if (or (not gnus-uu-has-been-grabbed) | |
1426 (not gnus-uu-unmark-articles-not-decoded)) | |
1427 () | |
1428 (if dont-unmark-last-article | |
1429 (progn | |
1430 (setq art (car gnus-uu-has-been-grabbed)) | |
1431 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))) | |
1432 (while gnus-uu-has-been-grabbed | |
1433 (gnus-summary-mark-as-unread (car gnus-uu-has-been-grabbed) t) | |
1434 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) | |
1435 (if dont-unmark-last-article | |
1436 (setq gnus-uu-has-been-grabbed (list art))) | |
1437 ))) | |
1438 | |
1439 | |
1440 (defun gnus-uu-grab-articles (list-of-articles process-function) | |
1441 "This function takes a list of articles and a function to apply | |
1442 to each article grabbed. The result of the function is appended | |
1443 on to gnus-uu-result-buffer. | |
1444 | |
1445 This function returns `t' if the grabbing and the process-function | |
1446 has been successful and `nil' otherwise." | |
1447 (let ((result-buffer (get-buffer-create gnus-uu-result-buffer)) | |
1448 (state 'first) | |
1449 (process-state 'ok) | |
1450 (result t) | |
1451 (wrong-type t) | |
1452 (has-been-begin nil) | |
1453 (article nil)) | |
1454 | |
1455 (save-excursion | |
1456 (set-buffer result-buffer) | |
1457 (erase-buffer)) | |
1458 (setq gnus-uu-has-been-grabbed nil) | |
1459 (while (and list-of-articles | |
1460 (not (eq process-state 'end)) | |
1461 (not (eq process-state 'begin-and-end)) | |
1462 (not (eq process-state 'error))) | |
1463 (setq article (car list-of-articles)) | |
1464 (setq list-of-articles (cdr list-of-articles)) | |
1465 (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) | |
1466 | |
1467 (if (eq list-of-articles ()) (setq state 'last)) | |
1468 | |
1469 (message (format "Getting article %d" article)) | |
1470 (if (not (= (or gnus-current-article 0) article)) | |
1471 (gnus-summary-display-article article)) | |
1472 (gnus-summary-mark-as-read article) | |
1473 | |
1474 (save-excursion | |
1475 (set-buffer gnus-article-buffer) | |
1476 (widen)) | |
1477 | |
1478 (setq process-state (funcall process-function gnus-article-buffer state)) | |
1479 | |
1480 (if (or (eq process-state 'begin) (eq process-state 'begin-and-end) | |
1481 (eq process-state 'ok)) | |
1482 (setq has-been-begin t)) | |
1483 | |
1484 (if (not (eq process-state 'wrong-type)) | |
1485 (setq wrong-type nil) | |
1486 (if gnus-uu-unmark-articles-not-decoded | |
1487 (gnus-summary-mark-as-unread article t))) | |
1488 | |
1489 (if gnus-uu-do-sloppy-uudecode | |
1490 (setq wrong-type nil)) | |
1491 | |
1492 (if (and (not has-been-begin) | |
1493 (not gnus-uu-do-sloppy-uudecode) | |
1494 (or (eq process-state 'end) | |
1495 (eq process-state 'middle))) | |
1496 (progn | |
1497 (setq process-state 'error) | |
1498 (message "No begin part at the beginning") | |
1499 (sit-for 2)) | |
1500 (setq state 'middle))) | |
1501 | |
1502 (if (and (not has-been-begin) (not gnus-uu-do-sloppy-uudecode)) | |
1503 (progn | |
1504 (setq result nil) | |
1505 (message "Wrong type file") | |
1506 (sit-for 2)) | |
1507 (if (eq process-state 'error) | |
1508 (setq result nil) | |
1509 (if (not (or (eq process-state 'ok) | |
1510 (eq process-state 'end) | |
1511 (eq process-state 'begin-and-end))) | |
1512 (progn | |
1513 (if (not gnus-uu-do-sloppy-uudecode) | |
1514 (progn | |
1515 (message "End of articles reached before end of file") | |
1516 (sit-for 2))) | |
1517 (gnus-uu-unmark-list-of-grabbed) | |
1518 (setq result nil))))) | |
1519 (setq gnus-uu-rest-of-articles list-of-articles) | |
1520 result)) | |
1521 | |
1522 | |
1523 (defun gnus-uu-uudecode-sentinel (process event) | |
1524 ; (message "Process '%s' has received event '%s'" process event) | |
1525 ; (sit-for 2) | |
1526 (delete-process (get-process process))) | |
1527 | |
1528 | |
1529 (defun gnus-uu-uustrip-article-as (process-buffer in-state) | |
1530 (let ((state 'ok) | |
1531 (process-connection-type nil) | |
1532 start-char pst name-beg name-end buf-state) | |
1533 (save-excursion | |
1534 (set-buffer process-buffer) | |
1535 (setq buf-state buffer-read-only) | |
1536 (setq buffer-read-only nil) | |
1537 | |
1538 (goto-char 1) | |
1539 | |
1540 (if gnus-uu-kill-carriage-return | |
1541 (progn | |
1542 (while (search-forward " | |
1543 " nil t) | |
1544 (delete-backward-char 1)) | |
1545 (goto-char 1))) | |
1546 | |
1547 (if (not (re-search-forward | |
1548 (concat gnus-uu-begin-string "\\|" gnus-uu-body-line) nil t)) | |
1549 (setq state 'wrong-type) | |
1550 | |
1551 (beginning-of-line) | |
1552 (setq start-char (point)) | |
1553 | |
1554 (if (looking-at gnus-uu-begin-string) | |
1555 (progn | |
1556 (setq name-end (match-end 1)) | |
1557 (goto-char (setq name-beg (match-beginning 1))) | |
1558 (while (re-search-forward "/" name-end t) | |
1559 (replace-match "-")) | |
1560 (setq gnus-uu-file-name (buffer-substring name-beg name-end)) | |
1561 (setq pst (process-status | |
1562 (or gnus-uu-uudecode-process "nevair"))) | |
1563 (if (or (eq pst 'stop) (eq pst 'run)) | |
1564 (progn | |
1565 (delete-process gnus-uu-uudecode-process) | |
1566 (gnus-uu-unmark-list-of-grabbed t))) | |
1567 (setq gnus-uu-uudecode-process | |
1568 (start-process | |
1569 "*uudecode*" | |
1570 (get-buffer-create gnus-uu-output-buffer-name) | |
1571 "sh" "-c" | |
1572 (format "cd %s ; uudecode" gnus-uu-tmp-dir))) | |
1573 (set-process-sentinel | |
1574 gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) | |
1575 (setq state 'begin) | |
1576 (gnus-uu-add-file (concat gnus-uu-tmp-dir gnus-uu-file-name))) | |
1577 (setq state 'middle)) | |
1578 | |
1579 (goto-char (point-max)) | |
1580 (re-search-backward | |
1581 (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) | |
1582 (if (looking-at gnus-uu-end-string) | |
1583 (if (eq state 'begin) | |
1584 (setq state 'begin-and-end) | |
1585 (setq state 'end))) | |
1586 (forward-line 1) | |
1587 | |
1588 (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) | |
1589 (if (or (eq pst 'run) (eq pst 'stop)) | |
1590 (progn | |
1591 (gnus-uu-check-correct-stripped-uucode start-char (point)) | |
1592 (condition-case err | |
1593 (process-send-region gnus-uu-uudecode-process start-char | |
1594 (point)) | |
1595 (error | |
1596 (progn | |
1597 (setq state 'wrong-type) | |
1598 (delete-process gnus-uu-uudecode-process))))) | |
1599 (setq state 'wrong-type))) | |
1600 (setq buffer-read-only buf-state)) | |
1601 state)) | |
1602 | |
1603 | |
1604 (defun gnus-uu-unshar-article (process-buffer in-state) | |
1605 "This function is used by gnus-uu-grab-articles to treat | |
1606 a shared article." | |
1607 (let ((state 'ok) | |
1608 start-char) | |
1609 (save-excursion | |
1610 (set-buffer process-buffer) | |
1611 (goto-char 1) | |
1612 (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) | |
1613 (setq state 'wrong-type) | |
1614 (beginning-of-line) | |
1615 (setq start-char (point)) | |
1616 (call-process-region | |
1617 start-char (point-max) "sh" nil | |
1618 (get-buffer-create gnus-uu-output-buffer-name) nil | |
1619 "-c" (concat "cd " gnus-uu-shar-directory " ; sh")))) | |
1620 state)) | |
1621 | |
1622 | |
1623 (defun gnus-uu-find-name-in-shar () | |
1624 "Returns the name of what the shar file is going to unpack." | |
1625 (let ((oldpoint (point)) | |
1626 res) | |
1627 (goto-char 1) | |
1628 (if (re-search-forward gnus-uu-shar-name-marker nil t) | |
1629 (setq res (buffer-substring (match-beginning 1) (match-end 1)))) | |
1630 (goto-char oldpoint) | |
1631 res)) | |
1632 | |
1633 | |
1634 (defun gnus-uu-article-number (subject) | |
1635 "Returns the article number of the given subject." | |
1636 (let (end) | |
1637 (string-match "[0-9]+[^0-9]" subject 1) | |
1638 (setq end (match-end 0)) | |
1639 (string-to-int | |
1640 (substring subject (string-match "[0-9]" subject 1) end)))) | |
1641 | |
1642 | |
1643 (defun gnus-uu-decode (directory) | |
1644 "UUdecodes everything in the buffer and returns the name of the resulting | |
1645 file." | |
1646 (let ((command (concat "cd " directory " ; uudecode")) | |
1647 file-name) | |
1648 (save-excursion | |
1649 (message "Uudecoding...") | |
1650 (set-buffer (get-buffer-create gnus-uu-result-buffer)) | |
1651 (setq file-name (concat gnus-uu-tmp-dir gnus-uu-file-name)) | |
1652 (gnus-uu-add-file file-name) | |
1653 (call-process-region 1 (point-max) "sh" nil t nil "-c" command) | |
1654 file-name))) | |
1655 | |
1656 | |
1657 (defun gnus-uu-choose-action (file-name file-action-list) | |
1658 "Chooses what action to perform given the name and gnus-uu-file-action-list. | |
1659 Returns either nil if no action is found, or the name of the command | |
1660 to run if such a rule is found." | |
1661 (let ((action-list (copy-sequence file-action-list)) | |
1662 rule action) | |
1663 (while (not (or (eq action-list ()) action)) | |
1664 (setq rule (car action-list)) | |
1665 (setq action-list (cdr action-list)) | |
1666 (if (string-match (car rule) file-name) | |
1667 (setq action (car (cdr rule))))) | |
1668 action)) | |
1669 | |
1670 | |
1671 (defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing) | |
1672 "Moves the file from the tmp directory to where the user wants it." | |
1673 (let (dir file-name command) | |
1674 (string-match "/[^/]*$" from-file-name) | |
1675 (setq file-name (substring from-file-name (1+ (match-beginning 0)))) | |
1676 (if default-dir | |
1677 (setq dir default-dir) | |
1678 (setq dir (gnus-uu-read-directory "Where do you want the file? "))) | |
1679 (if (and (not ignore-existing) (file-exists-p (concat dir file-name))) | |
1680 (progn | |
1681 (message (concat "There already is a file called " file-name)) | |
1682 (sit-for 2) | |
1683 (setq file-name | |
1684 (read-file-name "Give a new name: " dir (concat dir file-name) | |
1685 nil file-name))) | |
1686 (setq file-name (concat dir file-name))) | |
1687 (rename-file from-file-name file-name t))) | |
1688 | |
1689 | |
1690 (defun gnus-uu-read-directory (prompt &optional default) | |
1691 (let (dir ok create) | |
1692 (while (not ok) | |
1693 (setq ok t) | |
1694 (setq dir (if default default | |
1695 (read-file-name prompt gnus-uu-current-save-dir | |
1696 gnus-uu-current-save-dir))) | |
1697 (while (string-match "/$" dir) | |
1698 (setq dir (substring dir 0 (match-beginning 0)))) | |
1699 (if (file-exists-p dir) | |
1700 (if (not (file-directory-p dir)) | |
1701 (progn | |
1702 (setq ok nil) | |
1703 (message "%s is a file" dir) | |
1704 (sit-for 2))) | |
1705 (setq create ?o) | |
1706 (while (not (or (= create ?y) (= create ?n))) | |
1707 (message "%s: No such directory. Do you want to create it? (y/n)" | |
1708 dir) | |
1709 (setq create (read-char))) | |
1710 (if (= create ?y) (make-directory dir)))) | |
1711 (setq gnus-uu-current-save-dir (concat dir "/")))) | |
1712 | |
1713 | |
1714 (defun gnus-uu-treat-archive (file-name) | |
1715 "Unpacks an archive and views all the files in it. Returns `t' if | |
1716 viewing one or more files is successful." | |
1717 (let ((arc-dir (make-temp-name | |
1718 (concat gnus-uu-tmp-dir "gnusuu"))) | |
1719 action command files file did-view short-file-name | |
1720 error-during-unarching) | |
1721 (setq action (gnus-uu-choose-action | |
1722 file-name (append gnus-uu-user-archive-rules | |
1723 (if gnus-uu-ignore-default-archive-rules | |
1724 nil | |
1725 gnus-uu-default-archive-rules)))) | |
1726 (if (not action) | |
1727 (progn (message (format "No unpackers for the file %s" file-name)) | |
1728 (sit-for 2)) | |
1729 (string-match "/[^/]*$" file-name) | |
1730 (setq short-file-name (substring file-name (1+ (match-beginning 0)))) | |
1731 (setq command (format "%s %s %s ; cd %s ; %s %s " | |
1732 (if (or (string= action "uncompress") | |
1733 (string= action "gunzip")) | |
1734 "cp" | |
1735 "mv") | |
1736 file-name arc-dir | |
1737 arc-dir | |
1738 action short-file-name)) | |
1739 | |
1740 (make-directory arc-dir) | |
1741 (gnus-uu-add-file arc-dir) | |
1742 | |
1743 (save-excursion | |
1744 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) | |
1745 (erase-buffer)) | |
1746 | |
1747 (message (format "Unpacking with %s..." action)) | |
1748 | |
1749 (if (= 0 (call-process "sh" nil | |
1750 (get-buffer-create gnus-uu-output-buffer-name) | |
1751 nil "-c" command)) | |
1752 (message "") | |
1753 (message "Error during unpacking of archive") | |
1754 (sit-for 2) | |
1755 (sit-for 2) | |
1756 (setq error-during-unarching t)) | |
1757 | |
1758 (if (not (or (string= action "uncompress") | |
1759 (string= action "gunzip"))) | |
1760 (call-process "sh" nil (get-buffer gnus-uu-output-buffer-name) | |
1761 nil "-c" (format "mv %s/%s %s" | |
1762 arc-dir short-file-name | |
1763 gnus-uu-tmp-dir))) | |
1764 (gnus-uu-add-file (concat gnus-uu-tmp-dir short-file-name)) | |
1765 | |
1766 (setq did-view | |
1767 (or (gnus-uu-show-directory arc-dir gnus-uu-use-interactive-view) | |
1768 did-view)) | |
1769 | |
1770 (if (and (not gnus-uu-use-interactive-view) | |
1771 (file-directory-p arc-dir)) | |
1772 (delete-directory arc-dir))) | |
1773 | |
1774 did-view)) | |
1775 | |
1776 | |
1777 (defun gnus-uu-show-directory (dir &optional dont-delete-files) | |
1778 "Tries to view all the files in the given directory. Returns `t' if | |
1779 viewing one or more files is successful." | |
1780 (let (files file did-view) | |
1781 (setq files (directory-files dir t)) | |
1782 (setq gnus-uu-generated-file-list | |
1783 (append files gnus-uu-generated-file-list)) | |
1784 (while files | |
1785 (setq file (car files)) | |
1786 (setq files (cdr files)) | |
1787 (if (and (not (string-match "/\\.$" file)) | |
1788 (not (string-match "/\\.\\.$" file))) | |
1789 (progn | |
1790 (set-file-modes file 448) | |
1791 (if (file-directory-p file) | |
1792 (setq did-view (or (gnus-uu-show-directory file | |
1793 dont-delete-files) | |
1794 did-view)) | |
1795 (setq did-view (or (gnus-uu-view-file file t) did-view)) | |
1796 (if (and (not dont-delete-files) (file-exists-p file)) | |
1797 (delete-file file)))))) | |
1798 (if (not dont-delete-files) (delete-directory dir)) | |
1799 did-view)) | |
1800 | |
1801 | |
1802 ;; Manual marking | |
1803 | |
1804 (defun gnus-uu-enter-mark-in-list () | |
1805 (let (article beg) | |
1806 (beginning-of-line) | |
1807 (setq beg (point)) | |
1808 (end-of-line) | |
1809 (setq article (gnus-uu-article-number | |
1810 (buffer-substring beg (point)))) | |
1811 (message (format "Adding article %d to list" article)) | |
1812 (setq gnus-uu-marked-article-list | |
1813 (cons article gnus-uu-marked-article-list)))) | |
1814 | |
1815 (defun gnus-uu-mark-article () | |
1816 "Marks the current article to be decoded later." | |
1817 (interactive) | |
1818 (gnus-uu-enter-mark-in-list) | |
1819 (gnus-summary-mark-as-read nil ?#) | |
1820 (gnus-summary-next-subject 1 nil)) | |
1821 | |
1822 (defun gnus-uu-unmark-article () | |
1823 "Unmarks the current article." | |
1824 (interactive) | |
1825 (let ((in (copy-sequence gnus-uu-marked-article-list)) | |
1826 out article beg found | |
1827 (old-point (point))) | |
1828 (beginning-of-line) | |
1829 (setq beg (point)) | |
1830 (end-of-line) | |
1831 (setq article (gnus-uu-article-number (buffer-substring beg (point)))) | |
1832 (message (format "Removing article %d" article)) | |
1833 (while in | |
1834 (if (not (= (car in) article)) | |
1835 (setq out (cons (car in) out)) | |
1836 (setq found t) | |
1837 (message (format "Removing article %d" article))) | |
1838 (setq in (cdr in))) | |
1839 (if (not found) (message "Not a marked article.")) | |
1840 (setq gnus-uu-marked-article-list (reverse out)) | |
1841 (gnus-summary-mark-as-unread nil t) | |
1842 (gnus-summary-next-subject 1 nil))) | |
1843 | |
1844 | |
1845 (defun gnus-uu-unmark-all-articles () | |
1846 "Removes the mark from all articles marked for decoding." | |
1847 (interactive) | |
1848 (let ((articles (copy-sequence gnus-uu-marked-article-list))) | |
1849 (while articles | |
1850 (gnus-summary-goto-subject (car articles)) | |
1851 (gnus-summary-mark-as-unread nil t) | |
1852 (setq articles (cdr articles))) | |
1853 (setq gnus-uu-marked-article-list ()))) | |
1854 | |
1855 (defun gnus-uu-mark-by-regexp () | |
1856 "Asks for a regular expression and marks all articles that match for later decoding." | |
1857 (interactive) | |
1858 (let (exp) | |
1859 (setq exp (read-from-minibuffer "Enter regular expression: ")) | |
1860 (setq gnus-uu-marked-article-list | |
1861 (reverse (gnus-uu-get-list-of-articles exp t))) | |
1862 (message ""))) | |
1863 | |
1864 | |
1865 ;; Various | |
1866 | |
1867 (defun gnus-uu-check-correct-stripped-uucode (start end) | |
1868 (let (found beg length short) | |
1869 (if (not gnus-uu-correct-stripped-uucode) | |
1870 () | |
1871 (goto-char start) | |
1872 (while (< (point) end) | |
1873 (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) | |
1874 () | |
1875 (if (not found) | |
1876 (progn | |
1877 (beginning-of-line) | |
1878 (setq beg (point)) | |
1879 (end-of-line) | |
1880 (setq length (- (point) beg)))) | |
1881 (beginning-of-line) | |
1882 (setq beg (point)) | |
1883 (end-of-line) | |
1884 (if (not (= length (- (point) beg))) | |
1885 (insert (make-string (- length (- (point) beg))) ? ))) | |
1886 (forward-line 1))))) | |
1887 | |
1888 (defun gnus-uu-initialize () | |
1889 (if (not gnus-uu-use-interactive-view) | |
1890 () | |
1891 (save-excursion | |
1892 (setq gnus-uu-interactive-file-list nil) | |
1893 (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) | |
1894 (erase-buffer) | |
1895 (gnus-uu-mode) | |
1896 (insert | |
1897 "# Press return to execute a command. | |
1898 # Press `C-c C-c' to exit interactive view. | |
1899 | |
1900 ")))) | |
1901 | |
1902 | |
1903 (defun gnus-uu-clean-up () | |
1904 "Kills the temporary uu buffers." | |
1905 (let (buf pst) | |
1906 (setq gnus-uu-do-sloppy-uudecode nil) | |
1907 (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) | |
1908 (if (or (eq pst 'stop) (eq pst 'run)) | |
1909 (delete-process gnus-uu-uudecode-process)) | |
1910 (and (not gnus-uu-asynchronous) | |
1911 (setq buf (get-buffer gnus-uu-output-buffer-name)) | |
1912 (kill-buffer buf)) | |
1913 (and (setq buf (get-buffer gnus-uu-result-buffer)) | |
1914 (kill-buffer buf)))) | |
1915 | |
1916 | |
1917 (defun gnus-uu-check-for-generated-files () | |
1918 "Deletes any generated files that hasn't been deleted, if, for | |
1919 instance, the user terminated decoding with `C-g'." | |
1920 (let (file) | |
1921 (while gnus-uu-generated-file-list | |
1922 (setq file (car gnus-uu-generated-file-list)) | |
1923 (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list)) | |
1924 (if (not (string-match "/\\.[\\.]?$" file)) | |
1925 (progn | |
1926 (if (file-directory-p file) | |
1927 (delete-directory file) | |
1928 (if (file-exists-p file) | |
1929 (delete-file file)))))))) | |
1930 | |
1931 | |
1932 (defun gnus-uu-add-file (file) | |
1933 (setq gnus-uu-generated-file-list | |
1934 (cons file gnus-uu-generated-file-list))) | |
1935 | |
1936 (defun gnus-uu-summary-next-subject () | |
1937 (if (not (gnus-summary-search-forward t)) | |
1938 (progn | |
1939 (goto-char 1) | |
1940 (sit-for 0) | |
1941 (goto-char (point-max)) | |
1942 (forward-line -1) | |
1943 (beginning-of-line) | |
1944 (search-forward ":" nil t))) | |
1945 (sit-for 0) | |
1946 (gnus-summary-recenter)) | |
1947 | |
1948 | |
1949 ;; Initializing | |
1950 | |
1951 (add-hook 'gnus-exit-group-hook | |
1952 '(lambda () | |
1953 (gnus-uu-clean-up) | |
1954 (setq gnus-uu-marked-article-list nil) | |
1955 (gnus-uu-check-for-generated-files))) | |
1956 | |
1957 | |
1958 ;; Interactive exec mode | |
1959 | |
1960 (defvar gnus-uu-output-window nil) | |
1961 (defvar gnus-uu-mode-hook nil) | |
1962 (defvar gnus-uu-mode-map nil) | |
1963 | |
1964 (defun gnus-uu-do-interactive () | |
1965 (let (int-buffer out-buf) | |
1966 (set-buffer | |
1967 (setq int-buffer (get-buffer gnus-uu-interactive-buffer-name))) | |
1968 (switch-to-buffer-other-window int-buffer) | |
1969 (pop-to-buffer int-buffer) | |
1970 (setq gnus-uu-output-window | |
1971 (split-window nil (- (window-height) gnus-uu-output-window-height))) | |
1972 (set-window-buffer gnus-uu-output-window | |
1973 (setq out-buf | |
1974 (get-buffer-create gnus-uu-output-buffer-name))) | |
1975 (save-excursion (set-buffer out-buf) (erase-buffer)) | |
1976 (goto-char 1) | |
1977 (forward-line 3) | |
1978 (run-hooks 'gnus-uu-mode-hook))) | |
1979 | |
1980 | |
1981 (defun gnus-uu-enter-interactive-file (action file) | |
1982 (let (command) | |
1983 (save-excursion | |
1984 (setq gnus-uu-interactive-file-list | |
1985 (cons file gnus-uu-interactive-file-list)) | |
1986 (set-buffer (get-buffer gnus-uu-interactive-buffer-name)) | |
1987 (if (string-match "%s" action) | |
1988 (setq command (format action (concat "'" file "'"))) | |
1989 (setq command (concat action " " (concat "'" file "'")))) | |
1990 | |
1991 (insert (format "%s\n" command))))) | |
1992 | |
1993 | |
1994 (defun gnus-uu-interactive-execute () | |
1995 (interactive) | |
1996 (let (beg out-buf command) | |
1997 (beginning-of-line) | |
1998 (setq beg (point)) | |
1999 (end-of-line) | |
2000 (setq command (buffer-substring beg (point))) | |
2001 (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) | |
2002 (save-excursion | |
2003 (set-buffer out-buf) | |
2004 (erase-buffer) | |
2005 (insert (format "$ %s \n\n" command))) | |
2006 (message "Executing...") | |
2007 (if gnus-uu-asynchronous | |
2008 (start-process "gnus-uu-view" out-buf "sh" "-c" command) | |
2009 (call-process "sh" nil out-buf nil "-c" command) | |
2010 (message "")) | |
2011 (forward-line 1) | |
2012 (beginning-of-line))) | |
2013 | |
2014 | |
2015 (defun gnus-uu-interactive-end () | |
2016 "This function ends interactive view mode and returns to summary mode." | |
2017 (interactive) | |
2018 (let (buf) | |
2019 (delete-window gnus-uu-output-window) | |
2020 (gnus-uu-clean-up) | |
2021 (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files)) | |
2022 (setq buf (get-buffer gnus-uu-interactive-buffer-name)) | |
2023 (if gnus-article-buffer (switch-to-buffer gnus-article-buffer)) | |
2024 (if buf (kill-buffer buf)) | |
2025 (pop-to-buffer gnus-summary-buffer))) | |
2026 | |
2027 | |
2028 (if gnus-uu-mode-map | |
2029 () | |
2030 (setq gnus-uu-mode-map (make-sparse-keymap)) | |
2031 (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) | |
2032 (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) | |
2033 (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute) | |
2034 (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end) | |
2035 (define-key gnus-uu-mode-map "\C-cs" | |
2036 'gnus-uu-interactive-save-current-file) | |
2037 (define-key gnus-uu-mode-map "\C-c\C-s" | |
2038 'gnus-uu-interactive-save-current-file-silent) | |
2039 (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files) | |
2040 (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)) | |
2041 | |
2042 | |
2043 (defun gnus-uu-interactive-save-original-file () | |
2044 (interactive) | |
2045 (let (file) | |
2046 (if (file-exists-p | |
2047 (setq file (concat gnus-uu-tmp-dir | |
2048 (or gnus-uu-file-name gnus-uu-shar-file-name)))) | |
2049 (gnus-uu-save-file file) | |
2050 (message "Already saved.")))) | |
2051 | |
2052 | |
2053 (defun gnus-uu-interactive-save-current-file-silent () | |
2054 "hei" | |
2055 (interactive) | |
2056 (gnus-uu-interactive-save-current-file t)) | |
2057 | |
2058 (defun gnus-uu-interactive-save-current-file (&optional dont-ask silent) | |
2059 "Saves the file referred to on the current line." | |
2060 (interactive) | |
2061 (let (files beg line file) | |
2062 (setq files (copy-sequence gnus-uu-interactive-file-list)) | |
2063 (beginning-of-line) | |
2064 (setq beg (point)) | |
2065 (end-of-line) | |
2066 (setq line (buffer-substring beg (point))) | |
2067 (while (and files | |
2068 (not (string-match | |
2069 (concat "" (regexp-quote (setq file (car files))) "") | |
2070 line))) | |
2071 (setq files (cdr files))) | |
2072 (beginning-of-line) | |
2073 (forward-line 1) | |
2074 (if (not files) | |
2075 (if (not silent) | |
2076 (progn (message "Could not find file") (sit-for 2))) | |
2077 (gnus-uu-save-file file (if dont-ask gnus-uu-current-save-dir nil) silent) | |
2078 (delete-region beg (point))))) | |
2079 | |
2080 | |
2081 (defun gnus-uu-interactive-save-all-files () | |
2082 "Saves all files referred to on the current line." | |
2083 (interactive) | |
2084 (let (dir) | |
2085 (goto-char 1) | |
2086 (setq dir (gnus-uu-read-directory "Where do you want the files? ")) | |
2087 (while (not (eobp)) | |
2088 (gnus-uu-interactive-save-current-file t t)))) | |
2089 | |
2090 (defun gnus-uu-mode () | |
2091 "Major mode for editing view commands in gnus-uu. | |
2092 | |
2093 | |
2094 Commands: | |
2095 Return, C-c C-v, C-c C-x Execute the current command | |
2096 C-c C-c End interactive mode | |
2097 C-c s Save the current file | |
2098 C-c C-s Save the current file without asking | |
2099 where to put it | |
2100 C-c C-a Save all files | |
2101 C-c C-o Save the original file: If the files | |
2102 originated in an archive, the archive | |
2103 file is saved. | |
2104 " | |
2105 (interactive) | |
2106 (kill-all-local-variables) | |
2107 (use-local-map gnus-uu-mode-map) | |
2108 (setq mode-name "gnus-uu") | |
2109 (setq major-mode 'gnus-uu-mode) | |
2110 ) | |
2111 | |
2112 (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) | |
2113 (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) | |
2114 (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute) | |
2115 (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end) | |
2116 (define-key gnus-uu-mode-map "\C-cs" | |
2117 'gnus-uu-interactive-save-current-file) | |
2118 (define-key gnus-uu-mode-map "\C-c\C-s" | |
2119 'gnus-uu-interactive-save-current-file-silent) | |
2120 (define-key gnus-uu-mode-map "\C-c\C-a" 'gnus-uu-interactive-save-all-files) | |
2121 (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file) | |
2122 | |
2123 (provide 'gnus-uu) | |
2124 |