X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=c3ed0cdb2b895a694fd5a24c2ba065122eba83d8;hp=4a9223e4dfa8f1f0e95c76e10219a8f1a1863581;hb=784649561abb627a9d81e4f718656dad0b6b6207;hpb=7171e77d4d1e83fdf9c7a56987b98bce3f181598 diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 4a9223e4..c3ed0cdb 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -204,9 +204,10 @@ For a mouse binding, return nil." (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" 'notmuch-mua-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) @@ -221,6 +222,18 @@ For a mouse binding, return nil." "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) @@ -446,6 +459,44 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (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 before 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) @@ -485,7 +536,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (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)) (max-line (- (line-number-at-pos (point-max)) 2))) @@ -499,7 +550,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (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)) (max-line (- (line-number-at-pos (point-max)) 2))) @@ -550,6 +601,10 @@ This function advances the next thread when finished." (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)) @@ -567,6 +622,8 @@ This function advances the next thread when finished." (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))) @@ -593,7 +650,7 @@ 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 (list)) + :type '(alist :key-type (string) :value-type (custom-face-edit)) :group 'notmuch) (defun notmuch-search-color-line (start end line-tag-list) @@ -616,49 +673,87 @@ foreground and blue background." (defun notmuch-search-isearch-authors-show (overlay) (remove-from-invisibility-spec (cons (overlay-get overlay 'invisible) t))) +(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) - (let* ((propertized-authors - ;; Need to save the match data to avoid interfering with - ;; `notmuch-search-process-filter'. - (save-match-data - ;; Authors that don't match the search query are shown in a - ;; different font. - (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)))) - - (formatted-sample (format format-string "")) - (formatted-authors (format format-string propertized-authors)) - visible-string invisible-string) - - ;; Determine the part of the authors that will be visible by - ;; default. - (if (> (length formatted-authors) - (length formatted-sample)) - ;; 4 is `(length "... ")'. - (let ((visible-length (- (length formatted-sample) 4))) - (setq visible-string (substring propertized-authors 0 visible-length) - invisible-string (substring propertized-authors visible-length))) - (setq visible-string formatted-authors - invisible-string nil)) - - ;; Insert both the visible and invisible author strings. - (insert visible-string) - (when invisible-string - (let ((start (point)) - (invis-spec (make-symbol "notmuch-search-authors")) - overlay) - (insert invisible-string) - ;; Using a cons-cell here causes an ellipsis to be inserted - ;; instead of the invisible text. - (add-to-invisibility-spec (cons invis-spec t)) - (setq overlay (make-overlay start (point))) - (overlay-put overlay 'invisible invis-spec) - (overlay-put overlay 'isearch-open-invisible #'notmuch-search-isearch-authors-show) - (insert " "))))) + ;; 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)) + (invis-spec (make-symbol "notmuch-search-authors")) + overlay) + (insert invisible-string) + (add-to-invisibility-spec (cons invis-spec t)) + (setq overlay (make-overlay start (point))) + (overlay-put overlay 'invisible invis-spec) + (overlay-put overlay 'isearch-open-invisible #'notmuch-search-isearch-authors-show))) + (insert padding)))) (defun notmuch-search-insert-field (field date count authors subject tags) (cond @@ -694,8 +789,12 @@ foreground and blue background." (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 + (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)) @@ -705,6 +804,8 @@ foreground and blue background." (tags (match-string 6 string)) (tag-list (if tags (save-match-data (split-string tags))))) (goto-char (point-max)) + (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) @@ -716,7 +817,12 @@ foreground and blue background." (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)))) @@ -741,8 +847,7 @@ characters as well as `_.+-'. (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."