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