lisp/gnus/gnus-art.el: Refactored out gnus-article-mime-handles

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2f0641f139c111924f92b9a42b160f7a522c84b3..d8dd1d3b5fddccfe8f5b0f293f45eb6325219aa0 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,9 @@
+2014-12-09  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-art.el (gnus-article-mime-handles): Refactored out into own
+       function for reuse.
+       (gnus-mime-buttonize-attachments-in-header): Adjusted.
+
 2014-12-07  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * message.el (message-change-subject): Really check whether the subject
@@ -13,7 +19,7 @@
 
        * gnus-cloud.el (gnus-cloud): Add :version tag.
 
-2014-11-29  John Mastro <john.b.mastro@gmail.com>  (tiny change)
+2014-11-29  John Mastro  <john.b.mastro@gmail.com>  (tiny change)
 
        * auth-source.el (auth-source-macos-keychain-search-items): Return
        result of `auth-source-macos-keychain-result-append' (bug#19074).

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 62a60b2011129045bfa6c6eb0b471dae54cbc97f..53da05e939ba2d802b063907684a66ce9237a36c 100644 (file)
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6335,6 +6335,40 @@ Provided for backwards compatibility."
     (when image
       (gnus-add-image 'shr image))))
 
+(defun gnus-article-mime-handles (&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 (gnus-article-mime-handles
+                                     (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 (gnus-article-mime-handles
+                                   (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)
+             (if (cdar handle)
+                 ;; This is a hidden (i.e. unnumbered) handle.
+                 (progn
+                   (setcar handle
+                           (1+ (caar gnus-article-mime-handle-alist)))
+                   (push handle gnus-article-mime-handle-alist))
+               (setcar handle (caar handle))))
+           flat)
+      flat)))
+
 (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
@@ -6342,108 +6376,70 @@ 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
-    (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)
-                     (if (cdar handle)
-                         ;; This is a hidden (i.e. unnumbered) handle.
-                         (progn
-                           (setcar handle
-                                   (1+ (caar gnus-article-mime-handle-alist)))
-                           (push handle gnus-article-mime-handle-alist))
-                       (setcar handle (caar handle))))
-                   flat)
-             flat))))
-      (let ((case-fold-search t) buttons handle type st)
-       (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)
+    (let ((case-fold-search t) buttons handle type st)
+      (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)
+         (when buttons
+           ;; Delete header buttons.
+           (delete-region buttons (if (re-search-forward "^[^ ]" nil t)
+                                      (match-beginning 0)
+                                    (point-max))))
+         (unless (and interactive buttons)
+           ;; Find buttons.
+           (setq buttons nil)
+           (dolist (button (gnus-article-mime-handles))
+             (setq handle (cdr button)
+                   type (mm-handle-media-type handle))
+             (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer)
+                                (with-current-buffer gnus-summary-buffer
+                                  gnus-inhibit-images)
+                              gnus-inhibit-images)
+                            (string-match "\\`image/" type))
+                       (mm-inline-override-p handle)
+                       (and (mm-handle-disposition handle)
+                            (not (equal (car (mm-handle-disposition handle))
+                                        "inline"))
+                            (not (mm-attachment-override-p handle)))
+                       (not (mm-automatic-display-p handle))
+                       (not (or (and (mm-inlinable-p handle)
+                                     (mm-inlined-p handle))
+                                (mm-automatic-external-display-p type))))
+               (push button buttons)))
            (when buttons
-             ;; Delete header buttons.
-             (delete-region buttons (if (re-search-forward "^[^ ]" nil t)
-                                        (match-beginning 0)
-                                      (point-max))))
-           (unless (and interactive buttons)
-             ;; Find buttons.
-             (setq buttons nil)
-             (dolist (button (flattened-alist))
-               (setq handle (cdr button)
-                     type (mm-handle-media-type handle))
-               (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer)
-                                  (with-current-buffer gnus-summary-buffer
-                                    gnus-inhibit-images)
-                                gnus-inhibit-images)
-                              (string-match "\\`image/" type))
-                         (mm-inline-override-p handle)
-                         (and (mm-handle-disposition handle)
-                              (not (equal (car (mm-handle-disposition handle))
-                                          "inline"))
-                              (not (mm-attachment-override-p handle)))
-                         (not (mm-automatic-display-p handle))
-                         (not (or (and (mm-inlinable-p handle)
-                                       (mm-inlined-p handle))
-                                  (mm-automatic-external-display-p type))))
-                 (push button buttons)))
-             (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))
-                 (setq st (point))
-                 (insert " ")
-                 (mm-handle-set-undisplayer
-                  (setq handle (copy-sequence (cdr button))) nil)
-                 (gnus-insert-mime-button handle (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))))
-                 (gnus-treat-article 'head))))))))))
+             ;; Add header buttons.
+             (article-goto-body)
+             (forward-line -1)
+             (narrow-to-region (point) (point))
+             (insert "Attachment" (if (cdr buttons) "s" "") ":")
+             (dolist (button (nreverse buttons))
+               (setq st (point))
+               (insert " ")
+               (mm-handle-set-undisplayer
+                (setq handle (copy-sequence (cdr button))) nil)
+               (gnus-insert-mime-button handle (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))))
+               (gnus-treat-article 'head)))))))))
 
 ;;; Article savers.