notmuch-config.el: bring a number of definitions up out of cl-flet*

1 files changed, 242 insertions, 242 deletions

diff --git a/.emacs.d/notmuch-config.el b/.emacs.d/notmuch-config.el
index 49c5dcc7..ac264328 100644
--- a/.emacs.d/notmuch-config.el
+++ b/.emacs.d/notmuch-config.el
@@ -258,254 +258,254 @@ Two ways to read:
 	   (push (concat "id:" (plist-get props :id)) ids)))))
     (string-join ids " ")))
 
-(cl-flet* ((connective (word)
-                       (apply-partially
-                        (lambda (connec &rest queries)
-                          (mapconcat (lambda (query) (concat "(" query ")"))
-				     (flatten-tree queries)
-                                     (concat " " connec " ")))
-                        word))
-           (disjoin (connective "or"))
-           (conjoin (connective "and"))
-           (negate (query) (concat "not (" query ")"))
-           (thread (query) (concat "thread:{" query "}")))
-  (defvar spw/weekday-only-mail (disjoin "to:spwhitton@email.arizona.edu"
-                                         "from:arizona.edu"
-                                         (thread "tag:spw::work"))
-    "Mail to be filtered out of processing views at the weekend.")
-
-  (defun spw/standard-notmuch-saved-searches ()
-    (interactive)
-    (setq notmuch-saved-searches nil
-          spw/lists-browse-searches nil)
-    (when (file-exists-p (locate-user-emacs-file "notmuch-private.el"))
-      (load (locate-user-emacs-file "notmuch-private"))
-      (cl-loop for group in spw/lists-browse
-               for name = (if (atom group)
-                              ;; Assume we got a List: search and extract the
-                              ;; first component of the List-Id to use as the
-                              ;; name of the search.
-                              (if (string-match ":\\([^.]+\\)\\." group)
-                                  (match-string 1 group)
-                                (error "Could not extract a list name"))
-                            (plist-get group :name))
-               for query = (if (atom group)
-                               group
-                             (disjoin (plist-get group :queries)))
-               for usearch = `(:name ,(concat name " unread")
-                                     :search-type nil :sort-order newest-first
-                                     :query ,(conjoin "tag:unread" query))
-               collect `(:name ,name :search-type nil :sort-order newest-first
-                               :query ,query :key ,(plist-get group :key))
-               into searches
-               ;; Also add the tag:unread version of the search as a saved
-               ;; search so that buffers created by `spw/next-unread-group'
-               ;; get a reasonable name.
-               collect usearch into searches
-               collect (list :search usearch
-                             :catchup-method (plist-get group :catchup-method))
-               into browse-searches
-               finally (setq notmuch-saved-searches searches
-                             spw/lists-browse-searches browse-searches)))
-    (setq spw/readall
-          (conjoin
-           (disjoin
-            "folder:inbox"
-
-            ;; can use this to include all mail addressed directly
-            ;; to me in processing views, as an alternative to
-            ;; relying on 'folder:inbox'
-            ;; (mapcar (lambda (a) (concat "to:" a)) (notmuch-user-emails))
-
-            spw/lists-readall)
-           (negate (thread "tag:spw::browse"))))
-
-    ;; now prepend views for processing the day's mail addressed to me
-    (let* ((to-process (conjoin "tag:unread" spw/readall))
-           (to-process-weekend (conjoin to-process
-                                        (negate spw/weekday-only-mail))))
-      (add-to-list 'notmuch-saved-searches
-                   `(:name "weekend unread" :key "w" :search-type nil
-                           :sort-order oldest-first
-                           :query ,to-process-weekend))
-      (add-to-list 'notmuch-saved-searches
-                   `(:name "weekday unread" :key "u" :search-type nil
-                           :sort-order oldest-first
-                           :query ,to-process)))
-
-    ;; append some miscellaneous views
-    (add-to-list 'notmuch-saved-searches
-                 '(:name "flagged" :key "f" :search-type tree
-                         :query "tag:flagged" ) t)
-    (add-to-list 'notmuch-saved-searches
-                 `(:name "sent" :key "s" :search-type nil
-                         :sort-order newest-first
-                         :query ,(disjoin
-                                  (mapcar
-                                   (lambda (a) (concat "from:" a))
-                                   (notmuch-user-emails))))
-                 t)
-    (add-to-list 'notmuch-saved-searches
-                 '(:name "drafts" :key "D" :search-type nil
-                         :sort-order newest-first
-                         :query "tag:draft") t)
+(defun spw/notmuch-connective (word)
+  (let ((sep (format " %s " word))
+	(f (apply-partially #'format "(%s)")))
+    (lambda (&rest queries)
+      (mapconcat f (flatten-tree queries) sep))))
+
+(defalias 'spw/nm| (spw/notmuch-connective "or"))
+(defalias 'spw/nm& (spw/notmuch-connective "and"))
+(defalias 'spw/nm~ (apply-partially #'format "not (%s)"))
+(defalias 'spw/th{ (apply-partially #'format "thread:{%s}"))
+
+(defvar spw/weekday-only-mail (spw/nm| "to:spwhitton@email.arizona.edu"
+                                       "from:arizona.edu"
+                                       (spw/th{ "tag:spw::work"))
+  "Mail to be filtered out of processing views at the weekend.")
+
+(defun spw/standard-notmuch-saved-searches ()
+  (interactive)
+  (setq notmuch-saved-searches nil
+        spw/lists-browse-searches nil)
+  (when (file-exists-p (locate-user-emacs-file "notmuch-private.el"))
+    (load (locate-user-emacs-file "notmuch-private"))
+    (cl-loop for group in spw/lists-browse
+          for name = (if (atom group)
+                         ;; Assume we got a List: search and extract the
+                         ;; first component of the List-Id to use as the
+                         ;; name of the search.
+                         (if (string-match ":\\([^.]+\\)\\." group)
+                             (match-string 1 group)
+                           (error "Could not extract a list name"))
+                       (plist-get group :name))
+          for query = (if (atom group)
+                          group
+                        (spw/nm| (plist-get group :queries)))
+          for usearch = `(:name ,(concat name " unread")
+                                :search-type nil :sort-order newest-first
+                                :query ,(spw/nm& "tag:unread" query))
+          collect `(:name ,name :search-type nil :sort-order newest-first
+                          :query ,query :key ,(plist-get group :key))
+          into searches
+          ;; Also add the tag:unread version of the search as a saved
+          ;; search so that buffers created by `spw/next-unread-group'
+          ;; get a reasonable name.
+          collect usearch into searches
+          collect (list :search usearch
+                        :catchup-method (plist-get group :catchup-method))
+          into browse-searches
+          finally (setq notmuch-saved-searches searches
+                        spw/lists-browse-searches browse-searches)))
+  (setq spw/readall
+        (spw/nm&
+         (spw/nm|
+          "folder:inbox"
+
+          ;; can use this to include all mail addressed directly
+          ;; to me in processing views, as an alternative to
+          ;; relying on 'folder:inbox'
+          ;; (mapcar (lambda (a) (concat "to:" a)) (notmuch-user-emails))
+
+          spw/lists-readall)
+         (spw/nm~ (spw/th{ "tag:spw::browse"))))
+
+  ;; now prepend views for processing the day's mail addressed to me
+  (let* ((to-process (spw/nm& "tag:unread" spw/readall))
+         (to-process-weekend (spw/nm& to-process
+                                      (spw/nm~ spw/weekday-only-mail))))
     (add-to-list 'notmuch-saved-searches
-                 '(:name "imported series" :key "P" :search-type nil
-                         :sort-order newest-first
-                         :query "subject:\"/PATCH .+ imported/\"") t)
+                 `(:name "weekend unread" :key "w" :search-type nil
+                         :sort-order oldest-first
+                         :query ,to-process-weekend))
     (add-to-list 'notmuch-saved-searches
-		 '(:name "phone notes" :key "N" :search-type nil
-			 :sort-order newest-first
-			 :query "folder:notes") t)
-
-    (let* ((categorised (disjoin
-                         spw/readall
-                         (mapcar (lambda (search)
-                                   (if (atom search)
-                                       search
-                                     (plist-get search :queries)))
-                                 spw/lists-browse)
-                         spw/lists-archiveonly))
-	   ;; content not from mailing lists and not otherwise categorised --
-	   ;; previously such items would fall into "uncategorised unread" but
-	   ;; that's wrong because I've explicitly subscribed to each of these
-	   (uncategorised-feeds
-	    (conjoin "tag:unread"
-		     (disjoin "from:rss2email@athena.silentflame.com"
-			      "from:gmi2email@athena.silentflame.com")
-		     (negate categorised)))
-	   ;; finally, groups/lists where I don't know how or whether I want
-	   ;; to follow them; I may have subscribed just to post something
-	   (uncategorised-other
-	    (conjoin "tag:unread"
-		     (negate (disjoin "from:rss2email@athena.silentflame.com"
-				      "from:gmi2email@athena.silentflame.com"))
-		     (negate categorised)))
-	   (feeds-query `(:name "uncategorised feeds"
-				:key "R" :search-type nil
-				:sort-order newest-first
-				:query ,uncategorised-feeds))
-	   (other-query `(:name "uncategorised unread"
-				:key "U" :search-type nil
-				:sort-order newest-first
-				:query ,uncategorised-other)))
-      ;; splice it in just after "weekday unread" and "weekend unread"
-      (setcdr (cdr notmuch-saved-searches)
-	      (cons (cons "uncategorised feeds" uncategorised-feeds)
-		    (cddr notmuch-saved-searches)))
-      (add-to-list 'notmuch-saved-searches other-query t)
-      (add-to-list
-       'spw/lists-browse-searches
-       `(:search (:name "uncategorised feeds" :query ,uncategorised-feeds)
-		 :catchup-method :archive))
-      (add-to-list
-       'spw/lists-browse-searches
-       `(:search (:name "uncategorised unread" :query ,uncategorised-other))
-       t)))
-
-  (defun spw/notmuch-catchup-by-archive ()
-    (interactive)
-    (when (and (memq major-mode '(notmuch-tree-mode notmuch-search-mode))
-	       (y-or-n-p "Are you sure you want to mark all as read?")
-	       spw/readall)
-      (let ((query (if (eq major-mode 'notmuch-tree-mode)
-		       (notmuch-tree-get-query)
-		     (notmuch-search-get-query))))
-	(notmuch-tag (conjoin query (negate spw/readall)) '("-unread")))
-      (spw/next-unread-group)))
-
-  (defun spw/maybe-kill-thread (&optional resolve)
-    (interactive "p")
-    (unless (bound-and-true-p spw/readall)
-      (error "`spw/readall' not defined; unsafe to proceed"))
-    (let* ((thread-id
-	    (cl-ecase major-mode
-	      (notmuch-search-mode
-	       (concat "thread:"
-		       (plist-get (notmuch-search-get-result) :thread)))
-	      (notmuch-show-mode notmuch-show-thread-id)))
-	   (message-ids
-	    (cl-ecase major-mode
-	      (notmuch-search-mode
-	       (car (notmuch-search-find-stable-query)))
-	      (notmuch-show-mode (spw/notmuch-show-stable-matching-query))))
-	   (method-buffer (or notmuch-show-parent-buffer (current-buffer)))
-	   (catchup-method (and (buffer-local-boundp
-				 'spw/notmuch-catchup-method method-buffer)
-				(buffer-local-value
-				 'spw/notmuch-catchup-method method-buffer)))
-	   (killp (not (eq :archive catchup-method))))
-      ;; If any messages match `spw/readall' then for safety user must call
-      ;; `spw/kill-thread', which has a harder-to-press binding.
-      (when (spw/notmuch-query-has-results-p (conjoin thread-id spw/readall))
-	(user-error "Some messages in thread match `spw/readall'"))
-      ;; Catchup only the messages that were matched by the saved search.
-      (notmuch-tag message-ids '("-unread"))
-      ;; Kill unless we are in / came from a search in which we catchup by
-      ;; marking all as read.  This means we can call this function to work
-      ;; through groups with either catchup method.
+                 `(:name "weekday unread" :key "u" :search-type nil
+                         :sort-order oldest-first
+                         :query ,to-process)))
+
+  ;; append some miscellaneous views
+  (add-to-list 'notmuch-saved-searches
+               '(:name "flagged" :key "f" :search-type tree
+                 :query "tag:flagged" ) t)
+  (add-to-list 'notmuch-saved-searches
+               `(:name "sent" :key "s" :search-type nil
+                       :sort-order newest-first
+                       :query ,(spw/nm|
+                                (mapcar
+                                 (lambda (a) (concat "from:" a))
+                                 (notmuch-user-emails))))
+               t)
+  (add-to-list 'notmuch-saved-searches
+               '(:name "drafts" :key "D" :search-type nil
+                 :sort-order newest-first
+                 :query "tag:draft") t)
+  (add-to-list 'notmuch-saved-searches
+               '(:name "imported series" :key "P" :search-type nil
+                 :sort-order newest-first
+                 :query "subject:\"/PATCH .+ imported/\"") t)
+  (add-to-list 'notmuch-saved-searches
+	       '(:name "phone notes" :key "N" :search-type nil
+		 :sort-order newest-first
+		 :query "folder:notes") t)
+
+  (let* ((categorised (spw/nm|
+                       spw/readall
+                       (mapcar (lambda (search)
+                                 (if (atom search)
+                                     search
+                                   (plist-get search :queries)))
+                               spw/lists-browse)
+                       spw/lists-archiveonly))
+	 ;; content not from mailing lists and not otherwise categorised --
+	 ;; previously such items would fall into "uncategorised unread" but
+	 ;; that's wrong because I've explicitly subscribed to each of these
+	 (uncategorised-feeds
+	  (spw/nm& "tag:unread"
+		   (spw/nm| "from:rss2email@athena.silentflame.com"
+			    "from:gmi2email@athena.silentflame.com")
+		   (spw/nm~ categorised)))
+	 ;; finally, groups/lists where I don't know how or whether I want
+	 ;; to follow them; I may have subscribed just to post something
+	 (uncategorised-other
+	  (spw/nm& "tag:unread"
+		   (spw/nm~ (spw/nm| "from:rss2email@athena.silentflame.com"
+				     "from:gmi2email@athena.silentflame.com"))
+		   (spw/nm~ categorised)))
+	 (feeds-query `(:name "uncategorised feeds"
+			      :key "R" :search-type nil
+			      :sort-order newest-first
+			      :query ,uncategorised-feeds))
+	 (other-query `(:name "uncategorised unread"
+			      :key "U" :search-type nil
+			      :sort-order newest-first
+			      :query ,uncategorised-other)))
+    ;; splice it in just after "weekday unread" and "weekend unread"
+    (setcdr (cdr notmuch-saved-searches)
+	    (cons (cons "uncategorised feeds" uncategorised-feeds)
+		  (cddr notmuch-saved-searches)))
+    (add-to-list 'notmuch-saved-searches other-query t)
+    (add-to-list
+     'spw/lists-browse-searches
+     `(:search (:name "uncategorised feeds" :query ,uncategorised-feeds)
+	       :catchup-method :archive))
+    (add-to-list
+     'spw/lists-browse-searches
+     `(:search (:name "uncategorised unread" :query ,uncategorised-other))
+     t)))
+
+(defun spw/notmuch-catchup-by-archive ()
+  (interactive)
+  (when (and (memq major-mode '(notmuch-tree-mode notmuch-search-mode))
+	     (y-or-n-p "Are you sure you want to mark all as read?")
+	     spw/readall)
+    (let ((query (if (eq major-mode 'notmuch-tree-mode)
+		     (notmuch-tree-get-query)
+		   (notmuch-search-get-query))))
+      (notmuch-tag (spw/nm& query (spw/nm~ spw/readall)) '("-unread")))
+    (spw/next-unread-group)))
+
+(defun spw/maybe-kill-thread (&optional resolve)
+  (interactive "p")
+  (unless (bound-and-true-p spw/readall)
+    (error "`spw/readall' not defined; unsafe to proceed"))
+  (let* ((thread-id
+	  (cl-ecase major-mode
+	    (notmuch-search-mode
+	     (concat "thread:"
+		     (plist-get (notmuch-search-get-result) :thread)))
+	    (notmuch-show-mode notmuch-show-thread-id)))
+	 (message-ids
+	  (cl-ecase major-mode
+	    (notmuch-search-mode
+	     (car (notmuch-search-find-stable-query)))
+	    (notmuch-show-mode (spw/notmuch-show-stable-matching-query))))
+	 (method-buffer (or notmuch-show-parent-buffer (current-buffer)))
+	 (catchup-method (and (buffer-local-boundp
+			       'spw/notmuch-catchup-method method-buffer)
+			      (buffer-local-value
+			       'spw/notmuch-catchup-method method-buffer)))
+	 (killp (not (eq :archive catchup-method))))
+    ;; If any messages match `spw/readall' then for safety user must call
+    ;; `spw/kill-thread', which has a harder-to-press binding.
+    (when (spw/notmuch-query-has-results-p (spw/nm& thread-id spw/readall))
+      (user-error "Some messages in thread match `spw/readall'"))
+    ;; Catchup only the messages that were matched by the saved search.
+    (notmuch-tag message-ids '("-unread"))
+    ;; Kill unless we are in / came from a search in which we catchup by
+    ;; marking all as read.  This means we can call this function to work
+    ;; through groups with either catchup method.
+    ;;
+    ;; As in `spw/kill-thread' for `notmuch-search-mode', want to tag only a
+    ;; single message with spw::killed.
+    (when killp
+      (notmuch-tag (car (split-string message-ids)) '("+spw::killed")))
+    (when resolve
+      (cl-case major-mode
+	(notmuch-search-mode
+	 (let* ((result (notmuch-search-get-result))
+		(tags (remove "unread" (plist-get result :tags))))
+	   (notmuch-search-update-result
+	    (plist-put result
+		       :tags (if killp (cons "spw::killed" tags) tags))))
+	 (notmuch-search-next-thread))
+	(notmuch-show-mode (notmuch-show-next-thread t))))))
+
+(defun spw/notmuch-catchup-by-killing ()
+  (interactive)
+  (when (and (eq major-mode 'notmuch-search-mode)
+	     (y-or-n-p "Are you sure you want to kill all threads?"))
+    (goto-char (point-min))
+    (while (notmuch-search-get-result)
+      ;; Don't touch unless there are unread messages, so that we skip over
+      ;; threads which have been manually processed -- this is in case I
+      ;; just archived the thread without killing it, and want any new
+      ;; messages to show up as unread.
       ;;
-      ;; As in `spw/kill-thread' for `notmuch-search-mode', want to tag only a
-      ;; single message with spw::killed.
-      (when killp
-	(notmuch-tag (car (split-string message-ids)) '("+spw::killed")))
-      (when resolve
-	(cl-case major-mode
-	  (notmuch-search-mode
-	   (let* ((result (notmuch-search-get-result))
-		  (tags (remove "unread" (plist-get result :tags))))
-	     (notmuch-search-update-result
-	      (plist-put result
-			 :tags (if killp (cons "spw::killed" tags) tags))))
-	   (notmuch-search-next-thread))
-	  (notmuch-show-mode (notmuch-show-next-thread t))))))
-
-  (defun spw/notmuch-catchup-by-killing ()
-    (interactive)
-    (when (and (eq major-mode 'notmuch-search-mode)
-	       (y-or-n-p "Are you sure you want to kill all threads?"))
-      (goto-char (point-min))
-      (while (notmuch-search-get-result)
-        ;; Don't touch unless there are unread messages, so that we skip over
-        ;; threads which have been manually processed -- this is in case I
-        ;; just archived the thread without killing it, and want any new
-        ;; messages to show up as unread.
-        ;;
-        ;; We can't rely on (plist-get (notmuch-show-get-result) :tags) here
-        ;; because that might be out-of-date if the thread was archived from
-        ;; `notmuch-show-mode' rather than this buffer, and we can't refresh
-        ;; the buffer as we don't want to kill any newly-arrived threads
-	(when (spw/notmuch-query-has-results-p
-	       (conjoin "tag:unread" (car (notmuch-search-find-stable-query))))
-	  (ignore-error user-error (spw/maybe-kill-thread)))
-	(notmuch-search-next-thread))
-      (spw/next-unread-group)))
-
-  (defun spw/notmuch-show-advance-and-archive ()
-    "Like `notmuch-show-advance-and-archive' but confirm thread archive.
+      ;; We can't rely on (plist-get (notmuch-show-get-result) :tags) here
+      ;; because that might be out-of-date if the thread was archived from
+      ;; `notmuch-show-mode' rather than this buffer, and we can't refresh
+      ;; the buffer as we don't want to kill any newly-arrived threads
+      (when (spw/notmuch-query-has-results-p
+	     (spw/nm& "tag:unread" (car (notmuch-search-find-stable-query))))
+	(ignore-error user-error (spw/maybe-kill-thread)))
+      (notmuch-search-next-thread))
+    (spw/next-unread-group)))
+
+(defun spw/notmuch-show-advance-and-archive ()
+  "Like `notmuch-show-advance-and-archive' but confirm thread archive.
 
 Note that this does not archive individual messages are you
 scroll through them."
-    (interactive)
-    (when (or ;; since we have a confirmation, it's fine to archive when point
-	      ;; it not yet at the bottom of the window
-	      (pos-visible-in-window-p (point-max))
-	      (notmuch-show-advance))
-      (if (or (pos-visible-in-window-p (point-min))
-	      (let ((map (make-sparse-keymap)))
-		(set-keymap-parent map query-replace-map)
-		(define-key map " " 'ignore)
-		;; override usual map so SPC cannot confirm the archive, to
-		;; avoid accidental archives
-		(let ((query-replace-map map))
-		  (y-or-n-p "Mark all as read before moving on?"))))
-	  (when (and notmuch-show-thread-id notmuch-archive-tags)
-	    ;; only tag messages which would have been expanded when we opened
-	    ;; the thread
-	    (notmuch-tag (spw/notmuch-show-stable-matching-query)
-			 (notmuch-tag-change-list notmuch-archive-tags nil))
-	    (notmuch-show-next-thread t))
-	(notmuch-show-next-thread-show)))))
+  (interactive)
+  (when (or ;; since we have a confirmation, it's fine to archive when point
+	 ;; it not yet at the bottom of the window
+	 (pos-visible-in-window-p (point-max))
+	 (notmuch-show-advance))
+    (if (or (pos-visible-in-window-p (point-min))
+	    (let ((map (make-sparse-keymap)))
+	      (set-keymap-parent map query-replace-map)
+	      (define-key map " " 'ignore)
+	      ;; override usual map so SPC cannot confirm the archive, to
+	      ;; avoid accidental archives
+	      (let ((query-replace-map map))
+		(y-or-n-p "Mark all as read before moving on?"))))
+	(when (and notmuch-show-thread-id notmuch-archive-tags)
+	  ;; only tag messages which would have been expanded when we opened
+	  ;; the thread
+	  (notmuch-tag (spw/notmuch-show-stable-matching-query)
+		       (notmuch-tag-change-list notmuch-archive-tags nil))
+	  (notmuch-show-next-thread t))
+      (notmuch-show-next-thread-show))))
 
 ;; use on views produced by `spw/next-unread-group'
 (defun spw/notmuch-catchup (arg)