; overlays-at to query and manipulate the current overlay.
(define-key map "a" 'notmuch-show-archive-thread)
(define-key map "A" 'notmuch-show-mark-read-then-archive-thread)
- (define-key map "b" 'notmuch-show-toggle-body-read-visible)
- (define-key map "c" 'notmuch-show-toggle-citations-visible)
- (define-key map "h" 'notmuch-show-toggle-headers-visible)
(define-key map "m" 'message-mail)
(define-key map "n" 'notmuch-show-next-message)
(define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
(define-key map (kbd "C-p") 'notmuch-show-previous-line)
(define-key map "q" 'kill-this-buffer)
(define-key map "r" 'notmuch-show-reply)
- (define-key map "s" 'notmuch-show-toggle-signatures-visible)
(define-key map "v" 'notmuch-show-view-all-mime-parts)
(define-key map "w" 'notmuch-show-view-raw-message)
(define-key map "x" 'kill-this-buffer)
(define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
(define-key map "|" 'notmuch-show-pipe-message)
(define-key map "?" 'describe-mode)
+ (define-key map (kbd "TAB") 'notmuch-show-next-button)
+ (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
map)
"Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map)
(or (memq prop buffer-invisibility-spec)
(assq prop buffer-invisibility-spec)))))
+(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
+ (let ((tag-list
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))
+ (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
+
(defun notmuch-show-next-line ()
"Like builtin `next-line' but ensuring we end on a visible character.
(if (not (looking-at notmuch-show-message-begin-regexp))
(re-search-backward notmuch-show-message-begin-regexp))
(re-search-forward notmuch-show-id-regexp)
- (buffer-substring (match-beginning 1) (match-end 1))))
+ (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(defun notmuch-show-get-filename ()
(save-excursion
(if (not (looking-at notmuch-show-message-begin-regexp))
(re-search-backward notmuch-show-message-begin-regexp))
(re-search-forward notmuch-show-filename-regexp)
- (buffer-substring (match-beginning 1) (match-end 1))))
+ (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(defun notmuch-show-set-tags (tags)
(save-excursion
(defun notmuch-show-add-tag (&rest toadd)
"Add a tag to the current message."
- (interactive "sTag to add: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Tag to add: ")))
(apply 'notmuch-call-notmuch-process
(append (cons "tag"
(mapcar (lambda (s) (concat "+" s)) toadd))
(defun notmuch-show-remove-tag (&rest toremove)
"Remove a tag from the current message."
- (interactive "sTag to remove: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))
(let ((tags (notmuch-show-get-tags)))
(if (intersection tags toremove :test 'string=)
(progn
(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
current email message as stdin. Anything printed by the command
to stdout or stderr will appear in the *Messages* buffer."
(interactive "sPipe message to command: ")
- (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" (split-string (concat command " < " (notmuch-show-get-filename)))))
+ (apply 'start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*"
+ (list command " < " (shell-quote-argument (notmuch-show-get-filename)))))
(defun notmuch-show-move-to-current-message-summary-line ()
"Move to the beginning of the one-line summary of the current message.
(if last
(notmuch-show-archive-thread))))))
+(defun notmuch-show-next-button ()
+ "Advance point to the next button in the buffer."
+ (interactive)
+ (goto-char (button-start (next-button (point)))))
+
+(defun notmuch-show-previous-button ()
+ "Move point back to the previous button in the buffer."
+ (interactive)
+ (goto-char (button-start (previous-button (point)))))
+
(defun notmuch-toggle-invisible-action (cite-button)
(let ((invis-spec (button-get button 'invisibility-spec)))
(if (invisible-p invis-spec)
(remove-from-invisibility-spec invis-spec)
(add-to-invisibility-spec invis-spec)
))
- (goto-char (button-end cite-button)))
+ (force-window-update)
+ (redisplay t))
+
+(define-button-type 'notmuch-button-invisibility-toggle-type 'action 'notmuch-toggle-invisible-action 'follow-link 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-headers-toggle-type 'help-echo "mouse-1, RET: Show headers"
+ :supertype 'notmuch-button-invisibility-toggle-type)
+(define-button-type 'notmuch-button-body-toggle-type 'help-echo "mouse-1, RET: Show message"
+ :supertype 'notmuch-button-invisibility-toggle-type)
(defun notmuch-show-markup-citations-region (beg end depth)
(goto-char beg)
(invis-spec (make-symbol "notmuch-citation-region")))
(add-to-invisibility-spec invis-spec)
(overlay-put overlay 'invisible invis-spec)
- (let (
- (p (point))
+ (let ((p (point))
(cite-button-text
(concat "[" (number-to-string (count-lines beg-sub (point)))
- "-line citation.]"))
- )
+ "-line citation.]")))
(goto-char (- beg-sub 1))
(insert (concat "\n" indent))
- (let ((cite-button (insert-button cite-button-text)))
- (button-put cite-button 'invisibility-spec invis-spec)
- (button-put cite-button 'action 'notmuch-toggle-invisible-action)
- (button-put cite-button 'help-echo
- "mouse-2, RET: Show citation")
-
- )
+ (insert-button cite-button-text
+ 'invisibility-spec invis-spec
+ :type 'notmuch-button-citation-toggle-type)
(insert "\n")
(goto-char (+ (length cite-button-text) p))
))))
(goto-char (- beg-sub 1))
(insert (concat "\n" indent))
- (let ((sig-button (insert-button
- (concat "[" (number-to-string sig-lines)
- "-line signature.]"))))
- (button-put sig-button 'invisibility-spec invis-spec)
- (button-put sig-button 'action
- 'notmuch-toggle-invisible-action)
- (button-put sig-button 'help-echo
- "mouse-2, RET: Show signature")
- )
+ (let ((sig-button-text (concat "[" (number-to-string sig-lines)
+ "-line signature.]")))
+ (insert-button sig-button-text 'invisibility-spec invis-spec
+ :type 'notmuch-button-signature-toggle-type)
+ )
(insert "\n")
(goto-char end))))))
(forward-line))))
(while (< (point) end)
(notmuch-show-markup-part beg end depth))))
-(defun notmuch-show-markup-body (depth)
+(defun notmuch-show-markup-body (depth btn)
(re-search-forward notmuch-show-body-begin-regexp)
(forward-line)
(let ((beg (point-marker)))
(re-search-forward notmuch-show-body-end-regexp)
(let ((end (copy-marker (match-beginning 0))))
(notmuch-show-markup-parts-region beg end depth)
- (if (not (notmuch-show-message-unread-p))
- (overlay-put (make-overlay beg end)
- 'invisible 'notmuch-show-body-read))
+ (let ((invis-spec (make-symbol "notmuch-show-body-read")))
+ (overlay-put (make-overlay beg end)
+ 'invisible invis-spec)
+ (button-put btn 'invisibility-spec invis-spec)
+ (if (not (notmuch-show-message-unread-p))
+ (add-to-invisibility-spec invis-spec)))
(set-marker beg nil)
(set-marker end nil)
)))
(defun notmuch-show-markup-header (depth)
(re-search-forward notmuch-show-header-begin-regexp)
(forward-line)
- (let ((beg (point-marker)))
+ (let ((beg (point-marker))
+ (btn nil))
(end-of-line)
; Inverse video for subject
(overlay-put (make-overlay beg (point)) 'face '(:inverse-video t))
- (forward-line 2)
+ (setq btn (make-button beg (point) :type 'notmuch-button-body-toggle-type))
+ (forward-line 1)
+ (end-of-line)
(let ((beg-hidden (point-marker)))
(re-search-forward notmuch-show-header-end-regexp)
(beginning-of-line)
(forward-line)
)
(indent-rigidly beg end depth)
- (overlay-put (make-overlay beg-hidden end)
- 'invisible 'notmuch-show-header)
+ (let ((invis-spec (make-symbol "notmuch-show-header")))
+ (add-to-invisibility-spec (cons invis-spec t))
+ (overlay-put (make-overlay beg-hidden end)
+ 'invisible invis-spec)
+ (goto-char beg)
+ (forward-line)
+ (make-button (line-beginning-position) (line-end-position)
+ 'invisibility-spec (cons invis-spec t)
+ :type 'notmuch-button-headers-toggle-type))
(goto-char end)
(insert "\n")
(set-marker beg nil)
(set-marker beg-hidden nil)
(set-marker end nil)
- ))))
+ ))
+ btn))
(defun notmuch-show-markup-message ()
(if (re-search-forward notmuch-show-message-begin-regexp nil t)
(progn
(re-search-forward notmuch-show-depth-regexp)
- (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))))
- (notmuch-show-markup-header depth)
- (notmuch-show-markup-body depth)))
+ (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
+ (btn nil))
+ (setq btn (notmuch-show-markup-header depth))
+ (notmuch-show-markup-body depth btn)))
(goto-char (point-max))))
(defun notmuch-show-hide-markers ()
(notmuch-show-markup-message)))
(notmuch-show-hide-markers))
-(defun notmuch-show-toggle-citations-visible ()
- "Toggle visibility of citations"
- (interactive)
- (if notmuch-show-citations-visible
- (add-to-invisibility-spec 'notmuch-show-citation)
- (remove-from-invisibility-spec 'notmuch-show-citation))
- (set 'notmuch-show-citations-visible (not notmuch-show-citations-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-show-toggle-signatures-visible ()
- "Toggle visibility of signatures"
- (interactive)
- (if notmuch-show-signatures-visible
- (add-to-invisibility-spec 'notmuch-show-signature)
- (remove-from-invisibility-spec 'notmuch-show-signature))
- (set 'notmuch-show-signatures-visible (not notmuch-show-signatures-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-show-toggle-headers-visible ()
- "Toggle visibility of header fields"
- (interactive)
- (if notmuch-show-headers-visible
- (add-to-invisibility-spec 'notmuch-show-header)
- (remove-from-invisibility-spec 'notmuch-show-header))
- (set 'notmuch-show-headers-visible (not notmuch-show-headers-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
-(defun notmuch-show-toggle-body-read-visible ()
- "Toggle visibility of message bodies of read messages"
- (interactive)
- (if notmuch-show-body-read-visible
- (add-to-invisibility-spec 'notmuch-show-body-read)
- (remove-from-invisibility-spec 'notmuch-show-body-read))
- (set 'notmuch-show-body-read-visible (not notmuch-show-body-read-visible))
- ; Need to force the redisplay for some reason
- (force-window-update)
- (redisplay t))
-
;;;###autoload
(defun notmuch-show-mode ()
"Major mode for viewing a thread with notmuch.
\\{notmuch-show-mode-map}"
(interactive)
(kill-all-local-variables)
- (set (make-local-variable 'notmuch-show-headers-visible) t)
- (notmuch-show-toggle-headers-visible)
- (set (make-local-variable 'notmuch-show-body-read-visible) t)
- (notmuch-show-toggle-body-read-visible)
- (set (make-local-variable 'notmuch-show-citations-visible) t)
- (notmuch-show-toggle-citations-visible)
- (set (make-local-variable 'notmuch-show-signatures-visible) t)
- (notmuch-show-toggle-signatures-visible)
(add-to-invisibility-spec 'notmuch-show-marker)
(use-local-map notmuch-show-mode-map)
(setq major-mode 'notmuch-show-mode
(if (not (notmuch-show-message-unread-p))
(progn
(goto-char (point-min))
- (notmuch-show-toggle-body-read-visible)))))
+ (let ((btn (forward-button 1)))
+ (while btn
+ (if (button-has-type-p btn 'notmuch-button-body-toggle-type)
+ (push-button))
+ (condition-case err
+ (setq btn (forward-button 1))
+ (error (setq btn nil)))
+ ))
+ (beginning-of-buffer)
+ ))))
)))
(defvar notmuch-search-authors-width 40
(define-key map "t" 'notmuch-search-filter-by-tag)
(define-key map "x" 'kill-this-buffer)
(define-key map (kbd "RET") 'notmuch-search-show-thread)
+ (define-key map [mouse-1] 'notmuch-search-show-thread)
(define-key map "+" 'notmuch-search-add-tag)
(define-key map "-" 'notmuch-search-remove-tag)
(define-key map "<" 'beginning-of-buffer)
(fset 'notmuch-search-mode-map notmuch-search-mode-map)
(defvar notmuch-search-query-string)
-(defvar notmuch-search-oldest-first)
+(defvar notmuch-search-oldest-first t
+ "Show the oldest mail first in the search-mode")
+
(defun notmuch-search-scroll-up ()
"Scroll up, moving point to last message in thread if at end."
(setq buffer-read-only t))
(defun notmuch-search-find-thread-id ()
- (save-excursion
- (beginning-of-line)
- (let ((beg (point)))
- (re-search-forward "thread:[a-fA-F0-9]*" nil t)
- (filter-buffer-substring beg (point)))))
-
-(defun notmuch-search-markup-this-thread-id ()
- (beginning-of-line)
- (let ((beg (point)))
- (if (re-search-forward "thread:[a-fA-F0-9]*" nil t)
- (progn
- (forward-char)
- (overlay-put (make-overlay beg (point)) 'invisible 'notmuch-search)
- (re-search-forward ".*\\[[0-9]*/[0-9]*\\] \\([^;]*\\)\\(;\\)")
- (let* ((authors (buffer-substring (match-beginning 1) (match-end 1)))
- (authors-length (length authors)))
- ;; Drop the semi-colon
- (replace-match "" t nil nil 2)
- (if (<= authors-length notmuch-search-authors-width)
- (replace-match (concat authors (make-string
- (- notmuch-search-authors-width
- authors-length) ? )) t t nil 1)
- (replace-match (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...") t t nil 1)))))))
-
-(defun notmuch-search-markup-thread-ids ()
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (notmuch-search-markup-this-thread-id)
- (forward-line))))
+ "Return the thread for the current thread"
+ (get-text-property (point) 'notmuch-search-thread-id))
(defun notmuch-search-show-thread ()
(interactive)
(split-string (buffer-substring beg end))))))
(defun notmuch-search-add-tag (tag)
- (interactive "sTag to add: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Tag to add: ")))
(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<))))
(defun notmuch-search-remove-tag (tag)
- (interactive "sTag to remove: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id))))
(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 "inbox")
(forward-line))
+(defun notmuch-search-process-sentinel (proc msg)
+ "Add a message to let user know when \"notmuch search\" exits"
+ (let ((buffer (process-buffer proc))
+ (status (process-status proc))
+ (exit-status (process-exit-status proc)))
+ (if (memq status '(exit signal))
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-max))
+ (if (eq status 'signal)
+ (insert "Incomplete search results (search process was killed).\n"))
+ (if (eq status 'exit)
+ (progn
+ (insert "End of search results.")
+ (if (not (= exit-status 0))
+ (insert (format " (process returned %d)" exit-status)))
+ (insert "\n"))))))))))
+
+(defun notmuch-search-process-filter (proc string)
+ "Process and filter the output of \"notmuch search\""
+ (let ((buffer (process-buffer proc)))
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (let ((line 0)
+ (more t)
+ (inhibit-read-only t))
+ (while more
+ (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)))
+ (if (> authors-length 40)
+ (set 'authors (concat (substring authors 0 (- 40 3)) "...")))
+ (goto-char (point-max))
+ (let ((beg (point-marker)))
+ (insert (format "%s %-7s %-40s %s (%s)\n" date count authors subject tags))
+ (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id))
+ (set 'line (match-end 0)))
+ (set 'more nil))))))
+ (delete-process proc))))
+
(defun notmuch-search (query &optional oldest-first)
"Run \"notmuch search\" with the given query string and display results."
(interactive "sNotmuch search: ")
(erase-buffer)
(goto-char (point-min))
(save-excursion
- (if oldest-first
- (call-process notmuch-command nil t nil "search" "--sort=oldest-first" query)
- (call-process notmuch-command nil t nil "search" "--sort=newest-first" query))
- (notmuch-search-markup-thread-ids)
- ))
+ (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))))
+ (set-process-sentinel proc 'notmuch-search-process-sentinel)
+ (set-process-filter proc 'notmuch-search-process-filter))))
(run-hooks 'notmuch-search-hook)))
(defun notmuch-search-refresh-view ()
Runs a new search matching only messages that match both the
current search results AND that are tagged with the given tag."
- (interactive "sFilter by tag: ")
+ (interactive
+ (list (notmuch-select-tag-with-completion "Filter by tag: ")))
(notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
(defun notmuch ()
"Run notmuch to display all mail with tag of 'inbox'"
(interactive)
- (notmuch-search "tag:inbox" t))
+ (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 "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ (define-key map "x" 'kill-this-buffer)
+ (define-key map "q" 'kill-this-buffer)
+ (define-key map "s" 'notmuch-search)
+ (define-key map (kbd "RET") 'notmuch-folder-show-search)
+ (define-key map "<" 'beginning-of-buffer)
+ (define-key map "=" 'notmuch-folder)
+ (define-key map "?" 'describe-mode)
+ (define-key map [mouse-1] 'notmuch-folder-show-search)
+ 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 messages counts returned by a
+customizable set of searches of your email archives. Each line
+in the buffer shows the search terms and the resulting message count.
+
+Pressing RET on any line opens a search window containing the
+results for the search terms in that line.
+
+\\{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-add (folders)
+ (if folders
+ (let ((name (car (car folders)))
+ (inhibit-read-only t)
+ (search (cdr (car folders))))
+ (insert name)
+ (indent-to 16 1)
+ (call-process notmuch-command nil t nil "count" search)
+ (notmuch-folder-add (cdr folders)))))
+
+(defun notmuch-folder-find-name ()
+ (save-excursion
+ (beginning-of-line)
+ (let ((beg (point)))
+ (forward-word)
+ (filter-buffer-substring beg (point)))))
+
+(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))))
+
+(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))))
+
(provide 'notmuch)
projects / notmuch / blobdiff