emacs: Use `cl-lib' instead of deprecated `cl'

[notmuch] / emacs / notmuch.el

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 44519b7abc55449e3b00a5a63ef19cefc35cb7f6..a980c7a212358a9e54943d90b1a3b4bcbd9e3e45 100644 (file)
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -49,10 +49,24 @@
 ;; Have fun, and let us know if you have any comment, questions, or
 ;; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
 ;; required, but is available from https://notmuchmail.org).
 ;; Have fun, and let us know if you have any comment, questions, or
 ;; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
 ;; required, but is available from https://notmuchmail.org).

-
+;;
+;; Note for MELPA users (and others tracking the development version
+;; of notmuch-emacs):
+;;
+;; This emacs package needs a fairly closely matched version of the
+;; notmuch program. If you use the MELPA version of notmuch.el (as
+;; opposed to MELPA stable), you should be prepared to track the
+;; master development branch (i.e. build from git) for the notmuch
+;; program as well. Upgrading notmuch-emacs too far beyond the notmuch
+;; program can CAUSE YOUR EMAIL TO STOP WORKING.
+;;
+;; TL;DR: notmuch-emacs from MELPA and notmuch from distro packages is
+;; NOT SUPPORTED.
+;;

 ;;; Code:
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+

 (require 'mm-view)
 (require 'message)
 
 (require 'mm-view)
 (require 'message)
 


@@ -119,7 +133,7 @@ there will be called at other points of notmuch execution."
               (or (equal (car disposition) "attachment")
                   (and (equal (car disposition) "inline")
                        (assq 'filename disposition)))
               (or (equal (car disposition) "attachment")
                   (and (equal (car disposition) "inline")
                        (assq 'filename disposition)))

-              (incf count))))
+              (cl-incf count))))

      mm-handle)
     count))
 
      mm-handle)
     count))
 


@@ -175,7 +189,9 @@ there will be called at other points of notmuch execution."
     (define-key map "-" 'notmuch-search-remove-tag)
     (define-key map "+" 'notmuch-search-add-tag)
     (define-key map (kbd "RET") 'notmuch-search-show-thread)
     (define-key map "-" 'notmuch-search-remove-tag)
     (define-key map "+" 'notmuch-search-add-tag)
     (define-key map (kbd "RET") 'notmuch-search-show-thread)

+    (define-key map (kbd "M-RET") 'notmuch-tree-from-search-thread)

     (define-key map "Z" 'notmuch-tree-from-search-current-query)
     (define-key map "Z" 'notmuch-tree-from-search-current-query)

+    (define-key map "U" 'notmuch-unthreaded-from-search-current-query)

     map)
   "Keymap for \"notmuch search\" buffers.")
 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
     map)
   "Keymap for \"notmuch search\" buffers.")
 (fset 'notmuch-search-mode-map notmuch-search-mode-map)


@@ -374,7 +390,11 @@ Complete list of currently available key bindings:
   (set (make-local-variable 'scroll-preserve-screen-position) t)
   (add-to-invisibility-spec (cons 'ellipsis t))
   (setq truncate-lines t)
   (set (make-local-variable 'scroll-preserve-screen-position) t)
   (add-to-invisibility-spec (cons 'ellipsis t))
   (setq truncate-lines t)

-  (setq buffer-read-only t))
+  (setq buffer-read-only t)
+  (setq imenu-prev-index-position-function
+        #'notmuch-search-imenu-prev-index-position-function)
+  (setq imenu-extract-index-name-function
+        #'notmuch-search-imenu-extract-index-name-function))

 
 (defun notmuch-search-get-result (&optional pos)
   "Return the result object for the thread at POS (or point).
 
 (defun notmuch-search-get-result (&optional pos)
   "Return the result object for the thread at POS (or point).


@@ -402,28 +422,27 @@ returns nil"
     (next-single-property-change (or pos (point)) 'notmuch-search-result
                                 nil (point-max))))
 
     (next-single-property-change (or pos (point)) 'notmuch-search-result
                                 nil (point-max))))
 

-(defun notmuch-search-foreach-result (beg end function)
-  "Invoke FUNCTION for each result between BEG and END.
+(defun notmuch-search-foreach-result (beg end fn)
+  "Invoke FN for each result between BEG and END.

 
 

-FUNCTION should take one argument.  It will be applied to the
+FN should take one argument.  It will be applied to the

 character position of the beginning of each result that overlaps
 the region between points BEG and END.  As a special case, if (=
 character position of the beginning of each result that overlaps
 the region between points BEG and END.  As a special case, if (=

-BEG END), FUNCTION will be applied to the result containing point
+BEG END), FN will be applied to the result containing point

 BEG."
 BEG."

-
-  (lexical-let ((pos (notmuch-search-result-beginning beg))
-               ;; End must be a marker in case function changes the
-               ;; text.
-               (end (copy-marker end))
-               ;; Make sure we examine at least one result, even if
-               ;; (= beg end).
-               (first t))
+  (let ((pos (notmuch-search-result-beginning beg))
+       ;; End must be a marker in case fn changes the
+       ;; text.
+       (end (copy-marker end))
+       ;; Make sure we examine at least one result, even if
+       ;; (= beg end).
+       (first t))

     ;; We have to be careful if the region extends beyond the results.
     ;; In this case, pos could be null or there could be no result at
     ;; pos.
     (while (and pos (or (< pos end) first))
       (when (notmuch-search-get-result pos)
     ;; We have to be careful if the region extends beyond the results.
     ;; In this case, pos could be null or there could be no result at
     ;; pos.
     (while (and pos (or (< pos end) first))
       (when (notmuch-search-get-result pos)

-       (funcall function pos))
+       (funcall fn pos))

       (setq pos (notmuch-search-result-end pos)
            first nil))))
 ;; Unindent the function argument of notmuch-search-foreach-result so
       (setq pos (notmuch-search-result-end pos)
            first nil))))
 ;; Unindent the function argument of notmuch-search-foreach-result so


@@ -459,10 +478,10 @@ is nil, include both matched and unmatched messages. If there are
 no messages in the region then return nil."
   (let ((query-list nil) (all (not only-matched)))
     (dolist (queries (notmuch-search-properties-in-region :query beg end))
 no messages in the region then return nil."
   (let ((query-list nil) (all (not only-matched)))
     (dolist (queries (notmuch-search-properties-in-region :query beg end))

-      (when (first queries)
-       (push (first queries) query-list))
-      (when (and all (second queries))
-       (push (second queries) query-list)))
+      (when (car queries)
+       (push (car queries) query-list))
+      (when (and all (cadr queries))
+       (push (cadr queries) query-list)))

     (when query-list
       (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
 
     (when query-list
       (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
 


@@ -505,6 +524,11 @@ thread."
   (interactive)
   (notmuch-tree notmuch-search-query-string))
 
   (interactive)
   (notmuch-tree notmuch-search-query-string))
 

+(defun notmuch-unthreaded-from-search-current-query ()
+  "Call notmuch tree with the current query"
+  (interactive)
+  (notmuch-unthreaded notmuch-search-query-string))
+

 (defun notmuch-tree-from-search-thread ()
   "Show the selected thread with notmuch-tree"
   (interactive)
 (defun notmuch-tree-from-search-thread ()
   "Show the selected thread with notmuch-tree"
   (interactive)


@@ -540,25 +564,15 @@ thread."
        (setq output (append output (notmuch-search-get-tags pos)))))
     output))
 
        (setq output (append output (notmuch-search-get-tags pos)))))
     output))
 

-(defun notmuch-search-interactive-region ()
-  "Return the bounds of the current interactive region.
-
-This returns (BEG END), where BEG and END are the bounds of the
-region if the region is active, or both `point' otherwise."
-  (if (region-active-p)
-      (list (region-beginning) (region-end))
-    (list (point) (point))))
-

 (defun notmuch-search-interactive-tag-changes (&optional initial-input)
   "Prompt for tag changes for the current thread or region.
 
 Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
 (defun notmuch-search-interactive-tag-changes (&optional initial-input)
   "Prompt for tag changes for the current thread or region.
 
 Returns (TAG-CHANGES REGION-BEGIN REGION-END)."

-  (let* ((region (notmuch-search-interactive-region))
-        (beg (first region)) (end (second region))
-        (prompt (if (= beg end) "Tag thread" "Tag region")))
-    (cons (notmuch-read-tag-changes
-          (notmuch-search-get-tags-region beg end) prompt initial-input)
-         region)))
+  (pcase-let ((`(,beg ,end) (notmuch-interactive-region)))
+    (list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end)
+                                   (if (= beg end) "Tag thread" "Tag region")
+                                   initial-input)
+         beg end)))

 
 (defun notmuch-search-tag (tag-changes &optional beg end only-matched)
   "Change tags for the currently selected thread or region.
 
 (defun notmuch-search-tag (tag-changes &optional beg end only-matched)
   "Change tags for the currently selected thread or region.


@@ -573,8 +587,8 @@ is inactive this applies to the thread at point.
 If ONLY-MATCHED is non-nil, only tag matched messages."
   (interactive (notmuch-search-interactive-tag-changes))
   (unless (and beg end)
 If ONLY-MATCHED is non-nil, only tag matched messages."
   (interactive (notmuch-search-interactive-tag-changes))
   (unless (and beg end)

-    (setq beg (car (notmuch-search-interactive-region))
-         end (cadr (notmuch-search-interactive-region))))
+    (setq beg (car (notmuch-interactive-region))
+         end (cadr (notmuch-interactive-region))))

   (let ((search-string (notmuch-search-find-stable-query-region
                        beg end only-matched)))
     (notmuch-tag search-string tag-changes)
   (let ((search-string (notmuch-search-find-stable-query-region
                        beg end only-matched)))
     (notmuch-tag search-string tag-changes)


@@ -610,7 +624,7 @@ messages will be \"unarchived\" (i.e. the tag changes in
 `notmuch-archive-tags' will be reversed).
 
 This function advances the next thread when finished."
 `notmuch-archive-tags' will be reversed).
 
 This function advances the next thread when finished."

-  (interactive (cons current-prefix-arg (notmuch-search-interactive-region)))
+  (interactive (cons current-prefix-arg (notmuch-interactive-region)))

   (when notmuch-archive-tags
     (notmuch-search-tag
      (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end))
   (when notmuch-archive-tags
     (notmuch-search-tag
      (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end))


@@ -694,7 +708,7 @@ A thread with TAG will have FACE applied.
 Here is an example of how to color search results based on tags.
  (the following text would be placed in your ~/.emacs file):
 
 Here is an example of how to color search results based on tags.
  (the following text would be placed in your ~/.emacs file):
 

- (setq notmuch-search-line-faces '((\"unread\" . (:foreground \"green\"))
+ (setq notmuch-search-line-faces \\='((\"unread\" . (:foreground \"green\"))

                                    (\"deleted\" . (:foreground \"red\"
                                                  :background \"blue\"))))
 
                                    (\"deleted\" . (:foreground \"red\"
                                                  :background \"blue\"))))
 


@@ -876,12 +890,13 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
   (let* ((saved-search
          (let (longest
                (longest-length 0))
   (let* ((saved-search
          (let (longest
                (longest-length 0))

-           (loop for tuple in notmuch-saved-searches
-                 if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query))))
-                      (and (string-match (concat "^" quoted-query) query)
-                           (> (length (match-string 0 query))
-                              longest-length)))
-                 do (setq longest tuple))
+           (cl-loop for tuple in notmuch-saved-searches
+                    if (let ((quoted-query
+                              (regexp-quote (notmuch-saved-search-get tuple :query))))
+                         (and (string-match (concat "^" quoted-query) query)
+                              (> (length (match-string 0 query))
+                                 longest-length)))
+                    do (setq longest tuple))

            longest))
         (saved-search-name (notmuch-saved-search-get saved-search :name))
         (saved-search-query (notmuch-saved-search-get saved-search :query)))
            longest))
         (saved-search-name (notmuch-saved-search-get saved-search :name))
         (saved-search-query (notmuch-saved-search-get saved-search :query)))


@@ -902,7 +917,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
   "Read a notmuch-query from the minibuffer with completion.
 
 PROMPT is the string to prompt with."
   "Read a notmuch-query from the minibuffer with completion.
 
 PROMPT is the string to prompt with."

-  (lexical-let*
+  (let*

       ((all-tags
         (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
                 (process-lines notmuch-command "search" "--output=tags" "*")))
       ((all-tags
         (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
                 (process-lines notmuch-command "search" "--output=tags" "*")))


@@ -913,7 +928,7 @@ PROMPT is the string to prompt with."
                 (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
                 (mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types)))))
     (let ((keymap (copy-keymap minibuffer-local-map))
                 (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
                 (mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types)))))
     (let ((keymap (copy-keymap minibuffer-local-map))

-         (current-query (case major-mode
+         (current-query (cl-case major-mode

                           (notmuch-search-mode (notmuch-search-get-query))
                           (notmuch-show-mode (notmuch-show-get-query))
                           (notmuch-tree-mode (notmuch-tree-get-query))))
                           (notmuch-search-mode (notmuch-search-get-query))
                           (notmuch-show-mode (notmuch-show-get-query))
                           (notmuch-tree-mode (notmuch-tree-get-query))))


@@ -940,8 +955,8 @@ PROMPT is the string to prompt with."
   "Return the current query in this search buffer"
   notmuch-search-query-string)
 
   "Return the current query in this search buffer"
   notmuch-search-query-string)
 

-;;;###autoload

 (put 'notmuch-search 'notmuch-doc "Search for messages.")
 (put 'notmuch-search 'notmuch-doc "Search for messages.")

+;;;###autoload

 (defun notmuch-search (&optional query oldest-first target-thread target-line no-display)
   "Display threads matching QUERY in a notmuch-search buffer.
 
 (defun notmuch-search (&optional query oldest-first target-thread target-line no-display)
   "Display threads matching QUERY in a notmuch-search buffer.
 


@@ -990,7 +1005,7 @@ the configured default sort order."
       (save-excursion
        (let ((proc (notmuch-start-notmuch
                     "notmuch-search" buffer #'notmuch-search-process-sentinel
       (save-excursion
        (let ((proc (notmuch-start-notmuch
                     "notmuch-search" buffer #'notmuch-search-process-sentinel

-                    "search" "--format=sexp" "--format-version=2"
+                    "search" "--format=sexp" "--format-version=4"

                     (if oldest-first
                         "--sort=oldest-first"
                       "--sort=newest-first")
                     (if oldest-first
                         "--sort=oldest-first"
                       "--sort=newest-first")


@@ -1059,9 +1074,15 @@ current search results AND the additional query string provided."
 Runs a new search matching only messages that match both the
 current search results AND that are tagged with the given tag."
   (interactive
 Runs a new search matching only messages that match both the
 current search results AND that are tagged with the given tag."
   (interactive

-   (list (notmuch-select-tag-with-completion "Filter by tag: ")))
+   (list (notmuch-select-tag-with-completion "Filter by tag: " notmuch-search-query-string)))

   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
 
   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
 

+(defun notmuch-search-by-tag (tag)
+  "Display threads matching TAG in a notmuch-search buffer."
+  (interactive
+   (list (notmuch-select-tag-with-completion "Notmuch search tag: ")))
+  (notmuch-search (concat "tag:" tag)))
+

 ;;;###autoload
 (defun notmuch ()
   "Run notmuch and display saved searches, known tags, etc."
 ;;;###autoload
 (defun notmuch ()
   "Run notmuch and display saved searches, known tags, etc."


@@ -1093,9 +1114,9 @@ notmuch buffers exist, run `notmuch'."
       (bury-buffer))
 
     ;; Find the first notmuch buffer.
       (bury-buffer))
 
     ;; Find the first notmuch buffer.

-    (setq first (loop for buffer in (buffer-list)
-                    if (notmuch-interesting-buffer buffer)
-                    return buffer))
+    (setq first (cl-loop for buffer in (buffer-list)
+                        if (notmuch-interesting-buffer buffer)
+                        return buffer))

 
     (if first
        ;; If the first one we found is any other than the starting
 
     (if first
        ;; If the first one we found is any other than the starting


@@ -1104,6 +1125,23 @@ notmuch buffers exist, run `notmuch'."
          (switch-to-buffer first))
       (notmuch))))
 
          (switch-to-buffer first))
       (notmuch))))
 

+;;;; Imenu Support
+
+(defun notmuch-search-imenu-prev-index-position-function ()
+  "Move point to previous message in notmuch-search buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+  (notmuch-search-previous-thread))
+
+(defun notmuch-search-imenu-extract-index-name-function ()
+  "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'.  Point should be at the
+beginning of the line."
+  (let ((subject (notmuch-search-find-subject))
+       (author (notmuch-search-find-authors)))
+    (format "%s (%s)" subject author)))
+

 (setq mail-user-agent 'notmuch-user-agent)
 
 (provide 'notmuch)
 (setq mail-user-agent 'notmuch-user-agent)
 
 (provide 'notmuch)