[gnus git] branch master updated: m0-9-49-g9a5c0ef =1= gnus-art.el (gnus-mime-buttonize-attachments-in-header): Display buttons that are hidden in unselected alternative part as well
Katsumi Yamaoka <[email protected]> Fri, 07 Feb 2014 08:39:59 +0100
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 9a5c0ef5be3aa743f82281d0fa62a6fce8fa8ea4 (commit)
from 9edbfcd5fac631cc5098da65c55534d4a46054e1 (commit)
- Log -----------------------------------------------------------------
commit 9a5c0ef5be3aa743f82281d0fa62a6fce8fa8ea4
Author: Katsumi Yamaoka <[email protected]>
Date: Fri Feb 7 07:39:53 2014 +0000
gnus-art.el (gnus-mime-buttonize-attachments-in-header): Display buttons that are hidden in unselected alternative part as well
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a5491c1..474b676 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
2014-02-07 Katsumi Yamaoka <[email protected]>
+ * gnus-art.el (gnus-mime-buttonize-attachments-in-header): Display
+ buttons that are hidden in unselected alternative part as well.
+ (gnus-mime-display-alternative): Redraw attachment buttons in header.
+
* gmm-utils.el (gmm-flet, gmm-labels): Add edebug spec.
2014-02-07 Lars Ingebrigtsen <[email protected]>
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 87e37f7..20b63f7 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -6107,7 +6107,10 @@ If nil, don't show those extra buttons."
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
- (goto-char point))))
+ (goto-char point)))
+ ;; Redraw attachment buttons in the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header)))
(defconst gnus-article-wash-status-strings
(let ((alist '((cite "c" "Possible hidden citation text"
@@ -6220,8 +6223,40 @@ buttons to be added to the header are only the ones that aren't inlined
in the body. Use `gnus-header-face-alist' to highlight buttons."
(interactive (list t))
(gnus-with-article-buffer
- (let ((case-fold-search t)
- buttons st nd handle marker)
+ (gmm-labels
+ ;; Function that returns a flattened version of
+ ;; `gnus-article-mime-handle-alist'.
+ ((flattened-alist
+ (&optional alist id all)
+ (if alist
+ (let ((i 1) newid flat)
+ (dolist (handle alist flat)
+ (setq newid (append id (list i))
+ i (1+ i))
+ (if (stringp (car handle))
+ (setq flat (nconc flat (flattened-alist (cdr handle)
+ newid all)))
+ (delq (rassq handle all) all)
+ (setq flat (nconc flat (list (cons newid handle)))))))
+ (let ((flat (list nil)))
+ ;; Assume that elements of `gnus-article-mime-handle-alist'
+ ;; are in the decreasing order, but unnumbered subsidiaries
+ ;; in each element are in the increasing order.
+ (dolist (handle (reverse gnus-article-mime-handle-alist))
+ (if (stringp (cadr handle))
+ (setq flat (nconc flat (flattened-alist (cddr handle)
+ (list (car handle))
+ flat)))
+ (delq (rassq (cdr handle) flat) flat)
+ (setq flat (nconc flat (list (cons (list (car handle))
+ (cdr handle)))))))
+ (setq flat (cdr flat))
+ (mapc (lambda (handle)
+ (setcar handle (mapconcat 'number-to-string (car handle)
+ ".")))
+ flat)
+ flat))))
+ (let ((case-fold-search t) buttons st)
(save-excursion
(save-restriction
(widen)
@@ -6233,31 +6268,22 @@ in the body. Use `gnus-header-face-alist' to highlight buttons."
'gnus-button-attachment-extra)
(setq buttons (match-beginning 0))))
(widen)
- (if (and interactive buttons)
+ (when buttons
;; Delete header buttons.
- (delete-region buttons
- (if (re-search-forward "^[^ ]" nil t)
+ (delete-region buttons (if (re-search-forward "^[^ ]" nil t)
(match-beginning 0)
- (point-max)))
- (unless buttons
- (article-goto-body)
- (setq st (point))
- ;; Find buttons in the body.
- (while (setq st (text-property-not-all st (point-max)
- 'gnus-part nil))
- (setq nd (or (text-property-any st (point-max) 'gnus-part nil)
- (point-max)))
- (when (and (get-text-property st 'gnus-part)
- (setq handle (get-text-property st 'gnus-data))
- (not (and (mm-inlinable-p handle)
- (mm-inlined-p handle))))
- (goto-char nd)
- (skip-chars-backward "\t\n ")
- (when (> (point) st)
- (push (cons (buffer-substring st (point))
- (gnus-overlays-at st))
- buttons)))
- (setq st nd))
+ (point-max))))
+ (unless (and interactive buttons)
+ ;; Find buttons.
+ (setq buttons nil)
+ (dolist (handle (flattened-alist))
+ (when (and (not (stringp (cadr handle)))
+ (or (equal (car (mm-handle-disposition
+ (cdr handle)))
+ "attachment")
+ (not (and (mm-inlinable-p (cdr handle))
+ (mm-inlined-p (cdr handle))))))
+ (push handle buttons)))
(when buttons
;; Add header buttons.
(article-goto-body)
@@ -6265,32 +6291,19 @@ in the body. Use `gnus-header-face-alist' to highlight buttons."
(narrow-to-region (point) (point))
(insert "Attachment" (if (cdr buttons) "s" "") ":")
(dolist (button (nreverse buttons))
- (when (> (+ (current-column) 1 (string-width (car button)))
- (window-width))
- (insert "\n"))
- (insert " ")
(setq st (point))
- (insert (car button))
- (setq nd (point))
- ;; Make buttons uncatchable by the K-prefixed commands.
- (put-text-property
- st nd 'gnus-part
- (number-to-string (get-text-property st 'gnus-part)))
- (dolist (ovl (cdr button))
- (setq ovl (gnus-copy-overlay ovl))
- (when (setq marker
- (plist-get (cdr (gnus-overlay-get ovl 'button))
- :from))
- (set-marker marker st))
- (when (setq marker
- (plist-get (cdr (gnus-overlay-get ovl 'button))
- :to))
- (set-marker marker nd))
- (gnus-move-overlay ovl st nd)
- (setq st nd)
- (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
- (gnus-overlay-put ovl 'face nil)))
+ (insert " ")
+ (gnus-insert-mime-button (cdr button) (car button))
+ (skip-chars-backward "\t\n ")
+ (delete-region (point) (point-max))
+ (when (> (current-column) (window-width))
+ (goto-char st)
(insert "\n")
+ (end-of-line)))
+ (insert "\n")
+ (dolist (ovl (gnus-overlays-in (point-min) (point)))
+ (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
+ (gnus-overlay-put ovl 'face nil))
(let ((gnus-treatment-function-alist
'((gnus-treat-highlight-headers
gnus-article-highlight-headers))))
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 4 ++
lisp/gnus-art.el | 137 ++++++++++++++++++++++++++++++------------------------
2 files changed, 79 insertions(+), 62 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project