X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=cd201152455d4230989d1f82e747cb043ee001a9;hb=931e64049c6d898e55d204449f536e170937a03c;hp=c51dd6698fcb9f693ea1dad977386affdb52c298;hpb=324363043f771819426e05a28a4b1e40596e81ad;p=gnus diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index c51dd6698..cd2011524 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,8 +1,8 @@ -;;; mm-uu.el -- Return uu stuffs as mm handles -;; Copyright (c) 1998, 1999, 2000 Free Software Foundation, Inc. +;;; mm-uu.el --- Return uu stuff as mm handles +;; Copyright (c) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp +;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp ;; This file is part of GNU Emacs. @@ -23,7 +23,6 @@ ;;; Commentary: - ;;; Code: (eval-when-compile (require 'cl)) @@ -33,29 +32,39 @@ (require 'mailcap) (require 'mml2015) -(eval-and-compile - (autoload 'binhex-decode-region "binhex") - (autoload 'binhex-decode-region-external "binhex") - (autoload 'uudecode-decode-region "uudecode") - (autoload 'uudecode-decode-region-external "uudecode")) +(autoload 'uudecode-decode-region "uudecode") +(autoload 'uudecode-decode-region-external "uudecode") +(autoload 'uudecode-decode-region-internal "uudecode") + +(autoload 'binhex-decode-region "binhex") +(autoload 'binhex-decode-region-external "binhex") +(autoload 'binhex-decode-region-internal "binhex") + +(autoload 'yenc-decode-region "yenc") +(autoload 'yenc-extract-filename "yenc") (defcustom mm-uu-decode-function 'uudecode-decode-region "*Function to uudecode. -Internal function is done in elisp by default, therefore decoding may -appear to be horribly slow . You can make Gnus use the external Unix +Internal function is done in Lisp by default, therefore decoding may +appear to be horribly slow. You can make Gnus use an external decoder, such as uudecode." - :type '(choice (item :tag "internal" uudecode-decode-region) - (item :tag "external" uudecode-decode-region-external)) - :group 'gnus-article-mime) + :type '(choice + (function-item :tag "Auto detect" uudecode-decode-region) + (function-item :tag "Internal" uudecode-decode-region-internal) + (function-item :tag "External" uudecode-decode-region-external)) + :group 'gnus-article-mime) (defcustom mm-uu-binhex-decode-function 'binhex-decode-region "*Function to binhex decode. Internal function is done in elisp by default, therefore decoding may appear to be horribly slow . You can make Gnus use the external Unix decoder, such as hexbin." - :type '(choice (item :tag "internal" binhex-decode-region) - (item :tag "external" binhex-decode-region-external)) - :group 'gnus-article-mime) + :type '(choice (function-item :tag "Auto detect" binhex-decode-region) + (function-item :tag "Internal" binhex-decode-region-internal) + (function-item :tag "External" binhex-decode-region-external)) + :group 'gnus-article-mime) + +(defvar mm-uu-yenc-decode-function 'yenc-decode-region) (defvar mm-uu-pgp-beginning-signature "^-----BEGIN PGP SIGNATURE-----") @@ -66,14 +75,17 @@ decoder, such as hexbin." "The default disposition of uu parts. This can be either \"inline\" or \"attachment\".") +(defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources" + "The regexp of emacs sources groups.") + (defvar mm-uu-type-alist - '((postscript + '((postscript "^%!PS-" "^%%EOF$" mm-uu-postscript-extract nil) - (uu - "^begin[ \t]+[0-7][0-7][0-7][ \t]+" + (uu + "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+" "^end[ \t]*$" mm-uu-uu-extract mm-uu-uu-filename) @@ -83,12 +95,17 @@ This can be either \"inline\" or \"attachment\".") mm-uu-binhex-extract nil mm-uu-binhex-filename) - (shar + (yenc + "^=ybegin.*size=[0-9]+.*name=.*$" + "^=yend.*size=[0-9]+" + mm-uu-yenc-extract + mm-uu-yenc-filename) + (shar "^#! */bin/sh" - "^exit 0\\|^$" + "^exit 0$" mm-uu-shar-extract) - (forward -;;; Thanks to Edward J. Sabol and + (forward +;;; Thanks to Edward J. Sabol and ;;; Peter von der Ah\'e "^-+ \\(Start of \\)?Forwarded message" "^-+ End \\(of \\)?forwarded message" @@ -116,19 +133,22 @@ This can be either \"inline\" or \"attachment\".") "^-----END PGP PUBLIC KEY BLOCK-----" mm-uu-pgp-key-extract mm-uu-gpg-key-skip-to-last - nil))) + nil) + (emacs-sources + "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--" + "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here" + mm-uu-emacs-sources-extract + nil + mm-uu-emacs-sources-test))) -(defcustom mm-uu-configure-list nil +(defcustom mm-uu-configure-list '((shar . disabled)) "A list of mm-uu configuration. To disable dissecting shar codes, for instance, add `(shar . disabled)' to this list." - :type `(repeat (cons - ,(cons 'choice - (mapcar - (lambda (entry) - (cons 'item (car entry))) - mm-uu-type-alist)) - (choice (item disabled)))) + :type 'alist + :options (mapcar (lambda (entry) + (list (car entry) '(const disabled))) + mm-uu-type-alist) :group 'gnus-article-mime) ;; functions @@ -151,8 +171,9 @@ To disable dissecting shar codes, for instance, add (defsubst mm-uu-function-2 (entry) (nth 5 entry)) -(defun mm-uu-copy-to-buffer (from to) - "Copy the contents of the current buffer to a fresh buffer." +(defun mm-uu-copy-to-buffer (&optional from to) + "Copy the contents of the current buffer to a fresh buffer. +Return that buffer." (save-excursion (let ((obuf (current-buffer))) (set-buffer (generate-new-buffer " *mm-uu*")) @@ -166,7 +187,7 @@ To disable dissecting shar codes, for instance, add (if symbol (set-default symbol value)) (setq mm-uu-beginning-regexp nil) (mapcar (lambda (entry) - (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) + (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) nil (setq mm-uu-beginning-regexp (concat mm-uu-beginning-regexp @@ -186,7 +207,7 @@ To disable dissecting shar codes, for instance, add (if (looking-at ".+") (setq file-name (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 0)))))) (defun mm-uu-binhex-filename () @@ -194,6 +215,12 @@ To disable dissecting shar codes, for instance, add (ignore-errors (binhex-decode-region start-point end-point t)))) +(defun mm-uu-yenc-filename () + (goto-char start-point) + (setq file-name + (ignore-errors + (yenc-extract-filename)))) + (defun mm-uu-forward-test () (save-excursion (goto-char start-point) @@ -204,8 +231,24 @@ To disable dissecting shar codes, for instance, add (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) '("application/postscript"))) +(defun mm-uu-emacs-sources-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("application/emacs-lisp") + nil nil + (list mm-dissect-disposition + (cons 'filename file-name)))) + +(eval-when-compile + (defvar gnus-newsgroup-name)) + +(defun mm-uu-emacs-sources-test () + (setq file-name (match-string 1)) + (and gnus-newsgroup-name + mm-uu-emacs-sources-regexp + (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name))) + (defun mm-uu-forward-extract () - (mm-make-handle (mm-uu-copy-to-buffer + (mm-make-handle (mm-uu-copy-to-buffer (progn (goto-char start-point) (forward-line) (point)) (progn (goto-char end-point) (forward-line -1) (point))) '("message/rfc822" (charset . gnus-decoded)))) @@ -235,6 +278,19 @@ To disable dissecting shar codes, for instance, add (list mm-dissect-disposition (cons 'filename file-name))))) +(defun mm-uu-yenc-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + (list (or (and file-name + (string-match "\\.[^\\.]+$" file-name) + (mailcap-extension-to-mime + (match-string 0 file-name))) + "application/octet-stream")) + 'x-yenc nil + (if (and file-name (not (equal file-name ""))) + (list mm-dissect-disposition + (cons 'filename file-name))))) + + (defun mm-uu-shar-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) '("application/x-shar"))) @@ -246,7 +302,7 @@ To disable dissecting shar codes, for instance, add (narrow-to-region (point) end-point) (mm-dissect-buffer t))) -(defun mm-uu-pgp-signed-test () +(defun mm-uu-pgp-signed-test (&rest rest) (and mml2015-use (mml2015-clear-verify-function) @@ -256,29 +312,48 @@ To disable dissecting shar codes, for instance, add ((eq mm-verify-option 'known) t) (t (y-or-n-p "Verify pgp signed part?"))))) -(defun mm-uu-pgp-signed-extract () - (let ((buf (mm-uu-copy-to-buffer start-point end-point)) - (mm-security-handle (list (format "multipart/signed")))) - (mm-set-handle-multipart-parameter - mm-security-handle 'protocol "application/pgp-signature") +(eval-when-compile + (defvar gnus-newsgroup-charset)) + +(defun mm-uu-pgp-signed-extract-1 (handles ctl) + (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) (with-current-buffer buf - (when (mm-uu-pgp-signed-test) - (mml2015-clean-buffer) - (let ((coding-system-for-write (or gnus-newsgroup-charset - 'iso-8859-1))) - (funcall (mml2015-clear-verify-function)))) + (if (mm-uu-pgp-signed-test) + (progn + (mml2015-clean-buffer) + (let ((coding-system-for-write (or gnus-newsgroup-charset + 'iso-8859-1))) + (funcall (mml2015-clear-verify-function)))) + (when (and mml2015-use (null (mml2015-clear-verify-function))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (format "Clear verification not supported by `%s'.\n" mml2015-use)))) (goto-char (point-min)) (if (search-forward "\n\n" nil t) (delete-region (point-min) (point))) (if (re-search-forward mm-uu-pgp-beginning-signature nil t) - (delete-region (match-beginning 0) (point-max)))) - (setcdr mm-security-handle - (list - (mm-make-handle buf - '("text/plain" (charset . gnus-decoded))))) + (delete-region (match-beginning 0) (point-max))) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (replace-match "" t t) + (forward-line 1))) + (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded)))))) + +(defun mm-uu-pgp-signed-extract () + (let ((mm-security-handle (list (format "multipart/signed")))) + (mm-set-handle-multipart-parameter + mm-security-handle 'protocol "application/x-gnus-pgp-signature") + (save-restriction + (narrow-to-region start-point end-point) + (add-text-properties 0 (length (car mm-security-handle)) + (list 'buffer (mm-uu-copy-to-buffer)) + (car mm-security-handle)) + (setcdr mm-security-handle + (mm-uu-pgp-signed-extract-1 nil + mm-security-handle))) mm-security-handle)) -(defun mm-uu-pgp-encrypted-test () +(defun mm-uu-pgp-encrypted-test (&rest rest) (and mml2015-use (mml2015-clear-decrypt-function) @@ -286,21 +361,30 @@ To disable dissecting shar codes, for instance, add ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) t) - (t (y-or-n-p "Decrypt pgp encrypted part?"))))) + (t (y-or-n-p "Decrypt pgp encrypted part? "))))) -(defun mm-uu-pgp-encrypted-extract () - (let ((buf (mm-uu-copy-to-buffer start-point end-point)) - (mm-security-handle (list (format "multipart/encrypted")))) - (mm-set-handle-multipart-parameter - mm-security-handle 'protocol "application/pgp-encrypted") +(defun mm-uu-pgp-encrypted-extract-1 (handles ctl) + (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) (if (mm-uu-pgp-encrypted-test) (with-current-buffer buf (mml2015-clean-buffer) (funcall (mml2015-clear-decrypt-function)))) - (setcdr mm-security-handle - (list - (mm-make-handle buf - '("text/plain" (charset . gnus-decoded))))) + (list + (mm-make-handle buf + '("text/plain" (charset . gnus-decoded)))))) + +(defun mm-uu-pgp-encrypted-extract () + (let ((mm-security-handle (list (format "multipart/encrypted")))) + (mm-set-handle-multipart-parameter + mm-security-handle 'protocol "application/x-gnus-pgp-encrypted") + (save-restriction + (narrow-to-region start-point end-point) + (add-text-properties 0 (length (car mm-security-handle)) + (list 'buffer (mm-uu-copy-to-buffer)) + (car mm-security-handle)) + (setcdr mm-security-handle + (mm-uu-pgp-encrypted-extract-1 nil + mm-security-handle))) mm-security-handle)) (defun mm-uu-gpg-key-skip-to-last () @@ -320,15 +404,15 @@ To disable dissecting shar codes, for instance, add (mm-make-handle buf '("application/pgp-keys")))) -;;;### autoload +;;;###autoload (defun mm-uu-dissect () "Dissect the current buffer and return a list of uu handles." (let ((case-fold-search t) - text-start start-point end-point file-name result + text-start start-point end-point file-name result text-plain-type entry func) (save-excursion (goto-char (point-min)) - (cond + (cond ((looking-at "\n") (forward-line)) ((search-forward "\n\n" nil t) @@ -343,7 +427,7 @@ To disable dissecting shar codes, for instance, add (let ((alist mm-uu-type-alist) (beginning-regexp (match-string 0))) (while (not entry) - (if (string-match (mm-uu-beginning-regexp (car alist)) + (if (string-match (mm-uu-beginning-regexp (car alist)) beginning-regexp) (setq entry (car alist)) (pop alist)))) @@ -351,7 +435,7 @@ To disable dissecting shar codes, for instance, add (funcall func)) (forward-line);; in case of failure (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)) - (let ((end-regexp (mm-uu-end-regexp entry))) + (let ((end-regexp (mm-uu-end-regexp entry))) (if (not end-regexp) (or (setq end-point (point-max)) t) (prog1