1 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
2 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
30 (eval-when-compile (require 'cl))
38 (defgroup gnus-extract nil
39 "Extracting encoded files."
43 (defgroup gnus-extract-view nil
44 "Viewwing extracted files."
47 (defgroup gnus-extract-archive nil
48 "Extracting encoded archives."
51 (defgroup gnus-extract-post nil
52 "Extracting encoded archives."
53 :prefix "gnus-uu-post"
56 ;; Default viewing action rules
58 (defcustom gnus-uu-default-view-rules
59 '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'")
60 ("\\.pas$" "cat %s | sed 's/\r$//'")
61 ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
62 ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display")
63 ("\\.tga$" "tgatoppm %s | ee -")
64 ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
65 "sox -v .5 %s -t .au -u - > /dev/audio")
66 ("\\.au$" "cat %s > /dev/audio")
67 ("\\.midi?$" "playmidi -f")
69 ("\\.ps$" "ghostview")
71 ("\\.html$" "xmosaic")
72 ("\\.mpe?g$" "mpeg_play")
73 ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
74 ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
76 "*Default actions to be taken when the user asks to view a file.
77 To change the behaviour, you can either edit this variable or set
78 `gnus-uu-user-view-rules' to something useful.
82 To make gnus-uu use 'xli' to display JPEG and GIF files, put the
83 following in your .emacs file:
85 (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
87 Both these variables are lists of lists with two string elements. The
88 first string is a regular expression. If the file name matches this
89 regular expression, the command in the second string is executed with
90 the file as an argument.
92 If the command string contains \"%s\", the file name will be inserted
93 at that point in the command string. If there's no \"%s\" in the
94 command string, the file name will be appended to the command string
97 There are several user variables to tailor the behaviour of gnus-uu to
98 your needs. First we have `gnus-uu-user-view-rules', which is the
99 variable gnus-uu first consults when trying to decide how to view a
100 file. If this variable contains no matches, gnus-uu examines the
101 default rule variable provided in this package. If gnus-uu finds no
102 match here, it uses `gnus-uu-user-view-rules-end' to try to make a
104 :group 'gnus-extract-view
105 :type '(repeat (group regexp (string :tag "Command"))))
107 (defcustom gnus-uu-user-view-rules nil
108 "What actions are to be taken to view a file.
109 See the documentation on the `gnus-uu-default-view-rules' variable for
111 :group 'gnus-extract-view
112 :type '(repeat (group regexp (string :tag "Command"))))
114 (defcustom gnus-uu-user-view-rules-end
116 "*What actions are to be taken if no rule matched the file name.
117 See the documentation on the `gnus-uu-default-view-rules' variable for
119 :group 'gnus-extract-view
120 :type '(repeat (group regexp (string :tag "Command"))))
122 ;; Default unpacking commands
124 (defcustom gnus-uu-default-archive-rules
125 '(("\\.tar$" "tar xf")
126 ("\\.zip$" "unzip -o")
128 ("\\.arj$" "unarj x")
130 ("\\.\\(lzh\\|lha\\)$" "lha x")
131 ("\\.Z$" "uncompress")
133 ("\\.arc$" "arc -x"))
134 "*See `gnus-uu-user-archive-rules'."
135 :group 'gnus-extract-archive
136 :type '(repeat (group regexp (string :tag "Command"))))
138 (defvar gnus-uu-destructive-archivers
139 (list "uncompress" "gunzip"))
141 (defcustom gnus-uu-user-archive-rules nil
142 "A list that can be set to override the default archive unpacking commands.
143 To use, for instance, 'untar' to unpack tar files and 'zip -x' to
144 unpack zip files, say the following:
145 (setq gnus-uu-user-archive-rules
146 '((\"\\\\.tar$\" \"untar\")
147 (\"\\\\.zip$\" \"zip -x\")))"
148 :group 'gnus-extract-archive
149 :type '(repeat (group regexp (string :tag "Command"))))
151 (defcustom gnus-uu-ignore-files-by-name nil
152 "*A regular expression saying what files should not be viewed based on name.
153 If, for instance, you want gnus-uu to ignore all .au and .wav files,
154 you could say something like
156 (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
158 Note that this variable can be used in conjunction with the
159 `gnus-uu-ignore-files-by-type' variable."
161 :type '(choice (const :tag "off" nil)
162 (regexp :format "%v")))
164 (defcustom gnus-uu-ignore-files-by-type nil
165 "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
166 If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
167 you could say something like
169 (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
171 Note that this variable can be used in conjunction with the
172 `gnus-uu-ignore-files-by-name' variable."
174 :type '(choice (const :tag "off" nil)
175 (regexp :format "%v")))
177 ;; Pseudo-MIME support
179 (defconst gnus-uu-ext-to-mime-list
180 '(("\\.gif$" "image/gif")
181 ("\\.jpe?g$" "image/jpeg")
182 ("\\.tiff?$" "image/tiff")
183 ("\\.xwd$" "image/xwd")
184 ("\\.pbm$" "image/pbm")
185 ("\\.pgm$" "image/pgm")
186 ("\\.ppm$" "image/ppm")
187 ("\\.xbm$" "image/xbm")
188 ("\\.pcx$" "image/pcx")
189 ("\\.tga$" "image/tga")
190 ("\\.ps$" "image/postscript")
191 ("\\.fli$" "video/fli")
192 ("\\.wav$" "audio/wav")
193 ("\\.aiff$" "audio/aiff")
194 ("\\.hcom$" "audio/hcom")
195 ("\\.voc$" "audio/voc")
196 ("\\.smp$" "audio/smp")
197 ("\\.mod$" "audio/mod")
198 ("\\.dvi$" "image/dvi")
199 ("\\.mpe?g$" "video/mpeg")
200 ("\\.au$" "audio/basic")
201 ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
202 ("\\.\\(c\\|h\\)$" "text/source")
203 ("read.*me" "text/plain")
204 ("\\.html$" "text/html")
205 ("\\.bat$" "text/bat")
206 ("\\.[1-6]$" "text/man")
207 ("\\.flc$" "video/flc")
208 ("\\.rle$" "video/rle")
209 ("\\.pfx$" "video/pfx")
210 ("\\.avi$" "video/avi")
211 ("\\.sme$" "video/sme")
212 ("\\.rpza$" "video/prza")
213 ("\\.dl$" "video/dl")
214 ("\\.qt$" "video/qt")
215 ("\\.rsrc$" "video/rsrc")
216 ("\\..*$" "unknown/unknown")))
218 ;; Various variables users may set
220 (defcustom gnus-uu-tmp-dir
221 (cond ((fboundp 'temp-directory) (temp-directory))
222 ((boundp 'temporary-file-directory) temporary-file-directory)
224 "*Variable saying where gnus-uu is to do its work.
225 Default is \"/tmp/\"."
229 (defcustom gnus-uu-do-not-unpack-archives nil
230 "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
232 :group 'gnus-extract-archive
235 (defcustom gnus-uu-ignore-default-view-rules nil
236 "*Non-nil means that gnus-uu will ignore the default viewing rules.
237 Only the user viewing rules will be consulted. Default is nil."
238 :group 'gnus-extract-view
241 (defcustom gnus-uu-grabbed-file-functions nil
242 "Functions run on each file after successful decoding.
243 They will be called with the name of the file as the argument.
244 Likely functions you can use in this list are `gnus-uu-grab-view'
245 and `gnus-uu-grab-move'."
247 :options '(gnus-uu-grab-view gnus-uu-grab-move)
250 (defcustom gnus-uu-ignore-default-archive-rules nil
251 "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
252 Only the user unpacking commands will be consulted. Default is nil."
253 :group 'gnus-extract-archive
256 (defcustom gnus-uu-kill-carriage-return t
257 "*Non-nil means that gnus-uu will strip all carriage returns from articles.
262 (defcustom gnus-uu-view-with-metamail nil
263 "*Non-nil means that files will be viewed with metamail.
264 The gnus-uu viewing functions will be ignored and gnus-uu will try
265 to guess at a content-type based on file name suffixes. Default
270 (defcustom gnus-uu-unmark-articles-not-decoded nil
271 "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
276 (defcustom gnus-uu-correct-stripped-uucode nil
277 "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
282 (defcustom gnus-uu-save-in-digest nil
283 "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
284 If this variable is nil, gnus-uu will just save everything in a
285 file without any embellishments. The digesting almost conforms to RFC1153 -
286 no easy way to specify any meaningful volume and issue numbers were found,
287 so I simply dropped them."
291 (defcustom gnus-uu-pre-uudecode-hook nil
292 "Hook run before sending a message to uudecode."
296 (defcustom gnus-uu-digest-headers
297 '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
298 "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:"
299 "^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
301 "*List of regexps to match headers included in digested messages.
302 The headers will be included in the sequence they are matched."
304 :type '(repeat regexp))
306 (defcustom gnus-uu-save-separate-articles nil
307 "*Non-nil means that gnus-uu will save articles in separate files."
311 (defcustom gnus-uu-be-dangerous 'ask
312 "*Specifies what to do if unusual situations arise during decoding.
313 If nil, be as conservative as possible. If t, ignore things that
314 didn't work, and overwrite existing files. Otherwise, ask each time."
316 :type '(choice (const :tag "conservative" nil)
317 (const :tag "ask" ask)
318 (const :tag "liberal" t)))
320 ;; Internal variables
322 (defvar gnus-uu-saved-article-name nil)
324 (defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
325 (defvar gnus-uu-end-string "^end[ \t]*$")
327 (defvar gnus-uu-body-line "^M")
329 (while (> (setq i (1- i)) 0)
330 (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
331 (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
333 ;"^M.............................................................?$"
335 (defvar gnus-uu-shar-begin-string "^#! */bin/sh")
337 (defvar gnus-uu-shar-file-name nil)
338 (defvar gnus-uu-shar-name-marker
339 "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
341 (defvar gnus-uu-postscript-begin-string "^%!PS-")
342 (defvar gnus-uu-postscript-end-string "^%%EOF$")
344 (defvar gnus-uu-file-name nil)
345 (defvar gnus-uu-uudecode-process nil)
346 (defvar gnus-uu-binhex-article-name nil)
348 (defvar gnus-uu-work-dir nil)
350 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
352 (defvar gnus-uu-default-dir gnus-article-save-directory)
353 (defvar gnus-uu-digest-from-subject nil)
354 (defvar gnus-uu-digest-buffer nil)
358 (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
359 "p" gnus-summary-mark-as-processable
360 "u" gnus-summary-unmark-as-processable
361 "U" gnus-summary-unmark-all-processable
362 "v" gnus-uu-mark-over
363 "s" gnus-uu-mark-series
364 "r" gnus-uu-mark-region
365 "g" gnus-uu-unmark-region
366 "R" gnus-uu-mark-by-regexp
367 "G" gnus-uu-unmark-by-regexp
368 "t" gnus-uu-mark-thread
369 "T" gnus-uu-unmark-thread
371 "b" gnus-uu-mark-buffer
372 "S" gnus-uu-mark-sparse
373 "k" gnus-summary-kill-process-mark
374 "y" gnus-summary-yank-process-mark
375 "w" gnus-summary-save-process-mark
376 "i" gnus-uu-invert-processable)
378 (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
379 ;;"x" gnus-uu-extract-any
380 "m" gnus-summary-save-parts
381 "u" gnus-uu-decode-uu
382 "U" gnus-uu-decode-uu-and-save
383 "s" gnus-uu-decode-unshar
384 "S" gnus-uu-decode-unshar-and-save
385 "o" gnus-uu-decode-save
386 "O" gnus-uu-decode-save
387 "b" gnus-uu-decode-binhex
388 "B" gnus-uu-decode-binhex
389 "p" gnus-uu-decode-postscript
390 "P" gnus-uu-decode-postscript-and-save)
393 (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
394 "u" gnus-uu-decode-uu-view
395 "U" gnus-uu-decode-uu-and-save-view
396 "s" gnus-uu-decode-unshar-view
397 "S" gnus-uu-decode-unshar-and-save-view
398 "o" gnus-uu-decode-save-view
399 "O" gnus-uu-decode-save-view
400 "b" gnus-uu-decode-binhex-view
401 "B" gnus-uu-decode-binhex-view
402 "p" gnus-uu-decode-postscript-view
403 "P" gnus-uu-decode-postscript-and-save-view)
408 (defun gnus-uu-decode-uu (&optional n)
409 "Uudecodes the current article."
411 (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
413 (defun gnus-uu-decode-uu-and-save (n dir)
414 "Decodes and saves the resulting file."
416 (list current-prefix-arg
417 (file-name-as-directory
418 (read-file-name "Uudecode and save in dir: "
420 gnus-uu-default-dir t))))
421 (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
423 (defun gnus-uu-decode-unshar (&optional n)
424 "Unshars the current article."
426 (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
428 (defun gnus-uu-decode-unshar-and-save (n dir)
429 "Unshars and saves the current article."
431 (list current-prefix-arg
432 (file-name-as-directory
433 (read-file-name "Unshar and save in dir: "
435 gnus-uu-default-dir t))))
436 (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
438 (defun gnus-uu-decode-save (n file)
439 "Saves the current article."
441 (list current-prefix-arg
443 (if gnus-uu-save-separate-articles
444 "Save articles is dir: "
445 "Save articles in file: ")
447 gnus-uu-default-dir)))
448 (setq gnus-uu-saved-article-name file)
449 (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
451 (defun gnus-uu-decode-binhex (n dir)
452 "Unbinhexes the current article."
454 (list current-prefix-arg
455 (file-name-as-directory
456 (read-file-name "Unbinhex and save in dir: "
458 gnus-uu-default-dir))))
459 (setq gnus-uu-binhex-article-name
460 (make-temp-name (concat gnus-uu-work-dir "binhex")))
461 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
463 (defun gnus-uu-decode-uu-view (&optional n)
464 "Uudecodes and views the current article."
466 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
467 (gnus-uu-decode-uu n)))
469 (defun gnus-uu-decode-uu-and-save-view (n dir)
470 "Decodes, views and saves the resulting file."
472 (list current-prefix-arg