+ (let ((start (point)))
+ (notmuch-show-move-to-current-message-summary-line)
+ (if (not (< (point) start))
+ ; Go backward twice to skip the current message's marker
+ (progn
+ (re-search-backward notmuch-show-message-begin-regexp nil t)
+ (re-search-backward notmuch-show-message-begin-regexp nil t)
+ (notmuch-show-move-to-current-message-summary-line)
+ ))
+ (recenter 0)))
+
+(defun notmuch-show-find-previous-message ()
+ "Returns the position of the previous message in the buffer.
+
+Or the position of the beginning of the current message if point
+is originally within the message rather than at the beginning of
+it."
+ ; save-excursion doesn't save our window position
+ ; save-window-excursion doesn't save point
+ ; Looks like we have to use both.
+ (save-excursion
+ (save-window-excursion
+ (notmuch-show-previous-message)
+ (point))))
+
+(defun notmuch-show-mark-read-then-next-open-message ()
+ "Remove unread tag from this message, then advance to next open message."
+ (interactive)
+ (notmuch-show-remove-tag "unread")
+ (notmuch-show-next-open-message))
+
+(defun notmuch-show-rewind ()
+ "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-marking-read-and-archiving]).
+
+Specifically, if the beginning of the previous email is fewer
+than `window-height' lines from the current point, move to it
+just like `notmuch-show-previous-message'.
+
+Otherwise, just scroll down a screenful of the current message.
+
+This command does not modify any message tags, (it does not undo
+any effects from previous calls to
+`notmuch-show-advance-marking-read-and-archiving'."
+ (interactive)
+ (let ((previous (notmuch-show-find-previous-message)))
+ (if (> (count-lines previous (point)) (- (window-height) next-screen-context-lines))
+ (progn
+ (condition-case nil
+ (scroll-down nil)
+ ((beginning-of-buffer) nil))
+ (goto-char (window-start)))
+ (notmuch-show-previous-message))))
+
+(defun notmuch-show-advance-marking-read-and-archiving ()
+ "Advance through thread, marking read and archiving.
+
+This command is intended to be one of the simplest ways to
+process a thread of email. It does the following:
+
+If the current message in the thread is not yet fully visible,
+scroll by a near screenful to read more of the message.
+
+Otherwise, (the end of the current message is already within the
+current window), remove the \"unread\" tag (if present) from the
+current message and advance to the next open message.
+
+Finally, if there is no further message to advance to, and this
+last message is already read, then archive the entire current
+thread, (remove the \"inbox\" tag from each message). Also kill
+this buffer, and display the next thread from the search from
+which this thread was originally shown."
+ (interactive)
+ (let ((next (notmuch-show-find-next-message))
+ (unread (notmuch-show-message-unread-p)))
+ (if (> next (window-end))
+ (scroll-up nil)
+ (let ((last (notmuch-show-last-message-p)))
+ (notmuch-show-mark-read-then-next-open-message)
+ (if last
+ (notmuch-show-archive-thread))))))
+
+(defun notmuch-show-next-button ()
+ "Advance point to the next button in the buffer."
+ (interactive)
+ (forward-button 1))
+
+(defun notmuch-show-previous-button ()
+ "Move point back to the previous button in the buffer."
+ (interactive)
+ (backward-button 1))
+
+(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))
+
+(defun notmuch-show-toggle-current-body ()
+ "Toggle the display of the current message body."
+ (interactive)
+ (save-excursion
+ (notmuch-show-move-to-current-message-summary-line)
+ (unless (button-at (point))
+ (notmuch-show-next-button))
+ (push-button))
+ )
+
+(defun notmuch-show-toggle-current-header ()
+ "Toggle the display of the current message header."
+ (interactive)
+ (save-excursion
+ (notmuch-show-move-to-current-message-summary-line)
+ (forward-line)
+ (unless (button-at (point))
+ (notmuch-show-next-button))
+ (push-button))
+ )
+
+(define-button-type 'notmuch-button-invisibility-toggle-type
+ 'action 'notmuch-toggle-invisible-action
+ 'follow-link t
+ 'face 'font-lock-comment-face)
+(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"
+ 'face 'notmuch-message-summary-face
+ :supertype 'notmuch-button-invisibility-toggle-type)
+
+(defun notmuch-show-citation-regexp (depth)
+ "Build a regexp for matching citations at a given DEPTH (indent)"
+ (let ((line-regexp (format "[[:space:]]\\{%d\\}>.*\n" depth)))
+ (concat "\\(?:^" line-regexp
+ "\\(?:[[:space:]]*\n" line-regexp
+ "\\)?\\)+")))
+
+(defun notmuch-show-region-to-button (beg end type prefix button-text)
+ "Auxilary function to do the actual making of overlays and buttons
+
+BEG and END are buffer locations. TYPE should a string, either
+\"citation\" or \"signature\". PREFIX is some arbitrary text to
+insert before the button, probably for indentation. BUTTON-TEXT
+is what to put on the button."
+
+;; This uses some slightly tricky conversions between strings and
+;; symbols because of the way the button code works. Note that
+;; replacing intern-soft with make-symbol will cause this to fail,
+;; since the newly created symbol has no plist.
+
+ (let ((overlay (make-overlay beg end))
+ (invis-spec (make-symbol (concat "notmuch-" type "-region")))
+ (button-type (intern-soft (concat "notmuch-button-"
+ type "-toggle-type"))))
+ (add-to-invisibility-spec invis-spec)
+ (overlay-put overlay 'invisible invis-spec)
+ (goto-char (1+ end))
+ (save-excursion
+ (goto-char (1- beg))
+ (insert prefix)
+ (insert-button button-text
+ 'invisibility-spec invis-spec
+ :type button-type)
+ )))
+
+
+(defun notmuch-show-markup-citations-region (beg end depth)
+ "Markup citations, and up to one signature in the given region"
+ ;; it would be nice if the untabify was not required, but
+ ;; that would require notmuch to indent with spaces.
+ (untabify beg end)
+ (let ((citation-regexp (notmuch-show-citation-regexp depth))
+ (signature-regexp (concat (format "^[[:space:]]\\{%d\\}" depth)
+ notmuch-show-signature-regexp))
+ (indent (concat "\n" (make-string depth ? ))))
+ (goto-char beg)
+ (beginning-of-line)
+ (while (and (< (point) end)
+ (re-search-forward citation-regexp end t))
+ (let* ((cite-start (match-beginning 0))
+ (cite-end (match-end 0))
+ (cite-lines (count-lines cite-start cite-end)))
+ (when (> cite-lines (1+ notmuch-show-citation-lines-prefix))
+ (goto-char cite-start)
+ (forward-line notmuch-show-citation-lines-prefix)
+ (notmuch-show-region-to-button
+ (point) cite-end
+ "citation"
+ indent
+ (format notmuch-show-citation-button-format
+ (- cite-lines notmuch-show-citation-lines-prefix))
+ ))))
+ (if (and (< (point) end)
+ (re-search-forward signature-regexp end t))
+ (let* ((sig-start (match-beginning 0))
+ (sig-end (match-end 0))
+ (sig-lines (1- (count-lines sig-start end))))
+ (if (<= sig-lines notmuch-show-signature-lines-max)
+ (notmuch-show-region-to-button
+ sig-start
+ end
+ "signature"
+ indent
+ (format notmuch-show-signature-button-format sig-lines)
+ ))))))
+
+(defun notmuch-show-markup-part (beg end depth)
+ (if (re-search-forward notmuch-show-part-begin-regexp nil t)
+ (progn
+ (forward-line)
+ (let ((beg (point-marker)))
+ (re-search-forward notmuch-show-part-end-regexp)
+ (let ((end (copy-marker (match-beginning 0))))
+ (goto-char end)
+ (if (not (bolp))
+ (insert "\n"))
+ (indent-rigidly beg end depth)
+ (notmuch-show-markup-citations-region beg end depth)
+ ; Advance to the next part (if any) (so the outer loop can
+ ; determine whether we've left the current message.
+ (if (re-search-forward notmuch-show-part-begin-regexp nil t)
+ (beginning-of-line)))))
+ (goto-char end)))
+
+(defun notmuch-show-markup-parts-region (beg end depth)
+ (save-excursion
+ (goto-char beg)
+ (while (< (point) end)
+ (notmuch-show-markup-part beg end depth))))
+
+(defun notmuch-show-markup-body (depth match btn)
+ "Markup a message body, (indenting, buttonizing citations,
+etc.), and conditionally hiding the body itself if the message
+has been read and does not match the current search.
+
+DEPTH specifies the depth at which this message appears in the
+tree of the current thread, (the top-level messages have depth 0
+and each reply increases depth by 1). MATCH indicates whether
+this message is regarded as matching the current search. BTN is
+the button which is used to toggle the visibility of this
+message.
+
+When this function is called, point must be within the message, but
+before the delimiter marking the beginning of the body."
+ (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)
+ (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 (or (notmuch-show-message-unread-p) match))
+ (add-to-invisibility-spec invis-spec)))
+ (set-marker beg nil)
+ (set-marker end nil)
+ )))
+
+(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)))))))
+
+(defun notmuch-show-markup-header (message-begin depth)
+ "Buttonize and decorate faces in a message header.
+
+MESSAGE-BEGIN is the position of the absolute first character in
+the message (including all delimiters that will end up being
+invisible etc.). This is to allow a button to reliably extend to
+the beginning of the message even if point is positioned at an
+invisible character (such as the beginning of the buffer).
+
+DEPTH specifies the depth at which this message appears in the
+tree of the current thread, (the top-level messages have depth 0
+and each reply increases depth by 1)."
+ (re-search-forward notmuch-show-header-begin-regexp)
+ (forward-line)
+ (let ((beg (point-marker))
+ (summary-end (copy-marker (line-beginning-position 2)))
+ (subject-end (copy-marker (line-end-position 2)))
+ (invis-spec (make-symbol "notmuch-show-header"))
+ (btn nil))
+ (re-search-forward notmuch-show-header-end-regexp)
+ (beginning-of-line)
+ (let ((end (point-marker)))
+ (indent-rigidly beg end depth)
+ (goto-char beg)
+ (setq btn (make-button message-begin summary-end :type 'notmuch-button-body-toggle-type))
+ (forward-line)
+ (add-to-invisibility-spec invis-spec)
+ (overlay-put (make-overlay subject-end end)
+ 'invisible invis-spec)
+ (make-button (line-beginning-position) subject-end
+ 'invisibility-spec invis-spec
+ :type 'notmuch-button-headers-toggle-type)
+ (while (looking-at "[[:space:]]*[A-Za-z][-A-Za-z0-9]*:")
+ (beginning-of-line)
+ (notmuch-fontify-headers)
+ (forward-line)
+ )
+ (goto-char end)
+ (insert "\n")
+ (set-marker beg nil)
+ (set-marker summary-end nil)
+ (set-marker subject-end nil)
+ (set-marker end nil)
+ )
+ btn))
+
+(defun notmuch-show-markup-message ()
+ (if (re-search-forward notmuch-show-message-begin-regexp nil t)
+ (let ((message-begin (match-beginning 0)))
+ (re-search-forward notmuch-show-depth-match-regexp)
+ (let ((depth (string-to-number (buffer-substring (match-beginning 1) (match-end 1))))
+ (match (string= "1" (buffer-substring (match-beginning 2) (match-end 2))))
+ (btn nil))
+ (setq btn (notmuch-show-markup-header message-begin depth))
+ (notmuch-show-markup-body depth match btn)))
+ (goto-char (point-max))))
+
+(defun notmuch-show-hide-markers ()
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward notmuch-show-marker-regexp nil t)
+ (progn
+ (overlay-put (make-overlay (match-beginning 0) (+ (match-end 0) 1))
+ 'invisible 'notmuch-show-marker))
+ (goto-char (point-max))))))
+
+(defun notmuch-show-markup-messages ()
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (notmuch-show-markup-message)))
+ (notmuch-show-hide-markers))
+
+(defun notmuch-documentation-first-line (symbol)
+ "Return the first line of the documentation string for SYMBOL."
+ (let ((doc (documentation symbol)))
+ (if doc
+ (with-temp-buffer
+ (insert (documentation symbol t))
+ (goto-char (point-min))
+ (let ((beg (point)))
+ (end-of-line)
+ (buffer-substring beg (point))))
+ "")))
+
+(defun notmuch-prefix-key-description (key)
+ "Given a prefix key code, return a human-readable string representation.
+
+This is basically just `format-kbd-macro' but we also convert ESC to M-."
+ (let ((desc (format-kbd-macro (vector key))))
+ (if (string= desc "ESC")
+ "M-"
+ (concat desc " "))))
+
+; I would think that emacs would have code handy for walking a keymap
+; and generating strings for each key, and I would prefer to just call
+; that. But I couldn't find any (could be all implemented in C I
+; suppose), so I wrote my own here.
+(defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
+ "For a key binding, return a string showing a human-readable
+representation of the prefixed key as well as the first line of
+documentation from the bound function.
+
+For a mouse binding, return nil."
+ (let ((key (car binding))
+ (action (cdr binding)))
+ (if (mouse-event-p key)
+ nil
+ (if (keymapp action)
+ (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key))))
+ (mapconcat substitute (cdr action) "\n"))
+ (concat prefix (format-kbd-macro (vector key))
+ "\t"
+ (notmuch-documentation-first-line action))))))
+
+(defalias 'notmuch-substitute-one-command-key
+ (apply-partially 'notmuch-substitute-one-command-key-with-prefix nil))
+
+(defun notmuch-substitute-command-keys (doc)
+ "Like `substitute-command-keys' but with documentation, not function names."
+ (let ((beg 0))
+ (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
+ (let ((map (substring doc (match-beginning 1) (match-end 1))))
+ (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key
+ (cdr (symbol-value (intern map))) "\n") 1 1 doc)))
+ (setq beg (match-end 0)))
+ doc))
+
+(defun notmuch-help ()
+ "Display help for the current notmuch mode."
+ (interactive)
+ (let* ((mode major-mode)
+ (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
+ (with-current-buffer (generate-new-buffer "*notmuch-help*")
+ (insert doc)
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))