]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
emacs: customizable names for search buffers
[notmuch] / emacs / notmuch.el
index 027c5cfad7c404fe1a5ef783fd224ff5c338f561..6abb17ffdc6d0b1b529ac0024bb08cff5a127b45 100644 (file)
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'mm-view)
 (require 'message)
 
+(require 'hl-line)
+
 (require 'notmuch-lib)
 (require 'notmuch-tag)
 (require 'notmuch-show)
     ("authors" . "%-20s ")
     ("subject" . "%s ")
     ("tags" . "(%s)"))
-  "Search result formatting. Supported fields are:
-       date, count, authors, subject, tags
+  "Search result formatting.
+
+Supported fields are: date, count, authors, subject, tags.
 For example:
-       (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
-                                            \(\"subject\" . \"%s\"\)\)\)
+    (setq notmuch-search-result-format
+          '((\"authors\" . \"%-40s\")
+            (\"subject\" . \"%s\")))
+
 Line breaks are permitted in format strings (though this is
 currently experimental).  Note that a line break at the end of an
 \"authors\" field will get elided if the authors list is long;
 place it instead at the beginning of the following field.  To
 enter a line break when setting this variable with setq, use \\n.
 To enter a line break in customize, press \\[quoted-insert] C-j."
-  :type '(alist :key-type (string) :value-type (string))
+  :type '(alist :key-type string :value-type string)
   :group 'notmuch-search)
 
 ;; The name of this variable `notmuch-init-file' is consistent with the
@@ -114,8 +117,12 @@ there will be called at other points of notmuch execution."
   :type 'file
   :group 'notmuch)
 
-(defvar notmuch-query-history nil
-  "Variable to store minibuffer history for notmuch queries.")
+(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
+  "List of functions to call when notmuch displays the search results."
+  :type 'hook
+  :options '(notmuch-hl-line-mode)
+  :group 'notmuch-search
+  :group 'notmuch-hooks)
 
 ;;; Mime Utilities
 
@@ -155,24 +162,6 @@ there will be called at other points of notmuch execution."
            (mm-save-part p))))
    mm-handle))
 
-;;; Integrations
-
-(require 'hl-line)
-
-(defun notmuch-hl-line-mode ()
-  (prog1 (hl-line-mode)
-    (when hl-line-overlay
-      (overlay-put hl-line-overlay 'priority 1))))
-
-;;; Options
-
-(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
-  "List of functions to call when notmuch displays the search results."
-  :type 'hook
-  :options '(notmuch-hl-line-mode)
-  :group 'notmuch-search
-  :group 'notmuch-hooks)
-
 ;;; Keymap
 
 (defvar notmuch-search-mode-map
@@ -207,6 +196,9 @@ there will be called at other points of notmuch execution."
 
 ;;; Internal Variables
 
+(defvar notmuch-query-history nil
+  "Variable to store minibuffer history for notmuch queries.")
+
 (defvar-local notmuch-search-query-string nil)
 (defvar-local notmuch-search-target-thread nil)
 (defvar-local notmuch-search-target-line nil)
@@ -230,7 +222,7 @@ there will be called at other points of notmuch execution."
 (defun notmuch-stash-query ()
   "Copy current query to kill-ring."
   (interactive)
-  (notmuch-common-do-stash (notmuch-search-get-query)))
+  (notmuch-common-do-stash notmuch-search-query-string))
 
 ;;; Movement
 
@@ -530,26 +522,25 @@ With a prefix argument, invert the default value of
 `notmuch-show-only-matching-messages' when displaying the
 thread."
   (interactive "P")
-  (let ((thread-id (notmuch-search-find-thread-id))
-       (subject (notmuch-search-find-subject)))
-    (if (> (length thread-id) 0)
+  (let ((thread-id (notmuch-search-find-thread-id)))
+    (if thread-id
        (notmuch-show thread-id
                      elide-toggle
                      (current-buffer)
                      notmuch-search-query-string
                      ;; Name the buffer based on the subject.
-                     (concat "*"
-                             (truncate-string-to-width subject 30 nil nil t)
-                             "*"))
+                     (format "*%s*" (truncate-string-to-width
+                                     (notmuch-search-find-subject)
+                                     30 nil nil t)))
       (message "End of search results."))))
 
 (defun notmuch-tree-from-search-current-query ()
-  "Call notmuch tree with the current query."
+  "Tree view of current query."
   (interactive)
   (notmuch-tree notmuch-search-query-string))
 
 (defun notmuch-unthreaded-from-search-current-query ()
-  "Call notmuch tree with the current query."
+  "Unthreaded view of current query."
   (interactive)
   (notmuch-unthreaded notmuch-search-query-string))
 
@@ -565,20 +556,21 @@ thread."
 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
   "Begin composing a reply-all to the entire current thread in a new buffer."
   (interactive "P")
-  (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-mua-new-reply message-id prompt-for-sender t)))
+  (notmuch-mua-new-reply (notmuch-search-find-thread-id)
+                        prompt-for-sender t))
 
 (defun notmuch-search-reply-to-thread-sender (&optional prompt-for-sender)
   "Begin composing a reply to the entire current thread in a new buffer."
   (interactive "P")
-  (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-mua-new-reply message-id prompt-for-sender nil)))
+  (notmuch-mua-new-reply (notmuch-search-find-thread-id)
+                        prompt-for-sender nil))
 
 ;;; Tags
 
 (defun notmuch-search-set-tags (tags &optional pos)
-  (let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
-    (notmuch-search-update-result new-result pos)))
+  (notmuch-search-update-result
+   (plist-put (notmuch-search-get-result pos) :tags tags)
+   pos))
 
 (defun notmuch-search-get-tags (&optional pos)
   (plist-get (notmuch-search-get-result pos) :tags))
@@ -588,7 +580,7 @@ thread."
     (notmuch-search-foreach-result beg end
       (lambda (pos)
        (setq output (append output (notmuch-search-get-tags pos)))))
-    output))
+    (delete-dups output)))
 
 (defun notmuch-search-interactive-tag-changes (&optional initial-input)
   "Prompt for tag changes for the current thread or region.
@@ -825,13 +817,13 @@ non-authors is found, assume that all of the authors match."
        (setq invisible-string (notmuch-search-author-propertize invisible-string)))
       ;; If there is any invisible text, add it as a tooltip to the
       ;; visible text.
-      (unless (string= invisible-string "")
+      (unless (string-empty-p invisible-string)
        (setq visible-string
              (propertize visible-string
                          'help-echo (concat "..." invisible-string))))
       ;; Insert the visible and, if present, invisible author strings.
       (insert visible-string)
-      (unless (string= invisible-string "")
+      (unless (string-empty-p invisible-string)
        (let ((start (point))
              overlay)
          (insert invisible-string)
@@ -841,26 +833,28 @@ non-authors is found, assume that all of the authors match."
       (insert padding))))
 
 (defun notmuch-search-insert-field (field format-string result)
-  (cond
-   ((string-equal field "date")
-    (insert (propertize (format format-string (plist-get result :date_relative))
-                       'face 'notmuch-search-date)))
-   ((string-equal field "count")
-    (insert (propertize (format format-string
-                               (format "[%s/%s]" (plist-get result :matched)
-                                       (plist-get result :total)))
-                       'face 'notmuch-search-count)))
-   ((string-equal field "subject")
-    (insert (propertize (format format-string
-                               (notmuch-sanitize (plist-get result :subject)))
-                       'face 'notmuch-search-subject)))
-   ((string-equal field "authors")
-    (notmuch-search-insert-authors
-     format-string (notmuch-sanitize (plist-get result :authors))))
-   ((string-equal field "tags")
-    (let ((tags (plist-get result :tags))
-         (orig-tags (plist-get result :orig-tags)))
-      (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
+  (pcase field
+    ((pred functionp)
+     (insert (funcall field format-string result)))
+    ("date"
+     (insert (propertize (format format-string (plist-get result :date_relative))
+                        'face 'notmuch-search-date)))
+    ("count"
+     (insert (propertize (format format-string
+                                (format "[%s/%s]" (plist-get result :matched)
+                                        (plist-get result :total)))
+                        'face 'notmuch-search-count)))
+    ("subject"
+     (insert (propertize (format format-string
+                                (notmuch-sanitize (plist-get result :subject)))
+                        'face 'notmuch-search-subject)))
+    ("authors"
+     (notmuch-search-insert-authors format-string
+                                   (notmuch-sanitize (plist-get result :authors))))
+    ("tags"
+     (let ((tags (plist-get result :tags))
+          (orig-tags (plist-get result :orig-tags)))
+       (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
 
 (defun notmuch-search-show-result (result pos)
   "Insert RESULT at POS."
@@ -886,6 +880,14 @@ sets the :orig-tag property."
       (setq notmuch-search-target-thread "found")
       (goto-char pos))))
 
+(defvar-local notmuch--search-hook-run nil
+  "Flag used to ensure the notmuch-search-hook is only run once per buffer")
+
+(defun notmuch--search-hook-wrapper ()
+  (unless notmuch--search-hook-run
+    (setq notmuch--search-hook-run t)
+    (run-hooks 'notmuch-search-hook)))
+
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\"."
   (let ((results-buf (process-buffer proc))
@@ -898,7 +900,9 @@ sets the :orig-tag property."
          (goto-char (point-max))
          (insert string))
        (notmuch-sexp-parse-partial-list 'notmuch-search-append-result
-                                        results-buf)))))
+                                        results-buf))
+      (with-current-buffer results-buf
+       (notmuch--search-hook-wrapper)))))
 
 ;;; Commands (and some helper functions used by them)
 
@@ -911,7 +915,39 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
          (notmuch-search-get-tags-region (point-min) (point-max)) "Tag all")))
   (notmuch-search-tag tag-changes (point-min) (point-max) t))
 
-(defun notmuch-search-buffer-title (query)
+(defcustom notmuch-search-buffer-name-format "*notmuch-%t-%s*"
+  "Format for the name of search results buffers.
+
+In this spec, %s will be replaced by a description of the search
+query and %t by its type (search, tree or unthreaded).  The
+buffer name is formatted using `format-spec': see its docstring
+for additional parameters for the s and t format specifiers.
+
+See also `notmuch-saved-search-buffer-name-format'"
+  :type 'string
+  :group 'notmuch-search)
+
+(defcustom notmuch-saved-search-buffer-name-format "*notmuch-saved-%t-%s*"
+  "Format for the name of search results buffers for saved searches.
+
+In this spec, %s will be replaced by the saved search name and %t
+by its type (search, tree or unthreaded).  The buffer name is
+formatted using `format-spec': see its docstring for additional
+parameters for the s and t format specifiers.
+
+See also `notmuch-search-buffer-name-format'"
+  :type 'string
+  :group 'notmuch-search)
+
+(defun notmuch-search-format-buffer-name (query type saved)
+  "Compose a buffer name for the given QUERY, TYPE (search, tree,
+unthreaded) and whether it's SAVED (t or nil)."
+  (let ((fmt (if saved
+                notmuch-saved-search-buffer-name-format
+              notmuch-search-buffer-name-format)))
+    (format-spec fmt `((?t . ,(or type "search")) (?s . ,query)))))
+
+(defun notmuch-search-buffer-title (query &optional type)
   "Returns the title for a buffer with notmuch search results."
   (let* ((saved-search
          (let (longest
@@ -926,19 +962,20 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
                     do (setq longest tuple))
            longest))
         (saved-search-name (notmuch-saved-search-get saved-search :name))
+        (saved-search-type (notmuch-saved-search-get saved-search :search-type))
         (saved-search-query (notmuch-saved-search-get saved-search :query)))
     (cond ((and saved-search (equal saved-search-query query))
           ;; Query is the same as saved search (ignoring case)
-          (concat "*notmuch-saved-search-" saved-search-name "*"))
+          (notmuch-search-format-buffer-name saved-search-name
+                                             saved-search-type
+                                             t))
          (saved-search
-          (concat "*notmuch-search-"
-                  (replace-regexp-in-string
-                   (concat "^" (regexp-quote saved-search-query))
-                   (concat "[ " saved-search-name " ]")
-                   query)
-                  "*"))
-         (t
-          (concat "*notmuch-search-" query "*")))))
+          (let ((query (replace-regexp-in-string
+                        (concat "^" (regexp-quote saved-search-query))
+                        (concat "[ " saved-search-name " ]")
+                        query)))
+            (notmuch-search-format-buffer-name query saved-search-type t)))
+         (t (notmuch-search-format-buffer-name query type nil)))))
 
 (defun notmuch-read-query (prompt)
   "Read a notmuch-query from the minibuffer with completion.
@@ -946,7 +983,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
 PROMPT is the string to prompt with."
   (let* ((all-tags
          (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
-                 (process-lines notmuch-command "search" "--output=tags" "*")))
+                 (notmuch--process-lines notmuch-command "search" "--output=tags" "*")))
         (completions
          (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
                        "subject:" "attachment:")
@@ -984,7 +1021,8 @@ PROMPT is the string to prompt with."
 
 (put 'notmuch-search 'notmuch-doc "Search for messages.")
 ;;;###autoload
-(defun notmuch-search (&optional query oldest-first target-thread target-line no-display)
+(defun notmuch-search (&optional query oldest-first target-thread target-line
+                                no-display)
   "Display threads matching QUERY in a notmuch-search buffer.
 
 If QUERY is nil, it is read interactively from the minibuffer.
@@ -1022,16 +1060,15 @@ the configured default sort order."
     (setq notmuch-search-target-thread target-thread)
     (setq notmuch-search-target-line target-line)
     (notmuch-tag-clear-cache)
-    (let ((proc (get-buffer-process (current-buffer)))
-         (inhibit-read-only t))
-      (when proc
-       (error "notmuch search process already running for query `%s'" query))
+    (when (get-buffer-process buffer)
+      (error "notmuch search process already running for query `%s'" query))
+    (let ((inhibit-read-only t))
       (erase-buffer)
       (goto-char (point-min))
       (save-excursion
        (let ((proc (notmuch-start-notmuch
                     "notmuch-search" buffer #'notmuch-search-process-sentinel
-                    "search" "--format=sexp" "--format-version=4"
+                    "search" "--format=sexp" "--format-version=5"
                     (if oldest-first
                         "--sort=oldest-first"
                       "--sort=newest-first")
@@ -1042,8 +1079,7 @@ the configured default sort order."
          (process-put proc 'parse-buf
                       (generate-new-buffer " *notmuch search parse*"))
          (set-process-filter proc 'notmuch-search-process-filter)
-         (set-process-query-on-exit-flag proc nil))))
-    (run-hooks 'notmuch-search-hook)))
+         (set-process-query-on-exit-flag proc nil))))))
 
 (defun notmuch-search-refresh-view ()
   "Refresh the current view.
@@ -1054,13 +1090,12 @@ the new search results, then point will be placed on the same
 thread. Otherwise, point will be moved to attempt to be in the
 same relative position within the new buffer."
   (interactive)
-  (let ((target-line (line-number-at-pos))
-       (oldest-first notmuch-search-oldest-first)
-       (target-thread (notmuch-search-find-thread-id 'bare))
-       (query notmuch-search-query-string))
-    ;; notmuch-search erases the current buffer.
-    (notmuch-search query oldest-first target-thread target-line t)
-    (goto-char (point-min))))
+  (notmuch-search notmuch-search-query-string
+                 notmuch-search-oldest-first
+                 (notmuch-search-find-thread-id 'bare)
+                 (line-number-at-pos)
+                 t)
+  (goto-char (point-min)))
 
 (defun notmuch-search-toggle-order ()
   "Toggle the current search order.
@@ -1150,7 +1185,15 @@ If no notmuch buffers exist, run `notmuch'."
          (pop-to-buffer-same-window first))
       (notmuch))))
 
-;;; Imenu Support
+;;; Integrations
+;;;; Hl-line Support
+
+(defun notmuch-hl-line-mode ()
+  (prog1 (hl-line-mode)
+    (when hl-line-overlay
+      (overlay-put hl-line-overlay 'priority 1))))
+
+;;;; Imenu Support
 
 (defun notmuch-search-imenu-prev-index-position-function ()
   "Move point to previous message in notmuch-search buffer.
@@ -1161,14 +1204,12 @@ Used as`imenu-prev-index-position-function' in notmuch buffers."
   "Return imenu name for line at point.
 Used as `imenu-extract-index-name-function' in notmuch buffers.
 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)))
+  (format "%s (%s)"
+         (notmuch-search-find-subject)
+         (notmuch-search-find-authors)))
 
 ;;; _
 
-(setq mail-user-agent 'notmuch-user-agent)
-
 (provide 'notmuch)
 
 ;; After provide to avoid loops if notmuch was require'd via notmuch-init-file.