; kudos: Notmuch list <notmuch@notmuchmail.org> (subscription is not
; required, but is available from http://notmuchmail.org).
-(require 'cl)
+(eval-when-compile (require 'cl))
(require 'mm-view)
(require 'message)
(require 'notmuch-lib)
(require 'notmuch-show)
+(require 'notmuch-mua)
+(require 'notmuch-hello)
+(require 'notmuch-maildir-fcc)
+(require 'notmuch-message)
+
+(defcustom notmuch-search-result-format
+ `(("date" . "%s ")
+ ("count" . "%-7s ")
+ ("authors" . "%-20s ")
+ ("subject" . "%s ")
+ ("tags" . "(%s)"))
+ "Search result formatting. Supported fields are:
+ date, count, authors, subject, tags
+For example:
+ (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
+ \(\"subject\" . \"%s\"\)\)\)"
+ :type '(alist :key-type (string) :value-type (string))
+ :group 'notmuch)
+
+(defvar notmuch-query-history nil
+ "Variable to store minibuffer history for notmuch queries")
(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
(let ((tag-list
(mm-save-part p))))
mm-handle))
-(defun notmuch-reply (query-string)
- (switch-to-buffer (generate-new-buffer "notmuch-draft"))
- (call-process notmuch-command nil t nil "reply" query-string)
- (message-insert-signature)
- (goto-char (point-min))
- (if (re-search-forward "^$" nil t)
- (progn
- (insert "--text follows this line--")
- (forward-line)))
- (message-mode))
-
-(defun notmuch-toggle-invisible-action (cite-button)
- (let ((invis-spec (button-get cite-button 'invisibility-spec)))
- (if (invisible-p invis-spec)
- (remove-from-invisibility-spec invis-spec)
- (add-to-invisibility-spec invis-spec)
- ))
- (force-window-update)
- (redisplay t))
-
-(define-button-type 'notmuch-button-citation-toggle-type 'help-echo "mouse-1, RET: Show citation"
- :supertype 'notmuch-button-invisibility-toggle-type)
-(define-button-type 'notmuch-button-signature-toggle-type 'help-echo "mouse-1, RET: Show signature"
- :supertype 'notmuch-button-invisibility-toggle-type)
-(define-button-type 'notmuch-button-body-toggle-type
- 'help-echo "mouse-1, RET: Show message"
- 'face 'notmuch-message-summary-face
- :supertype 'notmuch-button-invisibility-toggle-type)
-
-(defun notmuch-fontify-headers ()
- (while (looking-at "[[:space:]]")
- (forward-char))
- (if (looking-at "[Tt]o:")
- (progn
- (overlay-put (make-overlay (point) (re-search-forward ":"))
- 'face 'message-header-name)
- (overlay-put (make-overlay (point) (re-search-forward ".*$"))
- 'face 'message-header-to))
- (if (looking-at "[B]?[Cc][Cc]:")
- (progn
- (overlay-put (make-overlay (point) (re-search-forward ":"))
- 'face 'message-header-name)
- (overlay-put (make-overlay (point) (re-search-forward ".*$"))
- 'face 'message-header-cc))
- (if (looking-at "[Ss]ubject:")
- (progn
- (overlay-put (make-overlay (point) (re-search-forward ":"))
- 'face 'message-header-name)
- (overlay-put (make-overlay (point) (re-search-forward ".*$"))
- 'face 'message-header-subject))
- (if (looking-at "[Ff]rom:")
- (progn
- (overlay-put (make-overlay (point) (re-search-forward ":"))
- 'face 'message-header-name)
- (overlay-put (make-overlay (point) (re-search-forward ".*$"))
- 'face 'message-header-other))
- (if (looking-at "[Dd]ate:")
- (progn
- (overlay-put (make-overlay (point) (re-search-forward ":"))
- 'face 'message-header-name)
- (overlay-put (make-overlay (point) (re-search-forward ".*$"))
- 'face 'message-header-other))))))))
-
(defun notmuch-documentation-first-line (symbol)
"Return the first line of the documentation string for SYMBOL."
(let ((doc (documentation symbol)))
(set-buffer-modified-p nil)
(view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
-(defgroup notmuch nil
- "Notmuch mail reader for Emacs."
- :group 'mail)
-
-(defcustom notmuch-search-hook nil
+(defcustom notmuch-search-hook '(hl-line-mode)
"List of functions to call when notmuch displays the search results."
:type 'hook
:options '(hl-line-mode)
:group 'notmuch)
-(defvar notmuch-search-authors-width 20
- "Number of columns to use to display authors in a notmuch-search buffer.")
-
(defvar notmuch-search-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "?" 'notmuch-help)
- (define-key map "q" 'kill-this-buffer)
- (define-key map "x" 'kill-this-buffer)
+ (define-key map "q" 'notmuch-search-quit)
+ (define-key map "x" 'notmuch-search-quit)
(define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
(define-key map "b" 'notmuch-search-scroll-down)
(define-key map " " 'notmuch-search-scroll-up)
(define-key map "p" 'notmuch-search-previous-thread)
(define-key map "n" 'notmuch-search-next-thread)
(define-key map "r" 'notmuch-search-reply-to-thread)
- (define-key map "m" 'message-mail)
+ (define-key map "m" 'notmuch-mua-new-mail)
(define-key map "s" 'notmuch-search)
(define-key map "o" 'notmuch-search-toggle-order)
+ (define-key map "c" 'notmuch-search-stash-map)
(define-key map "=" 'notmuch-search-refresh-view)
+ (define-key map "G" 'notmuch-search-poll-and-refresh-view)
(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-remove-tag)
(define-key map "+" 'notmuch-search-add-tag)
(define-key map (kbd "RET") 'notmuch-search-show-thread)
- (define-key map "F" 'notmuch-folder)
+ (define-key map (kbd "M-RET") 'notmuch-search-show-thread-crypto-switch)
map)
"Keymap for \"notmuch search\" buffers.")
(fset 'notmuch-search-mode-map notmuch-search-mode-map)
+(defvar notmuch-search-stash-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "i" 'notmuch-search-stash-thread-id)
+ map)
+ "Submap for stash commands")
+(fset 'notmuch-search-stash-map notmuch-search-stash-map)
+
+(defun notmuch-search-stash-thread-id ()
+ "Copy thread ID of current thread to kill-ring."
+ (interactive)
+ (notmuch-common-do-stash (notmuch-search-find-thread-id)))
+
(defvar notmuch-search-query-string)
(defvar notmuch-search-target-thread)
(defvar notmuch-search-target-line)
-(defvar notmuch-search-oldest-first t
- "Show the oldest mail first in the search-mode")
+(defvar notmuch-search-continuation)
(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
+(defun notmuch-search-quit ()
+ "Exit the search buffer, calling any defined continuation function."
+ (interactive)
+ (let ((continuation notmuch-search-continuation))
+ (notmuch-kill-this-buffer)
+ (when continuation
+ (funcall continuation))))
+
(defun notmuch-search-scroll-up ()
"Move forward through search results by one window's worth."
(interactive)
"Face for the single-line message summary in notmuch-show-mode."
:group 'notmuch)
+(defface notmuch-search-date
+ '((t :inherit default))
+ "Face used in search mode for dates."
+ :group 'notmuch)
+
+(defface notmuch-search-count
+ '((t :inherit default))
+ "Face used in search mode for the count matching the query."
+ :group 'notmuch)
+
+(defface notmuch-search-subject
+ '((t :inherit default))
+ "Face used in search mode for subjects."
+ :group 'notmuch)
+
+(defface notmuch-search-matching-authors
+ '((t :inherit default))
+ "Face used in search mode for authors matching the query."
+ :group 'notmuch)
+
+(defface notmuch-search-non-matching-authors
+ '((((class color)
+ (background dark))
+ (:foreground "grey30"))
+ (((class color)
+ (background light))
+ (:foreground "grey60"))
+ (t
+ (:italic t)))
+ "Face used in search mode for authors not matching the query."
+ :group 'notmuch)
+
(defface notmuch-tag-face
'((((class color)
(background dark))
(:foreground "navy blue" :bold t))
(t
(:bold t)))
- "Notmuch search mode face used to highligh tags."
+ "Face used in search mode face for tags."
:group 'notmuch)
-(defvar notmuch-tag-face-alist nil
- "List containing the tag list that need to be highlighed")
-
-(defvar notmuch-search-font-lock-keywords nil)
-
-;;;###autoload
(defun notmuch-search-mode ()
"Major mode displaying results of a notmuch search.
(make-local-variable 'notmuch-search-oldest-first)
(make-local-variable 'notmuch-search-target-thread)
(make-local-variable 'notmuch-search-target-line)
+ (set (make-local-variable 'notmuch-search-continuation) nil)
(set (make-local-variable 'scroll-preserve-screen-position) t)
- (add-to-invisibility-spec 'notmuch-search)
+ (add-to-invisibility-spec (cons 'ellipsis t))
(use-local-map notmuch-search-mode-map)
(setq truncate-lines t)
(setq major-mode 'notmuch-search-mode
mode-name "notmuch-search")
- (setq buffer-read-only t)
- (if (not notmuch-tag-face-alist)
- (add-to-list 'notmuch-search-font-lock-keywords (list
- "(\\([^()]*\\))$" '(1 'notmuch-tag-face)))
- (let ((notmuch-search-tags (mapcar 'car notmuch-tag-face-alist)))
- (loop for notmuch-search-tag in notmuch-search-tags
- do (add-to-list 'notmuch-search-font-lock-keywords (list
- (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$")
- `(1 ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist))))))))
- (set (make-local-variable 'font-lock-defaults)
- '(notmuch-search-font-lock-keywords t)))
+ (setq buffer-read-only t))
(defun notmuch-search-properties-in-region (property beg end)
(save-excursion
(let ((output nil)
- (last-line (line-number-at-pos end)))
+ (last-line (line-number-at-pos end))
+ (max-line (- (line-number-at-pos (point-max)) 2)))
(goto-char beg)
(beginning-of-line)
- (while (<= (line-number-at-pos) last-line)
+ (while (<= (line-number-at-pos) (min last-line max-line))
(setq output (cons (get-text-property (point) property) output))
(forward-line 1))
output)))
"Return a list of authors for the current region"
(notmuch-search-properties-in-region 'notmuch-search-subject beg end))
-(defun notmuch-search-show-thread ()
+(defun notmuch-search-show-thread-crypto-switch ()
+ (interactive)
+ (notmuch-search-show-thread t))
+
+(defun notmuch-search-show-thread (&optional crypto-switch)
"Display the currently selected thread."
(interactive)
(let ((thread-id (notmuch-search-find-thread-id))
- (subject (notmuch-search-find-subject))
- buffer-name)
- (when (string-match "^[ \t]*$" subject)
- (setq subject "[No Subject]"))
- (setq buffer-name (concat "*"
- (truncate-string-to-width subject 32 nil nil t)
- "*"))
+ (subject (notmuch-search-find-subject)))
(if (> (length thread-id) 0)
(notmuch-show thread-id
(current-buffer)
notmuch-search-query-string
- buffer-name)
+ ;; name the buffer based on notmuch-search-find-subject
+ (if (string-match "^[ \t]*$" subject)
+ "[No Subject]"
+ (truncate-string-to-width
+ (concat "*"
+ (truncate-string-to-width subject 32 nil nil t)
+ "*")
+ 32 nil nil t))
+ crypto-switch)
(error "End of search results"))))
-(defun notmuch-search-reply-to-thread ()
+(defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
"Begin composing a reply to the entire current thread in a new buffer."
- (interactive)
+ (interactive "P")
(let ((message-id (notmuch-search-find-thread-id)))
- (notmuch-reply message-id)))
+ (notmuch-mua-new-reply message-id prompt-for-sender)))
(defun notmuch-call-notmuch-process (&rest args)
"Synchronously invoke \"notmuch\" with the given list of arguments.
(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."
+ (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)
+
+(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)
+
(defun notmuch-search-set-tags (tags)
(save-excursion
(end-of-line)
(backward-char)
(let ((end (point)))
(delete-region beg end)
- (insert (mapconcat 'identity tags " "))))))
+ (insert (propertize (mapconcat 'identity tags " ")
+ 'face 'notmuch-tag-face))))))
(defun notmuch-search-get-tags ()
(save-excursion
(defun notmuch-search-get-tags-region (beg end)
(save-excursion
(let ((output nil)
- (last-line (line-number-at-pos end)))
+ (last-line (line-number-at-pos end))
+ (max-line (- (line-number-at-pos (point-max)) 2)))
(goto-char beg)
- (while (<= (line-number-at-pos) last-line)
+ (while (<= (line-number-at-pos) (min last-line max-line))
(setq output (append output (notmuch-search-get-tags)))
(forward-line 1))
output)))
(defun notmuch-search-add-tag-thread (tag)
- (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))
- (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
+ (notmuch-search-add-tag-region tag (point) (point)))
(defun notmuch-search-add-tag-region (tag beg end)
(let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
- (notmuch-call-notmuch-process "tag" (concat "+" tag) search-id-string)
+ (notmuch-tag search-id-string (concat "+" tag))
(save-excursion
- (let ((last-line (line-number-at-pos end)))
+ (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) last-line)
+ (while (<= (line-number-at-pos) (min last-line max-line))
(notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<)))
(forward-line))))))
(defun notmuch-search-remove-tag-thread (tag)
- (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))
- (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
+ (notmuch-search-remove-tag-region tag (point) (point)))
(defun notmuch-search-remove-tag-region (tag beg end)
(let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or ")))
- (notmuch-call-notmuch-process "tag" (concat "-" tag) search-id-string)
+ (notmuch-tag search-id-string (concat "-" tag))
(save-excursion
- (let ((last-line (line-number-at-pos end)))
+ (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) last-line)
+ (while (<= (line-number-at-pos) (min last-line max-line))
(notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))
(forward-line))))))
(notmuch-search-remove-tag-thread "inbox")
(forward-line))
+(defvar notmuch-search-process-filter-data nil
+ "Data that has not yet been processed.")
+(make-variable-buffer-local 'notmuch-search-process-filter-data)
+
(defun notmuch-search-process-sentinel (proc msg)
"Add a message to let user know when \"notmuch search\" exits"
(let ((buffer (process-buffer proc))
(insert "Incomplete search results (search process was killed).\n"))
(if (eq status 'exit)
(progn
+ (if notmuch-search-process-filter-data
+ (insert (concat "Error: Unexpected output from notmuch search:\n" notmuch-search-process-filter-data)))
(insert "End of search results.")
(if (not (= exit-status 0))
(insert (format " (process returned %d)" exit-status)))
(if (and atbob
(not (string= notmuch-search-target-thread "found")))
(set 'never-found-target-thread t))))))
- (if (and never-found-target-thread
+ (when (and never-found-target-thread
notmuch-search-target-line)
- (goto-line notmuch-search-target-line)))))))
+ (goto-char (point-min))
+ (forward-line (1- notmuch-search-target-line))))))))
(defcustom notmuch-search-line-faces nil
"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):
+ (the following text would be placed in your ~/.emacs file):
-(setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\"))
- (\"unread\" . '(:foreground \"green\"))))
+ (setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\"
+ :background \"blue\"))
+ (\"unread\" . '(:foreground \"green\"))))
-Order matters: for lines with multiple tags, the the first
-matching will be applied."
- :type '(alist :key-type (string) :value-type (list))
+The attributes defined for matching tags are merged, with later
+attributes overriding earlier. A message having both \"delete\"
+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))
:group 'notmuch)
(defun notmuch-search-color-line (start end line-tag-list)
- "Colorize lines in notmuch-show based on tags"
- (if notmuch-search-line-faces
- (let ((overlay (make-overlay start end))
- (tags-faces (copy-alist notmuch-search-line-faces)))
- (while tags-faces
- (let* ((tag-face (car tags-faces))
- (tag (car tag-face))
- (face (cdr tag-face)))
- (cond ((member tag line-tag-list)
- (overlay-put overlay 'face face)
- (setq tags-faces nil))
- (t
- (setq tags-faces (cdr tags-faces)))))))))
+ "Colorize lines in `notmuch-show' based on tags."
+ ;; Create the overlay only if the message has tags which match one
+ ;; of those specified in `notmuch-search-line-faces'.
+ (let (overlay)
+ (mapc '(lambda (elem)
+ (let ((tag (car elem))
+ (attributes (cdr elem)))
+ (when (member tag line-tag-list)
+ (when (not overlay)
+ (setq overlay (make-overlay start end)))
+ ;; Merge the specified properties with any already
+ ;; applied from an earlier match.
+ (overlay-put overlay 'face
+ (append (overlay-get overlay 'face) attributes)))))
+ notmuch-search-line-faces)))
+
+(defun notmuch-search-author-propertize (authors)
+ "Split `authors' into matching and non-matching authors and
+propertize appropriately. If no boundary between authors and
+non-authors is found, assume that all of the authors match."
+ (if (string-match "\\(.*\\)|\\(.*\\)" authors)
+ (concat (propertize (concat (match-string 1 authors) ",")
+ 'face 'notmuch-search-matching-authors)
+ (propertize (match-string 2 authors)
+ 'face 'notmuch-search-non-matching-authors))
+ (propertize authors 'face 'notmuch-search-matching-authors)))
+
+(defun notmuch-search-insert-authors (format-string authors)
+ ;; Save the match data to avoid interfering with
+ ;; `notmuch-search-process-filter'.
+ (save-match-data
+ (let* ((formatted-authors (format format-string authors))
+ (formatted-sample (format format-string ""))
+ (visible-string formatted-authors)
+ (invisible-string "")
+ (padding ""))
+
+ ;; Truncate the author string to fit the specification.
+ (if (> (length formatted-authors)
+ (length formatted-sample))
+ (let ((visible-length (- (length formatted-sample)
+ (length "... "))))
+ ;; Truncate the visible string according to the width of
+ ;; the display string.
+ (setq visible-string (substring formatted-authors 0 visible-length)
+ invisible-string (substring formatted-authors visible-length))
+ ;; If possible, truncate the visible string at a natural
+ ;; break (comma or pipe), as incremental search doesn't
+ ;; match across the visible/invisible border.
+ (when (string-match "\\(.*\\)\\([,|] \\)\\([^,|]*\\)" visible-string)
+ ;; Second clause is destructive on `visible-string', so
+ ;; order is important.
+ (setq invisible-string (concat (match-string 3 visible-string)
+ invisible-string)
+ visible-string (concat (match-string 1 visible-string)
+ (match-string 2 visible-string))))
+ ;; `visible-string' may be shorter than the space allowed
+ ;; by `format-string'. If so we must insert some padding
+ ;; after `invisible-string'.
+ (setq padding (make-string (- (length formatted-sample)
+ (length visible-string)
+ (length "..."))
+ ? ))))
+
+ ;; Use different faces to show matching and non-matching authors.
+ (if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
+ ;; The visible string contains both matching and
+ ;; non-matching authors.
+ (setq visible-string (notmuch-search-author-propertize visible-string)
+ ;; The invisible string must contain only non-matching
+ ;; authors, as the visible-string contains both.
+ invisible-string (propertize invisible-string
+ 'face 'notmuch-search-non-matching-authors))
+ ;; The visible string contains only matching authors.
+ (setq visible-string (propertize visible-string
+ 'face 'notmuch-search-matching-authors)
+ ;; The invisible string may contain both matching and
+ ;; non-matching authors.
+ invisible-string (notmuch-search-author-propertize invisible-string)))
+
+ ;; If there is any invisible text, add it as a tooltip to the
+ ;; visible text.
+ (when (not (string= 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)
+ (when (not (string= invisible-string ""))
+ (let ((start (point))
+ overlay)
+ (insert invisible-string)
+ (setq overlay (make-overlay start (point)))
+ (overlay-put overlay 'invisible 'ellipsis)
+ (overlay-put overlay 'isearch-open-invisible #'delete-overlay)))
+ (insert padding))))
+
+(defun notmuch-search-insert-field (field date count authors subject tags)
+ (cond
+ ((string-equal field "date")
+ (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) date)
+ 'face 'notmuch-search-date)))
+ ((string-equal field "count")
+ (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) count)
+ 'face 'notmuch-search-count)))
+ ((string-equal field "subject")
+ (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) subject)
+ 'face 'notmuch-search-subject)))
+
+ ((string-equal field "authors")
+ (notmuch-search-insert-authors (cdr (assoc field notmuch-search-result-format)) authors))
+
+ ((string-equal field "tags")
+ (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-process-filter (proc string)
"Process and filter the output of \"notmuch search\""
(save-excursion
(let ((line 0)
(more t)
- (inhibit-read-only t))
+ (inhibit-read-only t)
+ (string (concat notmuch-search-process-filter-data string)))
+ (setq notmuch-search-process-filter-data nil)
(while more
- (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
+ (while (and (< line (length string)) (= (elt string line) ?\n))
+ (setq line (1+ line)))
+ (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
(let* ((thread-id (match-string 1 string))
(date (match-string 2 string))
(count (match-string 3 string))
(authors (match-string 4 string))
- (authors-length (length authors))
(subject (match-string 5 string))
(tags (match-string 6 string))
(tag-list (if tags (save-match-data (split-string tags)))))
- (if (> authors-length notmuch-search-authors-width)
- (set 'authors (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...")))
(goto-char (point-max))
- (let ((beg (point-marker))
- (format-string (format "%%s %%-7s %%-%ds %%s (%%s)\n" notmuch-search-authors-width)))
- (insert (format format-string date count authors subject tags))
+ (if (/= (match-beginning 1) line)
+ (insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n")))
+ (let ((beg (point-marker)))
+ (notmuch-search-show-result date count authors subject tags)
(notmuch-search-color-line beg (point-marker) tag-list)
(put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
(put-text-property beg (point-marker) 'notmuch-search-authors authors)
(set 'found-target beg)
(set 'notmuch-search-target-thread "found"))))
(set 'line (match-end 0)))
- (set 'more nil)))))
+ (set 'more nil)
+ (while (and (< line (length string)) (= (elt string line) ?\n))
+ (setq line (1+ line)))
+ (if (< line (length string))
+ (setq notmuch-search-process-filter-data (substring string line)))
+ ))))
(if found-target
(goto-char found-target)))
(delete-process proc))))
(defun notmuch-search-operate-all (action)
"Add/remove tags from all matching messages.
-Tis command adds or removes tags from all messages matching the
+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.
(unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
(error "Action must be of the form `+thistag -that_tag'"))
(setq words (cdr words))))
- (apply 'notmuch-call-notmuch-process "tag"
- (append action-split (list notmuch-search-query-string) nil))))
+ (apply 'notmuch-tag notmuch-search-query-string action-split)))
+
+(defun notmuch-search-buffer-title (query)
+ "Returns the title for a buffer with notmuch search results."
+ (let* ((saved-search
+ (let (longest
+ (longest-length 0))
+ (loop for tuple in notmuch-saved-searches
+ if (let ((quoted-query (regexp-quote (cdr tuple))))
+ (and (string-match (concat "^" quoted-query) query)
+ (> (length (match-string 0 query))
+ longest-length)))
+ do (setq longest tuple))
+ longest))
+ (saved-search-name (car saved-search))
+ (saved-search-query (cdr saved-search)))
+ (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 "*"))
+ (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 "*"))
+ )))
+
+(defun notmuch-read-query (prompt)
+ "Read a notmuch-query from the minibuffer with completion.
+
+PROMPT is the string to prompt with."
+ (lexical-let
+ ((completions
+ (append (list "folder:" "thread:" "id:" "date:" "from:" "to:"
+ "subject:" "attachment:")
+ (mapcar (lambda (tag)
+ (concat "tag:" tag))
+ (process-lines "notmuch" "search" "--output=tags" "*")))))
+ (let ((keymap (copy-keymap minibuffer-local-map))
+ (minibuffer-completion-table
+ (completion-table-dynamic
+ (lambda (string)
+ ;; generate a list of possible completions for the current input
+ (cond
+ ;; this ugly regexp is used to get the last word of the input
+ ;; possibly preceded by a '('
+ ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
+ (mapcar (lambda (compl)
+ (concat (match-string-no-properties 1 string) compl))
+ (all-completions (match-string-no-properties 2 string)
+ completions)))
+ (t (list string)))))))
+ ;; this was simpler than convincing completing-read to accept spaces:
+ (define-key keymap (kbd "<tab>") 'minibuffer-complete)
+ (read-from-minibuffer prompt nil keymap nil
+ 'notmuch-query-history nil nil))))
;;;###autoload
-(defun notmuch-search (query &optional oldest-first target-thread target-line)
+(defun notmuch-search (query &optional oldest-first target-thread target-line continuation)
"Run \"notmuch search\" with the given query string and display results.
The optional parameters are used as follows:
current if it appears in the search results.
target-line: The line number to move to if the target thread does not
appear in the search results."
- (interactive "sNotmuch search: ")
- (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
+ (interactive (list (notmuch-read-query "Notmuch search: ")))
+ (let ((buffer (get-buffer-create (notmuch-search-buffer-title query))))
(switch-to-buffer buffer)
(notmuch-search-mode)
(set 'notmuch-search-query-string query)
(set 'notmuch-search-oldest-first oldest-first)
(set 'notmuch-search-target-thread target-thread)
(set 'notmuch-search-target-line target-line)
+ (set 'notmuch-search-continuation continuation)
(let ((proc (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(if proc
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (let ((proc (start-process-shell-command
- "notmuch-search" buffer notmuch-command "search"
- (if oldest-first "--sort=oldest-first" "--sort=newest-first")
- (shell-quote-argument query))))
+ (let ((proc (start-process
+ "notmuch-search" buffer
+ notmuch-command "search"
+ (if oldest-first
+ "--sort=oldest-first"
+ "--sort=newest-first")
+ query)))
(set-process-sentinel proc 'notmuch-search-process-sentinel)
- (set-process-filter proc 'notmuch-search-process-filter))))
+ (set-process-filter proc 'notmuch-search-process-filter)
+ (set-process-query-on-exit-flag proc nil))))
(run-hooks 'notmuch-search-hook)))
(defun notmuch-search-refresh-view ()
(let ((target-line (line-number-at-pos))
(oldest-first notmuch-search-oldest-first)
(target-thread (notmuch-search-find-thread-id))
- (query notmuch-search-query-string))
- (kill-this-buffer)
- (notmuch-search query oldest-first target-thread target-line)
- (goto-char (point-min))
- ))
+ (query notmuch-search-query-string)
+ (continuation notmuch-search-continuation))
+ (notmuch-kill-this-buffer)
+ (notmuch-search query oldest-first target-thread target-line continuation)
+ (goto-char (point-min))))
+
+(defcustom notmuch-poll-script ""
+ "An external script to incorporate new mail into the notmuch database.
+
+If this variable is non empty, then it should name a script to be
+invoked by `notmuch-search-poll-and-refresh-view' and
+`notmuch-hello-poll-and-update' (each have a default keybinding
+of 'G'). The script could do any of the following depending on
+the user's needs:
+
+1. Invoke a program to transfer mail to the local mail store
+2. Invoke \"notmuch new\" to incorporate the new mail
+3. Invoke one or more \"notmuch tag\" commands to classify the mail"
+ :type 'string
+ :group 'notmuch)
+
+(defun notmuch-poll ()
+ "Run external script to import mail.
+
+Invokes `notmuch-poll-script' if it is not set to an empty string."
+ (interactive)
+ (if (not (string= notmuch-poll-script ""))
+ (call-process notmuch-poll-script nil nil)))
+
+(defun notmuch-search-poll-and-refresh-view ()
+ "Invoke `notmuch-poll' to import mail, then refresh the current view."
+ (interactive)
+ (notmuch-poll)
+ (notmuch-search-refresh-view))
(defun notmuch-search-toggle-order ()
"Toggle the current search order.
Runs a new search matching only messages that match both the
current search results AND the additional query string provided."
- (interactive "sFilter search: ")
- (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query) (concat "( " query " )") query)))
- (notmuch-search (concat notmuch-search-query-string " and " grouped-query) notmuch-search-oldest-first)))
+ (interactive (list (notmuch-read-query "Filter search: ")))
+ (let ((grouped-query (if (string-match-p notmuch-search-disjunctive-regexp query)
+ (concat "( " query " )")
+ query)))
+ (notmuch-search (if (string= notmuch-search-query-string "*")
+ grouped-query
+ (concat notmuch-search-query-string " and " grouped-query)) notmuch-search-oldest-first)))
(defun notmuch-search-filter-by-tag (tag)
"Filter the current search results based on a single tag.
;;;###autoload
(defun notmuch ()
- "Run notmuch to display all mail with tag of 'inbox'"
- (interactive)
- (notmuch-search "tag:inbox" notmuch-search-oldest-first))
-
-(setq mail-user-agent 'message-user-agent)
-
-(defvar notmuch-folder-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "?" 'notmuch-help)
- (define-key map "x" 'kill-this-buffer)
- (define-key map "q" 'kill-this-buffer)
- (define-key map "m" 'message-mail)
- (define-key map "e" 'notmuch-folder-show-empty-toggle)
- (define-key map ">" 'notmuch-folder-last)
- (define-key map "<" 'notmuch-folder-first)
- (define-key map "=" 'notmuch-folder)
- (define-key map "s" 'notmuch-search)
- (define-key map [mouse-1] 'notmuch-folder-show-search)
- (define-key map (kbd "RET") 'notmuch-folder-show-search)
- (define-key map " " 'notmuch-folder-show-search)
- (define-key map "p" 'notmuch-folder-previous)
- (define-key map "n" 'notmuch-folder-next)
- map)
- "Keymap for \"notmuch folder\" buffers.")
-
-(fset 'notmuch-folder-mode-map notmuch-folder-mode-map)
-
-(defcustom notmuch-folders (quote (("inbox" . "tag:inbox") ("unread" . "tag:unread")))
- "List of searches for the notmuch folder view"
- :type '(alist :key-type (string) :value-type (string))
- :group 'notmuch)
-
-(defun notmuch-folder-mode ()
- "Major mode for showing notmuch 'folders'.
-
-This buffer contains a list of message counts returned by a
-customizable set of searches of your email archives. Each line in
-the buffer shows the name of a saved search and the resulting
-message count.
-
-Pressing RET on any line opens a search window containing the
-results for the saved search on that line.
-
-Here is an example of how the search list could be
-customized, (the following text would be placed in your ~/.emacs
-file):
-
-(setq notmuch-folders '((\"inbox\" . \"tag:inbox\")
- (\"unread\" . \"tag:inbox AND tag:unread\")
- (\"notmuch\" . \"tag:inbox AND to:notmuchmail.org\")))
-
-Of course, you can have any number of folders, each configured
-with any supported search terms (see \"notmuch help search-terms\").
-
-Currently available key bindings:
-
-\\{notmuch-folder-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map 'notmuch-folder-mode-map)
- (setq truncate-lines t)
- (hl-line-mode 1)
- (setq major-mode 'notmuch-folder-mode
- mode-name "notmuch-folder")
- (setq buffer-read-only t))
-
-(defun notmuch-folder-next ()
- "Select the next folder in the list."
- (interactive)
- (forward-line 1)
- (if (eobp)
- (forward-line -1)))
-
-(defun notmuch-folder-previous ()
- "Select the previous folder in the list."
- (interactive)
- (forward-line -1))
-
-(defun notmuch-folder-first ()
- "Select the first folder in the list."
- (interactive)
- (goto-char (point-min)))
-
-(defun notmuch-folder-last ()
- "Select the last folder in the list."
- (interactive)
- (goto-char (point-max))
- (forward-line -1))
-
-(defun notmuch-folder-count (search)
- (car (process-lines notmuch-command "count" search)))
-
-(defvar notmuch-folder-show-empty t
- "Whether `notmuch-folder-mode' should display empty folders.")
-
-(defun notmuch-folder-show-empty-toggle ()
- "Toggle the listing of empty folders"
+ "Run notmuch and display saved searches, known tags, etc."
(interactive)
- (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
- (notmuch-folder))
-
-(defun notmuch-folder-add (folders)
- (if folders
- (let* ((name (car (car folders)))
- (inhibit-read-only t)
- (search (cdr (car folders)))
- (count (notmuch-folder-count search)))
- (if (or notmuch-folder-show-empty
- (not (equal count "0")))
- (progn
- (insert name)
- (indent-to 16 1)
- (insert count)
- (insert "\n")
- )
- )
- (notmuch-folder-add (cdr folders)))))
-
-(defun notmuch-folder-find-name ()
- (save-excursion
- (beginning-of-line)
- (let ((beg (point)))
- (re-search-forward "\\([ \t]*[^ \t]+\\)")
- (filter-buffer-substring (match-beginning 1) (match-end 1)))))
+ (notmuch-hello))
-(defun notmuch-folder-show-search (&optional folder)
- "Show a search window for the search related to the specified folder."
- (interactive)
- (if (null folder)
- (setq folder (notmuch-folder-find-name)))
- (let ((search (assoc folder notmuch-folders)))
- (if search
- (notmuch-search (cdr search) notmuch-search-oldest-first))))
-
-;;;###autoload
-(defun notmuch-folder ()
- "Show the notmuch folder view and update the displayed counts."
- (interactive)
- (let ((buffer (get-buffer-create "*notmuch-folders*")))
- (switch-to-buffer buffer)
- (let ((inhibit-read-only t)
- (n (line-number-at-pos)))
- (erase-buffer)
- (notmuch-folder-mode)
- (notmuch-folder-add notmuch-folders)
- (goto-char (point-min))
- (goto-line n))))
+(setq mail-user-agent 'notmuch-user-agent)
(provide 'notmuch)
projects / notmuch / blobdiff