Commit 8e45f27f authored by Katsumi Yamaoka's avatar Katsumi Yamaoka
Browse files

gnus-art.el: Misc improvements for displaying MIME parts

* gnus-art.el (gnus-mm-display-part): Don't put article out of sight
while prompting a user for a file name, etc.
(gnus-mime-display-single): Display part with a common appearance no
matter whether MIME button is omitted or not; don't add duplicate entry
to gnus-article-mime-handle-alist.
(gnus-mime-buttonize-attachments-in-header): Use copied buttons.
parent b722ea4e
2014-05-09 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-mm-display-part): Don't put article out of sight
while prompting a user for a file name, etc.
(gnus-mime-display-single): Display part with a common appearance no
matter whether MIME button is omitted or not; don't add duplicate entry
to gnus-article-mime-handle-alist.
(gnus-mime-buttonize-attachments-in-header): Use copied buttons.
2014-05-08 Adam Sjøgren <asjo@koldfront.dk> 2014-05-08 Adam Sjøgren <asjo@koldfront.dk>
   
* mml2015.el (mml2015-display-key-image): New variable. * mml2015.el (mml2015-display-key-image): New variable.
......
...@@ -5693,27 +5693,36 @@ all parts." ...@@ -5693,27 +5693,36 @@ all parts."
(setq point (previous-single-property-change (setq point (previous-single-property-change
(next-single-property-change point 'gnus-data) (next-single-property-change point 'gnus-data)
'gnus-data)) 'gnus-data))
(forward-line)
(if (mm-handle-displayed-p handle) (if (mm-handle-displayed-p handle)
;; This will remove the part. ;; This will remove the part.
(setq retval (mm-display-part handle)) (setq retval (mm-display-part handle))
(save-window-excursion (let ((part (or (and (mm-inlinable-p handle)
(save-restriction (mm-inlined-p handle)
;; FIXME: nothing is displayed in the article buffer t)
;; while prompting a user for a file name. (with-temp-buffer
(narrow-to-region (point) (gnus-bind-safe-url-regexp
(if (eobp) (point) (1+ (point)))) (setq retval (mm-display-part handle)))
(gnus-bind-safe-url-regexp (unless (zerop (buffer-size))
(setq retval (mm-display-part handle))) (buffer-string))))))
;; We narrow to the part itself and (forward-line)
;; then call the treatment functions. (cond ((stringp part)
(goto-char (point-min)) (save-restriction
(forward-line 1) (narrow-to-region (point)
(narrow-to-region (point) (point-max)) (progn
(gnus-treat-article (insert part)
nil id (unless (bolp) (insert "\n"))
(gnus-article-mime-total-parts) (point)))
(mm-handle-media-type handle)))))) (gnus-treat-article nil id
(gnus-article-mime-total-parts)
(mm-handle-media-type handle))
(mm-handle-set-undisplayer
handle
`(lambda ()
(let ((inhibit-read-only t))
(delete-region ,(copy-marker (point-min) t)
,(point-max-marker)))))))
(part
(mm-display-inline handle))))))
(goto-char point) (goto-char point)
;; Toggle the button appearance between `[button]...' and `[button]'. ;; Toggle the button appearance between `[button]...' and `[button]'.
(gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle))) (gnus-insert-mime-button handle id (list (mm-handle-displayed-p handle)))
...@@ -5985,7 +5994,6 @@ If nil, don't show those extra buttons." ...@@ -5985,7 +5994,6 @@ If nil, don't show those extra buttons."
(let ((type (mm-handle-media-type handle)) (let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types) (ignored gnus-ignored-mime-types)
(not-attachment t) (not-attachment t)
(move nil)
display text) display text)
(catch 'ignored (catch 'ignored
(progn (progn
...@@ -6011,9 +6019,11 @@ If nil, don't show those extra buttons." ...@@ -6011,9 +6019,11 @@ If nil, don't show those extra buttons."
(setq display t) (setq display t)
(when (equal (mm-handle-media-supertype handle) "text") (when (equal (mm-handle-media-supertype handle) "text")
(setq text t))) (setq text t)))
(let ((id (1+ (length gnus-article-mime-handle-alist))) (let ((id (car (rassq handle gnus-article-mime-handle-alist)))
beg) beg)
(push (cons id handle) gnus-article-mime-handle-alist) (unless id
(setq id (1+ (length gnus-article-mime-handle-alist)))
(push (cons id handle) gnus-article-mime-handle-alist))
(when (and display (when (and display
(equal (mm-handle-media-supertype handle) "message")) (equal (mm-handle-media-supertype handle) "message"))
(insert-char (insert-char
...@@ -6025,16 +6035,13 @@ If nil, don't show those extra buttons." ...@@ -6025,16 +6035,13 @@ If nil, don't show those extra buttons."
(not (gnus-unbuttonized-mime-type-p type)) (not (gnus-unbuttonized-mime-type-p type))
(eq id gnus-mime-buttonized-part-id)) (eq id gnus-mime-buttonized-part-id))
(gnus-insert-mime-button (gnus-insert-mime-button
handle id (list (or display (and not-attachment text)))) handle id (list (or display (and not-attachment text)))))
(gnus-article-insert-newline) (gnus-article-insert-newline)
;; Remember modify the number of forward lines. (when (or display (and text not-attachment))
(setq move t)) (forward-line -1))
(setq beg (point)) (setq beg (point))
(cond (cond
(display (display
(when move
(forward-line -1)
(setq beg (point)))
(let ((mail-parse-charset gnus-newsgroup-charset) (let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets (mail-parse-ignored-charsets
(save-excursion (condition-case () (save-excursion (condition-case ()
...@@ -6044,9 +6051,6 @@ If nil, don't show those extra buttons." ...@@ -6044,9 +6051,6 @@ If nil, don't show those extra buttons."
(gnus-bind-safe-url-regexp (mm-display-part handle t))) (gnus-bind-safe-url-regexp (mm-display-part handle t)))
(goto-char (point-max))) (goto-char (point-max)))
((and text not-attachment) ((and text not-attachment)
(when move
(forward-line -1)
(setq beg (point)))
(gnus-article-insert-newline) (gnus-article-insert-newline)
(mm-display-inline handle) (mm-display-inline handle)
(goto-char (point-max)))) (goto-char (point-max))))
...@@ -6334,7 +6338,7 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." ...@@ -6334,7 +6338,7 @@ in the body. Use `gnus-header-face-alist' to highlight buttons."
(setcar handle (caar handle)))) (setcar handle (caar handle))))
flat) flat)
flat)))) flat))))
(let ((case-fold-search t) buttons st) (let ((case-fold-search t) buttons st handle)
(save-excursion (save-excursion
(save-restriction (save-restriction
(widen) (widen)
...@@ -6371,7 +6375,9 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." ...@@ -6371,7 +6375,9 @@ in the body. Use `gnus-header-face-alist' to highlight buttons."
(dolist (button (nreverse buttons)) (dolist (button (nreverse buttons))
(setq st (point)) (setq st (point))
(insert " ") (insert " ")
(gnus-insert-mime-button (cdr button) (car button)) (mm-handle-set-undisplayer
(setq handle (copy-sequence (cdr button))) nil)
(gnus-insert-mime-button handle (car button))
(skip-chars-backward "\t\n ") (skip-chars-backward "\t\n ")
(delete-region (point) (point-max)) (delete-region (point) (point-max))
(when (> (current-column) (window-width)) (when (> (current-column) (window-width))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment