X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=4197b2aa54ae3b200f714bc52f42d45574ecf799;hp=782184153632d9ec258ae7123c990f48e846ff63;hb=HEAD;hpb=f4d486326efc55e51816619defc4353e97fb1d96 diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 782184153..4197b2aa5 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -1,27 +1,24 @@ ;;; mm-uu.el --- Return uu stuff as mm handles -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -68,9 +65,6 @@ decoder, such as hexbin." (defvar mm-uu-yenc-decode-function 'yenc-decode-region) -(defvar mm-uu-pgp-beginning-signature - "^-----BEGIN PGP SIGNATURE-----") - (defvar mm-uu-beginning-regexp nil) (defvar mm-dissect-disposition "inline" @@ -92,7 +86,7 @@ This can be either \"inline\" or \"attachment\".") (defcustom mm-uu-tex-groups-regexp "\\.tex\\>" "*Regexp matching TeX groups." - :version "23.0" + :version "23.1" :type 'regexp :group 'gnus-article-mime) @@ -124,7 +118,7 @@ This can be either \"inline\" or \"attachment\".") mm-uu-shar-extract) (forward ;; Thanks to Edward J. Sabol and - ;; Peter von der Ah\'e + ;; Peter von der Ahé "^-+ \\(Start of \\)?Forwarded message" "^-+ End \\(of \\)?forwarded message" mm-uu-forward-extract @@ -164,13 +158,25 @@ This can be either \"inline\" or \"attachment\".") mm-uu-diff-extract nil mm-uu-diff-test) + (diff + "^=== modified file " + nil + mm-uu-diff-extract + nil + mm-uu-diff-test) + (git-format-patch + "^diff --git " + "^-- " + mm-uu-diff-extract + nil + mm-uu-diff-test) (message-marks ;; Text enclosed with tags similar to `message-mark-insert-begin' and ;; `message-mark-insert-end'. Don't use those variables to avoid ;; dependency on `message.el'. "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" - (lambda () (mm-uu-verbatim-marks-extract 0 -1 1 -1)) + (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1)) nil) ;; Omitting [a-z8<] leads to false positives (bogus signature separators ;; and mailing list banners). @@ -181,22 +187,33 @@ This can be either \"inline\" or \"attachment\".") nil) (verbatim-marks ;; slrn-style verbatim marks, see - ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81 + ;; http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks "^#v\\+" "^#v\\-$" - (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1)) + (lambda () (mm-uu-verbatim-marks-extract 0 0)) nil) (LaTeX "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]" "^\\\\end{document}" mm-uu-latex-extract nil - mm-uu-latex-test)) + mm-uu-latex-test) + (org-src-code-block + "^[ \t]*#\\+begin_" + "^[ \t]*#\\+end_" + mm-uu-org-src-code-block-extract) + (org-meta-line + "^[ \t]*#\\+[[:alpha:]]+: " + "$" + mm-uu-org-src-code-block-extract)) "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].") +After modifying this list you must run \\[mm-uu-configure]. + +You can disable elements from this list by customizing +`mm-uu-configure-list'.") (defcustom mm-uu-configure-list '((shar . disabled)) "A list of mm-uu configuration. @@ -245,14 +262,22 @@ The value should be nil on displays where the face `mm-uu-extract' isn't distinguishable to the face `default'." :type '(choice (const :tag "Hide" t) (const :tag "Don't hide" nil)) - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'gnus-article-mime) -(defface mm-uu-extract '(;; Colors from `gnus-cite-3' plus background: +(defface mm-uu-extract '(;; Inspired by `gnus-cite-3' + (((type tty) + (class color) + (background dark)) + (:background "dark blue")) (((class color) (background dark)) (:foreground "light yellow" :background "dark green")) + (((type tty) + (class color) + (background light)) + (:foreground "dark blue")) (((class color) (background light)) (:foreground "dark green" @@ -261,7 +286,7 @@ The value should be nil on displays where the face ())) "Face for extracted buffers." ;; See `mm-uu-verbatim-marks-extract'. - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'gnus-article-mime) (defun mm-uu-copy-to-buffer (&optional from to properties) @@ -272,11 +297,14 @@ 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 + (multi (and (boundp 'enable-multibyte-characters) + enable-multibyte-characters)) + (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*") + (if multi (mm-enable-multibyte) (mm-disable-multibyte)) (setq buffer-file-coding-system coding-system) (insert-buffer-substring obuf from to) (cond ((eq properties t) @@ -305,11 +333,10 @@ apply the face `mm-uu-extract'." (mm-uu-configure) -(eval-when-compile - (defvar file-name) - (defvar start-point) - (defvar end-point) - (defvar entry)) +(defvar file-name) +(defvar start-point) +(defvar end-point) +(defvar entry) (defun mm-uu-uu-filename () (if (looking-at ".+") @@ -375,8 +402,11 @@ apply the face `mm-uu-extract'." (list mm-dissect-disposition (cons 'filename file-name)))) -(eval-when-compile - (defvar gnus-newsgroup-name)) +(defun mm-uu-org-src-code-block-extract () + (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + '("text/x-org"))) + +(defvar gnus-newsgroup-name) (defun mm-uu-emacs-sources-test () (setq file-name (match-string 1)) @@ -400,7 +430,11 @@ apply the face `mm-uu-extract'." (defun mm-uu-forward-extract () (mm-make-handle (mm-uu-copy-to-buffer - (progn (goto-char start-point) (forward-line) (point)) + (progn + (goto-char start-point) + (forward-line) + (skip-chars-forward "\n") + (point)) (progn (goto-char end-point) (forward-line -1) (point))) '("message/rfc822" (charset . gnus-decoded)))) @@ -429,8 +463,14 @@ apply the face `mm-uu-extract'." (list mm-dissect-disposition (cons 'filename file-name))))) +(defvar gnus-original-article-buffer) ; gnus.el + (defun mm-uu-yenc-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) + ;; This might not be exactly correct, but we sure can't get the + ;; binary data from the article buffer, since that's already in a + ;; non-binary charset. So get it from the original article buffer. + (mm-make-handle (with-current-buffer gnus-original-article-buffer + (mm-uu-copy-to-buffer start-point end-point)) (list (or (and file-name (string-match "\\.[^\\.]+$" file-name) (mailcap-extension-to-mime @@ -465,8 +505,7 @@ apply the face `mm-uu-extract'." (y-or-n-p "Verify pgp signed part? ") (message "")))))) -(eval-when-compile - (defvar gnus-newsgroup-charset)) +(defvar gnus-newsgroup-charset) (defun mm-uu-pgp-signed-extract-1 (handles ctl) (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) @@ -474,31 +513,20 @@ apply the face `mm-uu-extract'." (if (mm-uu-pgp-signed-test) (progn (mml2015-clean-buffer) - (let ((coding-system-for-write (or gnus-newsgroup-charset - 'iso-8859-1))) + (let ((coding-system-for-write (or buffer-file-coding-system + gnus-newsgroup-charset + 'iso-8859-1)) + (coding-system-for-read (or buffer-file-coding-system + 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)) - (forward-line) - ;; We need to be careful not to strip beyond the armor headers. - ;; Previously, an attacker could replace the text inside our - ;; markup with trailing garbage by injecting whitespace into the - ;; message. - (while (looking-at "Hash:") ; The only header allowed in cleartext - (forward-line)) ; signatures according to RFC2440. - (when (looking-at "[\t ]*$") - (forward-line)) - (delete-region (point-min) (point)) - (if (re-search-forward mm-uu-pgp-beginning-signature nil t) - (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 mm-uu-text-plain-type)))) + (gnus-format-message + "Clear verification not supported by `%s'.\n" mml2015-use))) + (mml2015-extract-cleartext-signature)) + (list (mm-make-handle buf mm-uu-text-plain-type))))) (defun mm-uu-pgp-signed-extract () (let ((mm-security-handle (list (format "multipart/signed")))) @@ -646,22 +674,34 @@ value of `mm-uu-text-plain-type'." (goto-char text-start) (re-search-forward "." start-point t))) (push - (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - mm-uu-text-plain-type) + (mm-make-handle + (mm-uu-copy-to-buffer + text-start + ;; A start-separator is likely accompanied by + ;; a leading newline. + (if (and (eq (char-before start-point) ?\n) + (eq (char-before (1- start-point)) ?\n)) + (1- start-point) + start-point)) + mm-uu-text-plain-type) result)) (push (funcall (mm-uu-function-extract entry)) result) (goto-char (setq text-start end-point)))) (when result - (if (and (> (point-max) (1+ text-start)) - (save-excursion - (goto-char text-start) - (re-search-forward "." nil t))) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - mm-uu-text-plain-type) - result)) + (goto-char text-start) + (when (re-search-forward "." nil t) + (push (mm-make-handle + (mm-uu-copy-to-buffer + ;; An end-separator is likely accompanied by + ;; a trailing newline. + (if (eq (char-after text-start) ?\n) + (1+ text-start) + text-start) + (point-max)) + mm-uu-text-plain-type) + result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) @@ -682,6 +722,8 @@ Assume text has been decoded if DECODED is non-nil." ;; Mutt still uses application/pgp even though ;; it has already been withdrawn. (string-match "\\`text/\\|\\`application/pgp\\'" type) + (equal (car (mm-handle-disposition handle)) + "inline") (setq children (with-current-buffer buffer @@ -729,5 +771,8 @@ Assume text has been decoded if DECODED is non-nil." (provide 'mm-uu) -;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c +;; Local Variables: +;; coding: utf-8 +;; End: + ;;; mm-uu.el ends here