]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: use lexical-bindings in all libraries
[notmuch] / emacs / notmuch-show.el
index a210898b7e8bccf71e33d8162a02b81799ca9ff6..72e21d94387c698739e7cc435d34d13ce40598d1 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-show.el --- displaying notmuch forests.
+;;; notmuch-show.el --- displaying notmuch forests  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson
 (declare-function notmuch-read-query "notmuch" (prompt))
 (declare-function notmuch-draft-resume "notmuch-draft" (id))
 
+(defvar shr-blocked-images)
+(defvar gnus-blocked-images)
+(defvar shr-content-function)
+
+;;; Options
+
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
 
@@ -162,23 +168,19 @@ indentation."
   :type '(choice (const nil) regexp)
   :group 'notmuch-show)
 
-(defvar notmuch-show-thread-id nil)
-(make-variable-buffer-local 'notmuch-show-thread-id)
+;;; Variables
 
-(defvar notmuch-show-parent-buffer nil)
-(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(defvar-local notmuch-show-thread-id nil)
 
-(defvar notmuch-show-query-context nil)
-(make-variable-buffer-local 'notmuch-show-query-context)
+(defvar-local notmuch-show-parent-buffer nil)
 
-(defvar notmuch-show-process-crypto nil)
-(make-variable-buffer-local 'notmuch-show-process-crypto)
+(defvar-local notmuch-show-query-context nil)
 
-(defvar notmuch-show-elide-non-matching-messages nil)
-(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
+(defvar-local notmuch-show-process-crypto nil)
 
-(defvar notmuch-show-indent-content t)
-(make-variable-buffer-local 'notmuch-show-indent-content)
+(defvar-local notmuch-show-elide-non-matching-messages nil)
+
+(defvar-local notmuch-show-indent-content t)
 
 (defvar notmuch-show-attachment-debug nil
   "If t log stdout and stderr from attachment handlers.
@@ -186,8 +188,9 @@ indentation."
 When set to nil (the default) stdout and stderr from attachment
 handlers is discarded. When set to t the stdout and stderr from
 each attachment handler is logged in buffers with names beginning
-\" *notmuch-part*\". This option requires emacs version at least
-24.3 to work.")
+\" *notmuch-part*\".")
+
+;;; Options
 
 (defcustom notmuch-show-stash-mlarchive-link-alist
   '(("Gmane" . "https://mid.gmane.org/")
@@ -267,6 +270,8 @@ position of the message in the thread."
   :type 'boolean
   :group 'notmuch-show)
 
+;;; Utilities
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message."
   `(save-excursion
@@ -282,6 +287,8 @@ position of the message in the thread."
   "Enable Visual Line mode."
   (visual-line-mode t))
 
+;;; Commands
+
 ;; DEPRECATED in Notmuch 0.16 since we now have convenient part
 ;; commands.  We'll keep the command around for a version or two in
 ;; case people want to bind it themselves.
@@ -362,6 +369,8 @@ operation on the contents of the current buffer."
   (interactive)
   (notmuch-show-with-message-as-text 'notmuch-print-message))
 
+;;; Headers
+
 (defun notmuch-show-fontify-header ()
   (let ((face (cond
               ((looking-at "[Tt]o:")
@@ -468,7 +477,10 @@ message at DEPTH in the current thread."
       ;; invisible U+200E LEFT-TO-RIGHT MARK character which forces
       ;; the header paragraph as left-to-right text.
       (insert (propertize (string ?\x200e) 'invisible t)))
-    (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
+    (insert (if notmuch-show-indent-content
+               (notmuch-show-spaces-n (* notmuch-show-indent-messages-width
+                                         depth))
+             "")
            from
            " ("
            date
@@ -497,6 +509,8 @@ message at DEPTH in the current thread."
        (narrow-to-region start (point-max))
        (run-hooks 'notmuch-show-markup-headers-hook)))))
 
+;;; Parts
+
 (define-button-type 'notmuch-show-part-button-type
   'action 'notmuch-show-part-button-default
   'follow-link t
@@ -505,21 +519,17 @@ message at DEPTH in the current thread."
 
 (defun notmuch-show-insert-part-header (nth content-type declared-type
                                            &optional name comment)
-  (let ((button)
-       (base-label (concat (and name (concat name ": "))
+  (let ((base-label (concat (and name (concat name ": "))
                            declared-type
                            (and (not (string-equal declared-type content-type))
                                 (concat " (as " content-type ")"))
                            comment)))
-    (setq button
-         (insert-button
-          (concat "[ " base-label " ]")
-          :base-label base-label
-          :type 'notmuch-show-part-button-type
-          :notmuch-part-hidden nil))
-    (insert "\n")
-    ;; return button
-    button))
+    (prog1 (insert-button
+           (concat "[ " base-label " ]")
+           :base-label base-label
+           :type 'notmuch-show-part-button-type
+           :notmuch-part-hidden nil)
+      (insert "\n"))))
 
 (defun notmuch-show-toggle-part-invisibility (&optional button)
   (interactive)
@@ -556,7 +566,7 @@ message at DEPTH in the current thread."
              (overlay-put overlay 'invisible (not show))
              t)))))))
 
-;; Part content ID handling
+;;; Part content ID handling
 
 (defvar notmuch-show--cids nil
   "Alist from raw content ID to (MSG PART).")
@@ -575,12 +585,13 @@ message at DEPTH in the current thread."
       ;; alternative (even if we can't render it).
       (push (list content-id msg part) notmuch-show--cids)))
   ;; Recurse on sub-parts
-  (let ((ctype (notmuch-split-content-type
-               (downcase (plist-get part :content-type)))))
-    (cond ((equal (car ctype) "multipart")
+  (pcase-let ((`(,content ,type)
+              (split-string (downcase (plist-get part :content-type)) "/")))
+    (cond ((equal content "multipart")
           (mapc (apply-partially #'notmuch-show--register-cids msg)
                 (plist-get part :content)))
-         ((equal ctype '("message" "rfc822"))
+         ((and (equal content "message")
+               (equal type "rfc822"))
           (notmuch-show--register-cids
            msg
            (car (plist-get (car (plist-get part :content)) :body)))))))
@@ -818,7 +829,8 @@ will return nil if the CID is unknown or cannot be retrieved."
          (gnus-blocked-images notmuch-show-text/html-blocked-images))
       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
-;; These functions are used by notmuch-show--insert-part-text/html-shr
+;;; Functions used by notmuch-show--insert-part-text/html-shr
+
 (declare-function libxml-parse-html-region "xml.c")
 (declare-function shr-insert-document "shr")
 
@@ -843,7 +855,7 @@ will return nil if the CID is unknown or cannot be retrieved."
   (notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto)
   t)
 
-;; Functions for determining how to handle MIME parts.
+;;; Functions for determining how to handle MIME parts.
 
 (defun notmuch-show-handlers-for (content-type)
   "Return a list of content handlers for a part of type CONTENT-TYPE."
@@ -853,14 +865,13 @@ will return nil if the CID is unknown or cannot be retrieved."
              (push func result)))
          ;; Reverse order of prefrence.
          (list (intern (concat "notmuch-show-insert-part-*/*"))
-               (intern (concat
-                        "notmuch-show-insert-part-"
-                        (car (notmuch-split-content-type content-type))
-                        "/*"))
+               (intern (concat "notmuch-show-insert-part-"
+                               (car (split-string content-type "/"))
+                               "/*"))
                (intern (concat "notmuch-show-insert-part-" content-type))))
     result))
 
-;; \f
+;;; Parts
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
   ;; Run the handlers until one of them succeeds.
@@ -1106,6 +1117,8 @@ is t, hide the part initially and show the button."
     (notmuch-show-message-visible msg (and (plist-get msg :match)
                                           (not (plist-get msg :excluded))))))
 
+;;; Toggle commands
+
 (defun notmuch-show-toggle-process-crypto ()
   "Toggle the processing of cryptographic MIME parts."
   (interactive)
@@ -1134,6 +1147,8 @@ is t, hide the part initially and show the button."
             "Content is not indented."))
   (notmuch-show-refresh-view))
 
+;;; Main insert functions
+
 (defun notmuch-show-insert-tree (tree depth)
   "Insert the message tree TREE at depth DEPTH in the current thread."
   (let ((msg (car tree))
@@ -1151,6 +1166,8 @@ is t, hide the part initially and show the button."
   "Insert the forest of threads FOREST."
   (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
+;;; Link buttons
+
 (defvar notmuch-id-regexp
   (concat
    ;; Match the id: prefix only if it begins a word (to disallow, for
@@ -1211,6 +1228,8 @@ buttons for a corresponding notmuch search."
                          'help-echo "Mouse-1, RET: search for this message"
                          'face goto-address-mail-face)))))
 
+;;; Show command
+
 ;;;###autoload
 (defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name)
   "Run \"notmuch show\" with the given thread ID and display results.
@@ -1245,7 +1264,7 @@ matched."
                    (eval (car (get 'mm-inline-override-types 'standard-value))))
             (cons "application/*" mm-inline-override-types)
           mm-inline-override-types)))
-    (switch-to-buffer (get-buffer-create buffer-name))
+    (pop-to-buffer-same-window (get-buffer-create buffer-name))
     ;; No need to track undo information for this buffer.
     (setq buffer-undo-list t)
     (notmuch-show-mode)
@@ -1333,6 +1352,8 @@ If no messages match the query return NIL."
     ;; Report back to the caller whether any messages matched.
     forest))
 
+;;; Refresh command
+
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
 
@@ -1407,6 +1428,8 @@ reset based on the original query."
       (ding)
       (message "Refreshing the buffer resulted in no messages!"))))
 
+;;; Keymaps
+
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)
@@ -1486,7 +1509,8 @@ reset based on the original query."
     (define-key map "B" 'notmuch-show-browse-urls)
     map)
   "Keymap for \"notmuch show\" buffers.")
-(fset 'notmuch-show-mode-map notmuch-show-mode-map)
+
+;;; Mode
 
 (define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show"
   "Major mode for viewing a thread with notmuch.
@@ -1524,6 +1548,8 @@ All currently available key bindings:
   (setq imenu-extract-index-name-function
        #'notmuch-show-imenu-extract-index-name-function))
 
+;;; Tree commands
+
 (defun notmuch-tree-from-show-current-query ()
   "Call notmuch tree with the current query."
   (interactive)
@@ -1538,17 +1564,14 @@ All currently available key bindings:
                      notmuch-show-query-context
                      (notmuch-show-get-message-id)))
 
+;;; Movement related functions.
+
 (defun notmuch-show-move-to-message-top ()
   (goto-char (notmuch-show-message-top)))
 
 (defun notmuch-show-move-to-message-bottom ()
   (goto-char (notmuch-show-message-bottom)))
 
-(defun notmuch-show-message-adjust ()
-  (recenter 0))
-
-;; Movement related functions.
-
 ;; There's some strangeness here where a text property applied to a
 ;; region a->b is not found when point is at b. We walk backwards
 ;; until finding the property.
@@ -1592,8 +1615,7 @@ effects."
     (cl-loop do (funcall function)
             while (notmuch-show-goto-message-next))))
 
-;; Functions relating to the visibility of messages and their
-;; components.
+;;; Functions relating to the visibility of messages and their components.
 
 (defun notmuch-show-message-visible (props visible-p)
   (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
@@ -1603,8 +1625,7 @@ effects."
   (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
   (notmuch-show-set-prop :headers-visible visible-p props))
 
-;; Functions for setting and getting attributes of the current
-;; message.
+;;; Functions for setting and getting attributes of the current message.
 
 (defun notmuch-show-set-message-properties (props)
   (save-excursion
@@ -1760,7 +1781,7 @@ user decision and we should not override it."
          (funcall notmuch-show-mark-read-function (window-start) (window-end))
        ((debug error)
         (unless notmuch-show--seen-has-errored
-          (setq notmuch-show--seen-has-errored 't)
+          (setq notmuch-show--seen-has-errored t)
           (setq header-line-format
                 (concat header-line-format
                         (propertize
@@ -1777,8 +1798,7 @@ Reshows the current thread with matches defined by the new query-string."
     (notmuch-show-refresh-view t)
     (notmuch-show-goto-message msg-id)))
 
-;; Functions for getting attributes of several messages in the current
-;; thread.
+;;; Functions for getting attributes of several messages in the current thread.
 
 (defun notmuch-show-get-message-ids-for-open-messages ()
   "Return a list of all id: queries for open messages in the current thread."
@@ -1792,7 +1812,7 @@ Reshows the current thread with matches defined by the new query-string."
        (setq done (not (notmuch-show-goto-message-next))))
       message-ids)))
 
-;; Commands typically bound to keys.
+;;; Commands typically bound to keys.
 
 (defun notmuch-show-advance ()
   "Advance through thread.
@@ -1920,6 +1940,9 @@ any effects from previous calls to
     (message-resend addresses)
     (notmuch-bury-or-kill-this-buffer)))
 
+(defun notmuch-show-message-adjust ()
+  (recenter 0))
+
 (defun notmuch-show-next-message (&optional pop-at-end)
   "Show the next message.
 
@@ -2002,7 +2025,7 @@ to show, nil otherwise."
   (let* ((id (notmuch-show-get-message-id))
         (buf (get-buffer-create (concat "*notmuch-raw-" id "*")))
         (inhibit-read-only t))
-    (switch-to-buffer buf)
+    (pop-to-buffer-same-window buf)
     (erase-buffer)
     (let ((coding-system-for-read 'no-conversion))
       (call-process notmuch-command nil t nil "show" "--format=raw" id))
@@ -2061,7 +2084,7 @@ message."
          (set-buffer-modified-p nil)
          (setq buffer-read-only t)
          (unless (zerop exit-code)
-           (switch-to-buffer-other-window buf)
+           (pop-to-buffer buf)
            (message (format "Command '%s' exited abnormally with code %d"
                             shell-command exit-code))))))))
 
@@ -2350,7 +2373,9 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
   (browse-url (current-kill 0 t)))
 
 (defun notmuch-show-stash-git-helper (addresses prefix)
-  "Escape, trim, quote, and add PREFIX to each address in list of ADDRESSES, and return the result as a single string."
+  "Normalize all ADDRESSES while adding PREFIX.
+Escape, trim, quote and add PREFIX to each address in list
+of ADDRESSES, and return the result as a single string."
   (mapconcat (lambda (x)
               (concat prefix "\""
                       ;; escape double-quotes
@@ -2363,10 +2388,12 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
             addresses " "))
 
 (put 'notmuch-show-stash-git-send-email 'notmuch-prefix-doc
-     "Copy From/To/Cc of current message to kill-ring in a form suitable for pasting to git send-email command line.")
+     "Copy From/To/Cc of current message to kill-ring.
+Use a form suitable for pasting to git send-email command line.")
 
 (defun notmuch-show-stash-git-send-email (&optional no-in-reply-to)
-  "Copy From/To/Cc/Message-Id of current message to kill-ring in a form suitable for pasting to git send-email command line.
+  "Copy From/To/Cc/Message-Id of current message to kill-ring.
+Use a form suitable for pasting to git send-email command line.
 
 If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil),
 omit --in-reply-to=<Message-Id>."
@@ -2386,7 +2413,7 @@ omit --in-reply-to=<Message-Id>."
                          (list (notmuch-show-get-message-id t)) "--in-reply-to="))))
              " ")))
 
-;; Interactive part functions and their helpers
+;;; Interactive part functions and their helpers
 
 (defun notmuch-show-generate-part-buffer (msg part)
   "Return a temporary buffer containing the specified part's content."
@@ -2419,10 +2446,9 @@ This ensures that the temporary buffer created for the mm-handle
 is destroyed when FN returns. If MIME-TYPE is given then force
 part to be treated as if it had that mime-type."
   (let ((handle (notmuch-show-current-part-handle mime-type)))
-    ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
-    ;; call it from a temp-buffer, unless
-    ;; notmuch-show-attachment-debug is non-nil in which case we put
-    ;; it in " *notmuch-part*".
+    ;; Emacs puts stdout/stderr into the calling buffer so we call
+    ;; it from a temp-buffer, unless notmuch-show-attachment-debug
+    ;; is non-nil, in which case we put it in " *notmuch-part*".
     (unwind-protect
        (if notmuch-show-attachment-debug
            (with-current-buffer (generate-new-buffer " *notmuch-part*")
@@ -2469,7 +2495,7 @@ If the part is displayed in an external application then close
 the new buffer."
   (let ((buf (get-buffer-create (generate-new-buffer-name
                                 (concat " *notmuch-internal-part*")))))
-    (switch-to-buffer buf)
+    (pop-to-buffer-same-window buf)
     (if (eq (mm-display-part handle) 'external)
        (kill-buffer buf)
       (goto-char (point-min))
@@ -2534,6 +2560,8 @@ browsing."
        (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
       (message "No URLs found."))))
 
+;;; _
+
 (provide 'notmuch-show)
 
 ;;; notmuch-show.el ends here