From a224eabf0a66b50f89df35b6f02fc093b68f77c0 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Wed, 5 Feb 2014 09:53:17 +0000 Subject: [PATCH] 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. --- 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(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fa9bfaea6..f933f75d8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2014-02-05 Katsumi Yamaoka + + * 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 * nnimap.el (nnimap-request-articles): New command to download several diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 0b0f1dd53..50cd60c54 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,26 +5657,22 @@ all parts." (if (mm-handle-displayed-p handle) ;; This will remove the part. (mm-display-part handle) - (save-restriction - (narrow-to-region (point) - (if (eobp) (point) (1+ (point)))) - (gnus-bind-safe-url-regexp (mm-display-part handle)) - ;; We narrow to the part itself and - ;; then call the treatment functions. - (goto-char (point-min)) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle))))) + (save-window-excursion + (save-restriction + (narrow-to-region (point) + (if (eobp) (point) (1+ (point)))) + (gnus-bind-safe-url-regexp (mm-display-part handle)) + ;; We narrow to the part itself and + ;; then call the treatment functions. + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (point-max)) + (gnus-treat-article + nil id + (gnus-article-mime-total-parts) + (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 0ed921f7e..2dc8593c6 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 0f5e01913..86f6a08ac 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,9 @@ +2014-02-05 Katsumi Yamaoka + + * gnus.texi (MIME Commands): Mention + gnus-mime-buttonize-attachments-in-header and + gnus-mime-display-attachment-buttons-in-header. + 2014-02-01 Lars Ingebrigtsen * message.texi (Forwarding): Mention diff --git a/texi/gnus.texi b/texi/gnus.texi index 61e328769..9fceed508 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 -- 2.25.1