cgit.sxemacs.org Git - gnus/blob - lisp/gnus-uu.el

   1 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
   2
   3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998,
   4 ;;   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Created: 2 Oct 1993
   8 ;; Keyword: news
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32
  33 (require 'gnus)
  34 (require 'gnus-art)
  35 (require 'message)
  36 (require 'gnus-msg)
  37 (require 'mm-decode)
  38
  39 (defgroup gnus-extract nil
  40   "Extracting encoded files."
  41   :prefix "gnus-uu-"
  42   :group 'gnus)
  43
  44 (defgroup gnus-extract-view nil
  45   "Viewwing extracted files."
  46   :group 'gnus-extract)
  47
  48 (defgroup gnus-extract-archive nil
  49   "Extracting encoded archives."
  50   :group 'gnus-extract)
  51
  52 (defgroup gnus-extract-post nil
  53   "Extracting encoded archives."
  54   :prefix "gnus-uu-post"
  55   :group 'gnus-extract)
  56
  57 ;; Default viewing action rules
  58
  59 (defcustom gnus-uu-default-view-rules
  60   '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'")
  61     ("\\.pas$" "cat %s | sed 's/\r$//'")
  62     ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
  63     ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display")
  64     ("\\.tga$" "tgatoppm %s | ee -")
  65     ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
  66      "sox -v .5 %s -t .au -u - > /dev/audio")
  67     ("\\.au$" "cat %s > /dev/audio")
  68     ("\\.midi?$" "playmidi -f")
  69     ("\\.mod$" "str32")
  70     ("\\.ps$" "ghostview")
  71     ("\\.dvi$" "xdvi")
  72     ("\\.html$" "xmosaic")
  73     ("\\.mpe?g$" "mpeg_play")
  74     ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
  75     ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
  76      "gnus-uu-archive"))
  77   "*Default actions to be taken when the user asks to view a file.
  78 To change the behaviour, you can either edit this variable or set
  79 `gnus-uu-user-view-rules' to something useful.
  80
  81 For example:
  82
  83 To make gnus-uu use 'xli' to display JPEG and GIF files, put the
  84 following in your .emacs file:
  85
  86   (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
  87
  88 Both these variables are lists of lists with two string elements.  The
  89 first string is a regular expression.  If the file name matches this
  90 regular expression, the command in the second string is executed with
  91 the file as an argument.
  92
  93 If the command string contains \"%s\", the file name will be inserted
  94 at that point in the command string.  If there's no \"%s\" in the
  95 command string, the file name will be appended to the command string
  96 before executing.
  97
  98 There are several user variables to tailor the behaviour of gnus-uu to
  99 your needs.  First we have `gnus-uu-user-view-rules', which is the
 100 variable gnus-uu first consults when trying to decide how to view a
 101 file.  If this variable contains no matches, gnus-uu examines the
 102 default rule variable provided in this package.  If gnus-uu finds no
 103 match here, it uses `gnus-uu-user-view-rules-end' to try to make a
 104 match."
 105   :group 'gnus-extract-view
 106   :type '(repeat (group regexp (string :tag "Command"))))
 107
 108 (defcustom gnus-uu-user-view-rules nil
 109   "What actions are to be taken to view a file.
 110 See the documentation on the `gnus-uu-default-view-rules' variable for
 111 details."
 112   :group 'gnus-extract-view
 113   :type '(repeat (group regexp (string :tag "Command"))))
 114
 115 (defcustom gnus-uu-user-view-rules-end
 116   '(("" "file"))
 117   "*What actions are to be taken if no rule matched the file name.
 118 See the documentation on the `gnus-uu-default-view-rules' variable for
 119 details."
 120   :group 'gnus-extract-view
 121   :type '(repeat (group regexp (string :tag "Command"))))
 122
 123 ;; Default unpacking commands
 124
 125 (defcustom gnus-uu-default-archive-rules
 126   '(("\\.tar$" "tar xf")
 127     ("\\.zip$" "unzip -o")
 128     ("\\.ar$" "ar x")
 129     ("\\.arj$" "unarj x")
 130     ("\\.zoo$" "zoo -e")
 131     ("\\.\\(lzh\\|lha\\)$" "lha x")
 132     ("\\.Z$" "uncompress")
 133     ("\\.gz$" "gunzip")
 134     ("\\.arc$" "arc -x"))
 135   "*See `gnus-uu-user-archive-rules'."
 136   :group 'gnus-extract-archive
 137   :type '(repeat (group regexp (string :tag "Command"))))
 138
 139 (defvar gnus-uu-destructive-archivers
 140   (list "uncompress" "gunzip"))
 141
 142 (defcustom gnus-uu-user-archive-rules nil
 143   "A list that can be set to override the default archive unpacking commands.
 144 To use, for instance, 'untar' to unpack tar files and 'zip -x' to
 145 unpack zip files, say the following:
 146   (setq gnus-uu-user-archive-rules
 147     '((\"\\\\.tar$\" \"untar\")
 148       (\"\\\\.zip$\" \"zip -x\")))"
 149   :group 'gnus-extract-archive
 150   :type '(repeat (group regexp (string :tag "Command"))))
 151
 152 (defcustom gnus-uu-ignore-files-by-name nil
 153   "*A regular expression saying what files should not be viewed based on name.
 154 If, for instance, you want gnus-uu to ignore all .au and .wav files,
 155 you could say something like
 156
 157   (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
 158
 159 Note that this variable can be used in conjunction with the
 160 `gnus-uu-ignore-files-by-type' variable."
 161   :group 'gnus-extract
 162   :type '(choice (const :tag "off" nil)
 163                  (regexp :format "%v")))
 164
 165 (defcustom gnus-uu-ignore-files-by-type nil
 166   "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
 167 If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
 168 you could say something like
 169
 170   (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
 171
 172 Note that this variable can be used in conjunction with the
 173 `gnus-uu-ignore-files-by-name' variable."
 174   :group 'gnus-extract
 175   :type '(choice (const :tag "off" nil)
 176                  (regexp :format "%v")))
 177
 178 ;; Pseudo-MIME support
 179
 180 (defconst gnus-uu-ext-to-mime-list
 181   '(("\\.gif$" "image/gif")
 182     ("\\.jpe?g$" "image/jpeg")
 183     ("\\.tiff?$" "image/tiff")
 184     ("\\.xwd$" "image/xwd")
 185     ("\\.pbm$" "image/pbm")
 186     ("\\.pgm$" "image/pgm")
 187     ("\\.ppm$" "image/ppm")
 188     ("\\.xbm$" "image/xbm")
 189     ("\\.pcx$" "image/pcx")
 190     ("\\.tga$" "image/tga")
 191     ("\\.ps$" "image/postscript")
 192     ("\\.fli$" "video/fli")
 193     ("\\.wav$" "audio/wav")
 194     ("\\.aiff$" "audio/aiff")
 195     ("\\.hcom$" "audio/hcom")
 196     ("\\.voc$" "audio/voc")
 197     ("\\.smp$" "audio/smp")
 198     ("\\.mod$" "audio/mod")
 199     ("\\.dvi$" "image/dvi")
 200     ("\\.mpe?g$" "video/mpeg")
 201     ("\\.au$" "audio/basic")
 202     ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
 203     ("\\.\\(c\\|h\\)$" "text/source")
 204     ("read.*me" "text/plain")
 205     ("\\.html$" "text/html")
 206     ("\\.bat$" "text/bat")
 207     ("\\.[1-6]$" "text/man")
 208     ("\\.flc$" "video/flc")
 209     ("\\.rle$" "video/rle")
 210     ("\\.pfx$" "video/pfx")
 211     ("\\.avi$" "video/avi")
 212     ("\\.sme$" "video/sme")
 213     ("\\.rpza$" "video/prza")
 214     ("\\.dl$" "video/dl")
 215     ("\\.qt$" "video/qt")
 216     ("\\.rsrc$" "video/rsrc")
 217     ("\\..*$" "unknown/unknown")))
 218
 219 ;; Various variables users may set
 220
 221 (defcustom gnus-uu-tmp-dir
 222   (cond ((fboundp 'temp-directory) (temp-directory))
 223         ((boundp 'temporary-file-directory) temporary-file-directory)
 224         ("/tmp/"))
 225   "*Variable saying where gnus-uu is to do its work.
 226 Default is \"/tmp/\"."
 227   :group 'gnus-extract
 228   :type 'directory)
 229
 230 (defcustom gnus-uu-do-not-unpack-archives nil
 231   "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
 232 Default is nil."
 233   :group 'gnus-extract-archive
 234   :type 'boolean)
 235
 236 (defcustom gnus-uu-ignore-default-view-rules nil
 237   "*Non-nil means that gnus-uu will ignore the default viewing rules.
 238 Only the user viewing rules will be consulted.  Default is nil."
 239   :group 'gnus-extract-view
 240   :type 'boolean)
 241
 242 (defcustom gnus-uu-grabbed-file-functions nil
 243   "Functions run on each file after successful decoding.
 244 They will be called with the name of the file as the argument.
 245 Likely functions you can use in this list are `gnus-uu-grab-view'
 246 and `gnus-uu-grab-move'."
 247   :group 'gnus-extract
 248   :options '(gnus-uu-grab-view gnus-uu-grab-move)
 249   :type 'hook)
 250
 251 (defcustom gnus-uu-ignore-default-archive-rules nil
 252   "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
 253 Only the user unpacking commands will be consulted.  Default is nil."
 254   :group 'gnus-extract-archive
 255   :type 'boolean)
 256
 257 (defcustom gnus-uu-kill-carriage-return t
 258   "*Non-nil means that gnus-uu will strip all carriage returns from articles.
 259 Default is t."
 260   :group 'gnus-extract
 261   :type 'boolean)
 262
 263 (defcustom gnus-uu-view-with-metamail nil
 264   "*Non-nil means that files will be viewed with metamail.
 265 The gnus-uu viewing functions will be ignored and gnus-uu will try
 266 to guess at a content-type based on file name suffixes.  Default
 267 it nil."
 268   :group 'gnus-extract
 269   :type 'boolean)
 270
 271 (defcustom gnus-uu-unmark-articles-not-decoded nil
 272   "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
 273 Default is nil."
 274   :group 'gnus-extract
 275   :type 'boolean)
 276
 277 (defcustom gnus-uu-correct-stripped-uucode nil
 278   "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
 279 Default is nil."
 280   :group 'gnus-extract
 281   :type 'boolean)
 282
 283 (defcustom gnus-uu-save-in-digest nil
 284   "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
 285 If this variable is nil, gnus-uu will just save everything in a
 286 file without any embellishments.  The digesting almost conforms to RFC1153 -
 287 no easy way to specify any meaningful volume and issue numbers were found,
 288 so I simply dropped them."
 289   :group 'gnus-extract
 290   :type 'boolean)
 291
 292 (defcustom gnus-uu-pre-uudecode-hook nil
 293   "Hook run before sending a message to uudecode."
 294   :group 'gnus-extract
 295   :type 'hook)
 296
 297 (defcustom gnus-uu-digest-headers
 298   '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
 299     "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:"
 300     "^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
 301     "^Content-ID:")
 302   "*List of regexps to match headers included in digested messages.
 303 The headers will be included in the sequence they are matched.  If nil
 304 include all headers."
 305   :group 'gnus-extract
 306   :type '(repeat regexp))
 307
 308 (defcustom gnus-uu-save-separate-articles nil
 309   "*Non-nil means that gnus-uu will save articles in separate files."
 310   :group 'gnus-extract
 311   :type 'boolean)
 312
 313 (defcustom gnus-uu-be-dangerous 'ask
 314   "*Specifies what to do if unusual situations arise during decoding.
 315 If nil, be as conservative as possible.  If t, ignore things that
 316 didn't work, and overwrite existing files.  Otherwise, ask each time."
 317   :group 'gnus-extract
 318   :type '(choice (const :tag "conservative" nil)
 319                  (const :tag "ask" ask)
 320                  (const :tag "liberal" t)))
 321
 322 ;; Internal variables
 323
 324 (defvar gnus-uu-saved-article-name nil)
 325
 326 (defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
 327 (defvar gnus-uu-end-string "^end[ \t]*$")
 328
 329 (defvar gnus-uu-body-line "^M")
 330 (let ((i 61))
 331   (while (> (setq i (1- i)) 0)
 332     (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
 333   (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
 334
 335 ;"^M.............................................................?$"
 336
 337 (defvar gnus-uu-shar-begin-string "^#! */bin/sh")
 338
 339 (defvar gnus-uu-shar-file-name nil)
 340 (defvar gnus-uu-shar-name-marker
 341   "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
 342
 343 (defvar gnus-uu-postscript-begin-string "^%!PS-")
 344 (defvar gnus-uu-postscript-end-string "^%%EOF$")
 345
 346 (defvar gnus-uu-file-name nil)
 347 (defvar gnus-uu-uudecode-process nil)
 348 (defvar gnus-uu-binhex-article-name nil)
 349
 350 (defvar gnus-uu-work-dir nil)
 351
 352 (defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
 353
 354 (defvar gnus-uu-default-dir gnus-article-save-directory)
 355 (defvar gnus-uu-digest-from-subject nil)
 356 (defvar gnus-uu-digest-buffer nil)
 357
 358 ;; Commands.
 359
 360 (defun gnus-uu-decode-uu (&optional n)
 361   "Uudecodes the current article."
 362   (interactive "P")
 363   (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
 364
 365 (defun gnus-uu-decode-uu-and-save (n dir)
 366   "Decodes and saves the resulting file."
 367   (interactive
 368    (list current-prefix-arg
 369          (file-name-as-directory
 370           (read-file-name "Uudecode and save in dir: "
 371                           gnus-uu-default-dir
 372                           gnus-uu-default-dir t))))
 373   (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
 374
 375 (defun gnus-uu-decode-unshar (&optional n)
 376   "Unshars the current article."
 377   (interactive "P")
 378   (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
 379
 380 (defun gnus-uu-decode-unshar-and-save (n dir)
 381   "Unshars and saves the current article."
 382   (interactive
 383    (list current-prefix-arg
 384          (file-name-as-directory
 385           (read-file-name "Unshar and save in dir: "
 386                           gnus-uu-default-dir
 387                           gnus-uu-default-dir t))))
 388   (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
 389
 390 (defun gnus-uu-decode-save (n file)
 391   "Saves the current article."
 392   (interactive
 393    (list current-prefix-arg
 394          (read-file-name
 395           (if gnus-uu-save-separate-articles
 396               "Save articles is dir: "
 397             "Save articles in file: ")
 398           gnus-uu-default-dir
 399           gnus-uu-default-dir)))
 400   (setq gnus-uu-saved-article-name file)
 401   (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
 402
 403 (defun gnus-uu-decode-binhex (n dir)
 404   "Unbinhexes the current article."
 405   (interactive
 406    (list current-prefix-arg
 407          (file-name-as-directory
 408           (read-file-name "Unbinhex and save in dir: "
 409                           gnus-uu-default-dir
 410      &