X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=5db13b692dec2577fbcb5ab65f692f1bc1e7d073;hb=bd6f313a1adbfcd857da128d61605c93614a0455;hp=33c9d5f842609a7e5a1a7b2cdf2fcb281b30cb6e;hpb=f7b5e156b3ceb2bd730efdac968a0b9666571297;p=gnus diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 33c9d5f84..5db13b692 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,8 +1,8 @@ -;;; mm-uu.el -- Return uu stuff 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, 2003 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)) @@ -32,20 +31,26 @@ (require 'mm-decode) (require 'mailcap) (require 'mml2015) -(require 'uudecode) -(require 'binhex) -;; This is not the right place for this. uudecode.el should decide -;; whether or not to use a program with a single interface, but I -;; guess it's too late now. Also the default should depend on a test -;; for the program. -- fx +(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 Lisp by default, therefore decoding may appear to be horribly slow. You can make Gnus use an external decoder, such as uudecode." :type '(choice - (function-item :tag "Internal" uudecode-decode-region) + (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) @@ -54,9 +59,12 @@ decoder, such as 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 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-----") @@ -67,14 +75,22 @@ 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.") + +(defcustom mm-uu-diff-groups-regexp "gnus\\.commits" + "*Regexp matching diff groups." + :type 'regexp + :group 'gnus-article-mime) + (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) @@ -84,12 +100,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$" 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" @@ -117,19 +138,28 @@ 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) + (diff + "^Index: " + nil + mm-uu-diff-extract + nil + mm-uu-diff-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 @@ -156,8 +186,13 @@ To disable dissecting shar codes, for instance, add "Copy the contents of the current buffer to a fresh buffer. Return that buffer." (save-excursion - (let ((obuf (current-buffer))) + (let ((obuf (current-buffer)) + (coding-system + ;; Might not exist in non-MULE XEmacs + (when (boundp 'buffer-file-coding-system) + buffer-file-coding-system))) (set-buffer (generate-new-buffer " *mm-uu*")) + (setq buffer-file-coding-system coding-system) (insert-buffer-substring obuf from to) (current-buffer)))) @@ -168,7 +203,7 @@ Return that buffer." (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 @@ -188,7 +223,7 @@ Return that buffer." (if (looking-at ".+") (setq file-name (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) + '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 0)))))) (defun mm-uu-binhex-filename () @@ -196,6 +231,12 @@ Return that buffer." (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) @@ -206,8 +247,33 @@ Return that buffer." (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-diff-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("text/x-patch"))) + +(defun mm-uu-diff-test () + (and gnus-newsgroup-name + mm-uu-diff-groups-regexp + (string-match mm-uu-diff-groups-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)))) @@ -237,6 +303,19 @@ Return that buffer." (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"))) @@ -256,7 +335,10 @@ Return that buffer." ((eq mm-verify-option 'never) nil) ((eq mm-verify-option 'always) t) ((eq mm-verify-option 'known) t) - (t (y-or-n-p "Verify pgp signed part?"))))) + (t (y-or-n-p "Verify pgp signed part? "))))) + +(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)))) @@ -269,20 +351,22 @@ Return that buffer." (funcall (mml2015-clear-verify-function)))) (when (and mml2015-use (null (mml2015-clear-verify-function))) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details + 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)))) - (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-set-handle-multipart-parameter mm-security-handle 'protocol "application/x-gnus-pgp-signature") (save-restriction (narrow-to-region start-point end-point) @@ -290,7 +374,7 @@ Return that buffer." (list 'buffer (mm-uu-copy-to-buffer)) (car mm-security-handle)) (setcdr mm-security-handle - (mm-uu-pgp-signed-extract-1 nil + (mm-uu-pgp-signed-extract-1 nil mm-security-handle))) mm-security-handle)) @@ -302,7 +386,7 @@ Return that buffer." ((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-1 (handles ctl) (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) @@ -316,7 +400,7 @@ Return that buffer." (defun mm-uu-pgp-encrypted-extract () (let ((mm-security-handle (list (format "multipart/encrypted")))) - (mm-set-handle-multipart-parameter + (mm-set-handle-multipart-parameter mm-security-handle 'protocol "application/x-gnus-pgp-encrypted") (save-restriction (narrow-to-region start-point end-point) @@ -324,7 +408,7 @@ Return that buffer." (list 'buffer (mm-uu-copy-to-buffer)) (car mm-security-handle)) (setcdr mm-security-handle - (mm-uu-pgp-encrypted-extract-1 nil + (mm-uu-pgp-encrypted-extract-1 nil mm-security-handle))) mm-security-handle)) @@ -345,15 +429,15 @@ Return that buffer." (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) @@ -368,7 +452,7 @@ Return that buffer." (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)))) @@ -376,7 +460,7 @@ Return that buffer." (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