debian/notmuch
1
0
Fork 0
mirror of https://git.notmuchmail.org/git/notmuch synced 2024-11-25 04:18:08 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

emacs: Use cl-lib' instead of deprecated cl'

Browse source 
Starting with Emacs 27 the old `cl' implementation is finally
considered obsolete.  Previously its use was strongly discouraged
at run-time but one was still allowed to use it at compile-time.

For the most part the transition is very simple and boils down to
adding the "cl-" prefix to some symbols.  A few replacements do not
follow that simple pattern; e.g. `first' is replaced with `car',
even though the alias `cl-first' exists, because the latter is not
idiomatic emacs-lisp.

In a few cases we start using `pcase-let' or `pcase-lambda' instead
of renaming e.g. `first' to `car'.  That way we can remind the reader
of the meaning of the various parts of the data that is being
deconstructed.

An obsolete `lexical-let' and a `lexical-let*' are replaced with their
regular variants `let' and `let*' even though we do not at the same
time enable `lexical-binding' for that file.  That is the right thing
to do because it does not actually make a difference in those cases
whether lexical bindings are used or not, and because this should be
enabled in a separate commit.

We need to explicitly depend on the `cl-lib' package because Emacs
24.1 and 24.2 lack that library.  When using these releases we end
up using the backport from GNU Elpa.

We need to explicitly require the `pcase' library because
`pcase-dolist' was not autoloaded until Emacs 25.1.
This commit is contained in:
Jonas Bernoulli 2020-04-25 22:18:07 +02:00 committed by David Bremner
parent 7b756d1e38
commit 11ac932a45
16 changed files with 304 additions and 299 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
emacs/notmuch-company.el
View file

@ -27,7 +27,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'notmuch-lib) (require 'notmuch-lib)
(defvar notmuch-company-last-prefix nil) (defvar notmuch-company-last-prefix nil)
@ -65,7 +66,7 @@
(require 'company) (require 'company)
(let ((case-fold-search t) (let ((case-fold-search t)
(completion-ignore-case t)) (completion-ignore-case t))
(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 (concat notmuch-address-completion-headers-regexp ".*")

2
emacs/notmuch-draft.el
View file

@ -152,7 +152,7 @@ Used when a new version is saved, or the message is sent."
"Checks if we should save a message that should be encrypted. "Checks if we should save a message that should be encrypted.
`notmuch-draft-save-plaintext' controls the behaviour." `notmuch-draft-save-plaintext' controls the behaviour."
(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.

147
emacs/notmuch-hello.el
View file

@ -21,7 +21,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'widget) (require 'widget)
(require 'wid-edit) ; For `widget-forward'. (require 'wid-edit) ; For `widget-forward'.
@ -47,17 +48,19 @@ lists (NAME QUERY COUNT-QUERY)."
((keywordp (car saved-search)) ((keywordp (car saved-search))
(plist-get saved-search field)) (plist-get saved-search field))
;; It is not a plist so it is an old-style entry. ;; It is not a plist so it is an old-style entry.
((consp (cdr saved-search)) ;; It is a list (NAME QUERY COUNT-QUERY) ((consp (cdr saved-search))
(case field (pcase-let ((`(,name ,query ,count-query) saved-search))
(:name (first saved-search)) (cl-case field
(:query (second saved-search)) (:name name)
(:count-query (third saved-search)) (:query query)
(t nil))) (:count-query count-query)
(t ;; It is a cons-cell (NAME . QUERY) (t nil))))
(case field (t
(:name (car saved-search)) (pcase-let ((`(,name . ,query) saved-search))
(:query (cdr saved-search)) (cl-case field
(t nil))))) (:name name)
(:query query)
(t nil))))))
(defun notmuch-hello-saved-search-to-plist (saved-search) (defun notmuch-hello-saved-search-to-plist (saved-search)
"Return a copy of SAVED-SEARCH in plist form. "Return a copy of SAVED-SEARCH in plist form.
@ -66,7 +69,7 @@ If saved search is a plist then just return a copy. In other
cases, for backwards compatibility, convert to plist form and cases, for backwards compatibility, convert to plist form and
return that." return that."
(if (keywordp (car saved-search)) (if (keywordp (car saved-search))
(copy-seq saved-search) (copy-sequence saved-search)
(let ((fields (list :name :query :count-query)) (let ((fields (list :name :query :count-query))
plist-search) plist-search)
(dolist (field fields plist-search) (dolist (field fields plist-search)
@ -396,10 +399,10 @@ afterwards.")
notmuch-saved-searches))) notmuch-saved-searches)))
;; If an existing saved search with this name exists, remove it. ;; If an existing saved search with this name exists, remove it.
(setq notmuch-saved-searches (setq notmuch-saved-searches
(loop for elem in notmuch-saved-searches (cl-loop for elem in notmuch-saved-searches
if (not (equal name if (not (equal name
(notmuch-saved-search-get elem :name))) (notmuch-saved-search-get elem :name)))
collect elem)) collect elem))
;; Add the new one. ;; Add the new one.
(customize-save-variable 'notmuch-saved-searches (customize-save-variable 'notmuch-saved-searches
(add-to-list 'notmuch-saved-searches (add-to-list 'notmuch-saved-searches
@ -417,28 +420,28 @@ afterwards.")
(notmuch-hello-update))) (notmuch-hello-update)))
(defun notmuch-hello-longest-label (searches-alist) (defun notmuch-hello-longest-label (searches-alist)
(or (loop for elem in searches-alist (or (cl-loop for elem in searches-alist
maximize (length (notmuch-saved-search-get elem :name))) maximize (length (notmuch-saved-search-get elem :name)))
0)) 0))
(defun notmuch-hello-reflect-generate-row (ncols nrows row list) (defun notmuch-hello-reflect-generate-row (ncols nrows row list)
(let ((len (length list))) (let ((len (length list)))
(loop for col from 0 to (- ncols 1) (cl-loop for col from 0 to (- ncols 1)
collect (let ((offset (+ (* nrows col) row))) collect (let ((offset (+ (* nrows col) row)))
(if (< offset len) (if (< offset len)
(nth offset list) (nth offset list)
;; Don't forget to insert an empty slot in the ;; Don't forget to insert an empty slot in the
;; output matrix if there is no corresponding ;; output matrix if there is no corresponding
;; value in the input matrix. ;; value in the input matrix.
nil))))) nil)))))
(defun notmuch-hello-reflect (list ncols) (defun notmuch-hello-reflect (list ncols)
"Reflect a `ncols' wide matrix represented by `list' along the "Reflect a `ncols' wide matrix represented by `list' along the
diagonal." diagonal."
;; Not very lispy... ;; Not very lispy...
(let ((nrows (ceiling (length list) ncols))) (let ((nrows (ceiling (length list) ncols)))
(loop for row from 0 to (- nrows 1) (cl-loop for row from 0 to (- nrows 1)
append (notmuch-hello-reflect-generate-row ncols nrows row list)))) append (notmuch-hello-reflect-generate-row ncols nrows row list))))
(defun notmuch-hello-widget-search (widget &rest ignore) (defun notmuch-hello-widget-search (widget &rest ignore)
(cond (cond
@ -584,7 +587,7 @@ with `notmuch-hello-query-counts'."
(widget-insert (make-string column-indent ? ))) (widget-insert (make-string column-indent ? )))
(let* ((name (plist-get elem :name)) (let* ((name (plist-get elem :name))
(query (plist-get elem :query)) (query (plist-get elem :query))
(oldest-first (case (plist-get elem :sort-order) (oldest-first (cl-case (plist-get elem :sort-order)
(newest-first nil) (newest-first nil)
(oldest-first t) (oldest-first t)
(otherwise notmuch-search-oldest-first))) (otherwise notmuch-search-oldest-first)))
@ -812,48 +815,48 @@ Complete list of currently available key bindings:
"clear") "clear")
(widget-insert "\n\n") (widget-insert "\n\n")
(let ((start (point))) (let ((start (point)))
(loop for i from 1 to notmuch-hello-recent-searches-max (cl-loop for i from 1 to notmuch-hello-recent-searches-max
for search in notmuch-search-history do for search in notmuch-search-history do
(let ((widget-symbol (intern (format "notmuch-hello-search-%d" i)))) (let ((widget-symbol (intern (format "notmuch-hello-search-%d" i))))
(set widget-symbol (set widget-symbol
(widget-create 'editable-field (widget-create 'editable-field
;; Don't let the search boxes be ;; Don't let the search boxes be
;; less than 8 characters wide. ;; less than 8 characters wide.
:size (max 8 :size (max 8
(- (window-width) (- (window-width)
;; Leave some space ;; Leave some space
;; at the start and ;; at the start and
;; end of the ;; end of the
;; boxes. ;; boxes.
(* 2 notmuch-hello-indent) (* 2 notmuch-hello-indent)
;; 1 for the space ;; 1 for the space
;; before the ;; before the
;; `[save]' button. 6 ;; `[save]' button. 6
;; for the `[save]' ;; for the `[save]'
;; button. ;; button.
1 6 1 6
;; 1 for the space ;; 1 for the space
;; before the `[del]' ;; before the `[del]'
;; button. 5 for the ;; button. 5 for the
;; `[del]' button. ;; `[del]' button.
1 5)) 1 5))
:action (lambda (widget &rest ignore) :action (lambda (widget &rest ignore)
(notmuch-hello-search (widget-value widget))) (notmuch-hello-search (widget-value widget)))
search)) search))
(widget-insert " ") (widget-insert " ")
(widget-create 'push-button (widget-create 'push-button
:notify (lambda (widget &rest ignore) :notify (lambda (widget &rest ignore)
(notmuch-hello-add-saved-search widget)) (notmuch-hello-add-saved-search widget))
:notmuch-saved-search-widget widget-symbol :notmuch-saved-search-widget widget-symbol
"save") "save")
(widget-insert " ") (widget-insert " ")
(widget-create 'push-button (widget-create 'push-button
:notify (lambda (widget &rest ignore) :notify (lambda (widget &rest ignore)
(when (y-or-n-p "Are you sure you want to delete this search? ") (when (y-or-n-p "Are you sure you want to delete this search? ")
(notmuch-hello-delete-search-from-history widget))) (notmuch-hello-delete-search-from-history widget)))
:notmuch-saved-search-widget widget-symbol :notmuch-saved-search-widget widget-symbol
"del")) "del"))
(widget-insert "\n")) (widget-insert "\n"))
(indent-rigidly start (point) notmuch-hello-indent)) (indent-rigidly start (point) notmuch-hello-indent))
nil)) nil))

45
emacs/notmuch-jump.el
View file

@ -22,7 +22,9 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile
(require 'cl-lib)
(require 'pcase))
(require 'notmuch-lib) (require 'notmuch-lib)
(require 'notmuch-hello) (require 'notmuch-hello)
@ -51,7 +53,7 @@ fast way to jump to a saved search from anywhere in Notmuch."
(let ((name (plist-get saved-search :name)) (let ((name (plist-get saved-search :name))
(query (plist-get saved-search :query)) (query (plist-get saved-search :query))
(oldest-first (oldest-first
(case (plist-get saved-search :sort-order) (cl-case (plist-get saved-search :sort-order)
(newest-first nil) (newest-first nil)
(oldest-first t) (oldest-first t)
(otherwise (default-value 'notmuch-search-oldest-first))))) (otherwise (default-value 'notmuch-search-oldest-first)))))
@ -127,18 +129,16 @@ buffer."
;; Compute the maximum key description width ;; Compute the maximum key description width
(let ((key-width 1)) (let ((key-width 1))
(dolist (entry action-map) (pcase-dolist (`(,key ,desc) action-map)
(setq key-width (setq key-width
(max key-width (max key-width
(string-width (format-kbd-macro (first entry)))))) (string-width (format-kbd-macro key)))))
;; Format each action ;; Format each action
(mapcar (lambda (entry) (mapcar (pcase-lambda (`(,key ,desc))
(let ((key (format-kbd-macro (first entry))) (setq key (format-kbd-macro key))
(desc (second entry))) (concat (propertize key 'face 'minibuffer-prompt)
(concat (make-string (- key-width (length key)) ? )
(propertize key 'face 'minibuffer-prompt) " " desc))
(make-string (- key-width (length key)) ? )
" " desc)))
action-map))) action-map)))
(defun notmuch-jump--insert-items (width items) (defun notmuch-jump--insert-items (width items)
@ -173,28 +173,25 @@ buffer."
"Translate ACTION-MAP into a minibuffer keymap." "Translate ACTION-MAP into a minibuffer keymap."
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(set-keymap-parent map notmuch-jump-minibuffer-map) (set-keymap-parent map notmuch-jump-minibuffer-map)
(dolist (action action-map) (pcase-dolist (`(,key ,name ,fn) action-map)
(if (= (length (first action)) 1) (if (= (length key) 1)
(define-key map (first action) (define-key map key
`(lambda () (interactive) `(lambda () (interactive)
(setq notmuch-jump--action ',(third action)) (setq notmuch-jump--action ',fn)
(exit-minibuffer))))) (exit-minibuffer)))))
;; By doing this in two passes (and checking if we already have a ;; By doing this in two passes (and checking if we already have a
;; binding) we avoid problems if the user specifies a binding which ;; binding) we avoid problems if the user specifies a binding which
;; is a prefix of another binding. ;; is a prefix of another binding.
(dolist (action action-map) (pcase-dolist (`(,key ,name ,fn) action-map)
(if (> (length (first action)) 1) (if (> (length key) 1)
(let* ((key (elt (first action) 0)) (let* ((key (elt key 0))
(keystr (string key)) (keystr (string key))
(new-prompt (concat prompt (format-kbd-macro keystr) " ")) (new-prompt (concat prompt (format-kbd-macro keystr) " "))
(action-submap nil)) (action-submap nil))
(unless (lookup-key map keystr) (unless (lookup-key map keystr)
(dolist (act action-map) (pcase-dolist (`(,k ,n ,f) action-map)
(when (= key (elt (first act) 0)) (when (= key (elt k 0))
(push (list (substring (first act) 1) (push (list (substring k 1) n f) action-submap)))
(second act)
(third act))
action-submap)))
;; We deal with backspace specially ;; We deal with backspace specially
(push (list (kbd "DEL") (push (list (kbd "DEL")
"Backup" "Backup"

18
emacs/notmuch-lib.el
View file

@ -23,10 +23,12 @@
;;; Code: ;;; Code:
(require 'cl-lib)
(require 'mm-util) (require 'mm-util)
(require 'mm-view) (require 'mm-view)
(require 'mm-decode) (require 'mm-decode)
(require 'cl)
(require 'notmuch-compat) (require 'notmuch-compat)
(unless (require 'notmuch-version nil t) (unless (require 'notmuch-version nil t)
@ -574,7 +576,7 @@ for this message, if present."
(defun notmuch-parts-filter-by-type (parts type) (defun notmuch-parts-filter-by-type (parts type)
"Given a list of message parts, return a list containing the ones matching "Given a list of message parts, return a list containing the ones matching
the given type." the given type."
(remove-if-not (cl-remove-if-not
(lambda (part) (notmuch-match-content-type (plist-get part :content-type) type)) (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
parts)) parts))
@ -685,8 +687,8 @@ current buffer, if possible."
;; have symbols of the form :Header as keys, and the resulting alist will have ;; have symbols of the form :Header as keys, and the resulting alist will have
;; symbols of the form 'Header as keys. ;; symbols of the form 'Header as keys.
(defun notmuch-headers-plist-to-alist (plist) (defun notmuch-headers-plist-to-alist (plist)
(loop for (key value . rest) on plist by #'cddr (cl-loop for (key value . rest) on plist by #'cddr
collect (cons (intern (substring (symbol-name key) 1)) value))) collect (cons (intern (substring (symbol-name key) 1)) value)))
(defun notmuch-face-ensure-list-form (face) (defun notmuch-face-ensure-list-form (face)
"Return FACE in face list form. "Return FACE in face list form.
@ -780,7 +782,7 @@ arguments passed to the sentinel. COMMAND and ERR, if provided,
are passed to `notmuch-check-exit-status'. If COMMAND is not are passed to `notmuch-check-exit-status'. If COMMAND is not
provided, it is taken from `process-command'." provided, it is taken from `process-command'."
(let ((exit-status (let ((exit-status
(case (process-status proc) (cl-case (process-status proc)
((exit) (process-exit-status proc)) ((exit) (process-exit-status proc))
((signal) msg)))) ((signal) msg))))
(when exit-status (when exit-status
@ -848,7 +850,7 @@ for `call-process'. ARGS is as described for
(let (stdin-string) (let (stdin-string)
(while (keywordp (car args)) (while (keywordp (car args))
(case (car args) (cl-case (car args)
(:stdin-string (setq stdin-string (cadr args) (:stdin-string (setq stdin-string (cadr args)
args (cddr args))) args (cddr args)))
(otherwise (otherwise
@ -1026,8 +1028,4 @@ region if the region is active, or both `point' otherwise."
(provide 'notmuch-lib) (provide 'notmuch-lib)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
;;; notmuch-lib.el ends here ;;; notmuch-lib.el ends here

35
emacs/notmuch-maildir-fcc.el
View file

@ -22,7 +22,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'message) (require 'message)
(require 'notmuch-lib) (require 'notmuch-lib)
@ -251,12 +252,12 @@ If CREATE is non-nil then create the folder if necessary."
(let ((response (notmuch-read-char-choice (let ((response (notmuch-read-char-choice
"Insert failed: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " "Insert failed: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? "
'(?r ?c ?i ?e)))) '(?r ?c ?i ?e))))
(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))
(?i 't) (?i 't)
(?e (notmuch-maildir-fcc-with-notmuch-insert (?e (notmuch-maildir-fcc-with-notmuch-insert
(read-from-minibuffer "Fcc header: " fcc-header))))))))) (read-from-minibuffer "Fcc header: " fcc-header)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -335,16 +336,16 @@ if needed."
(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: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? "
fcc-header)) fcc-header))
(response (notmuch-read-char-choice prompt '(?r ?c ?i ?e)))) (response (notmuch-read-char-choice prompt '(?r ?c ?i ?e))))
(case response (cl-case response
(?r (notmuch-maildir-fcc-file-fcc fcc-header)) (?r (notmuch-maildir-fcc-file-fcc fcc-header))
(?c (if (file-writable-p fcc-header) (?c (if (file-writable-p fcc-header)
(notmuch-maildir-fcc-create-maildir fcc-header) (notmuch-maildir-fcc-create-maildir fcc-header)
(message "No permission to create %s." fcc-header) (message "No permission to create %s." fcc-header)
(sit-for 2)) (sit-for 2))
(notmuch-maildir-fcc-file-fcc fcc-header)) (notmuch-maildir-fcc-file-fcc fcc-header))
(?i 't) (?i 't)
(?e (notmuch-maildir-fcc-file-fcc (?e (notmuch-maildir-fcc-file-fcc
(read-from-minibuffer "Fcc header: " fcc-header))))))) (read-from-minibuffer "Fcc header: " fcc-header)))))))
(defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen) (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen)
"Writes the current buffer to maildir destdir. If mark-seen is "Writes the current buffer to maildir destdir. If mark-seen is

76
emacs/notmuch-mua.el
View file

@ -21,6 +21,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'message) (require 'message)
(require 'mm-view) (require 'mm-view)
(require 'format-spec) (require 'format-spec)
@ -30,8 +32,6 @@
(require 'notmuch-draft) (require 'notmuch-draft)
(require 'notmuch-message) (require 'notmuch-message)
(eval-when-compile (require 'cl))
(declare-function notmuch-show-insert-body "notmuch-show" (msg body depth)) (declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
(declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ()) (declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
(declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ()) (declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
@ -140,17 +140,18 @@ Typically this is added to `notmuch-mua-send-hook'."
;; Limit search from reaching other possible parts of the message ;; Limit search from reaching other possible parts of the message
(let ((search-limit (search-forward "\n<#" nil t))) (let ((search-limit (search-forward "\n<#" nil t)))
(message-goto-body) (message-goto-body)
(loop while (re-search-forward notmuch-mua-attachment-regexp search-limit t) (cl-loop while (re-search-forward notmuch-mua-attachment-regexp
;; For every instance of the "attachment" string search-limit t)
;; found, examine the text properties. If the text ;; For every instance of the "attachment" string
;; has either a `face' or `syntax-table' property ;; found, examine the text properties. If the text
;; then it is quoted text and should *not* cause the ;; has either a `face' or `syntax-table' property
;; user to be asked about a missing attachment. ;; then it is quoted text and should *not* cause the
if (let ((props (text-properties-at (match-beginning 0)))) ;; user to be asked about a missing attachment.
(not (or (memq 'syntax-table props) if (let ((props (text-properties-at (match-beginning 0))))
(memq 'face props)))) (not (or (memq 'syntax-table props)
return t (memq 'face props))))
finally return nil))) return t
finally return nil)))
;; ...but doesn't have a part with a filename... ;; ...but doesn't have a part with a filename...
(save-excursion (save-excursion
(message-goto-body) (message-goto-body)
@ -203,11 +204,11 @@ 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."
(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) "multipart/encrypted")
do (mml-secure-message-sign-encrypt) 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)))) 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
@ -252,14 +253,14 @@ Typically this is added to `notmuch-mua-send-hook'."
;; We modify message-header-format-alist to get around a bug in message.el. ;; We modify message-header-format-alist to get around a bug in message.el.
;; See the comment above on notmuch-mua-insert-references. ;; See the comment above on notmuch-mua-insert-references.
(let ((message-header-format-alist (let ((message-header-format-alist
(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)
collect (cons 'References collect (cons 'References
(apply-partially (apply-partially
'notmuch-mua-insert-references 'notmuch-mua-insert-references
(cdr pair))) (cdr pair)))
else else
collect pair))) collect pair)))
(notmuch-mua-mail (plist-get reply-headers :To) (notmuch-mua-mail (plist-get reply-headers :To)
(notmuch-sanitize (plist-get reply-headers :Subject)) (notmuch-sanitize (plist-get reply-headers :Subject))
(notmuch-headers-plist-to-alist reply-headers) (notmuch-headers-plist-to-alist reply-headers)
@ -309,10 +310,10 @@ Typically this is added to `notmuch-mua-send-hook'."
;; Don't indent multipart sub-parts. ;; Don't indent multipart sub-parts.
(notmuch-show-indent-multipart nil)) (notmuch-show-indent-multipart nil))
;; We don't want sigstatus buttons (an information leak and usually wrong anyway). ;; We don't want sigstatus buttons (an information leak and usually wrong anyway).
(letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore) (cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore)
((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore))
(notmuch-show-insert-body original (plist-get original :body) 0) (notmuch-show-insert-body original (plist-get original :body) 0)
(buffer-substring-no-properties (point-min) (point-max)))))) (buffer-substring-no-properties (point-min) (point-max))))))
(set-mark (point)) (set-mark (point))
(goto-char start) (goto-char start)
@ -526,10 +527,9 @@ the From: address."
;; 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
(loop for id in forward-queries (cl-loop for id in forward-queries
collect collect
(cons id (cons id notmuch-message-forwarded-tags))))
notmuch-message-forwarded-tags))))
;; `message-forward-make-body' shows the User-agent header. Hide ;; `message-forward-make-body' shows the User-agent header. Hide
;; it again. ;; it again.
@ -609,10 +609,10 @@ 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))
(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)))))
(defun notmuch-mua-send-and-exit (&optional arg) (defun notmuch-mua-send-and-exit (&optional arg)
(interactive "P") (interactive "P")

18
emacs/notmuch-parser.el
View file

@ -21,7 +21,7 @@
;;; Code: ;;; Code:
(require 'cl) (eval-when-compile (require 'cl-lib))
(defun notmuch-sexp-create-parser () (defun notmuch-sexp-create-parser ()
"Return a new streaming S-expression parser. "Return a new streaming S-expression parser.
@ -70,7 +70,7 @@ returns the value."
;; error to be consistent with all other code paths. ;; error to be consistent with all other code paths.
(read (current-buffer)) (read (current-buffer))
;; Go up a level and return an end token ;; Go up a level and return an end token
(decf (notmuch-sexp--depth sp)) (cl-decf (notmuch-sexp--depth sp))
(forward-char) (forward-char)
'end)) 'end))
((= (char-after) ?\() ((= (char-after) ?\()
@ -94,8 +94,8 @@ returns the value."
(notmuch-sexp--partial-state sp))) (notmuch-sexp--partial-state sp)))
;; A complete value is available if we've ;; A complete value is available if we've
;; reached depth 0. ;; reached depth 0.
(depth (first new-state))) (depth (car new-state)))
(assert (>= depth 0)) (cl-assert (>= depth 0))
(if (= depth 0) (if (= depth 0)
;; Reset partial parse state ;; Reset partial parse state
(setf (notmuch-sexp--partial-state sp) nil (setf (notmuch-sexp--partial-state sp) nil
@ -139,7 +139,7 @@ beginning of a list, throw invalid-read-syntax."
(cond ((eobp) 'retry) (cond ((eobp) 'retry)
((= (char-after) ?\() ((= (char-after) ?\()
(forward-char) (forward-char)
(incf (notmuch-sexp--depth sp)) (cl-incf (notmuch-sexp--depth sp))
t) t)
(t (t
;; Skip over the bad character like `read' does ;; Skip over the bad character like `read' does
@ -181,7 +181,7 @@ move point in the input buffer."
(set (make-local-variable 'notmuch-sexp--state) 'begin)) (set (make-local-variable 'notmuch-sexp--state) 'begin))
(let (done) (let (done)
(while (not done) (while (not done)
(case notmuch-sexp--state (cl-case notmuch-sexp--state
(begin (begin
;; Enter the list ;; Enter the list
(if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry) (if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry)
@ -190,7 +190,7 @@ move point in the input buffer."
(result (result
;; Parse a result ;; Parse a result
(let ((result (notmuch-sexp-read notmuch-sexp--parser))) (let ((result (notmuch-sexp-read notmuch-sexp--parser)))
(case result (cl-case result
(retry (setq done t)) (retry (setq done t))
(end (setq notmuch-sexp--state 'end)) (end (setq notmuch-sexp--state 'end))
(t (with-current-buffer result-buffer (t (with-current-buffer result-buffer
@ -204,8 +204,4 @@ move point in the input buffer."
(provide 'notmuch-parser) (provide 'notmuch-parser)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
;;; notmuch-parser.el ends here ;;; notmuch-parser.el ends here

3
emacs/notmuch-pkg.el.tmpl
View file

@ -3,4 +3,5 @@
"notmuch" "notmuch"
%VERSION% %VERSION%
"Emacs based front-end (MUA) for notmuch" "Emacs based front-end (MUA) for notmuch"
'((emacs "24"))) '((emacs "24")
(cl-lib "0.6.1")))

103
emacs/notmuch-show.el
View file

@ -23,7 +23,10 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile
(require 'cl-lib)
(require 'pcase))
(require 'mm-view) (require 'mm-view)
(require 'message) (require 'message)
(require 'mm-decode) (require 'mm-decode)
@ -429,17 +432,16 @@ parsing fails."
(setq p-name (replace-regexp-in-string "\\\\" "" p-name)) (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
;; Outer single and double quotes, which might be nested. ;; Outer single and double quotes, which might be nested.
(loop (cl-loop with start-of-loop
with start-of-loop do (setq start-of-loop p-name)
do (setq start-of-loop p-name)
when (string-match "^\"\\(.*\\)\"$" p-name) when (string-match "^\"\\(.*\\)\"$" p-name)
do (setq p-name (match-string 1 p-name)) do (setq p-name (match-string 1 p-name))
when (string-match "^'\\(.*\\)'$" p-name) when (string-match "^'\\(.*\\)'$" p-name)
do (setq p-name (match-string 1 p-name)) do (setq p-name (match-string 1 p-name))
until (string= start-of-loop p-name))) until (string= start-of-loop p-name)))
;; If the address is 'foo@bar.com <foo@bar.com>' then show just ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
;; 'foo@bar.com'. ;; 'foo@bar.com'.
@ -573,13 +575,13 @@ message at DEPTH in the current thread."
;; Recurse on sub-parts ;; Recurse on sub-parts
(let ((ctype (notmuch-split-content-type (let ((ctype (notmuch-split-content-type
(downcase (plist-get part :content-type))))) (downcase (plist-get part :content-type)))))
(cond ((equal (first ctype) "multipart") (cond ((equal (car ctype) "multipart")
(mapc (apply-partially #'notmuch-show--register-cids msg) (mapc (apply-partially #'notmuch-show--register-cids msg)
(plist-get part :content))) (plist-get part :content)))
((equal ctype '("message" "rfc822")) ((equal ctype '("message" "rfc822"))
(notmuch-show--register-cids (notmuch-show--register-cids
msg msg
(first (plist-get (first (plist-get part :content)) :body))))))) (car (plist-get (car (plist-get part :content)) :body)))))))
(defun notmuch-show--get-cid-content (cid) (defun notmuch-show--get-cid-content (cid)
"Return a list (CID-content content-type) or nil. "Return a list (CID-content content-type) or nil.
@ -590,8 +592,8 @@ enclosing angle brackets, a cid: prefix, or URL encoding. This
will return nil if the CID is unknown or cannot be retrieved." will return nil if the CID is unknown or cannot be retrieved."
(let ((descriptor (cdr (assoc cid notmuch-show--cids)))) (let ((descriptor (cdr (assoc cid notmuch-show--cids))))
(when descriptor (when descriptor
(let* ((msg (first descriptor)) (let* ((msg (car descriptor))
(part (second descriptor)) (part (cadr descriptor))
;; Request caching for this content, as some messages ;; Request caching for this content, as some messages
;; reference the same cid: part many times (hundreds!). ;; reference the same cid: part many times (hundreds!).
(content (notmuch-get-bodypart-binary (content (notmuch-get-bodypart-binary
@ -616,8 +618,8 @@ will return nil if the CID is unknown or cannot be retrieved."
(with-current-buffer w3m-current-buffer (with-current-buffer w3m-current-buffer
(notmuch-show--get-cid-content cid)))) (notmuch-show--get-cid-content cid))))
(when content-and-type (when content-and-type
(insert (first content-and-type)) (insert (car content-and-type))
(second content-and-type)))) (cadr content-and-type))))
;; MIME part renderers ;; MIME part renderers
@ -785,7 +787,7 @@ will return nil if the CID is unknown or cannot be retrieved."
;; is defined before it will be shadowed by the letf below. Otherwise the version ;; 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). ;; in enriched.el may be loaded a bit later and used instead (for the first time).
(require 'enriched) (require 'enriched)
(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))))
(notmuch-show-insert-part-*/* msg part content-type nth depth button)))) (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
@ -843,7 +845,7 @@ will return nil if the CID is unknown or cannot be retrieved."
;; shr strips the "cid:" part of URL, but doesn't ;; shr strips the "cid:" part of URL, but doesn't
;; URL-decode it (see RFC 2392). ;; URL-decode it (see RFC 2392).
(let ((cid (url-unhex-string url))) (let ((cid (url-unhex-string url)))
(first (notmuch-show--get-cid-content cid)))))) (car (notmuch-show--get-cid-content cid))))))
(shr-insert-document dom) (shr-insert-document dom)
t)) t))
@ -873,15 +875,16 @@ will return nil if the CID is unknown or cannot be retrieved."
(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button) (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
;; Run the handlers until one of them succeeds. ;; Run the handlers until one of them succeeds.
(loop for handler in (notmuch-show-handlers-for content-type) (cl-loop for handler in (notmuch-show-handlers-for content-type)
until (condition-case err until (condition-case err
(funcall handler msg part content-type nth depth button) (funcall handler msg part content-type nth depth button)
;; Specifying `debug' here lets the debugger run if ;; Specifying `debug' here lets the debugger run if
;; `debug-on-error' is non-nil. ;; `debug-on-error' is non-nil.
((debug error) ((debug error)
(insert "!!! Bodypart handler `" (prin1-to-string handler) "' threw an error:\n" (insert "!!! Bodypart handler `" (prin1-to-string handler)
"!!! " (error-message-string err) "\n") "' threw an error:\n"
nil)))) "!!! " (error-message-string err) "\n")
nil))))
(defun notmuch-show-create-part-overlays (button beg end) (defun notmuch-show-create-part-overlays (button beg end)
"Add an overlay to the part between BEG and END" "Add an overlay to the part between BEG and END"
@ -907,13 +910,15 @@ will return nil if the CID is unknown or cannot be retrieved."
;; watch out for sticky specs of t, which means all properties are ;; watch out for sticky specs of t, which means all properties are
;; front-sticky/rear-nonsticky. ;; front-sticky/rear-nonsticky.
(notmuch-map-text-property beg end 'front-sticky (notmuch-map-text-property beg end 'front-sticky
(lambda (v) (if (listp v) (lambda (v)
(pushnew :notmuch-part v) (if (listp v)
v))) (cl-pushnew :notmuch-part v)
v)))
(notmuch-map-text-property beg end 'rear-nonsticky (notmuch-map-text-property beg end 'rear-nonsticky
(lambda (v) (if (listp v) (lambda (v)
(pushnew :notmuch-part v) (if (listp v)
v)))) (cl-pushnew :notmuch-part v)
v))))
(defun notmuch-show-lazy-part (part-args button) (defun notmuch-show-lazy-part (part-args button)
;; Insert the lazy part after the button for the part. We would just ;; Insert the lazy part after the button for the part. We would just
@ -941,7 +946,7 @@ will return nil if the CID is unknown or cannot be retrieved."
(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 (second part-args) (notmuch-show-record-part-information (cadr part-args)
(button-start button) (button-start button)
part-end) part-end)
;; Create the overlay. If the lazy-part turned out to be empty/not ;; Create the overlay. If the lazy-part turned out to be empty/not
@ -1037,7 +1042,7 @@ is t, hide the part initially and show the button."
;; Register all content IDs for this message. According to RFC ;; Register all content IDs for this message. According to RFC
;; 2392, content IDs are *global*, but it's okay if an MUA treats ;; 2392, content IDs are *global*, but it's okay if an MUA treats
;; them as only global within a message. ;; them as only global within a message.
(notmuch-show--register-cids msg (first body)) (notmuch-show--register-cids msg (car body))
(mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
@ -1220,13 +1225,13 @@ buttons for a corresponding notmuch search."
(url-unhex-string (match-string 0 mid-cid))))) (url-unhex-string (match-string 0 mid-cid)))))
(push (list (match-beginning 0) (match-end 0) (push (list (match-beginning 0) (match-end 0)
(notmuch-id-to-query mid)) links))) (notmuch-id-to-query mid)) links)))
(dolist (link links) (pcase-dolist (`(,beg ,end ,link) links)
;; Remove the overlay created by goto-address-mode ;; Remove the overlay created by goto-address-mode
(remove-overlays (first link) (second link) 'goto-address t) (remove-overlays beg end 'goto-address t)
(make-text-button (first link) (second link) (make-text-button beg end
:type 'notmuch-button-type :type 'notmuch-button-type
'action `(lambda (arg) 'action `(lambda (arg)
(notmuch-show ,(third link) current-prefix-arg)) (notmuch-show ,link current-prefix-arg))
'follow-link t 'follow-link t
'help-echo "Mouse-1, RET: search for this message" 'help-echo "Mouse-1, RET: search for this message"
'face goto-address-mail-face))))) 'face goto-address-mail-face)))))
@ -1387,9 +1392,9 @@ This includes:
(defun notmuch-show-goto-message (msg-id) (defun notmuch-show-goto-message (msg-id)
"Go to message with msg-id." "Go to message with msg-id."
(goto-char (point-min)) (goto-char (point-min))
(unless (loop if (string= msg-id (notmuch-show-get-message-id)) (unless (cl-loop if (string= msg-id (notmuch-show-get-message-id))
return t return t
until (not (notmuch-show-goto-message-next))) until (not (notmuch-show-goto-message-next)))
(goto-char (point-min)) (goto-char (point-min))
(message "Message-id not found.")) (message "Message-id not found."))
(notmuch-show-message-adjust)) (notmuch-show-message-adjust))
@ -1406,9 +1411,9 @@ This includes:
;; Open those that were open. ;; Open those that were open.
(goto-char (point-min)) (goto-char (point-min))
(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)) (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)
(with-selected-window (car win-msg-pair) (with-selected-window (car win-msg-pair)
@ -1620,8 +1625,8 @@ of the current message."
effects." effects."
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(loop do (funcall function) (cl-loop do (funcall function)
while (notmuch-show-goto-message-next)))) while (notmuch-show-goto-message-next))))
;; Functions relating to the visibility of messages and their ;; Functions relating to the visibility of messages and their
;; components. ;; components.
@ -2177,9 +2182,9 @@ argument, hide all of the messages."
(interactive) (interactive)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(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)) (not current-prefix-arg))
until (not (notmuch-show-goto-message-next)))) until (not (notmuch-show-goto-message-next))))
(force-window-update)) (force-window-update))
(defun notmuch-show-next-button () (defun notmuch-show-next-button ()

45
emacs/notmuch-tag.el
View file

@ -24,8 +24,12 @@
;;; Code: ;;; Code:
;; ;;
(require 'cl) (require 'cl-lib)
(eval-when-compile
(require 'pcase))
(require 'crm) (require 'crm)
(require 'notmuch-lib) (require 'notmuch-lib)
(declare-function notmuch-search-tag "notmuch" tag-changes) (declare-function notmuch-search-tag "notmuch" tag-changes)
@ -277,10 +281,10 @@ This can be used with `notmuch-tag-format-image-data'."
(save-match-data (save-match-data
;; Don't use assoc-default since there's no way to distinguish a ;; Don't use assoc-default since there's no way to distinguish a
;; missing key from a present key with a null cdr. ;; missing key from a present key with a null cdr.
(assoc* tag format-alist (cl-assoc tag format-alist
:test (lambda (tag key) :test (lambda (tag key)
(and (eq (string-match key tag) 0) (and (eq (string-match key tag) 0)
(= (match-end 0) (length tag))))))) (= (match-end 0) (length tag)))))))
(defun notmuch-tag--do-format (tag formatted-tag formats) (defun notmuch-tag--do-format (tag formatted-tag formats)
"Apply a tag-formats entry to TAG." "Apply a tag-formats entry to TAG."
@ -315,7 +319,7 @@ changed (the normal case) are shown using formats from
(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 (case tag-state (over (cl-case tag-state
(deleted (notmuch-tag--get-formats (deleted (notmuch-tag--get-formats
tag notmuch-tag-deleted-formats)) tag notmuch-tag-deleted-formats))
(added (notmuch-tag--get-formats (added (notmuch-tag--get-formats
@ -436,7 +440,7 @@ from TAGS if present."
(dolist (tag-change tag-changes) (dolist (tag-change tag-changes)
(let ((op (string-to-char tag-change)) (let ((op (string-to-char tag-change))
(tag (unless (string= tag-change "") (substring tag-change 1)))) (tag (unless (string= tag-change "") (substring tag-change 1))))
(case op (cl-case op
(?+ (unless (member tag result-tags) (?+ (unless (member tag result-tags)
(push tag result-tags))) (push tag result-tags)))
(?- (setq result-tags (delete tag result-tags))) (?- (setq result-tags (delete tag result-tags)))
@ -511,22 +515,21 @@ and vice versa."
;; REVERSE is specified. ;; REVERSE is specified.
(interactive "P") (interactive "P")
(let (action-map) (let (action-map)
(dolist (binding notmuch-tagging-keys) (pcase-dolist (`(,key ,tag ,name) notmuch-tagging-keys)
(let* ((tag-function (case major-mode (let* ((tag-function (cl-case major-mode
(notmuch-search-mode #'notmuch-search-tag) (notmuch-search-mode #'notmuch-search-tag)
(notmuch-show-mode #'notmuch-show-tag) (notmuch-show-mode #'notmuch-show-tag)
(notmuch-tree-mode #'notmuch-tree-tag))) (notmuch-tree-mode #'notmuch-tree-tag)))
(key (first binding)) (tag (if (symbolp tag)
(forward-tag-change (if (symbolp (second binding)) (symbol-value tag)
(symbol-value (second binding)) tag))
(second binding)))
(tag-change (if reverse (tag-change (if reverse
(notmuch-tag-change-list forward-tag-change 't) (notmuch-tag-change-list tag 't)
forward-tag-change)) tag))
(name (or (and (not (string= (third binding) "")) (name (or (and (not (string= name ""))
(third binding)) name)
(and (symbolp (second binding)) (and (symbolp name)
(symbol-name (second binding))))) (symbol-name name))))
(name-string (if name (name-string (if name
(if reverse (concat "Reverse " name) (if reverse (concat "Reverse " name)
name) name)
@ -546,7 +549,3 @@ and vice versa."
;; ;;
(provide 'notmuch-tag) (provide 'notmuch-tag)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:

20
emacs/notmuch-tree.el
View file

@ -24,6 +24,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'mail-parse) (require 'mail-parse)
(require 'notmuch-lib) (require 'notmuch-lib)
@ -32,7 +34,6 @@
(require 'notmuch-tag) (require 'notmuch-tag)
(require 'notmuch-parser) (require 'notmuch-parser)
(eval-when-compile (require 'cl))
(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))
@ -721,10 +722,10 @@ found or nil if not."
and call FUNCTION for side effects." and call FUNCTION for side effects."
(save-excursion (save-excursion
(notmuch-tree-thread-top) (notmuch-tree-thread-top)
(loop collect (funcall function) (cl-loop collect (funcall function)
do (forward-line) do (forward-line)
while (and (notmuch-tree-get-message-properties) while (and (notmuch-tree-get-message-properties)
(not (notmuch-tree-get-prop :first)))))) (not (notmuch-tree-get-prop :first))))))
(defun notmuch-tree-get-messages-ids-thread-search () (defun notmuch-tree-get-messages-ids-thread-search ()
"Return a search string for all message ids of messages in the current thread." "Return a search string for all message ids of messages in the current thread."
@ -905,10 +906,11 @@ message together with all its descendents."
(defun notmuch-tree-insert-thread (thread depth tree-status) (defun notmuch-tree-insert-thread (thread depth tree-status)
"Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest." "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
(let ((n (length thread))) (let ((n (length thread)))
(loop for tree in thread (cl-loop for tree in thread
for count from 1 to n for count from 1 to n
do (notmuch-tree-insert-tree tree depth tree-status
do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n))))) (eq count 1)
(eq count n)))))
(defun notmuch-tree-insert-forest-thread (forest-thread) (defun notmuch-tree-insert-forest-thread (forest-thread)
"Insert a single complete thread." "Insert a single complete thread."

62
emacs/notmuch.el
View file

@ -65,7 +65,8 @@
;; ;;
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'mm-view) (require 'mm-view)
(require 'message) (require 'message)
@ -132,7 +133,7 @@ there will be called at other points of notmuch execution."
(or (equal (car disposition) "attachment") (or (equal (car disposition) "attachment")
(and (equal (car disposition) "inline") (and (equal (car disposition) "inline")
(assq 'filename disposition))) (assq 'filename disposition)))
(incf count)))) (cl-incf count))))
mm-handle) mm-handle)
count)) count))
@ -429,14 +430,13 @@ character position of the beginning of each result that overlaps
the region between points BEG and END. As a special case, if (= the region between points BEG and END. As a special case, if (=
BEG END), FN will be applied to the result containing point BEG END), FN will be applied to the result containing point
BEG." BEG."
(let ((pos (notmuch-search-result-beginning beg))
(lexical-let ((pos (notmuch-search-result-beginning beg)) ;; End must be a marker in case fn changes the
;; End must be a marker in case fn changes the ;; text.
;; text. (end (copy-marker end))
(end (copy-marker end)) ;; Make sure we examine at least one result, even if
;; Make sure we examine at least one result, even if ;; (= beg end).
;; (= beg end). (first t))
(first t))
;; We have to be careful if the region extends beyond the results. ;; We have to be careful if the region extends beyond the results.
;; In this case, pos could be null or there could be no result at ;; In this case, pos could be null or there could be no result at
;; pos. ;; pos.
@ -478,10 +478,10 @@ is nil, include both matched and unmatched messages. If there are
no messages in the region then return nil." no messages in the region then return nil."
(let ((query-list nil) (all (not only-matched))) (let ((query-list nil) (all (not only-matched)))
(dolist (queries (notmuch-search-properties-in-region :query beg end)) (dolist (queries (notmuch-search-properties-in-region :query beg end))
(when (first queries) (when (car queries)
(push (first queries) query-list)) (push (car queries) query-list))
(when (and all (second queries)) (when (and all (cadr queries))
(push (second queries) query-list))) (push (cadr queries) query-list)))
(when query-list (when query-list
(concat "(" (mapconcat 'identity query-list ") or (") ")")))) (concat "(" (mapconcat 'identity query-list ") or (") ")"))))
@ -568,12 +568,11 @@ thread."
"Prompt for tag changes for the current thread or region. "Prompt for tag changes for the current thread or region.
Returns (TAG-CHANGES REGION-BEGIN REGION-END)." Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
(let* ((region (notmuch-interactive-region)) (pcase-let ((`(,beg ,end) (notmuch-interactive-region)))
(beg (first region)) (end (second region)) (list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end)
(prompt (if (= beg end) "Tag thread" "Tag region"))) (if (= beg end) "Tag thread" "Tag region")
(cons (notmuch-read-tag-changes initial-input)
(notmuch-search-get-tags-region beg end) prompt initial-input) beg end)))
region)))
(defun notmuch-search-tag (tag-changes &optional beg end only-matched) (defun notmuch-search-tag (tag-changes &optional beg end only-matched)
"Change tags for the currently selected thread or region. "Change tags for the currently selected thread or region.
@ -891,12 +890,13 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
(let* ((saved-search (let* ((saved-search
(let (longest (let (longest
(longest-length 0)) (longest-length 0))
(loop for tuple in notmuch-saved-searches (cl-loop for tuple in notmuch-saved-searches
if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query)))) if (let ((quoted-query
(and (string-match (concat "^" quoted-query) query) (regexp-quote (notmuch-saved-search-get tuple :query))))
(> (length (match-string 0 query)) (and (string-match (concat "^" quoted-query) query)
longest-length))) (> (length (match-string 0 query))
do (setq longest tuple)) longest-length)))
do (setq longest tuple))
longest)) longest))
(saved-search-name (notmuch-saved-search-get saved-search :name)) (saved-search-name (notmuch-saved-search-get saved-search :name))
(saved-search-query (notmuch-saved-search-get saved-search :query))) (saved-search-query (notmuch-saved-search-get saved-search :query)))
@ -917,7 +917,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
"Read a notmuch-query from the minibuffer with completion. "Read a notmuch-query from the minibuffer with completion.
PROMPT is the string to prompt with." PROMPT is the string to prompt with."
(lexical-let* (let*
((all-tags ((all-tags
(mapcar (lambda (tag) (notmuch-escape-boolean-term tag)) (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
(process-lines notmuch-command "search" "--output=tags" "*"))) (process-lines notmuch-command "search" "--output=tags" "*")))
@ -928,7 +928,7 @@ PROMPT is the string to prompt with."
(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 (case major-mode (current-query (cl-case major-mode
(notmuch-search-mode (notmuch-search-get-query)) (notmuch-search-mode (notmuch-search-get-query))
(notmuch-show-mode (notmuch-show-get-query)) (notmuch-show-mode (notmuch-show-get-query))
(notmuch-tree-mode (notmuch-tree-get-query)))) (notmuch-tree-mode (notmuch-tree-get-query))))
@ -1114,9 +1114,9 @@ notmuch buffers exist, run `notmuch'."
(bury-buffer)) (bury-buffer))
;; Find the first notmuch buffer. ;; Find the first notmuch buffer.
(setq first (loop for buffer in (buffer-list) (setq first (cl-loop for buffer in (buffer-list)
if (notmuch-interesting-buffer buffer) if (notmuch-interesting-buffer buffer)
return buffer)) return buffer))
(if first (if first
;; If the first one we found is any other than the starting ;; If the first one we found is any other than the starting

2
test/T450-emacs-show.sh
View file

@ -177,7 +177,7 @@ test_emacs "(let ((notmuch-command \"$PWD/notmuch_fail\"))
(let ((inhibit-read-only t)) (erase-buffer))) (let ((inhibit-read-only t)) (erase-buffer)))
(condition-case err (condition-case err
(notmuch-show \"*\") (notmuch-show \"*\")
(error (message \"%s\" (second err)))) (error (message \"%s\" (cadr err))))
(notmuch-test-wait) (notmuch-test-wait)
(with-current-buffer \"*Messages*\" (with-current-buffer \"*Messages*\"
(test-output \"MESSAGES\")) (test-output \"MESSAGES\"))

4
test/emacs-attachment-warnings.el
View file

@ -1,3 +1,4 @@
(require 'cl-lib)
(require 'notmuch-mua) (require 'notmuch-mua)
(defun attachment-check-test (&optional fn) (defun attachment-check-test (&optional fn)
@ -12,7 +13,8 @@ Return `t' if the message would be sent, otherwise `nil'"
(condition-case nil (condition-case nil
;; Force `y-or-n-p' to always return `nil', as if the user ;; Force `y-or-n-p' to always return `nil', as if the user
;; pressed "n". ;; pressed "n".
(letf (((symbol-function 'y-or-n-p) (lambda (&rest args) nil))) (cl-letf (((symbol-function 'y-or-n-p)
(lambda (&rest args) nil)))
(notmuch-mua-attachment-check) (notmuch-mua-attachment-check)
t) t)
('error nil)) ('error nil))

18
test/test-lib.el
View file

@ -20,7 +20,7 @@
;; ;;
;; Authors: Dmitry Kurochkin <dmitry.kurochkin@gmail.com> ;; Authors: Dmitry Kurochkin <dmitry.kurochkin@gmail.com>
(require 'cl) ;; This code is generally used uncompiled. (require 'cl-lib)
;; `read-file-name' by default uses `completing-read' function to read ;; `read-file-name' by default uses `completing-read' function to read
;; user input. It does not respect `standard-input' variable which we ;; user input. It does not respect `standard-input' variable which we
@ -116,10 +116,10 @@ nothing."
(defadvice notmuch-search-process-filter (around pessimal activate disable) (defadvice notmuch-search-process-filter (around pessimal activate disable)
"Feed notmuch-search-process-filter one character at a time." "Feed notmuch-search-process-filter one character at a time."
(let ((string (ad-get-arg 1))) (let ((string (ad-get-arg 1)))
(loop for char across string (cl-loop for char across string
do (progn do (progn
(ad-set-arg 1 (char-to-string char)) (ad-set-arg 1 (char-to-string char))
ad-do-it)))) ad-do-it))))
(defun notmuch-test-mark-links () (defun notmuch-test-mark-links ()
"Enclose links in the current buffer with << and >>." "Enclose links in the current buffer with << and >>."
@ -162,10 +162,10 @@ nothing."
;; reporting differing elements of OUTPUT and EXPECTED ;; reporting differing elements of OUTPUT and EXPECTED
;; pairwise. This is expected to make analysis of failures ;; pairwise. This is expected to make analysis of failures
;; simpler. ;; simpler.
(apply #'concat (loop for o in output (apply #'concat (cl-loop for o in output
for e in expected for e in expected
if (not (equal o e)) if (not (equal o e))
collect (notmuch-test-report-unexpected o e)))) collect (notmuch-test-report-unexpected o e))))
(t (t
(notmuch-test-report-unexpected output expected))))) (notmuch-test-report-unexpected output expected)))))