emacs: Shorten long lines

This commit is contained in:
Jonas Bernoulli 2020-08-08 13:49:36 +02:00 committed by David Bremner
parent e3fd546ad7
commit a4617f29ce
17 changed files with 326 additions and 187 deletions

View file

@ -1,6 +1,6 @@
;;; coolj.el --- automatically wrap long lines -*- coding:utf-8 -*- ;;; coolj.el --- automatically wrap long lines -*- coding:utf-8 -*-
;; Copyright (C) 2000, 2001, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Copyright (C) 2000, 2001, 2004-2009 Free Software Foundation, Inc.
;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> ;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Alex Schroeder <alex@gnu.org> ;; Alex Schroeder <alex@gnu.org>

View file

@ -195,10 +195,11 @@ external commands."
((eq notmuch-address-command 'internal) ((eq notmuch-address-command 'internal)
(unless (notmuch-address--harvest-ready) (unless (notmuch-address--harvest-ready)
;; First, run quick synchronous harvest based on what the user ;; First, run quick synchronous harvest based on what the user
;; entered so far ;; entered so far.
(notmuch-address-harvest original t)) (notmuch-address-harvest original t))
(prog1 (notmuch-address-matching original) (prog1 (notmuch-address-matching original)
;; Then start the (potentially long-running) full asynchronous harvest if necessary ;; Then start the (potentially long-running) full asynchronous
;; harvest if necessary.
(notmuch-address-harvest-trigger))) (notmuch-address-harvest-trigger)))
(t (t
(process-lines notmuch-address-command original)))) (process-lines notmuch-address-command original))))
@ -241,7 +242,8 @@ external commands."
(push chosen notmuch-address-history) (push chosen notmuch-address-history)
(delete-region beg end) (delete-region beg end)
(insert chosen) (insert chosen)
(run-hook-with-args 'notmuch-address-post-completion-functions chosen)) (run-hook-with-args 'notmuch-address-post-completion-functions
chosen))
(message "No matches.") (message "No matches.")
(ding)))) (ding))))
(t nil))) (t nil)))
@ -393,10 +395,11 @@ to be a saved address hash."
;; The file exists, check it is a file we saved ;; The file exists, check it is a file we saved
(notmuch-address--get-address-hash)) (notmuch-address--get-address-hash))
(with-temp-file notmuch-address-save-filename (with-temp-file notmuch-address-save-filename
(let ((save-plist (list :version notmuch-address--save-hash-version (let ((save-plist
:completion-settings notmuch-address-internal-completion (list :version notmuch-address--save-hash-version
:last-harvest notmuch-address-last-harvest :completion-settings notmuch-address-internal-completion
:completions notmuch-address-completions))) :last-harvest notmuch-address-last-harvest
:completions notmuch-address-completions)))
(print "notmuch-address-hash" (current-buffer)) (print "notmuch-address-hash" (current-buffer))
(print save-plist (current-buffer)))) (print save-plist (current-buffer))))
(message "\ (message "\
@ -408,16 +411,17 @@ appear to be an address savefile. Not overwriting."
(let ((now (float-time))) (let ((now (float-time)))
(when (> (- now notmuch-address-last-harvest) 86400) (when (> (- now notmuch-address-last-harvest) 86400)
(setq notmuch-address-last-harvest now) (setq notmuch-address-last-harvest now)
(notmuch-address-harvest nil nil (notmuch-address-harvest
(lambda (proc event) nil nil
;; If harvest fails, we want to try (lambda (proc event)
;; again when the trigger is next ;; If harvest fails, we want to try
;; called ;; again when the trigger is next
(if (string= event "finished\n") ;; called
(progn (if (string= event "finished\n")
(notmuch-address--save-address-hash) (progn
(setq notmuch-address-full-harvest-finished t)) (notmuch-address--save-address-hash)
(setq notmuch-address-last-harvest 0))))))) (setq notmuch-address-full-harvest-finished t))
(setq notmuch-address-last-harvest 0)))))))
;; ;;

View file

@ -69,9 +69,11 @@
(cl-case command (cl-case command
(interactive (company-begin-backend 'notmuch-company)) (interactive (company-begin-backend 'notmuch-company))
(prefix (and (derived-mode-p 'message-mode) (prefix (and (derived-mode-p 'message-mode)
(looking-back (concat notmuch-address-completion-headers-regexp ".*") (looking-back
(line-beginning-position)) (concat notmuch-address-completion-headers-regexp ".*")
(setq notmuch-company-last-prefix (company-grab "[:,][ \t]*\\(.*\\)" 1 (point-at-bol))))) (line-beginning-position))
(setq notmuch-company-last-prefix
(company-grab "[:,][ \t]*\\(.*\\)" 1 (point-at-bol)))))
(candidates (cond (candidates (cond
((notmuch-address--harvest-ready) ((notmuch-address--harvest-ready)
;; Update harvested addressed from time to time ;; Update harvested addressed from time to time
@ -80,17 +82,20 @@
(t (t
(cons :async (cons :async
(lambda (callback) (lambda (callback)
;; First run quick asynchronous harvest based on what the user entered so far ;; First run quick asynchronous harvest
;; based on what the user entered so far
(notmuch-address-harvest (notmuch-address-harvest
arg nil arg nil
(lambda (_proc _event) (lambda (_proc _event)
(funcall callback (notmuch-address-matching arg)) (funcall callback (notmuch-address-matching arg))
;; Then start the (potentially long-running) full asynchronous harvest if necessary ;; Then start the (potentially long-running)
;; full asynchronous harvest if necessary
(notmuch-address-harvest-trigger)))))))) (notmuch-address-harvest-trigger))))))))
(match (if (string-match notmuch-company-last-prefix arg) (match (if (string-match notmuch-company-last-prefix arg)
(match-end 0) (match-end 0)
0)) 0))
(post-completion (run-hook-with-args 'notmuch-address-post-completion-functions arg)) (post-completion
(run-hook-with-args 'notmuch-address-post-completion-functions arg))
(no-cache t)))) (no-cache t))))

View file

@ -161,7 +161,8 @@ by user FROM."
(goto-char (point-max)) (goto-char (point-max))
(insert (format "-- Key %s in message %s:\n" (insert (format "-- Key %s in message %s:\n"
fingerprint id)) fingerprint id))
(call-process notmuch-crypto-gpg-program nil t t "--batch" "--no-tty" "--list-keys" fingerprint)) (call-process notmuch-crypto-gpg-program nil t t
"--batch" "--no-tty" "--list-keys" fingerprint))
(recenter -1)))) (recenter -1))))
(declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state)) (declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state))
@ -220,12 +221,13 @@ corresponding key when the status button is pressed."
(with-current-buffer buffer (with-current-buffer buffer
(goto-char (point-max)) (goto-char (point-max))
(insert (format "--- Retrieving key %s:\n" keyid))) (insert (format "--- Retrieving key %s:\n" keyid)))
(let ((p (make-process :name "notmuch GPG key retrieval" (let ((p (make-process
:connection-type 'pipe :name "notmuch GPG key retrieval"
:buffer buffer :connection-type 'pipe
:stderr buffer :buffer buffer
:command (list notmuch-crypto-gpg-program "--recv-keys" keyid) :stderr buffer
:sentinel #'notmuch-crypto--async-key-sentinel))) :command (list notmuch-crypto-gpg-program "--recv-keys" keyid)
:sentinel #'notmuch-crypto--async-key-sentinel)))
(process-put p :gpg-key-id keyid) (process-put p :gpg-key-id keyid)
(process-put p :notmuch-show-buffer (current-buffer)) (process-put p :notmuch-show-buffer (current-buffer))
(process-put p :notmuch-show-point (point)) (process-put p :notmuch-show-point (point))

View file

@ -154,12 +154,14 @@ Used when a new version is saved, or the message is sent."
`notmuch-draft-save-plaintext' controls the behaviour." `notmuch-draft-save-plaintext' controls the behaviour."
(cl-case notmuch-draft-save-plaintext (cl-case notmuch-draft-save-plaintext
((ask) ((ask)
(unless (yes-or-no-p "(Customize `notmuch-draft-save-plaintext' to avoid this warning) (unless (yes-or-no-p
"(Customize `notmuch-draft-save-plaintext' to avoid this warning)
This message contains mml tags that suggest it is intended to be encrypted. This message contains mml tags that suggest it is intended to be encrypted.
Really save and index an unencrypted copy? ") Really save and index an unencrypted copy? ")
(error "Save aborted"))) (error "Save aborted")))
((nil) ((nil)
(error "Refusing to save draft with encryption tags (see `notmuch-draft-save-plaintext')")) (error "Refusing to save draft with encryption tags (see `%s')"
'notmuch-draft-save-plaintext))
((t) ((t)
(ignore)))) (ignore))))
@ -192,14 +194,16 @@ applied to newly inserted messages)."
(message-remove-header "Message-ID") (message-remove-header "Message-ID")
(message-add-header (concat "Message-ID: <" id ">"))) (message-add-header (concat "Message-ID: <" id ">")))
(t (t
(message "You have customized emacs so Message-ID is not a deletable header, so not changing it") (message "You have customized emacs so Message-ID is not a %s"
"deletable header, so not changing it")
(setq id nil))) (setq id nil)))
(cond (cond
((member 'Date message-deletable-headers) ((member 'Date message-deletable-headers)
(message-remove-header "Date") (message-remove-header "Date")
(message-add-header (concat "Date: " (message-make-date)))) (message-add-header (concat "Date: " (message-make-date))))
(t (t
(message "You have customized emacs so Date is not a deletable header, so not changing it"))) (message "You have customized emacs so Date is not a deletable %s"
"header, so not changing it")))
(message-add-header "X-Notmuch-Emacs-Draft: True") (message-add-header "X-Notmuch-Emacs-Draft: True")
(notmuch-draft-quote-some-mml) (notmuch-draft-quote-some-mml)
(notmuch-maildir-setup-message-for-saving) (notmuch-maildir-setup-message-for-saving)

View file

@ -29,7 +29,8 @@
(require 'notmuch-lib) (require 'notmuch-lib)
(require 'notmuch-mua) (require 'notmuch-mua)
(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line continuation)) (declare-function notmuch-search "notmuch"
(&optional query oldest-first target-thread target-line continuation))
(declare-function notmuch-poll "notmuch" ()) (declare-function notmuch-poll "notmuch" ())
(declare-function notmuch-tree "notmuch-tree" (declare-function notmuch-tree "notmuch-tree"
(&optional query query-context target buffer-name open-target unthreaded)) (&optional query query-context target buffer-name open-target unthreaded))
@ -91,18 +92,28 @@ searches so they still work in customize."
:tag "Saved Search" :tag "Saved Search"
:args '((list :inline t :args '((list :inline t
:format "%v" :format "%v"
(group :format "%v" :inline t (const :format " Name: " :name) (string :format "%v")) (group :format "%v" :inline t
(group :format "%v" :inline t (const :format " Query: " :query) (string :format "%v"))) (const :format " Name: " :name)
(string :format "%v"))
(group :format "%v" :inline t
(const :format " Query: " :query)
(string :format "%v")))
(checklist :inline t (checklist :inline t
:format "%v" :format "%v"
(group :format "%v" :inline t (const :format "Shortcut key: " :key) (key-sequence :format "%v")) (group :format "%v" :inline t
(group :format "%v" :inline t (const :format "Count-Query: " :count-query) (string :format "%v")) (const :format "Shortcut key: " :key)
(group :format "%v" :inline t (const :format "" :sort-order) (key-sequence :format "%v"))
(group :format "%v" :inline t
(const :format "Count-Query: " :count-query)
(string :format "%v"))
(group :format "%v" :inline t
(const :format "" :sort-order)
(choice :tag " Sort Order" (choice :tag " Sort Order"
(const :tag "Default" nil) (const :tag "Default" nil)
(const :tag "Oldest-first" oldest-first) (const :tag "Oldest-first" oldest-first)
(const :tag "Newest-first" newest-first))) (const :tag "Newest-first" newest-first)))
(group :format "%v" :inline t (const :format "" :search-type) (group :format "%v" :inline t
(const :format "" :search-type)
(choice :tag " Search Type" (choice :tag " Search Type"
(const :tag "Search mode" nil) (const :tag "Search mode" nil)
(const :tag "Tree mode" tree) (const :tag "Tree mode" tree)
@ -474,7 +485,8 @@ should be. Returns a cons cell `(tags-per-line width)'."
((floatp notmuch-column-control) ((floatp notmuch-column-control)
(let* ((available-width (- (window-width) notmuch-hello-indent)) (let* ((available-width (- (window-width) notmuch-hello-indent))
(proposed-width (max (* available-width notmuch-column-control) widest))) (proposed-width (max (* available-width notmuch-column-control)
widest)))
(floor available-width proposed-width))) (floor available-width proposed-width)))
(t (t
@ -536,8 +548,9 @@ options will be handled as specified for
(unless (= (call-process-region (point-min) (point-max) notmuch-command (unless (= (call-process-region (point-min) (point-max) notmuch-command
t t nil "count" "--batch") 0) t t nil "count" "--batch") 0)
(notmuch-logged-error "notmuch count --batch failed" (notmuch-logged-error
"Please check that the notmuch CLI is new enough to support `count "notmuch count --batch failed"
"Please check that the notmuch CLI is new enough to support `count
--batch'. In general we recommend running matching versions of --batch'. In general we recommend running matching versions of
the CLI and emacs interface.")) the CLI and emacs interface."))
@ -553,7 +566,8 @@ the CLI and emacs interface."))
search-query (plist-get options :filter))) search-query (plist-get options :filter)))
(message-count (prog1 (read (current-buffer)) (message-count (prog1 (read (current-buffer))
(forward-line 1)))) (forward-line 1))))
(when (and filtered-query (or (plist-get options :show-empty-searches) (> message-count 0))) (when (and filtered-query (or (plist-get options :show-empty-searches)
(> message-count 0)))
(setq elem-plist (plist-put elem-plist :query filtered-query)) (setq elem-plist (plist-put elem-plist :query filtered-query))
(plist-put elem-plist :count message-count)))) (plist-put elem-plist :count message-count))))
query-list)))) query-list))))
@ -740,7 +754,9 @@ Complete list of currently available key bindings:
;; dark background. ;; dark background.
(setq image (cons 'image (setq image (cons 'image
(append (cdr image) (append (cdr image)
(list :background (face-background 'notmuch-hello-logo-background))))) (list :background
(face-background
'notmuch-hello-logo-background)))))
(insert-image image)) (insert-image image))
(widget-insert " ")) (widget-insert " "))
@ -760,7 +776,8 @@ Complete list of currently available key bindings:
(notmuch-hello-update)) (notmuch-hello-update))
:help-echo "Refresh" :help-echo "Refresh"
(notmuch-hello-nice-number (notmuch-hello-nice-number
(string-to-number (car (process-lines notmuch-command "count"))))) (string-to-number
(car (process-lines notmuch-command "count")))))
(widget-insert " messages.\n"))) (widget-insert " messages.\n")))

View file

@ -70,7 +70,8 @@ fast way to jump to a saved search from anywhere in Notmuch."
(if action-map (if action-map
(notmuch-jump action-map "Search: ") (notmuch-jump action-map "Search: ")
(error "To use notmuch-jump, please customize shortcut keys in notmuch-saved-searches.")))) (error "To use notmuch-jump, \
please customize shortcut keys in notmuch-saved-searches."))))
(defvar notmuch-jump--action nil) (defvar notmuch-jump--action nil)
@ -200,7 +201,9 @@ buffer."
(define-key map keystr (define-key map keystr
`(lambda () (interactive) `(lambda () (interactive)
(setq notmuch-jump--action (setq notmuch-jump--action
',(apply-partially #'notmuch-jump action-submap new-prompt)) ',(apply-partially #'notmuch-jump
action-submap
new-prompt))
(exit-minibuffer))))))) (exit-minibuffer)))))))
map)) map))

View file

@ -316,8 +316,10 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
tail))) tail)))
;; Documentation for command ;; Documentation for command
(push (cons key-string (push (cons key-string
(or (and (symbolp binding) (get binding 'notmuch-doc)) (or (and (symbolp binding)
(and (functionp binding) (notmuch-documentation-first-line binding)))) (get binding 'notmuch-doc))
(and (functionp binding)
(notmuch-documentation-first-line binding))))
tail))) tail)))
tail) tail)
@ -327,13 +329,13 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
;; binding whose "key" is 'remap, and whose "binding" is itself a ;; binding whose "key" is 'remap, and whose "binding" is itself a
;; keymap that maps not from keys to commands, but from old (remapped) ;; keymap that maps not from keys to commands, but from old (remapped)
;; functions to the commands to use in their stead. ;; functions to the commands to use in their stead.
(map-keymap (map-keymap (lambda (command binding)
(lambda (command binding) (mapc (lambda (actual-key)
(mapc (setq tail
(lambda (actual-key) (notmuch-describe-key actual-key binding
(setq tail (notmuch-describe-key actual-key binding prefix ua-keys tail))) prefix ua-keys tail)))
(where-is-internal command base-keymap))) (where-is-internal command base-keymap)))
remap-keymap) remap-keymap)
tail) tail)
(defun notmuch-describe-keymap (keymap ua-keys base-keymap &optional prefix tail) (defun notmuch-describe-keymap (keymap ua-keys base-keymap &optional prefix tail)
@ -356,9 +358,13 @@ prefix argument. PREFIX and TAIL are used internally."
(notmuch-describe-remaps (notmuch-describe-remaps
binding ua-keys base-keymap prefix tail) binding ua-keys base-keymap prefix tail)
(notmuch-describe-keymap (notmuch-describe-keymap
binding ua-keys base-keymap (notmuch-prefix-key-description key) tail)))) binding ua-keys base-keymap
(notmuch-prefix-key-description key)
tail))))
(binding (binding
(setq tail (notmuch-describe-key (vector key) binding prefix ua-keys tail))))) (setq tail
(notmuch-describe-key (vector key)
binding prefix ua-keys tail)))))
keymap) keymap)
tail) tail)
@ -368,11 +374,15 @@ prefix argument. PREFIX and TAIL are used internally."
(while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg) (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
(let ((desc (let ((desc
(save-match-data (save-match-data
(let* ((keymap-name (substring doc (match-beginning 1) (match-end 1))) (let* ((keymap-name (substring doc
(match-beginning 1)
(match-end 1)))
(keymap (symbol-value (intern keymap-name))) (keymap (symbol-value (intern keymap-name)))
(ua-keys (where-is-internal 'universal-argument keymap t)) (ua-keys (where-is-internal 'universal-argument keymap t))
(desc-alist (notmuch-describe-keymap keymap ua-keys keymap)) (desc-alist (notmuch-describe-keymap keymap ua-keys keymap))
(desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist))) (desc-list (mapcar (lambda (arg)
(concat (car arg) "\t" (cdr arg)))
desc-alist)))
(mapconcat #'identity desc-list "\n"))))) (mapconcat #'identity desc-list "\n")))))
(setq doc (replace-match desc 1 1 doc))) (setq doc (replace-match desc 1 1 doc)))
(setq beg (match-end 0))) (setq beg (match-end 0)))
@ -391,7 +401,8 @@ its prefixed behavior by setting the 'notmuch-prefix-doc property
of its command symbol." of its command symbol."
(interactive) (interactive)
(let* ((mode major-mode) (let* ((mode major-mode)
(doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t))))) (doc (substitute-command-keys
(notmuch-substitute-command-keys (documentation mode t)))))
(with-current-buffer (generate-new-buffer "*notmuch-help*") (with-current-buffer (generate-new-buffer "*notmuch-help*")
(insert doc) (insert doc)
(goto-char (point-min)) (goto-char (point-min))
@ -411,8 +422,10 @@ of its command symbol."
(let* ((subkeymap (key-binding prefix)) (let* ((subkeymap (key-binding prefix))
(ua-keys (where-is-internal 'universal-argument nil t)) (ua-keys (where-is-internal 'universal-argument nil t))
(prefix-string (notmuch-prefix-key-description prefix)) (prefix-string (notmuch-prefix-key-description prefix))
(desc-alist (notmuch-describe-keymap subkeymap ua-keys subkeymap prefix-string)) (desc-alist (notmuch-describe-keymap
(desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist)) subkeymap ua-keys subkeymap prefix-string))
(desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg)))
desc-alist))
(desc (mapconcat #'identity desc-list "\n"))) (desc (mapconcat #'identity desc-list "\n")))
(with-help-window (help-buffer) (with-help-window (help-buffer)
(with-current-buffer standard-output (with-current-buffer standard-output
@ -547,7 +560,8 @@ This replaces spaces, percents, and double quotes in STR with
'( '(
;; Avoid HTML parts. ;; Avoid HTML parts.
"text/html" "text/html"
;; multipart/related usually contain a text/html part and some associated graphics. ;; multipart/related usually contain a text/html part and some
;; associated graphics.
"multipart/related" "multipart/related"
)) ))
@ -602,8 +616,9 @@ the given type."
,(notmuch-id-to-query (plist-get msg :id)))) ,(notmuch-id-to-query (plist-get msg :id))))
(coding-system-for-read (coding-system-for-read
(if binaryp 'no-conversion (if binaryp 'no-conversion
(let ((coding-system (mm-charset-to-coding-system (let ((coding-system
(plist-get part :content-charset)))) (mm-charset-to-coding-system
(plist-get part :content-charset))))
;; Sadly, ;; Sadly,
;; `mm-charset-to-coding-system' seems ;; `mm-charset-to-coding-system' seems
;; to return things that are not ;; to return things that are not
@ -615,7 +630,8 @@ the given type."
;; charset is US-ASCII. RFC6657 ;; charset is US-ASCII. RFC6657
;; complicates this somewhat. ;; complicates this somewhat.
'us-ascii))))) 'us-ascii)))))
(apply #'call-process notmuch-command nil '(t nil) nil args) (apply #'call-process
notmuch-command nil '(t nil) nil args)
(buffer-string)))))) (buffer-string))))))
(when (and cache data) (when (and cache data)
(plist-put part plist-elem data)) (plist-put part plist-elem data))
@ -670,7 +686,8 @@ current buffer, if possible."
(let* ((have-content (plist-member part :content)) (let* ((have-content (plist-member part :content))
(charset (if have-content 'gnus-decoded (charset (if have-content 'gnus-decoded
(plist-get part :content-charset))) (plist-get part :content-charset)))
(handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset))))) (handle (mm-make-handle (current-buffer)
`(,content-type (charset . ,charset)))))
;; If the user wants the part inlined, insert the content and ;; If the user wants the part inlined, insert the content and
;; test whether we are able to inline it (which includes both ;; test whether we are able to inline it (which includes both
;; capability and suitability tests). ;; capability and suitability tests).
@ -786,7 +803,8 @@ provided, it is taken from `process-command'."
((exit) (process-exit-status proc)) ((exit) (process-exit-status proc))
((signal) msg)))) ((signal) msg))))
(when exit-status (when exit-status
(notmuch-check-exit-status exit-status (or command (process-command proc)) (notmuch-check-exit-status exit-status
(or command (process-command proc))
nil err)))) nil err))))
(defun notmuch-check-exit-status (exit-status command &optional output err) (defun notmuch-check-exit-status (exit-status command &optional output err)

View file

@ -135,8 +135,9 @@ by notmuch-mua-mail."
;; really want this header inserted. ;; really want this header inserted.
(when (or (not (= (elt subdir 0) ?/)) (when (or (not (= (elt subdir 0) ?/))
(y-or-n-p (format "Fcc header %s is an absolute path and notmuch insert is requested.\nInsert header anyway? " (y-or-n-p
subdir))) (format "Fcc header %s is an absolute path and notmuch insert is requested.
Insert header anyway? " subdir)))
(message-add-header (concat "Fcc: " subdir)))) (message-add-header (concat "Fcc: " subdir))))
(defun notmuch-maildir-add-file-style-fcc-header (subdir) (defun notmuch-maildir-add-file-style-fcc-header (subdir)
@ -249,9 +250,8 @@ If CREATE is non-nil then create the folder if necessary."
;; typo, or just the user want a new folder, let the user decide ;; typo, or just the user want a new folder, let the user decide
;; how to deal with it. ;; how to deal with it.
(error (error
(let ((response (notmuch-read-char-choice (let ((response (notmuch-read-char-choice "Insert failed: \
"Insert failed: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " \(r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " '(?r ?c ?i ?e))))
'(?r ?c ?i ?e))))
(cl-case response (cl-case response
(?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header)) (?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header))
(?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't)) (?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't))
@ -333,8 +333,8 @@ if needed."
(notmuch-maildir-fcc-write-buffer-to-maildir fcc-header 't) (notmuch-maildir-fcc-write-buffer-to-maildir fcc-header 't)
;; The fcc-header is not a valid maildir see if the user wants to ;; The fcc-header is not a valid maildir see if the user wants to
;; fix it in some way. ;; fix it in some way.
(let* ((prompt (format "Fcc %s is not a maildir: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " (let* ((prompt (format "Fcc %s is not a maildir: \
fcc-header)) \(r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " fcc-header))
(response (notmuch-read-char-choice prompt '(?r ?c ?i ?e)))) (response (notmuch-read-char-choice prompt '(?r ?c ?i ?e))))
(cl-case response (cl-case response
(?r (notmuch-maildir-fcc-file-fcc fcc-header)) (?r (notmuch-maildir-fcc-file-fcc fcc-header))

View file

@ -60,7 +60,8 @@ the first is a notmuch query and the rest are the tag changes to
be applied to the matching messages.") be applied to the matching messages.")
(defun notmuch-message-apply-queued-tag-changes () (defun notmuch-message-apply-queued-tag-changes ()
;; Apply the tag changes queued in the buffer-local variable notmuch-message-queued-tag-changes. ;; Apply the tag changes queued in the buffer-local variable
;; notmuch-message-queued-tag-changes.
(dolist (query-and-tags notmuch-message-queued-tag-changes) (dolist (query-and-tags notmuch-message-queued-tag-changes)
(notmuch-tag (car query-and-tags) (notmuch-tag (car query-and-tags)
(cdr query-and-tags)))) (cdr query-and-tags))))

View file

@ -205,10 +205,12 @@ Typically this is added to `notmuch-mua-send-hook'."
(defun notmuch-mua-reply-crypto (parts) (defun notmuch-mua-reply-crypto (parts)
"Add mml sign-encrypt flag if any part of original message is encrypted." "Add mml sign-encrypt flag if any part of original message is encrypted."
(cl-loop for part in parts (cl-loop for part in parts
if (notmuch-match-content-type (plist-get part :content-type) "multipart/encrypted") if (notmuch-match-content-type (plist-get part :content-type)
do (mml-secure-message-sign-encrypt) "multipart/encrypted")
else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*") do (mml-secure-message-sign-encrypt)
do (notmuch-mua-reply-crypto (plist-get part :content)))) else if (notmuch-match-content-type (plist-get part :content-type)
"multipart/*")
do (notmuch-mua-reply-crypto (plist-get part :content))))
;; There is a bug in emacs 23's message.el that results in a newline ;; There is a bug in emacs 23's message.el that results in a newline
;; not being inserted after the References header, so the next header ;; not being inserted after the References header, so the next header
@ -250,8 +252,9 @@ Typically this is added to `notmuch-mua-send-hook'."
;; the original message. ;; the original message.
((same-window-regexps '("\\*mail .*"))) ((same-window-regexps '("\\*mail .*")))
;; We modify message-header-format-alist to get around a bug in message.el. ;; We modify message-header-format-alist to get around
;; See the comment above on notmuch-mua-insert-references. ;; a bug in message.el. See the comment above on
;; notmuch-mua-insert-references.
(let ((message-header-format-alist (let ((message-header-format-alist
(cl-loop for pair in message-header-format-alist (cl-loop for pair in message-header-format-alist
if (eq (car pair) 'References) if (eq (car pair) 'References)
@ -266,7 +269,8 @@ Typically this is added to `notmuch-mua-send-hook'."
(notmuch-headers-plist-to-alist reply-headers) (notmuch-headers-plist-to-alist reply-headers)
nil (notmuch-mua-get-switch-function)))) nil (notmuch-mua-get-switch-function))))
;; Create a buffer-local queue for tag changes triggered when sending the reply ;; Create a buffer-local queue for tag changes triggered when
;; sending the reply.
(when notmuch-message-replied-tags (when notmuch-message-replied-tags
(setq-local notmuch-message-queued-tag-changes (setq-local notmuch-message-queued-tag-changes
(list (cons query-string notmuch-message-replied-tags)))) (list (cons query-string notmuch-message-replied-tags))))
@ -293,27 +297,29 @@ Typically this is added to `notmuch-mua-send-hook'."
(insert "From: " from "\n") (insert "From: " from "\n")
(insert "Date: " date "\n\n") (insert "Date: " date "\n\n")
(insert (with-temp-buffer (insert
(let (with-temp-buffer
;; Don't attempt to clean up messages, excerpt (let
;; citations, etc. in the original message before ;; Don't attempt to clean up messages, excerpt
;; quoting. ;; citations, etc. in the original message before
((notmuch-show-insert-text/plain-hook nil) ;; quoting.
;; Don't omit long parts. ((notmuch-show-insert-text/plain-hook nil)
(notmuch-show-max-text-part-size 0) ;; Don't omit long parts.
;; Insert headers for parts as appropriate for replying. (notmuch-show-max-text-part-size 0)
(notmuch-show-insert-header-p-function notmuch-mua-reply-insert-header-p-function) ;; Insert headers for parts as appropriate for replying.
;; Ensure that any encrypted parts are (notmuch-show-insert-header-p-function
;; decrypted during the generation of the reply notmuch-mua-reply-insert-header-p-function)
;; text. ;; Ensure that any encrypted parts are
(notmuch-show-process-crypto process-crypto) ;; decrypted during the generation of the reply
;; Don't indent multipart sub-parts. ;; text.
(notmuch-show-indent-multipart nil)) (notmuch-show-process-crypto process-crypto)
;; We don't want sigstatus buttons (an information leak and usually wrong anyway). ;; Don't indent multipart sub-parts.
(cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore) (notmuch-show-indent-multipart nil))
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) ;; We don't want sigstatus buttons (an information leak and usually wrong anyway).
(notmuch-show-insert-body original (plist-get original :body) 0) (cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore)
(buffer-substring-no-properties (point-min) (point-max)))))) ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
(notmuch-show-insert-body original (plist-get original :body) 0)
(buffer-substring-no-properties (point-min) (point-max))))))
(set-mark (point)) (set-mark (point))
(goto-char start) (goto-char start)
@ -383,10 +389,13 @@ modified. This function is notmuch addaptation of
(unless (assq 'From other-headers) (unless (assq 'From other-headers)
(push (cons 'From (message-make-from (push (cons 'From (message-make-from
(notmuch-user-name) (notmuch-user-primary-email))) other-headers)) (notmuch-user-name)
(notmuch-user-primary-email)))
other-headers))
(notmuch-mua-pop-to-buffer (message-buffer-name "mail" to) (notmuch-mua-pop-to-buffer (message-buffer-name "mail" to)
(or switch-function (notmuch-mua-get-switch-function))) (or switch-function
(notmuch-mua-get-switch-function)))
(let ((headers (let ((headers
(append (append
;; The following is copied from `message-mail' ;; The following is copied from `message-mail'
@ -499,7 +508,8 @@ the From: address."
(with-current-buffer temp-buffer (with-current-buffer temp-buffer
(erase-buffer) (erase-buffer)
(let ((coding-system-for-read 'no-conversion)) (let ((coding-system-for-read 'no-conversion))
(call-process notmuch-command nil t nil "show" "--format=raw" id)) (call-process notmuch-command nil t nil
"show" "--format=raw" id))
;; Because we process the messages in reverse order, ;; Because we process the messages in reverse order,
;; always generate a forwarded subject, then use the ;; always generate a forwarded subject, then use the
;; last (i.e. first) one. ;; last (i.e. first) one.
@ -524,7 +534,8 @@ the From: address."
(message-add-header (concat "References: " (message-add-header (concat "References: "
(mapconcat 'identity forward-references " ")))) (mapconcat 'identity forward-references " "))))
;; Create a buffer-local queue for tag changes triggered when sending the message ;; Create a buffer-local queue for tag changes triggered when
;; sending the message.
(when notmuch-message-forwarded-tags (when notmuch-message-forwarded-tags
(setq-local notmuch-message-queued-tag-changes (setq-local notmuch-message-queued-tag-changes
(cl-loop for id in forward-queries (cl-loop for id in forward-queries
@ -609,7 +620,8 @@ unencrypted. Really send? "))))
(run-hooks 'notmuch-mua-send-hook) (run-hooks 'notmuch-mua-send-hook)
(when (and (notmuch-mua-check-no-misplaced-secure-tag) (when (and (notmuch-mua-check-no-misplaced-secure-tag)
(notmuch-mua-check-secure-tag-has-newline)) (notmuch-mua-check-secure-tag-has-newline))
(cl-letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc)) (cl-letf (((symbol-function 'message-do-fcc)
#'notmuch-maildir-message-do-fcc))
(if exit (if exit
(message-send-and-exit arg) (message-send-and-exit arg)
(message-send arg))))) (message-send arg)))))

View file

@ -51,7 +51,8 @@
(declare-function notmuch-count-attachments "notmuch" (mm-handle)) (declare-function notmuch-count-attachments "notmuch" (mm-handle))
(declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp)) (declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
(declare-function notmuch-tree "notmuch-tree" (declare-function notmuch-tree "notmuch-tree"
(&optional query query-context target buffer-name open-target unthreaded)) (&optional query query-context target buffer-name
open-target unthreaded))
(declare-function notmuch-tree-get-message-properties "notmuch-tree" nil) (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
(declare-function notmuch-unthreaded (declare-function notmuch-unthreaded
(&optional query query-context target buffer-name open-target)) (&optional query query-context target buffer-name open-target))
@ -95,10 +96,11 @@ visible for any given message."
:group 'notmuch-show :group 'notmuch-show
:group 'notmuch-hooks) :group 'notmuch-hooks)
(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines (defcustom notmuch-show-insert-text/plain-hook
notmuch-wash-tidy-citations '(notmuch-wash-wrap-long-lines
notmuch-wash-elide-blank-lines notmuch-wash-tidy-citations
notmuch-wash-excerpt-citations) notmuch-wash-elide-blank-lines
notmuch-wash-excerpt-citations)
"Functions used to improve the display of text/plain parts." "Functions used to improve the display of text/plain parts."
:type 'hook :type 'hook
:options '(notmuch-wash-convert-inline-patch-to-part :options '(notmuch-wash-convert-inline-patch-to-part
@ -348,7 +350,9 @@ operation on the contents of the current buffer."
(with-temp-buffer (with-temp-buffer
(insert all) (insert all)
(if indenting (if indenting
(indent-rigidly (point-min) (point-max) (- (* notmuch-show-indent-messages-width depth)))) (indent-rigidly (point-min)
(point-max)
(- (* notmuch-show-indent-messages-width depth))))
;; Remove the original header. ;; Remove the original header.
(goto-char (point-min)) (goto-char (point-min))
(re-search-forward "^$" (point-max) nil) (re-search-forward "^$" (point-max) nil)
@ -395,7 +399,9 @@ operation on the contents of the current buffer."
(if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t) (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(replace-match (concat "(" (replace-match (concat "("
(notmuch-tag-format-tags tags (notmuch-show-get-prop :orig-tags)) (notmuch-tag-format-tags
tags
(notmuch-show-get-prop :orig-tags))
")")))))) ")"))))))
(defun notmuch-clean-address (address) (defun notmuch-clean-address (address)
@ -481,7 +487,8 @@ message at DEPTH in the current thread."
") (" ") ("
(notmuch-tag-format-tags tags tags) (notmuch-tag-format-tags tags tags)
")\n") ")\n")
(overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) (overlay-put (make-overlay start (point))
'face 'notmuch-message-summary-face)))
(defun notmuch-show-insert-header (header header-value) (defun notmuch-show-insert-header (header header-value)
"Insert a single header." "Insert a single header."
@ -508,7 +515,8 @@ message at DEPTH in the current thread."
'face 'message-mml 'face 'message-mml
:supertype 'notmuch-button-type) :supertype 'notmuch-button-type)
(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment) (defun notmuch-show-insert-part-header (nth content-type declared-type
&optional name comment)
(let ((button) (let ((button)
(base-label (concat (when name (concat name ": ")) (base-label (concat (when name (concat name ": "))
declared-type declared-type
@ -532,8 +540,9 @@ message at DEPTH in the current thread."
(when button (when button
(let ((overlay (button-get button 'overlay)) (let ((overlay (button-get button 'overlay))
(lazy-part (button-get button :notmuch-lazy-part))) (lazy-part (button-get button :notmuch-lazy-part)))
;; We have a part to toggle if there is an overlay or if there is a lazy part. ;; We have a part to toggle if there is an overlay or if there
;; If neither is present we cannot toggle the part so we just return nil. ;; is a lazy part. If neither is present we cannot toggle the
;; part so we just return nil.
(when (or overlay lazy-part) (when (or overlay lazy-part)
(let* ((show (button-get button :notmuch-part-hidden)) (let* ((show (button-get button :notmuch-part-hidden))
(new-start (button-start button)) (new-start (button-start button))
@ -634,7 +643,8 @@ will return nil if the CID is unknown or cannot be retrieved."
(plist-get part :content))) (plist-get part :content)))
(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button) (defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)
(let ((chosen-type (car (notmuch-multipart/alternative-choose msg (notmuch-show-multipart/*-to-list part)))) (let ((chosen-type (car (notmuch-multipart/alternative-choose
msg (notmuch-show-multipart/*-to-list part))))
(inner-parts (plist-get part :content)) (inner-parts (plist-get part :content))
(start (point))) (start (point)))
;; This inserts all parts of the chosen type rather than just one, ;; This inserts all parts of the chosen type rather than just one,
@ -770,7 +780,8 @@ will return nil if the CID is unknown or cannot be retrieved."
(unwind-protect (unwind-protect
(progn (progn
(unless (icalendar-import-buffer file t) (unless (icalendar-import-buffer file t)
(error "Icalendar import error. See *icalendar-errors* for more information")) (error "Icalendar import error. %s"
"See *icalendar-errors* for more information"))
(set-buffer (get-file-buffer file)) (set-buffer (get-file-buffer file))
(setq result (buffer-substring (point-min) (point-max))) (setq result (buffer-substring (point-min) (point-max)))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
@ -788,10 +799,13 @@ will return nil if the CID is unknown or cannot be retrieved."
;; ;;
;; For newer emacs, we fall back to notmuch-show-insert-part-*/* ;; For newer emacs, we fall back to notmuch-show-insert-part-*/*
;; (see notmuch-show-handlers-for) ;; (see notmuch-show-handlers-for)
(defun notmuch-show-insert-part-text/enriched (msg part content-type nth depth button) (defun notmuch-show-insert-part-text/enriched
;; By requiring enriched below, we ensure that the function enriched-decode-display-prop (msg part content-type nth depth button)
;; is defined before it will be shadowed by the letf below. Otherwise the version ;; By requiring enriched below, we ensure that the function
;; in enriched.el may be loaded a bit later and used instead (for the first time). ;; enriched-decode-display-prop is defined before it will be
;; shadowed by the letf below. Otherwise the version in
;; enriched.el may be loaded a bit later and used instead (for
;; the first time).
(require 'enriched) (require 'enriched)
(cl-letf (((symbol-function 'enriched-decode-display-prop) (cl-letf (((symbol-function 'enriched-decode-display-prop)
(lambda (start end &optional param) (list start end)))) (lambda (start end &optional param) (list start end))))
@ -949,7 +963,9 @@ will return nil if the CID is unknown or cannot be retrieved."
(narrow-to-region part-beg part-end) (narrow-to-region part-beg part-end)
(delete-region part-beg part-end) (delete-region part-beg part-end)
(apply #'notmuch-show-insert-bodypart-internal part-args) (apply #'notmuch-show-insert-bodypart-internal part-args)
(indent-rigidly part-beg part-end (* notmuch-show-indent-messages-width depth))) (indent-rigidly part-beg
part-end
(* notmuch-show-indent-messages-width depth)))
(goto-char part-end) (goto-char part-end)
(delete-char 1) (delete-char 1)
(notmuch-show-record-part-information (cadr part-args) (notmuch-show-record-part-information (cadr part-args)
@ -1007,12 +1023,14 @@ is t, hide the part initially and show the button."
(nth (plist-get part :id)) (nth (plist-get part :id))
(long (and (notmuch-match-content-type mime-type "text/*") (long (and (notmuch-match-content-type mime-type "text/*")
(> notmuch-show-max-text-part-size 0) (> notmuch-show-max-text-part-size 0)
(> (length (plist-get part :content)) notmuch-show-max-text-part-size))) (> (length (plist-get part :content))
notmuch-show-max-text-part-size)))
(beg (point)) (beg (point))
;; This default header-p function omits the part button for ;; This default header-p function omits the part button for
;; the first (or only) part if this is text/plain. ;; the first (or only) part if this is text/plain.
(button (when (funcall notmuch-show-insert-header-p-function part hide) (button (when (funcall notmuch-show-insert-header-p-function part hide)
(notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename)))) (notmuch-show-insert-part-header nth mime-type content-type
(plist-get part :filename))))
;; Hide the part initially if HIDE is t, or if it is too long ;; Hide the part initially if HIDE is t, or if it is too long
;; and we have a button to allow toggling. ;; and we have a button to allow toggling.
(show-part (not (or (equal hide t) (show-part (not (or (equal hide t)
@ -1110,13 +1128,17 @@ is t, hide the part initially and show the button."
;; Indent according to the depth in the thread. ;; Indent according to the depth in the thread.
(if notmuch-show-indent-content (if notmuch-show-indent-content
(indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))) (indent-rigidly content-start
content-end
(* notmuch-show-indent-messages-width depth)))
(setq message-end (point-max-marker)) (setq message-end (point-max-marker))
;; Save the extents of this message over the whole text of the ;; Save the extents of this message over the whole text of the
;; message. ;; message.
(put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) (put-text-property message-start message-end
:notmuch-message-extent
(cons message-start message-end))
;; Create overlays used to control visibility ;; Create overlays used to control visibility
(plist-put msg :headers-overlay (make-overlay headers-start headers-end)) (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
@ -1150,7 +1172,8 @@ is t, hide the part initially and show the button."
(defun notmuch-show-toggle-elide-non-matching () (defun notmuch-show-toggle-elide-non-matching ()
"Toggle the display of non-matching messages." "Toggle the display of non-matching messages."
(interactive) (interactive)
(setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)) (setq notmuch-show-elide-non-matching-messages
(not notmuch-show-elide-non-matching-messages))
(message (if notmuch-show-elide-non-matching-messages (message (if notmuch-show-elide-non-matching-messages
"Showing matching messages only." "Showing matching messages only."
"Showing all messages.")) "Showing all messages."))
@ -1417,8 +1440,9 @@ This includes:
;; Open those that were open. ;; Open those that were open.
(goto-char (point-min)) (goto-char (point-min))
(cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties) (cl-loop do (notmuch-show-message-visible
(member (notmuch-show-get-message-id) open)) (notmuch-show-get-message-properties)
(member (notmuch-show-get-message-id) open))
until (not (notmuch-show-goto-message-next))) until (not (notmuch-show-goto-message-next)))
(dolist (win-msg-pair win-msg-alist) (dolist (win-msg-pair win-msg-alist)
@ -1651,7 +1675,8 @@ effects."
(defun notmuch-show-set-message-properties (props) (defun notmuch-show-set-message-properties (props)
(save-excursion (save-excursion
(notmuch-show-move-to-message-top) (notmuch-show-move-to-message-top)
(put-text-property (point) (+ (point) 1) :notmuch-message-properties props))) (put-text-property (point) (+ (point) 1)
:notmuch-message-properties props)))
(defun notmuch-show-get-message-properties () (defun notmuch-show-get-message-properties ()
"Return the properties of the current message as a plist. "Return the properties of the current message as a plist.
@ -1804,8 +1829,9 @@ user decision and we should not override it."
(setq notmuch-show--seen-has-errored 't) (setq notmuch-show--seen-has-errored 't)
(setq header-line-format (setq header-line-format
(concat header-line-format (concat header-line-format
(propertize " [some mark read tag changes may have failed]" (propertize
'face font-lock-warning-face))))))))) " [some mark read tag changes may have failed]"
'face font-lock-warning-face)))))))))
(defun notmuch-show-filter-thread (query) (defun notmuch-show-filter-thread (query)
"Filter or LIMIT the current thread based on a new query string. "Filter or LIMIT the current thread based on a new query string.
@ -1827,7 +1853,8 @@ Reshows the current thread with matches defined by the new query-string."
(goto-char (point-min)) (goto-char (point-min))
(while (not done) (while (not done)
(if (notmuch-show-message-visible-p) (if (notmuch-show-message-visible-p)
(setq message-ids (append message-ids (list (notmuch-show-get-message-id))))) (setq message-ids
(append message-ids (list (notmuch-show-get-message-id)))))
(setq done (not (notmuch-show-goto-message-next))) (setq done (not (notmuch-show-goto-message-next)))
) )
message-ids message-ids
@ -1891,7 +1918,8 @@ shown."
(notmuch-show-archive-thread-then-next))) (notmuch-show-archive-thread-then-next)))
(defun notmuch-show-rewind () (defun notmuch-show-rewind ()
"Backup through the thread (reverse scrolling compared to \\[notmuch-show-advance-and-archive]). "Backup through the thread (reverse scrolling compared to \
\\[notmuch-show-advance-and-archive]).
Specifically, if the beginning of the previous email is fewer Specifically, if the beginning of the previous email is fewer
than `window-height' lines from the current point, move to it than `window-height' lines from the current point, move to it
@ -2083,11 +2111,14 @@ message."
(setq shell-command (setq shell-command
(concat notmuch-command " show --format=mbox --exclude=false " (concat notmuch-command " show --format=mbox --exclude=false "
(shell-quote-argument (shell-quote-argument
(mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR ")) (mapconcat 'identity
(notmuch-show-get-message-ids-for-open-messages)
" OR "))
" | " command)) " | " command))
(setq shell-command (setq shell-command
(concat notmuch-command " show --format=raw " (concat notmuch-command " show --format=raw "
(shell-quote-argument (notmuch-show-get-message-id)) " | " command))) (shell-quote-argument (notmuch-show-get-message-id))
" | " command)))
(let ((cwd default-directory) (let ((cwd default-directory)
(buf (get-buffer-create (concat "*notmuch-pipe*")))) (buf (get-buffer-create (concat "*notmuch-pipe*"))))
(with-current-buffer buf (with-current-buffer buf
@ -2188,8 +2219,9 @@ argument, hide all of the messages."
(interactive) (interactive)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties) (cl-loop do (notmuch-show-message-visible
(not current-prefix-arg)) (notmuch-show-get-message-properties)
(not current-prefix-arg))
until (not (notmuch-show-goto-message-next)))) until (not (notmuch-show-goto-message-next))))
(force-window-update)) (force-window-update))
@ -2521,7 +2553,8 @@ the new buffer."
(interactive (interactive
(list (completing-read "Mime type to use (default text/plain): " (list (completing-read "Mime type to use (default text/plain): "
(mailcap-mime-types) nil nil nil nil "text/plain"))) (mailcap-mime-types) nil nil nil nil "text/plain")))
(notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part mime-type)) (notmuch-show-apply-to-current-part-handle #'notmuch-show--mm-display-part
mime-type))
(defun notmuch-show-imenu-prev-index-position-function () (defun notmuch-show-imenu-prev-index-position-function ()
"Move point to previous message in notmuch-show buffer. "Move point to previous message in notmuch-show buffer.

View file

@ -44,7 +44,9 @@
:args '((list :inline t :args '((list :inline t
:format "%v" :format "%v"
(key-sequence :tag "Key") (key-sequence :tag "Key")
(radio :tag "Tag operations" (repeat :tag "Tag list" (string :format "%v" :tag "change")) (radio :tag "Tag operations"
(repeat :tag "Tag list"
(string :format "%v" :tag "change"))
(variable :tag "Tag variable")) (variable :tag "Tag variable"))
(string :tag "Name")))) (string :tag "Name"))))
@ -316,7 +318,9 @@ changed (the normal case) are shown using formats from
`notmuch-tag-formats'." `notmuch-tag-formats'."
(let* ((tag-state (cond ((not (member tag tags)) 'deleted) (let* ((tag-state (cond ((not (member tag tags)) 'deleted)
((not (member tag orig-tags)) 'added))) ((not (member tag orig-tags)) 'added)))
(formatted-tag (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing))) (formatted-tag (gethash (cons tag tag-state)
notmuch-tag--format-cache
'missing)))
(when (eq formatted-tag 'missing) (when (eq formatted-tag 'missing)
(let ((base (notmuch-tag--get-formats tag notmuch-tag-formats)) (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))
(over (cl-case tag-state (over (cl-case tag-state
@ -338,9 +342,9 @@ changed (the normal case) are shown using formats from
(notmuch-apply-face (notmuch-apply-face
(mapconcat #'identity (mapconcat #'identity
;; nil indicated that the tag was deliberately hidden ;; nil indicated that the tag was deliberately hidden
(delq nil (mapcar (delq nil (mapcar (apply-partially #'notmuch-tag-format-tag
(apply-partially #'notmuch-tag-format-tag tags orig-tags) tags orig-tags)
all-tags)) all-tags))
" ") " ")
face face
t))) t)))

View file

@ -34,7 +34,8 @@
(require 'notmuch-tag) (require 'notmuch-tag)
(require 'notmuch-parser) (require 'notmuch-parser)
(declare-function notmuch-search "notmuch" (&optional query oldest-first target-thread target-line)) (declare-function notmuch-search "notmuch"
(&optional query oldest-first target-thread target-line))
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-read-query "notmuch" (prompt)) (declare-function notmuch-read-query "notmuch" (prompt))
(declare-function notmuch-search-find-thread-id "notmuch" (&optional bare)) (declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
@ -284,15 +285,18 @@ FUNC."
(set-keymap-parent map notmuch-common-keymap) (set-keymap-parent map notmuch-common-keymap)
;; The following override the global keymap. ;; The following override the global keymap.
;; Override because we want to close message pane first. ;; Override because we want to close message pane first.
(define-key map [remap notmuch-help] (notmuch-tree-close-message-pane-and #'notmuch-help)) (define-key map [remap notmuch-help]
(notmuch-tree-close-message-pane-and #'notmuch-help))
;; Override because we first close message pane and then close tree buffer. ;; Override because we first close message pane and then close tree buffer.
(define-key map [remap notmuch-bury-or-kill-this-buffer] 'notmuch-tree-quit) (define-key map [remap notmuch-bury-or-kill-this-buffer] 'notmuch-tree-quit)
;; Override because we close message pane after the search query is entered. ;; Override because we close message pane after the search query is entered.
(define-key map [remap notmuch-search] 'notmuch-tree-to-search) (define-key map [remap notmuch-search] 'notmuch-tree-to-search)
;; Override because we want to close message pane first. ;; Override because we want to close message pane first.
(define-key map [remap notmuch-mua-new-mail] (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail)) (define-key map [remap notmuch-mua-new-mail]
(notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
;; Override because we want to close message pane first. ;; Override because we want to close message pane first.
(define-key map [remap notmuch-jump-search] (notmuch-tree-close-message-pane-and #'notmuch-jump-search)) (define-key map [remap notmuch-jump-search]
(notmuch-tree-close-message-pane-and #'notmuch-jump-search))
(define-key map "S" 'notmuch-search-from-tree-current-query) (define-key map "S" 'notmuch-search-from-tree-current-query)
(define-key map "U" 'notmuch-unthreaded-from-tree-current-query) (define-key map "U" 'notmuch-unthreaded-from-tree-current-query)
@ -306,16 +310,24 @@ FUNC."
(define-key map "b" 'notmuch-show-resend-message) (define-key map "b" 'notmuch-show-resend-message)
;; these apply to the message pane ;; these apply to the message pane
(define-key map (kbd "M-TAB") (notmuch-tree-to-message-pane #'notmuch-show-previous-button)) (define-key map (kbd "M-TAB")
(define-key map (kbd "<backtab>") (notmuch-tree-to-message-pane #'notmuch-show-previous-button)) (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
(define-key map (kbd "TAB") (notmuch-tree-to-message-pane #'notmuch-show-next-button)) (define-key map (kbd "<backtab>")
(define-key map "$" (notmuch-tree-to-message-pane #'notmuch-show-toggle-process-crypto)) (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
(define-key map (kbd "TAB")
(notmuch-tree-to-message-pane #'notmuch-show-next-button))
(define-key map "$"
(notmuch-tree-to-message-pane #'notmuch-show-toggle-process-crypto))
;; bindings from show (or elsewhere) but we close the message pane first. ;; bindings from show (or elsewhere) but we close the message pane first.
(define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message)) (define-key map "f"
(define-key map "r" (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender)) (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
(define-key map "R" (notmuch-tree-close-message-pane-and #'notmuch-show-reply)) (define-key map "r"
(define-key map "V" (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message)) (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
(define-key map "R"
(notmuch-tree-close-message-pane-and #'notmuch-show-reply))
(define-key map "V"
(notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
;; The main tree view bindings ;; The main tree view bindings
(define-key map (kbd "RET") 'notmuch-tree-show-message) (define-key map (kbd "RET") 'notmuch-tree-show-message)
@ -354,7 +366,9 @@ Some useful entries are:
(defun notmuch-tree-set-message-properties (props) (defun notmuch-tree-set-message-properties (props)
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(put-text-property (point) (+ (point) 1) :notmuch-message-properties props))) (put-text-property (point)
(+ (point) 1)
:notmuch-message-properties props)))
(defun notmuch-tree-set-prop (prop val &optional props) (defun notmuch-tree-set-prop (prop val &optional props)
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
@ -407,7 +421,8 @@ updated."
;; from overwriting the buffer local copy of ;; from overwriting the buffer local copy of
;; notmuch-tree-previous-subject if this is called while the ;; notmuch-tree-previous-subject if this is called while the
;; buffer is displaying. ;; buffer is displaying.
(let ((notmuch-tree-previous-subject (notmuch-tree-get-prop :previous-subject))) (let ((notmuch-tree-previous-subject
(notmuch-tree-get-prop :previous-subject)))
(delete-region (point) (1+ (line-end-position))) (delete-region (point) (1+ (line-end-position)))
(notmuch-tree-insert-msg msg)) (notmuch-tree-insert-msg msg))
(let ((new-end (line-end-position))) (let ((new-end (line-end-position)))
@ -596,7 +611,8 @@ Shows in split pane or whole window according to value of
"Close the message-window. Return t if close succeeds." "Close the message-window. Return t if close succeeds."
(interactive) (interactive)
(when (and (window-live-p notmuch-tree-message-window) (when (and (window-live-p notmuch-tree-message-window)
(eq (window-buffer notmuch-tree-message-window) notmuch-tree-message-buffer)) (eq (window-buffer notmuch-tree-message-window)
notmuch-tree-message-buffer))
(delete-window notmuch-tree-message-window) (delete-window notmuch-tree-message-window)
(unless (get-buffer-window-list notmuch-tree-message-buffer) (unless (get-buffer-window-list notmuch-tree-message-buffer)
(kill-buffer notmuch-tree-message-buffer)) (kill-buffer notmuch-tree-message-buffer))
@ -611,7 +627,8 @@ message will be \"unarchived\", i.e. the tag changes in
`notmuch-archive-tags' will be reversed." `notmuch-archive-tags' will be reversed."
(interactive "P") (interactive "P")
(when notmuch-archive-tags (when notmuch-archive-tags
(notmuch-tree-tag (notmuch-tag-change-list notmuch-archive-tags unarchive)))) (notmuch-tree-tag
(notmuch-tag-change-list notmuch-archive-tags unarchive))))
(defun notmuch-tree-archive-message-then-next (&optional unarchive) (defun notmuch-tree-archive-message-then-next (&optional unarchive)
"Archive the current message and move to next matching message." "Archive the current message and move to next matching message."
@ -786,7 +803,8 @@ unchanged ADDRESS if parsing fails."
(let ((face (if match (let ((face (if match
'notmuch-tree-match-date-face 'notmuch-tree-match-date-face
'notmuch-tree-no-match-date-face))) 'notmuch-tree-no-match-date-face)))
(propertize (format format-string (plist-get msg :date_relative)) 'face face))) (propertize (format format-string (plist-get msg :date_relative))
'face face)))
((string-equal field "tree") ((string-equal field "tree")
(let ((tree-status (plist-get msg :tree-status)) (let ((tree-status (plist-get msg :tree-status))
@ -880,7 +898,8 @@ message together with all its descendents."
((and (< 0 depth) last) ((and (< 0 depth) last)
(push "" tree-status)) (push "" tree-status))
((and (eq 0 depth) first last) ((and (eq 0 depth) first last)
;; (push "─" tree-status)) choice between this and next line is matter of taste. ;; Choice between these two variants is a matter of taste.
;; (push "─" tree-status))
(push " " tree-status)) (push " " tree-status))
((and (eq 0 depth) first (not last)) ((and (eq 0 depth) first (not last))
(push "" tree-status)) (push "" tree-status))

View file

@ -25,7 +25,9 @@
(require 'coolj) (require 'coolj)
(require 'notmuch-lib) (require 'notmuch-lib)
(declare-function notmuch-show-insert-bodypart "notmuch-show" (msg part depth &optional hide))
(declare-function notmuch-show-insert-bodypart "notmuch-show"
(msg part depth &optional hide))
(defvar notmuch-show-indent-messages-width) (defvar notmuch-show-indent-messages-width)
;; ;;
@ -186,9 +188,12 @@ message parts."
(let* ((type (overlay-get overlay 'type)) (let* ((type (overlay-get overlay 'type))
(invis-spec (overlay-get overlay 'invisible)) (invis-spec (overlay-get overlay 'invisible))
(state (if (invisible-p invis-spec) "hidden" "visible")) (state (if (invisible-p invis-spec) "hidden" "visible"))
(label-format (symbol-value (intern-soft (concat "notmuch-wash-button-" (label-format (symbol-value
type "-" state "-format")))) (intern-soft
(lines-count (count-lines (overlay-start overlay) (overlay-end overlay)))) (format "notmuch-wash-button-%s-%s-format"
type state))))
(lines-count (count-lines (overlay-start overlay)
(overlay-end overlay))))
(format label-format lines-count))) (format label-format lines-count)))
(defun notmuch-wash-region-to-button (msg beg end type &optional prefix) (defun notmuch-wash-region-to-button (msg beg end type &optional prefix)
@ -238,7 +243,8 @@ that PREFIX should not include a newline."
(let* ((cite-start (match-beginning 0)) (let* ((cite-start (match-beginning 0))
(cite-end (match-end 0)) (cite-end (match-end 0))
(cite-lines (count-lines cite-start cite-end))) (cite-lines (count-lines cite-start cite-end)))
(overlay-put (make-overlay cite-start cite-end) 'face 'notmuch-wash-cited-text) (overlay-put (make-overlay cite-start cite-end)
'face 'notmuch-wash-cited-text)
(when (> cite-lines (+ notmuch-wash-citation-lines-prefix (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
notmuch-wash-citation-lines-suffix notmuch-wash-citation-lines-suffix
1)) 1))
@ -260,7 +266,8 @@ that PREFIX should not include a newline."
(sig-end-marker (make-marker))) (sig-end-marker (make-marker)))
(set-marker sig-start-marker sig-start) (set-marker sig-start-marker sig-start)
(set-marker sig-end-marker (point-max)) (set-marker sig-end-marker (point-max))
(overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text) (overlay-put (make-overlay sig-start-marker sig-end-marker)
'face 'message-cited-text)
(notmuch-wash-region-to-button (notmuch-wash-region-to-button
msg sig-start-marker sig-end-marker msg sig-start-marker sig-end-marker
"signature")))))) "signature"))))))

View file

@ -516,7 +516,9 @@ thread."
(current-buffer) (current-buffer)
notmuch-search-query-string notmuch-search-query-string
;; Name the buffer based on the subject. ;; Name the buffer based on the subject.
(concat "*" (truncate-string-to-width subject 30 nil nil t) "*")) (concat "*"
(truncate-string-to-width subject 30 nil nil t)
"*"))
(message "End of search results.")))) (message "End of search results."))))
(defun notmuch-tree-from-search-current-query () (defun notmuch-tree-from-search-current-query ()
@ -800,7 +802,9 @@ non-authors is found, assume that all of the authors match."
;; If there is any invisible text, add it as a tooltip to the ;; If there is any invisible text, add it as a tooltip to the
;; visible text. ;; visible text.
(when (not (string= invisible-string "")) (when (not (string= invisible-string ""))
(setq visible-string (propertize visible-string 'help-echo (concat "..." invisible-string)))) (setq visible-string
(propertize visible-string
'help-echo (concat "..." invisible-string))))
;; Insert the visible and, if present, invisible author strings. ;; Insert the visible and, if present, invisible author strings.
(insert visible-string) (insert visible-string)
@ -892,7 +896,8 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(longest-length 0)) (longest-length 0))
(cl-loop for tuple in notmuch-saved-searches (cl-loop for tuple in notmuch-saved-searches
if (let ((quoted-query if (let ((quoted-query
(regexp-quote (notmuch-saved-search-get tuple :query)))) (regexp-quote
(notmuch-saved-search-get tuple :query))))
(and (string-match (concat "^" quoted-query) query) (and (string-match (concat "^" quoted-query) query)
(> (length (match-string 0 query)) (> (length (match-string 0 query))
longest-length))) longest-length)))
@ -905,9 +910,10 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(concat "*notmuch-saved-search-" saved-search-name "*")) (concat "*notmuch-saved-search-" saved-search-name "*"))
(saved-search (saved-search
(concat "*notmuch-search-" (concat "*notmuch-search-"
(replace-regexp-in-string (concat "^" (regexp-quote saved-search-query)) (replace-regexp-in-string
(concat "[ " saved-search-name " ]") (concat "^" (regexp-quote saved-search-query))
query) (concat "[ " saved-search-name " ]")
query)
"*")) "*"))
(t (t
(concat "*notmuch-search-" query "*")) (concat "*notmuch-search-" query "*"))
@ -926,7 +932,8 @@ PROMPT is the string to prompt with."
"subject:" "attachment:") "subject:" "attachment:")
(mapcar (lambda (tag) (concat "tag:" tag)) all-tags) (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
(mapcar (lambda (tag) (concat "is:" tag)) all-tags) (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
(mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types))))) (mapcar (lambda (mimetype) (concat "mimetype:" mimetype))
(mailcap-mime-types)))))
(let ((keymap (copy-keymap minibuffer-local-map)) (let ((keymap (copy-keymap minibuffer-local-map))
(current-query (cl-case major-mode (current-query (cl-case major-mode
(notmuch-search-mode (notmuch-search-get-query)) (notmuch-search-mode (notmuch-search-get-query))
@ -1078,8 +1085,10 @@ current search results AND the additional query string provided."
Runs a new search matching only messages that match both the Runs a new search matching only messages that match both the
current search results AND that are tagged with the given tag." current search results AND that are tagged with the given tag."
(interactive (interactive
(list (notmuch-select-tag-with-completion "Filter by tag: " notmuch-search-query-string))) (list (notmuch-select-tag-with-completion "Filter by tag: "
(notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first)) notmuch-search-query-string)))
(notmuch-search (concat notmuch-search-query-string " and tag:" tag)
notmuch-search-oldest-first))
(defun notmuch-search-by-tag (tag) (defun notmuch-search-by-tag (tag)
"Display threads matching TAG in a notmuch-search buffer." "Display threads matching TAG in a notmuch-search buffer."

View file

@ -63,7 +63,8 @@
(defun rstdoc--insert-docstring (symbol docstring) (defun rstdoc--insert-docstring (symbol docstring)
(insert (format "\n.. |docstring::%s| replace::\n" symbol)) (insert (format "\n.. |docstring::%s| replace::\n" symbol))
(insert (replace-regexp-in-string "^" " " (rstdoc--rst-quote-string docstring))) (insert (replace-regexp-in-string "^" " "
(rstdoc--rst-quote-string docstring)))
(insert "\n")) (insert "\n"))
(defvar rst--escape-alist (defvar rst--escape-alist