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

   1 ;;; mm-uu.el --- Return uu stuff as mm handles
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   7 ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
   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 3 of the License, or
  14 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29 (require 'mail-parse)
  30 (require 'nnheader)
  31 (require 'mm-decode)
  32 (require 'mailcap)
  33 (require 'mml2015)
  34
  35 (autoload 'uudecode-decode-region "uudecode")
  36 (autoload 'uudecode-decode-region-external "uudecode")
  37 (autoload 'uudecode-decode-region-internal "uudecode")
  38
  39 (autoload 'binhex-decode-region "binhex")
  40 (autoload 'binhex-decode-region-external "binhex")
  41 (autoload 'binhex-decode-region-internal "binhex")
  42
  43 (autoload 'yenc-decode-region "yenc")
  44 (autoload 'yenc-extract-filename "yenc")
  45
  46 (defcustom mm-uu-decode-function 'uudecode-decode-region
  47   "*Function to uudecode.
  48 Internal function is done in Lisp by default, therefore decoding may
  49 appear to be horribly slow.  You can make Gnus use an external
  50 decoder, such as uudecode."
  51   :type '(choice
  52           (function-item :tag "Auto detect" uudecode-decode-region)
  53           (function-item :tag "Internal" uudecode-decode-region-internal)
  54           (function-item :tag "External" uudecode-decode-region-external))
  55   :group 'gnus-article-mime)
  56
  57 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
  58   "*Function to binhex decode.
  59 Internal function is done in elisp by default, therefore decoding may
  60 appear to be horribly slow . You can make Gnus use the external Unix
  61 decoder, such as hexbin."
  62   :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
  63                  (function-item :tag "Internal" binhex-decode-region-internal)
  64                  (function-item :tag "External" binhex-decode-region-external))
  65   :group 'gnus-article-mime)
  66
  67 (defvar mm-uu-yenc-decode-function 'yenc-decode-region)
  68
  69 (defvar mm-uu-beginning-regexp nil)
  70
  71 (defvar mm-dissect-disposition "inline"
  72   "The default disposition of uu parts.
  73 This can be either \"inline\" or \"attachment\".")
  74
  75 (defcustom mm-uu-emacs-sources-regexp "\\.emacs\\.sources"
  76   "The regexp of Emacs sources groups."
  77   :version "22.1"
  78   :type 'regexp
  79   :group 'gnus-article-mime)
  80
  81 (defcustom mm-uu-diff-groups-regexp
  82   "\\(gmane\\|gnu\\)\\..*\\(diff\\|commit\\|cvs\\|bug\\|devel\\)"
  83   "Regexp matching diff groups."
  84   :version "22.1"
  85   :type 'regexp
  86   :group 'gnus-article-mime)
  87
  88 (defcustom mm-uu-tex-groups-regexp "\\.tex\\>"
  89   "*Regexp matching TeX groups."
  90   :version "23.1"
  91   :type 'regexp
  92   :group 'gnus-article-mime)
  93
  94 (defvar mm-uu-type-alist
  95   '((postscript
  96      "^%!PS-"
  97      "^%%EOF$"
  98      mm-uu-postscript-extract
  99      nil)
 100     (uu ;; Maybe we should have a more strict test here.
 101      "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
 102      "^end[ \t]*$"
 103      mm-uu-uu-extract
 104      mm-uu-uu-filename)
 105     (binhex
 106      "^:.\\{63,63\\}$"
 107      ":$"
 108      mm-uu-binhex-extract
 109      nil
 110      mm-uu-binhex-filename)
 111     (yenc
 112      "^=ybegin.*size=[0-9]+.*name=.*$"
 113      "^=yend.*size=[0-9]+"
 114      mm-uu-yenc-extract
 115      mm-uu-yenc-filename)
 116     (shar
 117      "^#! */bin/sh"
 118      "^exit 0$"
 119      mm-uu-shar-extract)
 120     (forward
 121      ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
 122      ;; Peter von der Ah\'e <pahe@daimi.au.dk>
 123      "^-+ \\(Start of \\)?Forwarded message"
 124      "^-+ End \\(of \\)?forwarded message"
 125      mm-uu-forward-extract
 126      nil
 127      mm-uu-forward-test)
 128     (gnatsweb
 129      "^----gnatsweb-attachment----"
 130      nil
 131      mm-uu-gnatsweb-extract)
 132     (pgp-signed
 133      "^-----BEGIN PGP SIGNED MESSAGE-----"
 134      "^-----END PGP SIGNATURE-----"
 135      mm-uu-pgp-signed-extract
 136      nil
 137      nil)
 138     (pgp-encrypted
 139      "^-----BEGIN PGP MESSAGE-----"
 140      "^-----END PGP MESSAGE-----"
 141      mm-uu-pgp-encrypted-extract
 142      nil
 143      nil)
 144     (pgp-key
 145      "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
 146      "^-----END PGP PUBLIC KEY BLOCK-----"
 147      mm-uu-pgp-key-extract
 148      mm-uu-gpg-key-skip-to-last
 149      nil)
 150     (emacs-sources
 151      "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
 152      "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
 153      mm-uu-emacs-sources-extract
 154      nil
 155      mm-uu-emacs-sources-test)
 156     (diff
 157      "^Index: "
 158      nil
 159      mm-uu-diff-extract
 160      nil
 161      mm-uu-diff-test)
 162     (message-marks
 163      ;; Text enclosed with tags similar to `message-mark-insert-begin' and
 164      ;; `message-mark-insert-end'.  Don't use those variables to avoid
 165      ;; dependency on `message.el'.
 166      "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$"
 167      "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$"
 168      (lambda () (mm-uu-verbatim-marks-extract -1 0 1 -1))
 169      nil)
 170     ;; Omitting [a-z8<] leads to false positives (bogus signature separators
 171     ;; and mailing list banners).
 172     (insert-marks
 173      "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
 174      "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
 175      (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
 176      nil)
 177     (verbatim-marks
 178      ;; slrn-style verbatim marks, see
 179      ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81
 180      "^#v\\+"
 181      "^#v\\-$"
 182      (lambda () (mm-uu-verbatim-marks-extract 0 0))
 183      nil)
 184     (LaTeX
 185      "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
 186      "^\\\\end{document}"
 187      mm-uu-latex-extract
 188      nil
 189      mm-uu-latex-test))
 190   "A list of specifications for non-MIME attachments.
 191 Each element consist of the following entries: label,
 192 start-regexp, end-regexp, extract-function, test-function.
 193
 194 After modifying this list you must run \\[mm-uu-configure].
 195
 196 You can disable elements from this list by customizing
 197 `mm-uu-configure-list'.")
 198
 199 (defcustom mm-uu-configure-list '((shar . disabled))
 200   "A list of mm-uu configuration.
 201 To disable dissecting shar codes, for instance, add
 202 `(shar . disabled)' to this list."
 203   :type 'alist
 204   :options (mapcar (lambda (entry)
 205                      (list (car entry) '(const disabled)))
 206                    mm-uu-type-alist)
 207   :group 'gnus-article-mime)
 208
 209 (defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
 210   "MIME type and parameters for text/plain parts.
 211 `gnus-decoded' is a fake charset, which means no further decoding.")
 212
 213 ;; functions
 214
 215 (defsubst mm-uu-type (entry)
 216   (car entry))
 217
 218 (defsubst mm-uu-beginning-regexp (entry)
 219   (nth 1 entry))
 220
 221 (defsubst mm-uu-end-regexp (entry)
 222   (nth 2 entry))
 223
 224 (defsubst mm-uu-function-extract (entry)
 225   (nth 3 entry))
 226
 227 (defsubst mm-uu-function-1 (entry)
 228   (nth 4 entry))
 229
 230 (defsubst mm-uu-function-2 (entry)
 231   (nth 5 entry))
 232
 233 ;; In Emacs 22, we could use `min-colors' in the face definition.  But Emacs
 234 ;; 21 and XEmacs don't support it.
 235 (defcustom mm-uu-hide-markers
 236   (< 16 (or (and (fboundp 'defined-colors)
 237                  (length (defined-colors)))
 238             (and (fboundp 'device-color-cells)
 239                  (device-color-cells))
 240             0))
 241   "If non-nil, hide verbatim markers.
 242 The value should be nil on displays where the face
 243 `mm-uu-extract' isn't distinguishable to the face `default'."
 244   :type '(choice (const :tag "Hide" t)
 245                  (const :tag "Don't hide" nil))
 246   :version "23.1" ;; No Gnus
 247   :group 'gnus-article-mime)
 248
 249 (defface mm-uu-extract '(;; Inspired by `gnus-cite-3'
 250                          (((type tty)
 251                            (class color)
 252                            (background dark))
 253                           (:background "dark blue"