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

   1 ;;; gnus-uu.el --- extract (uu)encoded files in Gnus
   2 ;; Copyright (C) 1985,86,87,93,94,95 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   5 ;; Created: 2 Oct 1993
   6 ;; Version: v3.0
   7 ;; Keyword: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'gnus)
  30 (require 'gnus-msg)
  31
  32 ;; Default viewing action rules
  33
  34 (defvar gnus-uu-default-view-rules
  35   '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
  36     ("\\.pas$" "cat %s | sed s/\r//g")
  37     ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
  38     ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
  39     ("\\.tga$" "tgatoppm %s | xv -")
  40     ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
  41      "sox -v .5 %s -t .au -u - > /dev/audio")
  42     ("\\.au$" "cat %s > /dev/audio")
  43     ("\\.mod$" "str32")
  44     ("\\.ps$" "ghostview")
  45     ("\\.dvi$" "xdvi")
  46     ("\\.html$" "xmosaic")
  47     ("\\.mpe?g$" "mpeg_play")
  48     ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
  49     ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
  50      "gnus-uu-archive"))
  51   "*Default actions to be taken when the user asks to view a file.
  52 To change the behaviour, you can either edit this variable or set
  53 `gnus-uu-user-view-rules' to something useful.
  54
  55 For example:
  56
  57 To make gnus-uu use 'xli' to display JPEG and GIF files, put the
  58 following in your .emacs file:
  59
  60   (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
  61
  62 Both these variables are lists of lists with two string elements. The
  63 first string is a regular expression. If the file name matches this
  64 regular expression, the command in the second string is executed with
  65 the file as an argument.
  66
  67 If the command string contains \"%s\", the file name will be inserted
  68 at that point in the command string. If there's no \"%s\" in the
  69 command string, the file name will be appended to the command string
  70 before executing.
  71
  72 There are several user variables to tailor the behaviour of gnus-uu to
  73 your needs. First we have `gnus-uu-user-view-rules', which is the
  74 variable gnus-uu first consults when trying to decide how to view a
  75 file. If this variable contains no matches, gnus-uu examines the
  76 default rule variable provided in this package. If gnus-uu finds no
  77 match here, it uses `gnus-uu-user-view-rules-end' to try to make a
  78 match.")
  79
  80 (defvar gnus-uu-user-view-rules nil
  81   "*Variable detailing what actions are to be taken to view a file.
  82 See the documentation on the `gnus-uu-default-view-rules' variable for
  83 details.")
  84
  85 (defvar gnus-uu-user-view-rules-end
  86   '(("" "file"))
  87   "*Variable saying what actions are to be taken if no rule matched the file name.
  88 See the documentation on the `gnus-uu-default-view-rules' variable for
  89 details.")
  90
  91 ;; Default unpacking commands
  92
  93 (defvar gnus-uu-default-archive-rules
  94   '(("\\.tar$" "tar xf")
  95     ("\\.zip$" "unzip -o")
  96     ("\\.ar$" "ar x")
  97     ("\\.arj$" "unarj x")
  98     ("\\.zoo$" "zoo -e")
  99     ("\\.\\(lzh\\|lha\\)$" "lha x")
 100     ("\\.Z$" "uncompress")
 101     ("\\.gz$" "gunzip")
 102     ("\\.arc$" "arc -x")))
 103
 104 (defvar gnus-uu-destructive-archivers
 105   (list "uncompress" "gunzip"))
 106
 107 (defvar gnus-uu-user-archive-rules nil
 108   "*A list that can be set to override the default archive unpacking commands.
 109 To use, for instance, 'untar' to unpack tar files and 'zip -x' to
 110 unpack zip files, say the following:
 111   (setq gnus-uu-user-archive-rules
 112     '((\"\\\\.tar$\" \"untar\")
 113       (\"\\\\.zip$\" \"zip -x\")))")
 114
 115 (defvar gnus-uu-ignore-files-by-name nil
 116   "*A regular expression saying what files should not be viewed based on name.
 117 If, for instance, you want gnus-uu to ignore all .au and .wav files,
 118 you could say something like
 119
 120   (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
 121
 122 Note that this variable can be used in conjunction with the
 123 `gnus-uu-ignore-files-by-type' variable.")
 124
 125 (defvar gnus-uu-ignore-files-by-type nil
 126   "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
 127 If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
 128 you could say something like
 129
 130   (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
 131
 132 Note that this variable can be used in conjunction with the
 133 `gnus-uu-ignore-files-by-name' variable.")
 134
 135 ;; Pseudo-MIME support
 136
 137 (defconst gnus-uu-ext-to-mime-list
 138   '(("\\.gif$" "image/gif")
 139     ("\\.jpe?g$" "image/jpeg")
 140     ("\\.tiff?$" "image/tiff")
 141     ("\\.xwd$" "image/xwd")
 142     ("\\.pbm$" "image/pbm")
 143     ("\\.pgm$" "image/pgm")
 144     ("\\.ppm$" "image/ppm")
 145     ("\\.xbm$" "image/xbm")
 146     ("\\.pcx$" "image/pcx")
 147     ("\\.tga$" "image/tga")
 148     ("\\.ps$" "image/postscript")
 149     ("\\.fli$" "video/fli")
 150     ("\\.wav$" "audio/wav")
 151     ("\\.aiff$" "audio/aiff")
 152     ("\\.hcom$" "audio/hcom")
 153     ("\\.voc$" "audio/voc")
 154     ("\\.smp$" "audio/smp")
 155     ("\\.mod$" "audio/mod")
 156     ("\\.dvi$" "image/dvi")
 157     ("\\.mpe?g$" "video/mpeg")
 158     ("\\.au$" "audio/basic")
 159     ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
 160     ("\\.\\(c\\|h\\)$" "text/source")
 161     ("read.*me" "text/plain")
 162     ("\\.html$" "text/html")
 163     ("\\.bat$" "text/bat")
 164     ("\\.[1-6]$" "text/man")
 165     ("\\.flc$" "video/flc")
 166     ("\\.rle$" "video/rle")
 167     ("\\.pfx$" "video/pfx")
 168     ("\\.avi$" "video/avi")
 169     ("\\.sme$" "video/sme")
 170     ("\\.rpza$" "video/prza")
 171     ("\\.dl$" "video/dl")
 172     ("\\.qt$" "video/qt")
 173     ("\\.rsrc$" "video/rsrc")
 174     ("\\..*$" "unknown/unknown")))
 175
 176 ;; Various variables users may set
 177
 178 (defvar gnus-uu-tmp-dir "/tmp/"
 179   "*Variable saying where gnus-uu is to do its work.
 180 Default is \"/tmp/\".")
 181
 182 (defvar gnus-uu-do-not-unpack-archives nil
 183   "*Non-nil means that gnus-uu won't peek inside archives looking for files to dispay.
 184 Default is nil.")
 185
 186 (defvar gnus-uu-view-and-save nil
 187   "*Non-nil means that the user will always be asked to save a file after viewing it.
 188 If the variable is nil, the user will only be asked to save if the
 189 viewing is unsuccessful. Default is nil.")
 190
 191 (defvar gnus-uu-ignore-default-view-rules nil
 192   "*Non-nil means that gnus-uu will ignore the default viewing rules.
 193 Only the user viewing rules will be consulted. Default is nil.")
 194
 195 (defvar gnus-uu-ignore-default-archive-rules nil
 196   "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
 197 Only the user unpacking commands will be consulted. Default is nil.")
 198
 199 (defvar gnus-uu-kill-carriage-return t
 200   "*Non-nil means that gnus-uu will strip all carriage returns from articles.
 201 Default is t.")
 202
 203 (defvar gnus-uu-view-with-metamail nil
 204   "*Non-nil means that files will be viewed with metamail.
 205 The gnus-uu viewing functions will be ignored and gnus-uu will try
 206 to guess at a content-type based on file name suffixes. Default
 207 it nil.")
 208
 209 (defvar gnus-uu-unmark-articles-not-decoded nil
 210   "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
 211 Default is nil.")
 212
 213 (defvar gnus-uu-correct-stripped-uucode nil
 214   "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
 215 Default is nil.")
 216
 217 (defvar gnus-uu-save-in-digest nil
 218   "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
 219 If this variable is nil, gnus-uu will just save everything in a
 220 file without any embellishments. The digesting almost conforms to RFC1153 -
 221 no easy way to specify any meaningful volume and issue numbers were found,
 222 so I simply dropped them.")
 223
 224 (defvar gnus-uu-digest-headers
 225   '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
 226     "^Summary:" "^References:")
 227   "*List of regexps to match headers included in digested messages.
 228 The headers will be included in the sequence they are matched.")
 229
 230 (defvar gnus-uu-save-separate-articles nil
 231   "*Non-nil means that gnus-uu will save articles in separate files.")
 232
 233 ;; Internal variables
 234
 235 (defvar gnus-uu-saved-article-name nil)
 236
 237 (defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
 238 (defconst gnus-uu-end-string "^end[ \t]*$")
 239
 240 (defconst gnus-uu-body-line "^M")
 241 (let ((i 61))
 242   (while (> (setq i (1- i)) 0)
 243     (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
 244   (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
 245
 246 ;"^M.............................................................?$"
 247
 248 (defconst gnus-uu-shar-begin-string "^#! */bin/sh")
 249
 250 (defvar gnus-uu-shar-file-name nil)
 251 (defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
 252
 253 (defconst gnus-uu-postscript-begin-string "^%!PS-")
 254 (defconst gnus-uu-postscript-end-string "^%%EOF$")
 255
 256 (defvar gnus-uu-file-name nil)
 257 (defconst gnus-uu-uudecode-process nil)
 258
 259 (defvar gnus-uu-generated-file-list nil)
 260 (defvar gnus-uu-work-dir nil)
 261
 262 (defconst gnus-uu-output-buffer-name "*Gnus UU Output*")
 263
 264 (defconst gnus-uu-highest-article-number 1)
 265 (defvar gnus-uu-default-dir default-directory)
 266
 267 ;; Keymaps
 268
 269 (defvar gnus-uu-extract-map nil)
 270 (defvar gnus-uu-extract-view-map nil)
 271 (defvar gnus-uu-mark-map nil)
 272
 273 (define-prefix-command 'gnus-uu-mark-map)
 274 (define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map)
 275 (define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable)
 276 (define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable)
 277 (define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable)
 278 (define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series)
 279 (define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region)
 280 (define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp)
 281 (define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread)
 282 (define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all)
 283 (define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse)
 284
 285 (define-prefix-command 'gnus-uu-extract-map)
 286 (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
 287 ;;(define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any)
 288 ;;(define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime)
 289 (define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu)
 290 (define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save)
 291 (define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar)
 292 (define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save)
 293 (define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save)
 294 (define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save)
 295 (define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex)
 296 (define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex)
 297 (define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript)
 298 (define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save)
 299
 300 (define-prefix-command 'gnus-uu-extract-view-map)
 301 (define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map)
 302 (define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view)
 303 (define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view)
 304 (define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view)
 305 (define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view)
 306 (define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view)
 307 (define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view)
 308 (define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view)
 309 (define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view)
 310 (define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view)
 311 (define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view)
 312
 313
 314
 315 ;; Commands.
 316
 317 (defun gnus-uu-decode-uu (n)
 318   "Uudecodes the current article."
 319   (interactive "P")
 320   (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
 321
 322 (defun gnus-uu-decode-uu-and-save (n dir)
 323   "Decodes and saves the resulting file."
 324   (interactive
 325    (list current-prefix-arg
 326          (file-name-as-directory
 327           (read-file-name "Uudecode and save in dir: "
 328                           gnus-uu-default-dir
 329                           gnus-uu-default-dir t))))
 330   (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir))
 331
 332 (defun gnus-uu-decode-unshar (n)
 333   "Unshars the current article."
 334   (interactive "P")
 335   (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan))
 336
 337 (defun gnus-uu-decode-unshar-and-save (n dir)
 338   "Unshars and saves the current article."
 339   (interactive
 340    (list current-prefix-arg
 341          (file-name-as-directory
 342           (read-file-name "Unshar and save in dir: "
 343                           gnus-uu-default-dir
 344                           gnus-uu-default-dir t))))
 345   (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan))
 346
 347 (defun gnus-uu-decode-save (n file)
 348   "Saves the current article."
 349   (interactive
 350    (list current-prefix-arg
 351          (read-file-name
 352           (if gnus-uu-save-separate-articles
 353               "Save articles is dir: "
 354             "Save articles in file: ")
 355           gnus-uu-default-dir
 356           gnus-uu-default-dir)))
 357   (setq gnus-uu-saved-article-name file)
 358   (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)
 359   (setq gnus-uu-generated-file-list
 360         (delete file gnus-uu-generated-file-list)))
 361
 362 (defun gnus-uu-decode-binhex (n dir)
 363   "Unbinhexes the current article."
 364  &n