(make-variable-buffer-local 'notmuch-show-indent-content)
(put 'notmuch-show-indent-content 'permanent-local t)
+(defcustom notmuch-show-stash-mlarchive-link-alist
+ '(("Gmane" . "http://mid.gmane.org/")
+ ("MARC" . "http://marc.info/?i=")
+ ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=")
+ ;; FIXME: can these services be searched by `Message-Id' ?
+ ;; ("MarkMail" . "http://markmail.org/")
+ ;; ("Nabble" . "http://nabble.com/")
+ ;; ("opensubscriber" . "http://opensubscriber.com/")
+ )
+ "List of Mailing List Archives to use when stashing links.
+
+These URIs are concatenated with the current message's
+Message-Id in `notmuch-show-stash-mlarchive-link'."
+ :type '(alist :key-type (string :tag "Name")
+ :value-type (string :tag "URL"))
+ :group 'notmuch-show)
+
+(defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
+ "Default Mailing List Archive to use when stashing links.
+
+This is used when `notmuch-show-stash-mlarchive-link' isn't
+provided with an MLA argument nor `completing-read' input."
+ :type `(choice
+ ,@(mapcar
+ (lambda (mla)
+ (list 'const :tag (car mla) :value (car mla)))
+ notmuch-show-stash-mlarchive-link-alist))
+ :group 'notmuch-show)
+
(defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message"
`(save-excursion
(setq notmuch-show-process-crypto ,process-crypto)
;; Always acquires the part via `notmuch part', even if it is
;; available in the JSON output.
- (insert (notmuch-show-get-bodypart-internal ,message-id ,nth))
+ (insert (notmuch-get-bodypart-internal ,message-id ,nth notmuch-show-process-crypto))
,@body))))
(defun notmuch-show-save-part (message-id nth &optional filename content-type)
;; test whether we are able to inline it (which includes both
;; capability and suitability tests).
(when (mm-inlined-p handle)
- (insert (notmuch-show-get-bodypart-content msg part nth))
+ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
(when (mm-inlinable-p handle)
(set-buffer display-buffer)
(mm-display-part handle)
t))))))
-(defvar notmuch-show-multipart/alternative-discouraged
- '(
- ;; Avoid HTML parts.
- "text/html"
- ;; multipart/related usually contain a text/html part and some associated graphics.
- "multipart/related"
- ))
-
(defun notmuch-show-multipart/*-to-list (part)
(mapcar (lambda (inner-part) (plist-get inner-part :content-type))
(plist-get part :content)))
-(defun notmuch-show-multipart/alternative-choose (types)
- ;; Based on `mm-preferred-alternative-precedence'.
- (let ((seq types))
- (dolist (pref (reverse notmuch-show-multipart/alternative-discouraged))
- (dolist (elem (copy-sequence seq))
- (when (string-match pref elem)
- (setq seq (nconc (delete elem seq) (list elem))))))
- seq))
-
(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
(notmuch-show-insert-part-header nth declared-type content-type nil)
- (let ((chosen-type (car (notmuch-show-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
+ (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
(inner-parts (plist-get part :content))
(start (point)))
;; This inserts all parts of the chosen type rather than just one,
;; times (hundreds!), which results in many calls to
;; `notmuch part'.
(unless content
- (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
- part-number))
+ (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
+ part-number notmuch-show-process-crypto))
(with-current-buffer w3m-current-buffer
(notmuch-show-w3m-cid-store-internal url
message-id
;; insert a header to make this clear.
(if (> nth 1)
(notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
- (insert (notmuch-show-get-bodypart-content msg part nth))
+ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
(save-excursion
(save-restriction
(narrow-to-region start (point-max))
(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
(notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
(insert (with-temp-buffer
- (insert (notmuch-show-get-bodypart-content msg part nth))
+ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
(goto-char (point-min))
(let ((file (make-temp-file "notmuch-ical"))
result)
;; Functions for determining how to handle MIME parts.
-(defun notmuch-show-split-content-type (content-type)
- (split-string content-type "/"))
-
(defun notmuch-show-handlers-for (content-type)
"Return a list of content handlers for a part of type CONTENT-TYPE."
(let (result)
(list (intern (concat "notmuch-show-insert-part-*/*"))
(intern (concat
"notmuch-show-insert-part-"
- (car (notmuch-show-split-content-type content-type))
+ (car (notmuch-split-content-type content-type))
"/*"))
(intern (concat "notmuch-show-insert-part-" content-type))))
result))
-;; Helper for parts which are generally not included in the default
-;; JSON output.
-(defun notmuch-show-get-bodypart-internal (message-id part-number)
- (let ((args '("show" "--format=raw"))
- (part-arg (format "--part=%s" part-number)))
- (setq args (append args (list part-arg)))
- (if notmuch-show-process-crypto
- (setq args (append args '("--decrypt"))))
- (setq args (append args (list message-id)))
- (with-temp-buffer
- (let ((coding-system-for-read 'no-conversion))
- (progn
- (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
- (buffer-string))))))
-
-(defun notmuch-show-get-bodypart-content (msg part nth)
- (or (plist-get part :content)
- (notmuch-show-get-bodypart-internal (concat "id:" (plist-get msg :id)) nth)))
-
;; \f
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
;; Message visibility depends on whether it matched the search
;; criteria.
- (notmuch-show-message-visible msg (plist-get msg :match))))
+ (notmuch-show-message-visible msg (and (plist-get msg :match)
+ (not (plist-get msg :excluded))))))
(defun notmuch-show-toggle-process-crypto ()
"Toggle the processing of cryptographic MIME parts."
(message (if notmuch-show-process-crypto
"Processing cryptographic MIME parts."
"Not processing cryptographic MIME parts."))
- (notmuch-show-refresh-view t))
+ (notmuch-show-refresh-view))
(defun notmuch-show-toggle-elide-non-matching ()
"Toggle the display of non-matching messages."
(message (if notmuch-show-elide-non-matching-messages
"Showing matching messages only."
"Showing all messages."))
- (notmuch-show-refresh-view t))
+ (notmuch-show-refresh-view))
(defun notmuch-show-toggle-thread-indentation ()
"Toggle the indentation of threads."
(message (if notmuch-show-indent-content
"Content is indented."
"Content is not indented."))
- (notmuch-show-refresh-view t))
+ (notmuch-show-refresh-view))
(defun notmuch-show-insert-tree (tree depth)
"Insert the message tree TREE at depth DEPTH in the current thread."
(setq notmuch-show-thread-id thread-id
notmuch-show-parent-buffer parent-buffer
notmuch-show-query-context query-context)
- (notmuch-show-worker)))
+ (notmuch-show-build-buffer)
+ (notmuch-show-goto-first-wanted-message)))
-(defun notmuch-show-worker ()
+(defun notmuch-show-build-buffer ()
(let ((inhibit-read-only t))
(notmuch-show-mode)
(append (list "\'") basic-args
(list "and (" notmuch-show-query-context ")\'"))
(append (list "\'") basic-args (list "\'")))))
- (notmuch-show-insert-forest (notmuch-query-get-threads args))
+ (notmuch-show-insert-forest (notmuch-query-get-threads
+ (cons "--exclude=false" args)))
;; If the query context reduced the results to nothing, run
;; the basic query.
(when (and (eq (buffer-size) 0)
notmuch-show-query-context)
(notmuch-show-insert-forest
- (notmuch-query-get-threads basic-args))))
+ (notmuch-query-get-threads
+ (cons "--exclude=false" basic-args)))))
(jit-lock-register #'notmuch-show-buttonise-links)
(run-hooks 'notmuch-show-hook))
- ;; Move straight to the first open message
- (unless (notmuch-show-message-visible-p)
- (notmuch-show-next-open-message))
-
- ;; Set the header line to the subject of the first open message.
- (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-pretty-subject)))
-
- (notmuch-show-mark-read)))
+ ;; Set the header line to the subject of the first message.
+ (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))))
(defun notmuch-show-capture-state ()
"Capture the state of the current buffer.
(message "Previously current message not found."))
(notmuch-show-message-adjust)))
-(defun notmuch-show-refresh-view (&optional retain-state)
+(defun notmuch-show-refresh-view (&optional reset-state)
"Refresh the current view.
Refreshes the current view, observing changes in display
-preferences. If RETAIN-STATE is non-nil then the state of the
-buffer is stored and re-applied after the refresh."
+preferences. If invoked with a prefix argument (or RESET-STATE is
+non-nil) then the state of the buffer (open/closed messages) is
+reset based on the original query."
(interactive "P")
(let ((inhibit-read-only t)
- state)
- (if retain-state
- (setq state (notmuch-show-capture-state)))
+ (state (unless reset-state
+ (notmuch-show-capture-state))))
(erase-buffer)
- (notmuch-show-worker)
+ (notmuch-show-build-buffer)
(if state
- (notmuch-show-apply-state state))))
+ (notmuch-show-apply-state state)
+ ;; We're resetting state, so navigate to the first open message
+ ;; and mark it read, just like opening a new show buffer.
+ (notmuch-show-goto-first-wanted-message))))
(defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "s" 'notmuch-show-stash-subject)
(define-key map "T" 'notmuch-show-stash-tags)
(define-key map "t" 'notmuch-show-stash-to)
+ (define-key map "l" 'notmuch-show-stash-mlarchive-link)
+ (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
map)
"Submap for stash commands")
(fset 'notmuch-show-stash-map notmuch-show-stash-map)
(plist-get props prop)))
(defun notmuch-show-get-message-id (&optional bare)
- "Return the Message-Id of the current message.
+ "Return an id: query for the Message-Id of the current message.
If optional argument BARE is non-nil, return
-the Message-Id without prefix and quotes."
+the Message-Id without id: prefix and escaping."
(if bare
(notmuch-show-get-prop :id)
- (concat "id:\"" (notmuch-show-get-prop :id) "\"")))
+ (notmuch-id-to-query (notmuch-show-get-prop :id))))
(defun notmuch-show-get-messages-ids ()
- "Return all message ids of messages in the current thread."
+ "Return all id: queries of messages in the current thread."
(let ((message-ids))
(notmuch-show-mapc
(lambda () (push (notmuch-show-get-message-id) message-ids)))
(defun notmuch-show-get-depth ()
(notmuch-show-get-prop :depth))
-(defun notmuch-show-get-pretty-subject ()
- (notmuch-prettify-subject (notmuch-show-get-subject)))
-
(defun notmuch-show-set-tags (tags)
"Set the tags of the current message."
(notmuch-show-set-prop :tags tags)
;; thread.
(defun notmuch-show-get-message-ids-for-open-messages ()
- "Return a list of all message IDs for open messages in the current thread."
+ "Return a list of all id: queries for open messages in the current thread."
(save-excursion
(let (message-ids done)
(goto-char (point-min))
;; This is not the last message - move to the next visible one.
(notmuch-show-next-open-message))
+ ((not (= (point) (point-max)))
+ ;; This is the last message, but the cursor is not at the end of
+ ;; the buffer. Move it there.
+ (goto-char (point-max)))
+
(t
;; This is the last message - change the return value
(setq ret t)))
(goto-char (point-max))))
r))
+(defun notmuch-show-next-matching-message ()
+ "Show the next matching message."
+ (interactive)
+ (let (r)
+ (while (and (setq r (notmuch-show-goto-message-next))
+ (not (notmuch-show-get-prop :match))))
+ (if r
+ (progn
+ (notmuch-show-mark-read)
+ (notmuch-show-message-adjust))
+ (goto-char (point-max)))))
+
+(defun notmuch-show-open-if-matched ()
+ "Open a message if it is matched (whether or not excluded)."
+ (let ((props (notmuch-show-get-message-properties)))
+ (notmuch-show-message-visible props (plist-get props :match))))
+
+(defun notmuch-show-goto-first-wanted-message ()
+ "Move to the first open message and mark it read"
+ (goto-char (point-min))
+ (if (notmuch-show-message-visible-p)
+ (notmuch-show-mark-read)
+ (notmuch-show-next-open-message))
+ (when (eobp)
+ ;; There are no matched non-excluded messages so open all matched
+ ;; (necessarily excluded) messages and go to the first.
+ (notmuch-show-mapc 'notmuch-show-open-if-matched)
+ (force-window-update)
+ (goto-char (point-min))
+ (if (notmuch-show-message-visible-p)
+ (notmuch-show-mark-read)
+ (notmuch-show-next-open-message))))
+
(defun notmuch-show-previous-open-message ()
"Show the previous open message."
(interactive)
(apply 'notmuch-show-tag-message tag-changes)))
(defun notmuch-show-tag-all (&rest tag-changes)
- "Change tags for all messages in the current thread.
+ "Change tags for all messages in the current buffer.
TAG-CHANGES is a list of tag operations for `notmuch-tag'."
(interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))
(notmuch-show-tag-all (concat op "inbox"))))
(defun notmuch-show-archive-thread-then-next ()
- "Archive each message in thread, then show next thread from search."
+ "Archive all messages in the current buffer, then show next thread from search."
(interactive)
(notmuch-show-archive-thread)
(notmuch-show-next-thread t))
(defun notmuch-show-archive-thread-then-exit ()
- "Archive each message in thread, then exit back to search results."
+ "Archive all messages in the current buffer, then exit back to search results."
(interactive)
(notmuch-show-archive-thread)
(notmuch-show-next-thread))
(notmuch-common-do-stash (notmuch-show-get-from)))
(defun notmuch-show-stash-message-id ()
- "Copy message ID of current message to kill-ring."
+ "Copy id: query matching the current message to kill-ring."
(interactive)
(notmuch-common-do-stash (notmuch-show-get-message-id)))
(interactive)
(notmuch-common-do-stash (notmuch-show-get-to)))
+(defun notmuch-show-stash-mlarchive-link (&optional mla)
+ "Copy an ML Archive URI for the current message to the kill-ring.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+ (interactive)
+ (notmuch-common-do-stash
+ (concat (cdr (assoc
+ (or mla
+ (let ((completion-ignore-case t))
+ (completing-read
+ "Mailing List Archive: "
+ notmuch-show-stash-mlarchive-link-alist
+ nil t nil nil notmuch-show-stash-mlarchive-link-default)))
+ notmuch-show-stash-mlarchive-link-alist))
+ (notmuch-show-get-message-id t))))
+
+(defun notmuch-show-stash-mlarchive-link-and-go (&optional mla)
+ "Copy an ML Archive URI for the current message to the kill-ring and visit it.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+ (interactive)
+ (notmuch-show-stash-mlarchive-link mla)
+ (browse-url (current-kill 0 t)))
+
;; Commands typically bound to buttons.
(defun notmuch-show-part-button-default (&optional button)