[gnus git] branch master updated: m0-9-37-ga224eab =1= Buttonize MIME attachments in the article header
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via a224eabf0a66b50f89df35b6f02fc093b68f77c0 (commit)
from 5a0a6cc1fef60642ac30c3e24e06b8a45c994612 (commit)
- Log -----------------------------------------------------------------
commit a224eabf0a66b50f89df35b6f02fc093b68f77c0
Author: Katsumi Yamaoka <[email protected]>
Date: Wed Feb 5 09:53:17 2014 +0000
Buttonize MIME attachments in the article header
* gnus.texi (MIME Commands): Mention
gnus-mime-buttonize-attachments-in-header and
gnus-mime-display-attachment-buttons-in-header.
* gnus-art.el (gnus-mime-display-attachment-buttons-in-header):
New user option.
(gnus-mime-buttonize-attachments-in-header): New function.
(gnus-article-prepare): Use it.
(gnus-mime-inline-part): Suppress extra newline.
(gnus-mm-display-part): Save excursion;
remove useless deleting and adding of buttons.
(gnus-insert-mime-button): Allow insertion in the middle of a line.
* gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu):
Add gnus-mime-buttonize-attachments-in-header.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fa9bfae..f933f75 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2014-02-05 Katsumi Yamaoka <[email protected]>
+
+ * gnus-art.el (gnus-mime-display-attachment-buttons-in-header):
+ New user option.
+ (gnus-mime-buttonize-attachments-in-header): New function.
+ (gnus-article-prepare): Use it.
+ (gnus-mime-inline-part): Suppress extra newline.
+ (gnus-mm-display-part): Save excursion;
+ remove useless deleting and adding of buttons.
+ (gnus-insert-mime-button): Allow insertion in the middle of a line.
+
+ * gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu):
+ Add gnus-mime-buttonize-attachments-in-header.
+
2014-02-05 Lars Ingebrigtsen <[email protected]>
* nnimap.el (nnimap-request-articles): New command to download several
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 0b0f1dd..50cd60c 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -4696,6 +4696,9 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(when (or (numberp article)
(stringp article))
(gnus-article-prepare-display)
+ ;; Add attachment buttons to the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header))
;; Do page break.
(goto-char (point-min))
(when gnus-break-pages
@@ -5329,7 +5332,7 @@ Compressed files like .gz and .bz2 are decompressed."
(mm-read-coding-system "Charset: "))))
((mm-handle-undisplayer handle)
(mm-remove-part handle)))
- (forward-line 2)
+ (forward-line 1)
(mm-display-inline handle)
(goto-char b)))))
@@ -5654,6 +5657,7 @@ all parts."
(if (mm-handle-displayed-p handle)
;; This will remove the part.
(mm-display-part handle)
+ (save-window-excursion
(save-restriction
(narrow-to-region (point)
(if (eobp) (point) (1+ (point))))
@@ -5666,14 +5670,9 @@ all parts."
(gnus-treat-article
nil id
(gnus-article-mime-total-parts)
- (mm-handle-media-type handle)))))
+ (mm-handle-media-type handle))))))
(if (window-live-p window)
- (select-window window)))))
- (goto-char point)
- (gnus-delete-line)
- (gnus-insert-mime-button
- handle id (list (mm-handle-displayed-p handle)))
- (goto-char point))))
+ (select-window window))))))))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
@@ -5734,8 +5733,6 @@ all parts."
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
- (unless (bolp)
- (insert "\n"))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
@@ -5860,6 +5857,16 @@ If displaying \"text/html\" is discouraged \(see
:group 'gnus-article-mime
:type 'boolean)
+(defcustom gnus-mime-display-attachment-buttons-in-header t
+ "Add attachment buttons in the end of the header of an article.
+Since MIME attachments tend to be put at the end of an article, we may
+overlook them if there is a huge body. This option offers you a copy
+of all non-inlinable MIME parts as buttons shown in front of an article.
+If nil, don't show those extra buttons."
+ :version "24.5"
+ :group 'gnus-article
+ :type 'boolean)
+
(defun gnus-mime-display-part (handle)
(cond
;; Maybe a broken MIME message.
@@ -6206,6 +6213,88 @@ Provided for backwards compatibility."
(when image
(gnus-add-image 'shr image))))
+(defun gnus-mime-buttonize-attachments-in-header (&optional interactive)
+ "Show attachments as buttons in the end of the header of an article.
+This function toggles the display when called interactively. Note that
+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)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ ;; Header buttons exist?
+ (while (and (not buttons)
+ (re-search-forward "^attachments?:[\n ]+" nil t))
+ (when (get-char-property (match-end 0)
+ 'gnus-button-attachment-extra)
+ (setq buttons (match-beginning 0))))
+ (widen)
+ (if (and interactive buttons)
+ ;; Delete header buttons.
+ (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)) (overlays-at st))
+ buttons)))
+ (setq st nd))
+ (when buttons
+ ;; Add header buttons.
+ (article-goto-body)
+ (forward-line -1)
+ (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 (copy-overlay ovl))
+ (when (setq marker
+ (plist-get (cdr (overlay-get ovl 'button))
+ :from))
+ (set-marker marker st))
+ (when (setq marker
+ (plist-get (cdr (overlay-get ovl 'button))
+ :to))
+ (set-marker marker nd))
+ (move-overlay ovl st nd)
+ (setq st nd)
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (overlay-put ovl 'face nil)))
+ (insert "\n")
+ (let ((gnus-treatment-function-alist
+ '((gnus-treat-highlight-headers
+ gnus-article-highlight-headers))))
+ (gnus-treat-article 'head))))))))))
+
;;; Article savers.
(defun gnus-output-to-file (file-name)
diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 0ed921f..2dc8593 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -2185,6 +2185,7 @@ increase the score of each group you read."
(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
"w" gnus-article-decode-mime-words
"c" gnus-article-decode-charset
+ "h" gnus-mime-buttonize-attachments-in-header
"v" gnus-mime-view-all-parts
"b" gnus-article-view-part)
@@ -2391,6 +2392,8 @@ increase the score of each group you read."
["QP" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
["View MIME buttons" gnus-summary-display-buttonized t]
+ ["View MIME buttons in header"
+ gnus-mime-buttonize-attachments-in-header t]
["View all" gnus-mime-view-all-parts t]
["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
["Encrypt body" gnus-article-encrypt-body
diff --git a/texi/ChangeLog b/texi/ChangeLog
index 0f5e019..86f6a08 100644
--- a/texi/ChangeLog
+++ b/texi/ChangeLog
@@ -1,3 +1,9 @@
+2014-02-05 Katsumi Yamaoka <[email protected]>
+
+ * gnus.texi (MIME Commands): Mention
+ gnus-mime-buttonize-attachments-in-header and
+ gnus-mime-display-attachment-buttons-in-header.
+
2014-02-01 Lars Ingebrigtsen <[email protected]>
* message.texi (Forwarding): Mention
diff --git a/texi/gnus.texi b/texi/gnus.texi
index 61e3287..9fceed5 100644
--- a/texi/gnus.texi
+++ b/texi/gnus.texi
@@ -9801,6 +9801,19 @@ Make all the @acronym{MIME} parts have buttons in front of them. This is
mostly useful if you wish to save (or perform other actions) on inlined
parts.
+@item W M h
+@kindex W M h (Summary)
+@findex gnus-mime-buttonize-attachments-in-header
+@vindex gnus-mime-display-attachment-buttons-in-header
+Display @acronym{MIME} part buttons in the end of the header of an
+article (@code{gnus-mime-buttonize-attachments-in-header}). This
+command toggles the display. Note that buttons to be added to the
+header are only the ones that aren't inlined in the body. If you want
+those buttons always to be displayed, set
+@code{gnus-mime-display-attachment-buttons-in-header} to non-@code{nil}.
+The default is @code{t}. To change the appearance of buttons, customize
+@code{gnus-header-face-alist}.
+
@item K m
@kindex K m (Summary)
@findex gnus-summary-repair-multipart
-----------------------------------------------------------------------
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 | 14 ++++++
lisp/gnus-art.el | 133 +++++++++++++++++++++++++++++++++++++++++++++---------
lisp/gnus-sum.el | 3 ++
texi/ChangeLog | 6 +++
texi/gnus.texi | 13 ++++++
5 files changed, 147 insertions(+), 22 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