From 637e885c07c8f1e1f12bb05e408b497222d4dc19 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 17 Mar 2006 10:43:46 +0000 Subject: [PATCH] Synch to No Gnus 200603171043. --- lisp/ChangeLog | 15 ++++++++ lisp/gnus-art.el | 8 +++++ lisp/gnus-util.el | 3 ++ lisp/mm-decode.el | 52 ++++++++++++++++++--------- lisp/mm-extern.el | 104 +++++++++++++++++++++++++++++------------------------ 5 files changed, 119 insertions(+), 63 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f42a2c8..23c8b64 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +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-16 Reiner Steib * gmm-utils.el (gmm-image-load-path-for-library): Prefer user's diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 2f94550..a734dda 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -68,6 +68,7 @@ (autoload 'parse-time-string "parse-time" nil nil) (autoload 'ansi-color-apply-on-region "ansi-color") (autoload 'mm-url-insert-file-contents-external "mm-url") +(autoload 'mm-extern-cache-contents "mm-extern") (defgroup gnus-article nil "Article display." @@ -4710,6 +4711,9 @@ The current article has a complicated MIME structure, giving up...")) (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") @@ -4826,6 +4830,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))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 19b4e7d..9825c09 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1457,6 +1457,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/mm-decode.el b/lisp/mm-decode.el index 0a39fd7..bf910e9 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -35,6 +35,7 @@ (eval-and-compile (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) @@ -1076,17 +1077,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) @@ -1143,18 +1162,19 @@ string if you do not like underscores." (defun mm-save-part (handle &optional prompt) "Write HANDLE to a file. PROMPT overrides the default one used to ask user for a file name." - (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 (or prompt "Save MIME part to: ") - (or mm-default-directory default-directory) - nil nil (or filename name "")))) + (read-file-name (or prompt "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/mm-extern.el b/lisp/mm-extern.el index 84d47cf..0cd68d6 100644 --- a/lisp/mm-extern.el +++ b/lisp/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) -- 1.7.10.4