X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=31948466d5d5f28f10b85512aa040c2adfcce6fa;hb=4cacb5f23eb830e6950dba987063f413977708d7;hp=4efbfffe25c18c3969754e6e511930c5d92c778a;hpb=9c9d2770c2c2e5b6f8027943272b00fc807cebc3;p=elisp%2Fgnus.git- diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 4efbfff..3194846 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,6 +1,7 @@ ;;; mm-uu.el --- Return uu stuff as mm handles -;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp @@ -19,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -76,11 +77,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-emacs-sources-regexp "\\.emacs\\.sources" + "The regexp of Emacs sources groups." + :version "22.1" + :type 'regexp + :group 'gnus-article-mime) + +(defcustom mm-uu-diff-groups-regexp + "\\(gmane\\|gnu\\)\\..*\\(diff\\|commit\\|cvs\\|bug\\|devel\\)" + "Regexp matching diff groups." + :version "22.1" + :type 'regexp + :group 'gnus-article-mime) -(defcustom mm-uu-diff-groups-regexp "gnus\\.commits" - "*Regexp matching diff groups." +(defcustom mm-uu-tex-groups-regexp "\\.tex\\>" + "*Regexp matching TeX groups." + :version "23.0" :type 'regexp :group 'gnus-article-mime) @@ -111,8 +123,8 @@ This can be either \"inline\" or \"attachment\".") "^exit 0$" mm-uu-shar-extract) (forward -;;; Thanks to Edward J. Sabol and -;;; Peter von der Ah\'e + ;; Thanks to Edward J. Sabol and + ;; Peter von der Ah\'e "^-+ \\(Start of \\)?Forwarded message" "^-+ End \\(of \\)?forwarded message" mm-uu-forward-extract @@ -151,7 +163,25 @@ This can be either \"inline\" or \"attachment\".") nil mm-uu-diff-extract nil - mm-uu-diff-test))) + mm-uu-diff-test) + (verbatim-marks + ;; slrn-style verbatim marks, see + ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81 + "^#v\\+" + "^#v\\-$" + mm-uu-verbatim-marks-extract + nil) + (LaTeX + "^\\\\documentclass" + "^\\\\end{document}" + mm-uu-latex-extract + nil + mm-uu-latex-test)) + "A list of specifications for non-MIME attachments. +Each element consist of the following entries: label, +start-regexp, end-regexp, extract-function, test-function. + +After modifying this list you must run \\[mm-uu-configure].") (defcustom mm-uu-configure-list '((shar . disabled)) "A list of mm-uu configuration. @@ -187,24 +217,48 @@ To disable dissecting shar codes, for instance, add (defsubst mm-uu-function-2 (entry) (nth 5 entry)) -(defun mm-uu-copy-to-buffer (&optional from to) +(defface mm-uu-extract + '((((class color) + (background dark)) + (:background "gray5")) + (((class color) + (background light)) + (:background "gray95")) + (t + ())) + "Face for extracted buffers." + ;; See `mm-uu-verbatim-marks-extract'. + :version "23.0" ;; No Gnus + :group 'gnus-article-mime) + +(defun mm-uu-copy-to-buffer (&optional from to properties) "Copy the contents of the current buffer to a fresh buffer. -Return that buffer." - (save-excursion - (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*")) +Return that buffer. + +If PROPERTIES is non-nil, PROPERTIES are applied to the buffer, +see `set-text-properties'. If PROPERTIES equals t, this means to +apply the face `mm-uu-extract'." + (let ((obuf (current-buffer)) + (coding-system + ;; Might not exist in non-MULE XEmacs + (when (boundp 'buffer-file-coding-system) + buffer-file-coding-system))) + (with-current-buffer (generate-new-buffer " *mm-uu*") (setq buffer-file-coding-system coding-system) (insert-buffer-substring obuf from to) + (cond ((eq properties t) + (set-text-properties (point-min) (point-max) + '(face mm-uu-extract))) + (properties + (set-text-properties (point-min) (point-max) properties))) (current-buffer)))) (defun mm-uu-configure-p (key val) (member (cons key val) mm-uu-configure-list)) (defun mm-uu-configure (&optional symbol value) + "Configure detection of non-MIME attachments." + (interactive) (if symbol (set-default symbol value)) (setq mm-uu-beginning-regexp nil) (mapcar (lambda (entry) @@ -252,6 +306,20 @@ Return that buffer." (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) '("application/postscript"))) +(defun mm-uu-verbatim-marks-extract () + (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)) + t) + '("text/x-verbatim" (charset . gnus-decoded)))) + +(defun mm-uu-latex-extract () + (mm-make-handle + (mm-uu-copy-to-buffer start-point end-point t) + ;; application/x-tex? + '("text/x-verbatim" (charset . gnus-decoded)))) + (defun mm-uu-emacs-sources-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) '("application/emacs-lisp") @@ -277,6 +345,11 @@ Return that buffer." mm-uu-diff-groups-regexp (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name))) +(defun mm-uu-latex-test () + (and gnus-newsgroup-name + mm-uu-tex-groups-regexp + (string-match mm-uu-tex-groups-regexp gnus-newsgroup-name))) + (defun mm-uu-forward-extract () (mm-make-handle (mm-uu-copy-to-buffer (progn (goto-char start-point) (forward-line) (point)) @@ -500,11 +573,13 @@ value of `mm-uu-text-plain-type'." (defun mm-uu-dissect-text-parts (handle) "Dissect text parts and put uu handles into HANDLE." (let ((buffer (mm-handle-buffer handle)) - children) + type children) (cond ((stringp buffer) (mapc 'mm-uu-dissect-text-parts (cdr handle))) ((bufferp buffer) - (when (and (equal "text/plain" (mm-handle-media-type handle)) + (when (and (setq type (mm-handle-media-type handle)) + (stringp type) + (string-match "\\`text/" type) (with-current-buffer buffer (setq children (mm-uu-dissect t (mm-handle-type handle)))))