Keep track of the natural width of TD elements, so we know which ones to expand.

[gnus] / lisp / mm-decode.el

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 948fc08..70b735a 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -105,7 +105,8 @@
         ,disposition ,description ,cache ,id))
 
 (defcustom mm-text-html-renderer
-  (cond ((executable-find "w3m") 'gnus-article-html)
+  (cond ((fboundp 'libxml-parse-html-region) 'mm-shr)
+       ((executable-find "w3m") 'gnus-article-html)
        ((executable-find "links") 'links)
        ((executable-find "lynx") 'lynx)
        ((locate-library "w3") 'w3)
@@ -368,8 +369,12 @@ enables you to choose manually one of two types those mails include."
   :group 'mime-display)
 
 (defcustom mm-inline-large-images nil
-  "If non-nil, then all images fit in the buffer."
-  :type 'boolean
+  "If t, then all images fit in the buffer.
+If 'resize, try to resize the images so they fit."
+  :type '(radio
+          (const :tag "Inline large images as they are." t)
+          (const :tag "Resize large images." resize)
+          (const :tag "Do not inline large images." nil))
   :group 'mime-display)
 
 (defcustom mm-file-name-rewrite-functions
@@ -1147,13 +1152,15 @@ in HANDLE."
   ;; time to adjust it, since we know at this point that it should
   ;; be unibyte.
   `(let* ((handle ,handle))
-     (with-temp-buffer
-       (mm-disable-multibyte)
-       (insert-buffer-substring (mm-handle-buffer handle))
-       (mm-decode-content-transfer-encoding
-       (mm-handle-encoding handle)
-       (mm-handle-media-type handle))
-       ,@forms)))
+     (when (and (mm-handle-buffer handle)
+               (buffer-name (mm-handle-buffer handle)))
+       (with-temp-buffer
+        (mm-disable-multibyte)
+        (insert-buffer-substring (mm-handle-buffer handle))
+        (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))
 
@@ -1246,9 +1253,13 @@ PROMPT overrides the default one used to ask user for a file name."
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
                                        (file-name-nondirectory filename))))
     (setq file
-          (read-file-name (or prompt "Save MIME part to: ")
+          (read-file-name (or prompt
+                             (format "Save MIME part to (default %s): "
+                                     (or filename "")))
                           (or mm-default-directory default-directory)
-                          nil nil (or filename "")))
+                         (or filename "")))
+    (when (file-directory-p file)
+      (setq file (expand-file-name filename file)))
     (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? "
@@ -1317,11 +1328,11 @@ Use CMD as the process."
   "Display HANDLE using METHOD."
   (let* ((type (mm-handle-media-type handle))
         (methods
-         (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
+         (mapcar (lambda (i) (cdr (assoc 'viewer i)))
                  (mailcap-mime-info type 'all)))
         (method (let ((minibuffer-local-completion-map
                        mm-viewer-completion-map))
-                  (completing-read "Viewer: " methods))))
+                  (gnus-completing-read "Viewer" methods))))
     (when (string= method "")
       (error "No method given"))
     (if (string-match "^[^% \t]+$" method)
@@ -1473,7 +1484,7 @@ be determined."
    ;; Handle XEmacs
    ((fboundp 'valid-image-instantiator-format-p)
     (valid-image-instantiator-format-p format))
-   ;; Handle Emacs 21
+   ;; Handle Emacs
    ((fboundp 'image-type-available-p)
     (and (display-graphic-p)
         (image-type-available-p format)))
@@ -1668,6 +1679,38 @@ If RECURSIVE, search recursively."
         (and (eq (mm-body-7-or-8) '7bit)
              (not (mm-long-lines-p 76))))))
 
+(declare-function libxml-parse-html-region "xml.c"
+                 (start end &optional base-url))
+(declare-function shr-insert-document "shr" (dom))
+
+(defun mm-shr (handle)
+  ;; Require since we bind its variables.
+  (require 'shr)
+  (let ((article-buffer (current-buffer))
+       (shr-blocked-images (with-current-buffer gnus-summary-buffer
+                             gnus-blocked-images))
+       (shr-content-function (lambda (id)
+                               (let ((handle (mm-get-content-id id)))
+                                 (when handle
+                                   (mm-with-part handle
+                                     (buffer-string))))))
+       charset)
+    (unless handle
+      (setq handle (mm-dissect-buffer t)))
+    (setq charset (mail-content-type-get (mm-handle-type handle) 'charset))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (shr-insert-document
+       (mm-with-part handle
+        (when (and charset
+                   (setq charset (mm-charset-to-coding-system charset))
+                   (not (eq charset 'ascii)))
+          (insert (prog1
+                      (mm-decode-coding-string (buffer-string) charset)
+                    (erase-buffer)
+                    (mm-enable-multibyte))))
+        (libxml-parse-html-region (point-min) (point-max)))))))
+
 (provide 'mm-decode)
 
 ;;; mm-decode.el ends here