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 -*-
;; 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>
;; Alex Schroeder <alex@gnu.org>

View file

@ -195,10 +195,11 @@ external commands."
((eq notmuch-address-command 'internal)
(unless (notmuch-address--harvest-ready)
;; First, run quick synchronous harvest based on what the user
;; entered so far
;; entered so far.
(notmuch-address-harvest original t))
(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)))
(t
(process-lines notmuch-address-command original))))
@ -241,7 +242,8 @@ external commands."
(push chosen notmuch-address-history)
(delete-region beg end)
(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.")
(ding))))
(t nil)))
@ -393,7 +395,8 @@ to be a saved address hash."
;; The file exists, check it is a file we saved
(notmuch-address--get-address-hash))
(with-temp-file notmuch-address-save-filename
(let ((save-plist (list :version notmuch-address--save-hash-version
(let ((save-plist
(list :version notmuch-address--save-hash-version
:completion-settings notmuch-address-internal-completion
:last-harvest notmuch-address-last-harvest
:completions notmuch-address-completions)))
@ -408,7 +411,8 @@ appear to be an address savefile. Not overwriting."
(let ((now (float-time)))
(when (> (- now notmuch-address-last-harvest) 86400)
(setq notmuch-address-last-harvest now)
(notmuch-address-harvest nil nil
(notmuch-address-harvest
nil nil
(lambda (proc event)
;; If harvest fails, we want to try
;; again when the trigger is next

View file

@ -69,9 +69,11 @@
(cl-case command
(interactive (company-begin-backend 'notmuch-company))
(prefix (and (derived-mode-p 'message-mode)
(looking-back (concat notmuch-address-completion-headers-regexp ".*")
(looking-back
(concat notmuch-address-completion-headers-regexp ".*")
(line-beginning-position))
(setq notmuch-company-last-prefix (company-grab "[:,][ \t]*\\(.*\\)" 1 (point-at-bol)))))
(setq notmuch-company-last-prefix
(company-grab "[:,][ \t]*\\(.*\\)" 1 (point-at-bol)))))
(candidates (cond
((notmuch-address--harvest-ready)
;; Update harvested addressed from time to time
@ -80,17 +82,20 @@
(t
(cons :async
(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
arg nil
(lambda (_proc _event)
(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))))))))
(match (if (string-match notmuch-company-last-prefix arg)
(match-end 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))))

View file

@ -161,7 +161,8 @@ by user FROM."
(goto-char (point-max))
(insert (format "-- Key %s in message %s:\n"
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))))
(declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state))
@ -220,7 +221,8 @@ corresponding key when the status button is pressed."
(with-current-buffer buffer
(goto-char (point-max))
(insert (format "--- Retrieving key %s:\n" keyid)))
(let ((p (make-process :name "notmuch GPG key retrieval"
(let ((p (make-process
:name "notmuch GPG key retrieval"
:connection-type 'pipe
:buffer buffer
:stderr buffer

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."
(cl-case notmuch-draft-save-plaintext
((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.
Really save and index an unencrypted copy? ")
(error "Save aborted")))
((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)
(ignore))))
@ -192,14 +194,16 @@ applied to newly inserted messages)."
(message-remove-header "Message-ID")
(message-add-header (concat "Message-ID: <" id ">")))
(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)))
(cond
((member 'Date message-deletable-headers)
(message-remove-header "Date")
(message-add-header (concat "Date: " (message-make-date))))
(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")
(notmuch-draft-quote-some-mml)
(notmuch-maildir-setup-message-for-saving)

View file

@ -29,7 +29,8 @@
(require 'notmuch-lib)
(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-tree "notmuch-tree"
(&optional query query-context target buffer-name open-target unthreaded))
@ -91,18 +92,28 @@ searches so they still work in customize."
:tag "Saved Search"
:args '((list :inline t
:format "%v"
(group :format "%v" :inline t (const :format " Name: " :name) (string :format "%v"))
(group :format "%v" :inline t (const :format " Query: " :query) (string :format "%v")))
(group :format "%v" :inline t
(const :format " Name: " :name)
(string :format "%v"))
(group :format "%v" :inline t
(const :format " Query: " :query)
(string :format "%v")))
(checklist :inline t
:format "%v"
(group :format "%v" :inline t (const :format "Shortcut key: " :key) (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)
(group :format "%v" :inline t
(const :format "Shortcut key: " :key)
(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"
(const :tag "Default" nil)
(const :tag "Oldest-first" oldest-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"
(const :tag "Search mode" nil)
(const :tag "Tree mode" tree)
@ -474,7 +485,8 @@ should be. Returns a cons cell `(tags-per-line width)'."
((floatp notmuch-column-control)
(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)))
(t
@ -536,7 +548,8 @@ options will be handled as specified for
(unless (= (call-process-region (point-min) (point-max) notmuch-command
t t nil "count" "--batch") 0)
(notmuch-logged-error "notmuch count --batch failed"
(notmuch-logged-error
"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
the CLI and emacs interface."))
@ -553,7 +566,8 @@ the CLI and emacs interface."))
search-query (plist-get options :filter)))
(message-count (prog1 (read (current-buffer))
(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))
(plist-put elem-plist :count message-count))))
query-list))))
@ -740,7 +754,9 @@ Complete list of currently available key bindings:
;; dark background.
(setq image (cons 'image
(append (cdr image)
(list :background (face-background 'notmuch-hello-logo-background)))))
(list :background
(face-background
'notmuch-hello-logo-background)))))
(insert-image image))
(widget-insert " "))
@ -760,7 +776,8 @@ Complete list of currently available key bindings:
(notmuch-hello-update))
:help-echo "Refresh"
(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")))

View file

@ -70,7 +70,8 @@ fast way to jump to a saved search from anywhere in Notmuch."
(if action-map
(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)
@ -200,7 +201,9 @@ buffer."
(define-key map keystr
`(lambda () (interactive)
(setq notmuch-jump--action
',(apply-partially #'notmuch-jump action-submap new-prompt))
',(apply-partially #'notmuch-jump
action-submap
new-prompt))
(exit-minibuffer)))))))
map))

View file

@ -316,8 +316,10 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
tail)))
;; Documentation for command
(push (cons key-string
(or (and (symbolp binding) (get binding 'notmuch-doc))
(and (functionp binding) (notmuch-documentation-first-line binding))))
(or (and (symbolp binding)
(get binding 'notmuch-doc))
(and (functionp binding)
(notmuch-documentation-first-line binding))))
tail)))
tail)
@ -327,11 +329,11 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
;; binding whose "key" is 'remap, and whose "binding" is itself a
;; keymap that maps not from keys to commands, but from old (remapped)
;; functions to the commands to use in their stead.
(map-keymap
(lambda (command binding)
(mapc
(lambda (actual-key)
(setq tail (notmuch-describe-key actual-key binding prefix ua-keys tail)))
(map-keymap (lambda (command binding)
(mapc (lambda (actual-key)
(setq tail
(notmuch-describe-key actual-key binding
prefix ua-keys tail)))
(where-is-internal command base-keymap)))
remap-keymap)
tail)
@ -356,9 +358,13 @@ prefix argument. PREFIX and TAIL are used internally."
(notmuch-describe-remaps
binding ua-keys base-keymap prefix tail)
(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
(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)
tail)
@ -368,11 +374,15 @@ prefix argument. PREFIX and TAIL are used internally."
(while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
(let ((desc
(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)))
(ua-keys (where-is-internal 'universal-argument keymap t))
(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")))))
(setq doc (replace-match desc 1 1 doc)))
(setq beg (match-end 0)))
@ -391,7 +401,8 @@ its prefixed behavior by setting the 'notmuch-prefix-doc property
of its command symbol."
(interactive)
(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*")
(insert doc)
(goto-char (point-min))
@ -411,8 +422,10 @@ of its command symbol."
(let* ((subkeymap (key-binding prefix))
(ua-keys (where-is-internal 'universal-argument nil t))
(prefix-string (notmuch-prefix-key-description prefix))
(desc-alist (notmuch-describe-keymap subkeymap ua-keys subkeymap prefix-string))
(desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist))
(desc-alist (notmuch-describe-keymap
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")))
(with-help-window (help-buffer)
(with-current-buffer standard-output
@ -547,7 +560,8 @@ This replaces spaces, percents, and double quotes in STR with
'(
;; Avoid HTML parts.
"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"
))
@ -602,7 +616,8 @@ the given type."
,(notmuch-id-to-query (plist-get msg :id))))
(coding-system-for-read
(if binaryp 'no-conversion
(let ((coding-system (mm-charset-to-coding-system
(let ((coding-system
(mm-charset-to-coding-system
(plist-get part :content-charset))))
;; Sadly,
;; `mm-charset-to-coding-system' seems
@ -615,7 +630,8 @@ the given type."
;; charset is US-ASCII. RFC6657
;; complicates this somewhat.
'us-ascii)))))
(apply #'call-process notmuch-command nil '(t nil) nil args)
(apply #'call-process
notmuch-command nil '(t nil) nil args)
(buffer-string))))))
(when (and cache data)
(plist-put part plist-elem data))
@ -670,7 +686,8 @@ current buffer, if possible."
(let* ((have-content (plist-member part :content))
(charset (if have-content 'gnus-decoded
(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
;; test whether we are able to inline it (which includes both
;; capability and suitability tests).
@ -786,7 +803,8 @@ provided, it is taken from `process-command'."
((exit) (process-exit-status proc))
((signal) msg))))
(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))))
(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.
(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? "
subdir)))
(y-or-n-p
(format "Fcc header %s is an absolute path and notmuch insert is requested.
Insert header anyway? " subdir)))
(message-add-header (concat "Fcc: " 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
;; how to deal with it.
(error
(let ((response (notmuch-read-char-choice
"Insert failed: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? "
'(?r ?c ?i ?e))))
(let ((response (notmuch-read-char-choice "Insert failed: \
\(r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " '(?r ?c ?i ?e))))
(cl-case response
(?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header))
(?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)
;; The fcc-header is not a valid maildir see if the user wants to
;; 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? "
fcc-header))
(let* ((prompt (format "Fcc %s is not a maildir: \
\(r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " fcc-header))
(response (notmuch-read-char-choice prompt '(?r ?c ?i ?e))))
(cl-case response
(?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.")
(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)
(notmuch-tag (car query-and-tags)
(cdr query-and-tags))))

View file

@ -205,9 +205,11 @@ Typically this is added to `notmuch-mua-send-hook'."
(defun notmuch-mua-reply-crypto (parts)
"Add mml sign-encrypt flag if any part of original message is encrypted."
(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)
"multipart/encrypted")
do (mml-secure-message-sign-encrypt)
else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*")
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
@ -250,8 +252,9 @@ Typically this is added to `notmuch-mua-send-hook'."
;; the original message.
((same-window-regexps '("\\*mail .*")))
;; We modify message-header-format-alist to get around a bug in message.el.
;; See the comment above on notmuch-mua-insert-references.
;; We modify message-header-format-alist to get around
;; a bug in message.el. See the comment above on
;; notmuch-mua-insert-references.
(let ((message-header-format-alist
(cl-loop for pair in message-header-format-alist
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)
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
(setq-local notmuch-message-queued-tag-changes
(list (cons query-string notmuch-message-replied-tags))))
@ -293,7 +297,8 @@ Typically this is added to `notmuch-mua-send-hook'."
(insert "From: " from "\n")
(insert "Date: " date "\n\n")
(insert (with-temp-buffer
(insert
(with-temp-buffer
(let
;; Don't attempt to clean up messages, excerpt
;; citations, etc. in the original message before
@ -302,7 +307,8 @@ Typically this is added to `notmuch-mua-send-hook'."
;; Don't omit long parts.
(notmuch-show-max-text-part-size 0)
;; Insert headers for parts as appropriate for replying.
(notmuch-show-insert-header-p-function notmuch-mua-reply-insert-header-p-function)
(notmuch-show-insert-header-p-function
notmuch-mua-reply-insert-header-p-function)
;; Ensure that any encrypted parts are
;; decrypted during the generation of the reply
;; text.
@ -383,10 +389,13 @@ modified. This function is notmuch addaptation of
(unless (assq 'From other-headers)
(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)
(or switch-function (notmuch-mua-get-switch-function)))
(or switch-function
(notmuch-mua-get-switch-function)))
(let ((headers
(append
;; The following is copied from `message-mail'
@ -499,7 +508,8 @@ the From: address."
(with-current-buffer temp-buffer
(erase-buffer)
(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,
;; always generate a forwarded subject, then use the
;; last (i.e. first) one.
@ -524,7 +534,8 @@ the From: address."
(message-add-header (concat "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
(setq-local notmuch-message-queued-tag-changes
(cl-loop for id in forward-queries
@ -609,7 +620,8 @@ unencrypted. Really send? "))))
(run-hooks 'notmuch-mua-send-hook)
(when (and (notmuch-mua-check-no-misplaced-secure-tag)
(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
(message-send-and-exit arg)
(message-send arg)))))

View file

@ -51,7 +51,8 @@
(declare-function notmuch-count-attachments "notmuch" (mm-handle))
(declare-function notmuch-save-attachments "notmuch" (mm-handle &optional queryp))
(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-unthreaded
(&optional query query-context target buffer-name open-target))
@ -95,7 +96,8 @@ visible for any given message."
:group 'notmuch-show
:group 'notmuch-hooks)
(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
(defcustom notmuch-show-insert-text/plain-hook
'(notmuch-wash-wrap-long-lines
notmuch-wash-tidy-citations
notmuch-wash-elide-blank-lines
notmuch-wash-excerpt-citations)
@ -348,7 +350,9 @@ operation on the contents of the current buffer."
(with-temp-buffer
(insert all)
(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.
(goto-char (point-min))
(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)
(let ((inhibit-read-only t))
(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)
@ -481,7 +487,8 @@ message at DEPTH in the current thread."
") ("
(notmuch-tag-format-tags tags tags)
")\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)
"Insert a single header."
@ -508,7 +515,8 @@ message at DEPTH in the current thread."
'face 'message-mml
: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)
(base-label (concat (when name (concat name ": "))
declared-type
@ -532,8 +540,9 @@ message at DEPTH in the current thread."
(when button
(let ((overlay (button-get button 'overlay))
(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.
;; If neither is present we cannot toggle the part so we just return nil.
;; We have a part to toggle if there is an overlay or if there
;; is a lazy part. If neither is present we cannot toggle the
;; part so we just return nil.
(when (or overlay lazy-part)
(let* ((show (button-get button :notmuch-part-hidden))
(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)))
(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))
(start (point)))
;; 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
(progn
(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))
(setq result (buffer-substring (point-min) (point-max)))
(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-*/*
;; (see notmuch-show-handlers-for)
(defun notmuch-show-insert-part-text/enriched (msg part content-type nth depth button)
;; By requiring enriched below, we ensure that the function 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).
(defun notmuch-show-insert-part-text/enriched
(msg part content-type nth depth button)
;; By requiring enriched below, we ensure that the function
;; 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)
(cl-letf (((symbol-function 'enriched-decode-display-prop)
(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)
(delete-region part-beg part-end)
(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)
(delete-char 1)
(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))
(long (and (notmuch-match-content-type mime-type "text/*")
(> 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))
;; This default header-p function omits the part button for
;; the first (or only) part if this is text/plain.
(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
;; and we have a button to allow toggling.
(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.
(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))
;; Save the extents of this message over the whole text of the
;; 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
(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 ()
"Toggle the display of non-matching messages."
(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
"Showing matching messages only."
"Showing all messages."))
@ -1417,7 +1440,8 @@ This includes:
;; Open those that were open.
(goto-char (point-min))
(cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
(cl-loop do (notmuch-show-message-visible
(notmuch-show-get-message-properties)
(member (notmuch-show-get-message-id) open))
until (not (notmuch-show-goto-message-next)))
@ -1651,7 +1675,8 @@ effects."
(defun notmuch-show-set-message-properties (props)
(save-excursion
(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 ()
"Return the properties of the current message as a plist.
@ -1804,7 +1829,8 @@ user decision and we should not override it."
(setq notmuch-show--seen-has-errored 't)
(setq header-line-format
(concat header-line-format
(propertize " [some mark read tag changes may have failed]"
(propertize
" [some mark read tag changes may have failed]"
'face font-lock-warning-face)))))))))
(defun notmuch-show-filter-thread (query)
@ -1827,7 +1853,8 @@ Reshows the current thread with matches defined by the new query-string."
(goto-char (point-min))
(while (not done)
(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)))
)
message-ids
@ -1891,7 +1918,8 @@ shown."
(notmuch-show-archive-thread-then-next)))
(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
than `window-height' lines from the current point, move to it
@ -2083,11 +2111,14 @@ message."
(setq shell-command
(concat notmuch-command " show --format=mbox --exclude=false "
(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))
(setq shell-command
(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)
(buf (get-buffer-create (concat "*notmuch-pipe*"))))
(with-current-buffer buf
@ -2188,7 +2219,8 @@ argument, hide all of the messages."
(interactive)
(save-excursion
(goto-char (point-min))
(cl-loop do (notmuch-show-message-visible (notmuch-show-get-message-properties)
(cl-loop do (notmuch-show-message-visible
(notmuch-show-get-message-properties)
(not current-prefix-arg))
until (not (notmuch-show-goto-message-next))))
(force-window-update))
@ -2521,7 +2553,8 @@ the new buffer."
(interactive
(list (completing-read "Mime type to use (default 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 ()
"Move point to previous message in notmuch-show buffer.

View file

@ -44,7 +44,9 @@
:args '((list :inline t
:format "%v"
(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"))
(string :tag "Name"))))
@ -316,7 +318,9 @@ changed (the normal case) are shown using formats from
`notmuch-tag-formats'."
(let* ((tag-state (cond ((not (member tag tags)) 'deleted)
((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)
(let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))
(over (cl-case tag-state
@ -338,8 +342,8 @@ changed (the normal case) are shown using formats from
(notmuch-apply-face
(mapconcat #'identity
;; nil indicated that the tag was deliberately hidden
(delq nil (mapcar
(apply-partially #'notmuch-tag-format-tag tags orig-tags)
(delq nil (mapcar (apply-partially #'notmuch-tag-format-tag
tags orig-tags)
all-tags))
" ")
face

View file

@ -34,7 +34,8 @@
(require 'notmuch-tag)
(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-read-query "notmuch" (prompt))
(declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
@ -284,15 +285,18 @@ FUNC."
(set-keymap-parent map notmuch-common-keymap)
;; The following override the global keymap.
;; 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.
(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.
(define-key map [remap notmuch-search] 'notmuch-tree-to-search)
;; 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.
(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 "U" 'notmuch-unthreaded-from-tree-current-query)
@ -306,16 +310,24 @@ FUNC."
(define-key map "b" 'notmuch-show-resend-message)
;; 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 "<backtab>") (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))
(define-key map (kbd "M-TAB")
(notmuch-tree-to-message-pane #'notmuch-show-previous-button))
(define-key map (kbd "<backtab>")
(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.
(define-key map "f" (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
(define-key map "r" (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))
(define-key map "f"
(notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
(define-key map "r"
(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
(define-key map (kbd "RET") 'notmuch-tree-show-message)
@ -354,7 +366,9 @@ Some useful entries are:
(defun notmuch-tree-set-message-properties (props)
(save-excursion
(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)
(let ((inhibit-read-only t)
@ -407,7 +421,8 @@ updated."
;; from overwriting the buffer local copy of
;; notmuch-tree-previous-subject if this is called while the
;; 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)))
(notmuch-tree-insert-msg msg))
(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."
(interactive)
(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)
(unless (get-buffer-window-list 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."
(interactive "P")
(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)
"Archive the current message and move to next matching message."
@ -786,7 +803,8 @@ unchanged ADDRESS if parsing fails."
(let ((face (if match
'notmuch-tree-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")
(let ((tree-status (plist-get msg :tree-status))
@ -880,7 +898,8 @@ message together with all its descendents."
((and (< 0 depth) last)
(push "" tree-status))
((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))
((and (eq 0 depth) first (not last))
(push "" tree-status))

View file

@ -25,7 +25,9 @@
(require 'coolj)
(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)
;;
@ -186,9 +188,12 @@ message parts."
(let* ((type (overlay-get overlay 'type))
(invis-spec (overlay-get overlay 'invisible))
(state (if (invisible-p invis-spec) "hidden" "visible"))
(label-format (symbol-value (intern-soft (concat "notmuch-wash-button-"
type "-" state "-format"))))
(lines-count (count-lines (overlay-start overlay) (overlay-end overlay))))
(label-format (symbol-value
(intern-soft
(format "notmuch-wash-button-%s-%s-format"
type state))))
(lines-count (count-lines (overlay-start overlay)
(overlay-end overlay))))
(format label-format lines-count)))
(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))
(cite-end (match-end 0))
(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
notmuch-wash-citation-lines-suffix
1))
@ -260,7 +266,8 @@ that PREFIX should not include a newline."
(sig-end-marker (make-marker)))
(set-marker sig-start-marker sig-start)
(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
msg sig-start-marker sig-end-marker
"signature"))))))

View file

@ -516,7 +516,9 @@ thread."
(current-buffer)
notmuch-search-query-string
;; 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."))))
(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
;; visible text.
(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 visible-string)
@ -892,7 +896,8 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(longest-length 0))
(cl-loop for tuple in notmuch-saved-searches
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)
(> (length (match-string 0 query))
longest-length)))
@ -905,7 +910,8 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(concat "*notmuch-saved-search-" saved-search-name "*"))
(saved-search
(concat "*notmuch-search-"
(replace-regexp-in-string (concat "^" (regexp-quote saved-search-query))
(replace-regexp-in-string
(concat "^" (regexp-quote saved-search-query))
(concat "[ " saved-search-name " ]")
query)
"*"))
@ -926,7 +932,8 @@ PROMPT is the string to prompt with."
"subject:" "attachment:")
(mapcar (lambda (tag) (concat "tag:" 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))
(current-query (cl-case major-mode
(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
current search results AND that are tagged with the given tag."
(interactive
(list (notmuch-select-tag-with-completion "Filter by tag: " notmuch-search-query-string)))
(notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
(list (notmuch-select-tag-with-completion "Filter by tag: "
notmuch-search-query-string)))
(notmuch-search (concat notmuch-search-query-string " and tag:" tag)
notmuch-search-oldest-first))
(defun notmuch-search-by-tag (tag)
"Display threads matching TAG in a notmuch-search buffer."

View file

@ -63,7 +63,8 @@
(defun rstdoc--insert-docstring (symbol docstring)
(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"))
(defvar rst--escape-alist