Synch to No Gnus 200603171043.
authoryamaoka <yamaoka>
Fri, 17 Mar 2006 10:43:46 +0000 (10:43 +0000)
committeryamaoka <yamaoka>
Fri, 17 Mar 2006 10:43:46 +0000 (10:43 +0000)
lisp/ChangeLog
lisp/gnus-art.el
lisp/gnus-util.el
lisp/mm-decode.el
lisp/mm-extern.el

index f42a2c8..23c8b64 100644 (file)
@@ -1,3 +1,18 @@
+2006-03-17  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * 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  <Reiner.Steib@gmx.de>
 
        * gmm-utils.el (gmm-image-load-path-for-library): Prefer user's
index 2f94550..a734dda 100644 (file)
@@ -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)))
index 19b4e7d..9825c09 100644 (file)
@@ -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)
index 0a39fd7..bf910e9 100644 (file)
@@ -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? "
index 84d47cf..0cd68d6 100644 (file)
     (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)