From: Miles Bader Date: Sun, 19 Mar 2006 19:39:53 +0000 (+0000) Subject: Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163 X-Git-Tag: emacs-pretest-22.0.90~3519 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=531bedc37c5e0b060c51565ba3a17ef471c2b510;p=emacs.git Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 58-61) - Update from CVS --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 8023af47bfd..48bbc095375 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,38 @@ +2006-03-17 Katsumi Yamaoka + + * mm-decode.el (mm-with-part): New macro. + (mm-get-part): Use it; work with message/external-body as well. + (mm-save-part): Treat name and filename equally. + + * mm-extern.el (mm-extern-cache-contents): New function. + (mm-inline-external-body): Use it; force the part to be displayed; + move undisplayer added to the cached handle to the parent. + + * gnus-art.el (gnus-mime-save-part-and-strip): Add name parameter. + (gnus-mime-view-part-as-type): Work with message/external-body. + + * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode. + +2006-03-15 Andreas Seltenreich + + * gnus-art.el (gnus-article-only-boring-p): Bind + inhibit-point-motion-hooks to avoid infinite loop when entering + intangible text. Reported by Ralf Wachinger + . + +2006-03-14 Simon Josefsson + + * message.el (message-unique-id): Don't use message-number-base36 + if (user-uid) is a float. Reported by Bjorn Solberg + . + +2006-03-13 Katsumi Yamaoka + + * mm-uu.el (mm-uu-dissect): Dissect all parts correctly. + + * gnus-art.el (gnus-mime-display-single): Make sure there is an + empty line between a part and a message part. + 2006-03-10 Reiner Steib * smiley.el: Add more test smileys. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 0c9cb18506a..69fe8159c10 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -49,6 +49,7 @@ (autoload 'gnus-button-mailto "gnus-msg") (autoload 'gnus-button-reply "gnus-msg" nil t) (autoload 'parse-time-string "parse-time" nil nil) +(autoload 'mm-extern-cache-contents "mm-extern") (defgroup gnus-article nil "Article display." @@ -4151,6 +4152,9 @@ Deleting parts may malfunction or destroy the article; continue? ") (insert "Content-Type: " (mm-handle-media-type data)) (mml-insert-parameter-string (cdr (mm-handle-type data)) '(charset)) + ;; Add a filename for the sake of saving the part again. + (mml-insert-parameter + (mail-header-encode-parameter "name" (file-name-nondirectory file))) (insert "\n") (insert "Content-ID: " (message-make-message-id) "\n") (insert "Content-Transfer-Encoding: binary\n") @@ -4330,6 +4334,10 @@ Deleting parts may malfunction or destroy the article; continue? ") (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) (when handle + (when (equal (mm-handle-media-type handle) "message/external-body") + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (setq handle (mm-handle-cache handle))) (setq handle (mm-make-handle (mm-handle-buffer handle) (cons mime-type (cdr (mm-handle-type handle))) @@ -4889,13 +4897,18 @@ If displaying \"text/html\" is discouraged \(see (let ((id (1+ (length gnus-article-mime-handle-alist))) beg) (push (cons id handle) gnus-article-mime-handle-alist) + (when (and display + (equal (mm-handle-media-supertype handle) "message")) + (insert-char + ?\n + (cond ((not (bolp)) 2) + ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0) + (t 1)))) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) - ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) (gnus-article-insert-newline) - ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) @@ -5313,14 +5326,15 @@ not have a face in `gnus-article-boring-faces'." (boundp 'gnus-article-boring-faces) (symbol-value 'gnus-article-boring-faces)) (save-excursion - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (gnus-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) - (throw 'only-boring nil))) - (throw 'only-boring t))))) + (let ((inhibit-point-motion-hooks t)) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (gnus-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces))) + (throw 'only-boring nil))) + (throw 'only-boring t)))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 686fe1cf837..cb3a4e9209c 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1459,6 +1459,9 @@ Return nil otherwise." display)) display))))) +(eval-when-compile + (defvar tool-bar-mode)) + (defun gnus-tool-bar-update (&rest ignore) "Update the tool bar." (when (and (boundp 'tool-bar-mode) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 1bdc2f6a11f..236ec1bc23f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -4671,7 +4671,9 @@ If NOW, use that time instead." (* 25 25))) (let ((tm (current-time))) (concat - (if (memq system-type '(ms-dos emx vax-vms)) + (if (or (memq system-type '(ms-dos emx vax-vms)) + ;; message-number-base36 doesn't handle bigints. + (floatp (user-uid))) (let ((user (downcase (user-login-name)))) (while (string-match "[^a-z0-9_]" user) (aset user (match-beginning 0) ?_)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 01557659fd6..f0f1ee430ff 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -36,6 +36,7 @@ (autoload 'executable-find "executable") (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") + (autoload 'mm-extern-cache-contents "mm-extern") (autoload 'mm-insert-inline "mm-view")) (defvar gnus-current-window-configuration) @@ -1082,17 +1083,35 @@ external if displayed external." ;;; Functions for outputting parts ;;; +(defmacro mm-with-part (handle &rest forms) + "Run FORMS in the temp buffer containing the contents of HANDLE." + `(let* ((handle ,handle) + ;; The multibyteness of the temp buffer should be turned on + ;; if inserting a multibyte string. Contrarily, the buffer's + ;; multibyteness should be off if inserting a unibyte string, + ;; especially if a string contains 8bit data. + (default-enable-multibyte-characters + (with-current-buffer (mm-handle-buffer handle) + (mm-multibyte-p)))) + (with-temp-buffer + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-disable-multibyte) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + ,@forms))) +(put 'mm-with-part 'lisp-indent-function 1) +(put 'mm-with-part 'edebug-form-spec '(body)) + (defun mm-get-part (handle) "Return the contents of HANDLE as a string." - (let ((default-enable-multibyte-characters - (with-current-buffer (mm-handle-buffer handle) - (mm-multibyte-p)))) - (with-temp-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-disable-multibyte) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) + (if (equal (mm-handle-media-type handle) "message/external-body") + (progn + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (with-current-buffer (mm-handle-buffer (mm-handle-cache handle)) + (buffer-string))) + (mm-with-part handle (buffer-string)))) (defun mm-insert-part (handle) @@ -1148,18 +1167,19 @@ string if you do not like underscores." (defun mm-save-part (handle) "Write HANDLE to a file." - (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) - (filename (mail-content-type-get - (mm-handle-disposition handle) 'filename)) - file) + (let ((filename (or (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (mail-content-type-get + (mm-handle-type handle) 'name))) + file) (when filename (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file (mm-with-multibyte - (read-file-name "Save MIME part to: " - (or mm-default-directory default-directory) - nil nil (or filename name "")))) + (read-file-name "Save MIME part to: " + (or mm-default-directory default-directory) + nil nil (or filename "")))) (setq mm-default-directory (file-name-directory file)) (and (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? " diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index da3ecb8f351..b736374f016 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -112,11 +112,8 @@ (insert "[" info "]\n\n"))) ;;;###autoload -(defun mm-inline-external-body (handle &optional no-display) - "Show the external-body part of HANDLE. -This function replaces the buffer of HANDLE with a buffer contains -the entire message. -If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." +(defun mm-extern-cache-contents (handle) + "Put the external-body part of HANDLE into its cache." (let* ((access-type (cdr (assq 'access-type (cdr (mm-handle-type handle))))) (func (cdr (assq (intern @@ -124,48 +121,61 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (or access-type (error "Couldn't find access type")))) mm-extern-function-alist))) - gnus-displaying-mime buf - handles) - (unless (mm-handle-cache handle) - (unless func - (error "Access type (%s) is not supported" access-type)) - (with-temp-buffer - (mm-insert-part handle) - (goto-char (point-max)) - (insert "\n\n") - (setq handles (mm-dissect-buffer t))) - (unless (bufferp (car handles)) - (mm-destroy-parts handles) - (error "Multipart external body is not supported")) - (save-excursion ;; single part - (set-buffer (setq buf (mm-handle-buffer handles))) - (let (good) - (unwind-protect - (progn - (funcall func handle) - (setq good t)) - (unless good - (mm-destroy-parts handles)))) - (mm-handle-set-cache handle handles)) - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles))) - (unless no-display - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (gnus-display-mime (mm-handle-cache handle)) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (condition-case nil - ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground)) - (error nil)) - (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + buf handles) + (unless func + (error "Access type (%s) is not supported" access-type)) + (mm-with-part handle + (goto-char (point-max)) + (insert "\n\n") + ;; It should be just a single MIME handle. + (setq handles (mm-dissect-buffer t))) + (unless (bufferp (car handles)) + (mm-destroy-parts handles) + (error "Multipart external body is not supported")) + (save-excursion + (set-buffer (setq buf (mm-handle-buffer handles))) + (let (good) + (unwind-protect + (progn + (funcall func handle) + (setq good t)) + (unless good + (mm-destroy-parts handles)))) + (mm-handle-set-cache handle handles)) + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handles)))) + +;;;###autoload +(defun mm-inline-external-body (handle &optional no-display) + "Show the external-body part of HANDLE. +This function replaces the buffer of HANDLE with a buffer contains +the entire message. +If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (let* ((type (regexp-quote + (mm-handle-media-type (mm-handle-cache handle)))) + ;; Force the part to be displayed (but if there is no + ;; method to display, a user will be prompted to save). + ;; See `gnus-mime-display-single'. + (mm-inline-override-types nil) + (mm-attachment-override-types + (cons type mm-attachment-override-types)) + (mm-automatic-display (cons type mm-automatic-display)) + (mm-automatic-external-display + (cons type mm-automatic-external-display)) + ;; Suppress adding of button to the cached part. + (gnus-inhibit-mime-unbuttonizing nil)) + (gnus-display-mime (mm-handle-cache handle))) + ;; Move undisplayer added to the cached handle to the parent. + (mm-handle-set-undisplayer + handle + (mm-handle-undisplayer (mm-handle-cache handle))) + (mm-handle-set-undisplayer (mm-handle-cache handle) nil))))) (provide 'mm-extern) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index eb5afa794f5..9029e0d699c 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -464,7 +464,8 @@ value of `mm-uu-text-plain-type'." (t (goto-char (point-max)))) (setq text-start (point)) (while (re-search-forward mm-uu-beginning-regexp nil t) - (setq start-point (match-beginning 0)) + (setq start-point (match-beginning 0) + entry nil) (let ((alist mm-uu-type-alist) (beginning-regexp (match-string 0))) (while (not entry)