emacs: Move search-target logic to `notmuch-search-show-result'

[notmuch] / emacs / notmuch.el

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 1b472dd2305fd026027a496b326b704667b34829..5bf01cae522665dac420b48e6987d09baf9d8b04 100644 (file)
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -48,11 +48,11 @@
 ;; required, but is available from http://notmuchmail.org).
 
 (eval-when-compile (require 'cl))
 ;; required, but is available from http://notmuchmail.org).
 
 (eval-when-compile (require 'cl))

-(require 'crm)

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

+(require 'notmuch-tag)

 (require 'notmuch-show)
 (require 'notmuch-mua)
 (require 'notmuch-hello)
 (require 'notmuch-show)
 (require 'notmuch-mua)
 (require 'notmuch-hello)


@@ -76,57 +76,6 @@ For example:
 (defvar notmuch-query-history nil
   "Variable to store minibuffer history for notmuch queries")
 
 (defvar notmuch-query-history nil
   "Variable to store minibuffer history for notmuch queries")
 

-(defun notmuch-tag-completions (&optional search-terms)
-  (split-string
-   (with-output-to-string
-     (with-current-buffer standard-output
-       (apply 'call-process notmuch-command nil t
-             nil "search-tags" search-terms)))
-   "\n+" t))
-
-(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
-  (let ((tag-list (notmuch-tag-completions search-terms)))
-    (completing-read prompt tag-list)))
-
-(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)
-  (let* ((all-tag-list (notmuch-tag-completions))
-        (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
-        (remove-tag-list (mapcar (apply-partially 'concat "-")
-                                 (if (null search-terms)
-                                     all-tag-list
-                                   (notmuch-tag-completions search-terms))))
-        (tag-list (append add-tag-list remove-tag-list))
-        (crm-separator " ")
-        ;; By default, space is bound to "complete word" function.
-        ;; Re-bind it to insert a space instead.  Note that <tab>
-        ;; still does the completion.
-        (crm-local-completion-map
-         (let ((map (make-sparse-keymap)))
-           (set-keymap-parent map crm-local-completion-map)
-           (define-key map " " 'self-insert-command)
-           map)))
-    (delete "" (completing-read-multiple "Tags (+add -drop): "
-               tag-list nil nil initial-input))))
-
-(defun notmuch-update-tags (tags tag-changes)
-  "Return a copy of TAGS with additions and removals from TAG-CHANGES.
-
-TAG-CHANGES must be a list of tags names, each prefixed with
-either a \"+\" to indicate the tag should be added to TAGS if not
-present or a \"-\" to indicate that the tag should be removed
-from TAGS if present."
-  (let ((result-tags (copy-sequence tags)))
-    (dolist (tag-change tag-changes)
-      (let ((op (string-to-char tag-change))
-           (tag (unless (string= tag-change "") (substring tag-change 1))))
-       (case op
-         (?+ (unless (member tag result-tags)
-               (push tag result-tags)))
-         (?- (setq result-tags (delete tag result-tags)))
-         (otherwise
-          (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
-    (sort result-tags 'string<)))
-

 (defun notmuch-foreach-mime-part (function mm-handle)
   (cond ((stringp (car mm-handle))
          (dolist (part (cdr mm-handle))
 (defun notmuch-foreach-mime-part (function mm-handle)
   (cond ((stringp (car mm-handle))
          (dolist (part (cdr mm-handle))


@@ -240,10 +189,17 @@ For a mouse binding, return nil."
       (set-buffer-modified-p nil)
       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
 
       (set-buffer-modified-p nil)
       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
 

-(defcustom notmuch-search-hook '(hl-line-mode)
+(require 'hl-line)
+
+(defun notmuch-hl-line-mode ()
+  (prog1 (hl-line-mode)
+    (when hl-line-overlay
+      (overlay-put hl-line-overlay 'priority 1))))
+
+(defcustom notmuch-search-hook '(notmuch-hl-line-mode)

   "List of functions to call when notmuch displays the search results."
   :type 'hook
   "List of functions to call when notmuch displays the search results."
   :type 'hook

-  :options '(hl-line-mode)
+  :options '(notmuch-hl-line-mode)

   :group 'notmuch-search
   :group 'notmuch-hooks)
 
   :group 'notmuch-search
   :group 'notmuch-hooks)
 


@@ -270,7 +226,7 @@ For a mouse binding, return nil."
     (define-key map "t" 'notmuch-search-filter-by-tag)
     (define-key map "f" 'notmuch-search-filter)
     (define-key map [mouse-1] 'notmuch-search-show-thread)
     (define-key map "t" 'notmuch-search-filter-by-tag)
     (define-key map "f" 'notmuch-search-filter)
     (define-key map [mouse-1] 'notmuch-search-show-thread)

-    (define-key map "*" 'notmuch-search-operate-all)
+    (define-key map "*" 'notmuch-search-tag-all)

     (define-key map "a" 'notmuch-search-archive-thread)
     (define-key map "-" 'notmuch-search-remove-tag)
     (define-key map "+" 'notmuch-search-add-tag)
     (define-key map "a" 'notmuch-search-archive-thread)
     (define-key map "-" 'notmuch-search-remove-tag)
     (define-key map "+" 'notmuch-search-add-tag)


@@ -419,7 +375,7 @@ any tags).
 Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
 keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
 is a convenience for archiving a thread (removing the \"inbox\"
 Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
 keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
 is a convenience for archiving a thread (removing the \"inbox\"

-tag). The '\\[notmuch-search-operate-all]' key can be used to add or remove a tag from all
+tag). The '\\[notmuch-search-tag-all]' key can be used to add or remove a tag from all

 threads in the current buffer.
 
 Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
 threads in the current buffer.
 
 Other useful commands are '\\[notmuch-search-filter]' for filtering the current search


@@ -485,18 +441,17 @@ Complete list of currently available key bindings:
   "Return a list of authors for the current region"
   (notmuch-search-properties-in-region 'notmuch-search-subject beg end))
 
   "Return a list of authors for the current region"
   (notmuch-search-properties-in-region 'notmuch-search-subject beg end))
 

-(defun notmuch-search-show-thread (&optional crypto-switch)
+(defun notmuch-search-show-thread ()

   "Display the currently selected thread."
   "Display the currently selected thread."

-  (interactive "P")
+  (interactive)

   (let ((thread-id (notmuch-search-find-thread-id))
   (let ((thread-id (notmuch-search-find-thread-id))

-       (subject (notmuch-prettify-subject (notmuch-search-find-subject))))
+       (subject (notmuch-search-find-subject)))

     (if (> (length thread-id) 0)
        (notmuch-show thread-id
                      (current-buffer)
                      notmuch-search-query-string
                      ;; Name the buffer based on the subject.
     (if (> (length thread-id) 0)
        (notmuch-show thread-id
                      (current-buffer)
                      notmuch-search-query-string
                      ;; Name the buffer based on the subject.

-                     (concat "*" (truncate-string-to-width subject 30 nil nil t) "*")
-                     crypto-switch)
+                     (concat "*" (truncate-string-to-width subject 30 nil nil t) "*"))

       (message "End of search results."))))
 
 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
       (message "End of search results."))))
 
 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)


@@ -528,50 +483,6 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
            (error (buffer-substring beg end))
            ))))))
 
            (error (buffer-substring beg end))
            ))))))
 

-(defun notmuch-tag (query &rest tags)
-  "Add/remove tags in TAGS to messages matching QUERY.
-
-TAGS should be a list of strings of the form \"+TAG\" or \"-TAG\" and
-QUERY should be a string containing the search-query.
-
-Note: Other code should always use this function alter tags of
-messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
-directly, so that hooks specified in notmuch-before-tag-hook and
-notmuch-after-tag-hook will be run."
-  ;; Perform some validation
-  (when (null tags) (error "No tags given"))
-  (mapc (lambda (tag)
-         (unless (string-match-p "^[-+][-+_.[:word:]]+$" tag)
-           (error "Tag must be of the form `+this_tag' or `-that_tag'")))
-       tags)
-  (run-hooks 'notmuch-before-tag-hook)
-  (apply 'notmuch-call-notmuch-process
-        (append (list "tag") tags (list "--" query)))
-  (run-hooks 'notmuch-after-tag-hook))
-
-(defcustom notmuch-before-tag-hook nil
-  "Hooks that are run before tags of a message are modified.
-
-'tags' will contain the tags that are about to be added or removed as
-a list of strings of the form \"+TAG\" or \"-TAG\".
-'query' will be a string containing the search query that determines
-the messages that are about to be tagged"
-
-  :type 'hook
-  :options '(hl-line-mode)
-  :group 'notmuch-hooks)
-
-(defcustom notmuch-after-tag-hook nil
-  "Hooks that are run after tags of a message are modified.
-
-'tags' will contain the tags that were added or removed as
-a list of strings of the form \"+TAG\" or \"-TAG\".
-'query' will be a string containing the search query that determines
-the messages that were tagged"
-  :type 'hook
-  :options '(hl-line-mode)
-  :group 'notmuch-hooks)
-

 (defun notmuch-search-set-tags (tags)
   (save-excursion
     (end-of-line)
 (defun notmuch-search-set-tags (tags)
   (save-excursion
     (end-of-line)


@@ -606,36 +517,27 @@ the messages that were tagged"
        (forward-line 1))
       output)))
 
        (forward-line 1))
       output)))
 

-(defun notmuch-search-tag-thread (&rest tags)
-  "Change tags for the currently selected thread.
-
-See `notmuch-search-tag-region' for details."
-  (apply 'notmuch-search-tag-region (point) (point) tags))
-
-(defun notmuch-search-tag-region (beg end &rest tags)
-  "Change tags for threads in the given region.
-
-TAGS is a list of tag operations for `notmuch-tag'.  The tags are
-added or removed for all threads in the region from BEG to END."
+(defun notmuch-search-tag-region (beg end &optional tag-changes)
+  "Change tags for threads in the given region."

   (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))
   (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))

-    (apply 'notmuch-tag search-string tags)
+    (setq tag-changes (funcall 'notmuch-tag search-string tag-changes))

     (save-excursion
       (let ((last-line (line-number-at-pos end))
            (max-line (- (line-number-at-pos (point-max)) 2)))
        (goto-char beg)
        (while (<= (line-number-at-pos) (min last-line max-line))
          (notmuch-search-set-tags
     (save-excursion
       (let ((last-line (line-number-at-pos end))
            (max-line (- (line-number-at-pos (point-max)) 2)))
        (goto-char beg)
        (while (<= (line-number-at-pos) (min last-line max-line))
          (notmuch-search-set-tags

-          (notmuch-update-tags (notmuch-search-get-tags) tags))
+          (notmuch-update-tags (notmuch-search-get-tags) tag-changes))

          (forward-line))))))
 
          (forward-line))))))
 

-(defun notmuch-search-tag (&optional initial-input)
-  "Change tags for the currently selected thread or region."
+(defun notmuch-search-tag (&optional tag-changes)
+  "Change tags for the currently selected thread or region.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES."

   (interactive)
   (let* ((beg (if (region-active-p) (region-beginning) (point)))
   (interactive)
   (let* ((beg (if (region-active-p) (region-beginning) (point)))

-        (end (if (region-active-p) (region-end) (point)))
-        (search-string (notmuch-search-find-thread-id-region-search beg end))
-        (tags (notmuch-read-tag-changes initial-input search-string)))
-    (apply 'notmuch-search-tag-region beg end tags)))
+        (end (if (region-active-p) (region-end) (point))))
+    (funcall 'notmuch-search-tag-region beg end tag-changes)))

 
 (defun notmuch-search-add-tag ()
   "Same as `notmuch-search-tag' but sets initial input to '+'."
 
 (defun notmuch-search-add-tag ()
   "Same as `notmuch-search-tag' but sets initial input to '+'."


@@ -652,7 +554,7 @@ added or removed for all threads in the region from BEG to END."
 
 This function advances the next thread when finished."
   (interactive)
 
 This function advances the next thread when finished."
   (interactive)

-  (notmuch-search-tag-thread "-inbox")
+  (notmuch-search-tag '("-inbox"))

   (notmuch-search-next-thread))
 
 (defvar notmuch-search-process-filter-data nil
   (notmuch-search-next-thread))
 
 (defvar notmuch-search-process-filter-data nil


@@ -689,18 +591,19 @@ This function advances the next thread when finished."
                  (goto-char (point-min))
                  (forward-line (1- notmuch-search-target-line))))))))
 
                  (goto-char (point-min))
                  (forward-line (1- notmuch-search-target-line))))))))
 

-(defcustom notmuch-search-line-faces nil
+(defcustom notmuch-search-line-faces '(("unread" :weight bold)
+                                      ("flagged" :foreground "blue"))

   "Tag/face mapping for line highlighting in notmuch-search.
 
 Here is an example of how to color search results based on tags.
  (the following text would be placed in your ~/.emacs file):
 
   "Tag/face mapping for line highlighting in notmuch-search.
 
 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 '((\"delete\" . (:foreground \"red\"
+ (setq notmuch-search-line-faces '((\"deleted\" . (:foreground \"red\"

                                                  :background \"blue\"))
                                    (\"unread\" . (:foreground \"green\"))))
 
 The attributes defined for matching tags are merged, with later
                                                  :background \"blue\"))
                                    (\"unread\" . (:foreground \"green\"))))
 
 The attributes defined for matching tags are merged, with later

-attributes overriding earlier. A message having both \"delete\"
+attributes overriding earlier. A message having both \"deleted\"

 and \"unread\" tags with the above settings would have a green
 foreground and blue background."
   :type '(alist :key-type (string) :value-type (custom-face-edit))
 and \"unread\" tags with the above settings would have a green
 foreground and blue background."
   :type '(alist :key-type (string) :value-type (custom-face-edit))


@@ -804,38 +707,57 @@ non-authors is found, assume that all of the authors match."
          (overlay-put overlay 'isearch-open-invisible #'delete-overlay)))
       (insert padding))))
 
          (overlay-put overlay 'isearch-open-invisible #'delete-overlay)))
       (insert padding))))
 

-(defun notmuch-search-insert-field (field date count authors subject tags)
+(defun notmuch-search-insert-field (field format-string date count authors subject tags)

   (cond
    ((string-equal field "date")
   (cond
    ((string-equal field "date")

-    (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) date)
+    (insert (propertize (format format-string date)

                        'face 'notmuch-search-date)))
    ((string-equal field "count")
                        'face 'notmuch-search-date)))
    ((string-equal field "count")

-    (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) count)
+    (insert (propertize (format format-string count)

                        'face 'notmuch-search-count)))
    ((string-equal field "subject")
                        'face 'notmuch-search-count)))
    ((string-equal field "subject")

-    (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) subject)
+    (insert (propertize (format format-string subject)

                        'face 'notmuch-search-subject)))
 
    ((string-equal field "authors")
                        'face 'notmuch-search-subject)))
 
    ((string-equal field "authors")

-    (notmuch-search-insert-authors (cdr (assoc field notmuch-search-result-format)) authors))
+    (notmuch-search-insert-authors format-string authors))

 
    ((string-equal field "tags")
 
    ((string-equal field "tags")

+    ;; Ignore format-string here because notmuch-search-set-tags
+    ;; depends on the format of this

     (insert (concat "(" (propertize tags 'font-lock-face 'notmuch-tag-face) ")")))))
 
     (insert (concat "(" (propertize tags 'font-lock-face 'notmuch-tag-face) ")")))))
 

-(defun notmuch-search-show-result (date count authors subject tags)
-  (let ((fields) (field))
-    (setq fields (mapcar 'car notmuch-search-result-format))
-    (loop for field in fields
-         do (notmuch-search-insert-field field date count authors subject tags)))
-  (insert "\n"))
+(defun notmuch-search-show-result (thread-id date count authors subject tags)
+  ;; Ignore excluded matches
+  (unless (eq (aref count 1) ?0)
+    (let ((beg (point-max))
+         (tags-str (mapconcat 'identity tags " ")))
+      (save-excursion
+       (goto-char beg)
+       (dolist (spec notmuch-search-result-format)
+         (notmuch-search-insert-field (car spec) (cdr spec)
+                                      date count authors subject tags-str))
+       (insert "\n")
+       (notmuch-search-color-line beg (point) tags)
+       (put-text-property beg (point) 'notmuch-search-thread-id thread-id)
+       (put-text-property beg (point) 'notmuch-search-authors authors)
+       (put-text-property beg (point) 'notmuch-search-subject subject))
+      (when (string= thread-id notmuch-search-target-thread)
+       (setq notmuch-search-target-thread "found")
+       (goto-char beg)))))
+
+(defun notmuch-search-show-error (string &rest objects)
+  (save-excursion
+    (goto-char (point-max))
+    (insert "Error: Unexpected output from notmuch search:\n")
+    (insert (apply #'format string objects))
+    (insert "\n")))

 
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
 
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""

-  (let ((buffer (process-buffer proc))
-       (found-target nil))
+  (let ((buffer (process-buffer proc)))

     (if (buffer-live-p buffer)
        (with-current-buffer buffer
     (if (buffer-live-p buffer)
        (with-current-buffer buffer

-         (save-excursion

            (let ((line 0)
                  (more t)
                  (inhibit-read-only t)
            (let ((line 0)
                  (more t)
                  (inhibit-read-only t)


@@ -852,19 +774,10 @@ non-authors is found, assume that all of the authors match."
                           (subject (match-string 5 string))
                           (tags (match-string 6 string))
                           (tag-list (if tags (save-match-data (split-string tags)))))
                           (subject (match-string 5 string))
                           (tags (match-string 6 string))
                           (tag-list (if tags (save-match-data (split-string tags)))))

-                     (goto-char (point-max))

                      (if (/= (match-beginning 1) line)
                      (if (/= (match-beginning 1) line)

-                         (insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n")))
-                     (let ((beg (point)))
-                       (notmuch-search-show-result date count authors
-                                                   (notmuch-prettify-subject subject) tags)
-                       (notmuch-search-color-line beg (point) tag-list)
-                       (put-text-property beg (point) 'notmuch-search-thread-id thread-id)
-                       (put-text-property beg (point) 'notmuch-search-authors authors)
-                       (put-text-property beg (point) 'notmuch-search-subject subject)
-                       (when (string= thread-id notmuch-search-target-thread)
-                         (set 'found-target beg)
-                         (set 'notmuch-search-target-thread "found")))
+                         (notmuch-search-show-error
+                          (substring string line (match-beginning 1))))
+                     (notmuch-search-show-result thread-id date count authors subject tag-list)

                      (set 'line (match-end 0)))
                  (set 'more nil)
                  (while (and (< line (length string)) (= (elt string line) ?\n))
                      (set 'line (match-end 0)))
                  (set 'more nil)
                  (while (and (< line (length string)) (= (elt string line) ?\n))


@@ -872,23 +785,14 @@ non-authors is found, assume that all of the authors match."
                  (if (< line (length string))
                      (setq notmuch-search-process-filter-data (substring string line)))
                  ))))
                  (if (< line (length string))
                      (setq notmuch-search-process-filter-data (substring string line)))
                  ))))

-         (if found-target
-             (goto-char found-target)))

       (delete-process proc))))
 
       (delete-process proc))))
 

-(defun notmuch-search-operate-all (&rest actions)
-  "Add/remove tags from all matching messages.
+(defun notmuch-search-tag-all (&optional tag-changes)
+  "Add/remove tags from all messages in current search buffer.

 
 

-This command adds or removes tags from all messages matching the
-current search terms. When called interactively, this command
-will prompt for tags to be added or removed. Tags prefixed with
-'+' will be added and tags prefixed with '-' will be removed.
-
-Each character of the tag name may consist of alphanumeric
-characters as well as `_.+-'.
-"
-  (interactive (notmuch-read-tag-changes))
-  (apply 'notmuch-tag notmuch-search-query-string actions))
+See `notmuch-tag' for information on the format of TAG-CHANGES."
+  (interactive)
+  (apply 'notmuch-tag notmuch-search-query-string tag-changes))

 
 (defun notmuch-search-buffer-title (query)
   "Returns the title for a buffer with notmuch search results."
 
 (defun notmuch-search-buffer-title (query)
   "Returns the title for a buffer with notmuch search results."


@@ -943,7 +847,7 @@ PROMPT is the string to prompt with."
                                         completions)))
               (t (list string)))))))
       ;; this was simpler than convincing completing-read to accept spaces:
                                         completions)))
               (t (list string)))))))
       ;; this was simpler than convincing completing-read to accept spaces:

-      (define-key keymap (kbd "<tab>") 'minibuffer-complete)
+      (define-key keymap (kbd "TAB") 'minibuffer-complete)

       (let ((history-delete-duplicates t))
        (read-from-minibuffer prompt nil keymap nil
                              'notmuch-search-history nil nil)))))
       (let ((history-delete-duplicates t))
        (read-from-minibuffer prompt nil keymap nil
                              'notmuch-search-history nil nil)))))