From 11ac932a4503872c19987b843d58513c4b9ef76f Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Sat, 25 Apr 2020 22:18:07 +0200 Subject: [PATCH] emacs: Use `cl-lib' instead of deprecated `cl' 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. --- emacs/notmuch-company.el | 5 +- emacs/notmuch-draft.el | 2 +- emacs/notmuch-hello.el | 147 +++++++++++++++--------------- emacs/notmuch-jump.el | 45 +++++---- emacs/notmuch-lib.el | 18 ++-- emacs/notmuch-maildir-fcc.el | 35 +++---- emacs/notmuch-mua.el | 76 +++++++-------- emacs/notmuch-parser.el | 18 ++-- emacs/notmuch-pkg.el.tmpl | 3 +- emacs/notmuch-show.el | 103 +++++++++++---------- emacs/notmuch-tag.el | 45 +++++---- emacs/notmuch-tree.el | 20 ++-- emacs/notmuch.el | 62 ++++++------- test/T450-emacs-show.sh | 2 +- test/emacs-attachment-warnings.el | 4 +- test/test-lib.el | 18 ++-- 16 files changed, 304 insertions(+), 299 deletions(-) diff --git a/emacs/notmuch-company.el b/emacs/notmuch-company.el index 3e12e7a9..ac998f9b 100644 --- a/emacs/notmuch-company.el +++ b/emacs/notmuch-company.el @@ -27,7 +27,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) + (require 'notmuch-lib) (defvar notmuch-company-last-prefix nil) @@ -65,7 +66,7 @@ (require 'company) (let ((case-fold-search t) (completion-ignore-case t)) - (case command + (cl-case command (interactive (company-begin-backend 'notmuch-company)) (prefix (and (derived-mode-p 'message-mode) (looking-back (concat notmuch-address-completion-headers-regexp ".*") diff --git a/emacs/notmuch-draft.el b/emacs/notmuch-draft.el index e22e0d16..504b33be 100644 --- a/emacs/notmuch-draft.el +++ b/emacs/notmuch-draft.el @@ -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. `notmuch-draft-save-plaintext' controls the behaviour." - (case notmuch-draft-save-plaintext + (cl-case notmuch-draft-save-plaintext ((ask) (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. diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index ab6ee798..bdf584e6 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -21,7 +21,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) + (require 'widget) (require 'wid-edit) ; For `widget-forward'. @@ -47,17 +48,19 @@ lists (NAME QUERY COUNT-QUERY)." ((keywordp (car saved-search)) (plist-get saved-search field)) ;; It is not a plist so it is an old-style entry. - ((consp (cdr saved-search)) ;; It is a list (NAME QUERY COUNT-QUERY) - (case field - (:name (first saved-search)) - (:query (second saved-search)) - (:count-query (third saved-search)) - (t nil))) - (t ;; It is a cons-cell (NAME . QUERY) - (case field - (:name (car saved-search)) - (:query (cdr saved-search)) - (t nil))))) + ((consp (cdr saved-search)) + (pcase-let ((`(,name ,query ,count-query) saved-search)) + (cl-case field + (:name name) + (:query query) + (:count-query count-query) + (t nil)))) + (t + (pcase-let ((`(,name . ,query) saved-search)) + (cl-case field + (:name name) + (:query query) + (t nil)))))) (defun notmuch-hello-saved-search-to-plist (saved-search) "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 return that." (if (keywordp (car saved-search)) - (copy-seq saved-search) + (copy-sequence saved-search) (let ((fields (list :name :query :count-query)) plist-search) (dolist (field fields plist-search) @@ -396,10 +399,10 @@ afterwards.") notmuch-saved-searches))) ;; If an existing saved search with this name exists, remove it. (setq notmuch-saved-searches - (loop for elem in notmuch-saved-searches - if (not (equal name - (notmuch-saved-search-get elem :name))) - collect elem)) + (cl-loop for elem in notmuch-saved-searches + if (not (equal name + (notmuch-saved-search-get elem :name))) + collect elem)) ;; Add the new one. (customize-save-variable 'notmuch-saved-searches (add-to-list 'notmuch-saved-searches @@ -417,28 +420,28 @@ afterwards.") (notmuch-hello-update))) (defun notmuch-hello-longest-label (searches-alist) - (or (loop for elem in searches-alist - maximize (length (notmuch-saved-search-get elem :name))) + (or (cl-loop for elem in searches-alist + maximize (length (notmuch-saved-search-get elem :name))) 0)) (defun notmuch-hello-reflect-generate-row (ncols nrows row list) (let ((len (length list))) - (loop for col from 0 to (- ncols 1) - collect (let ((offset (+ (* nrows col) row))) - (if (< offset len) - (nth offset list) - ;; Don't forget to insert an empty slot in the - ;; output matrix if there is no corresponding - ;; value in the input matrix. - nil))))) + (cl-loop for col from 0 to (- ncols 1) + collect (let ((offset (+ (* nrows col) row))) + (if (< offset len) + (nth offset list) + ;; Don't forget to insert an empty slot in the + ;; output matrix if there is no corresponding + ;; value in the input matrix. + nil))))) (defun notmuch-hello-reflect (list ncols) "Reflect a `ncols' wide matrix represented by `list' along the diagonal." ;; Not very lispy... (let ((nrows (ceiling (length list) ncols))) - (loop for row from 0 to (- nrows 1) - append (notmuch-hello-reflect-generate-row ncols nrows row list)))) + (cl-loop for row from 0 to (- nrows 1) + append (notmuch-hello-reflect-generate-row ncols nrows row list)))) (defun notmuch-hello-widget-search (widget &rest ignore) (cond @@ -584,7 +587,7 @@ with `notmuch-hello-query-counts'." (widget-insert (make-string column-indent ? ))) (let* ((name (plist-get elem :name)) (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) (oldest-first t) (otherwise notmuch-search-oldest-first))) @@ -812,48 +815,48 @@ Complete list of currently available key bindings: "clear") (widget-insert "\n\n") (let ((start (point))) - (loop for i from 1 to notmuch-hello-recent-searches-max - for search in notmuch-search-history do - (let ((widget-symbol (intern (format "notmuch-hello-search-%d" i)))) - (set widget-symbol - (widget-create 'editable-field - ;; Don't let the search boxes be - ;; less than 8 characters wide. - :size (max 8 - (- (window-width) - ;; Leave some space - ;; at the start and - ;; end of the - ;; boxes. - (* 2 notmuch-hello-indent) - ;; 1 for the space - ;; before the - ;; `[save]' button. 6 - ;; for the `[save]' - ;; button. - 1 6 - ;; 1 for the space - ;; before the `[del]' - ;; button. 5 for the - ;; `[del]' button. - 1 5)) - :action (lambda (widget &rest ignore) - (notmuch-hello-search (widget-value widget))) - search)) - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (widget &rest ignore) - (notmuch-hello-add-saved-search widget)) - :notmuch-saved-search-widget widget-symbol - "save") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (widget &rest ignore) - (when (y-or-n-p "Are you sure you want to delete this search? ") - (notmuch-hello-delete-search-from-history widget))) - :notmuch-saved-search-widget widget-symbol - "del")) - (widget-insert "\n")) + (cl-loop for i from 1 to notmuch-hello-recent-searches-max + for search in notmuch-search-history do + (let ((widget-symbol (intern (format "notmuch-hello-search-%d" i)))) + (set widget-symbol + (widget-create 'editable-field + ;; Don't let the search boxes be + ;; less than 8 characters wide. + :size (max 8 + (- (window-width) + ;; Leave some space + ;; at the start and + ;; end of the + ;; boxes. + (* 2 notmuch-hello-indent) + ;; 1 for the space + ;; before the + ;; `[save]' button. 6 + ;; for the `[save]' + ;; button. + 1 6 + ;; 1 for the space + ;; before the `[del]' + ;; button. 5 for the + ;; `[del]' button. + 1 5)) + :action (lambda (widget &rest ignore) + (notmuch-hello-search (widget-value widget))) + search)) + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (widget &rest ignore) + (notmuch-hello-add-saved-search widget)) + :notmuch-saved-search-widget widget-symbol + "save") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (widget &rest ignore) + (when (y-or-n-p "Are you sure you want to delete this search? ") + (notmuch-hello-delete-search-from-history widget))) + :notmuch-saved-search-widget widget-symbol + "del")) + (widget-insert "\n")) (indent-rigidly start (point) notmuch-hello-indent)) nil)) diff --git a/emacs/notmuch-jump.el b/emacs/notmuch-jump.el index 1cdf5b50..92a5a2cc 100644 --- a/emacs/notmuch-jump.el +++ b/emacs/notmuch-jump.el @@ -22,7 +22,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl-lib) + (require 'pcase)) (require 'notmuch-lib) (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)) (query (plist-get saved-search :query)) (oldest-first - (case (plist-get saved-search :sort-order) + (cl-case (plist-get saved-search :sort-order) (newest-first nil) (oldest-first t) (otherwise (default-value 'notmuch-search-oldest-first))))) @@ -127,18 +129,16 @@ buffer." ;; Compute the maximum key description width (let ((key-width 1)) - (dolist (entry action-map) + (pcase-dolist (`(,key ,desc) action-map) (setq key-width (max key-width - (string-width (format-kbd-macro (first entry)))))) + (string-width (format-kbd-macro key))))) ;; Format each action - (mapcar (lambda (entry) - (let ((key (format-kbd-macro (first entry))) - (desc (second entry))) - (concat - (propertize key 'face 'minibuffer-prompt) - (make-string (- key-width (length key)) ? ) - " " desc))) + (mapcar (pcase-lambda (`(,key ,desc)) + (setq key (format-kbd-macro key)) + (concat (propertize key 'face 'minibuffer-prompt) + (make-string (- key-width (length key)) ? ) + " " desc)) action-map))) (defun notmuch-jump--insert-items (width items) @@ -173,28 +173,25 @@ buffer." "Translate ACTION-MAP into a minibuffer keymap." (let ((map (make-sparse-keymap))) (set-keymap-parent map notmuch-jump-minibuffer-map) - (dolist (action action-map) - (if (= (length (first action)) 1) - (define-key map (first action) + (pcase-dolist (`(,key ,name ,fn) action-map) + (if (= (length key) 1) + (define-key map key `(lambda () (interactive) - (setq notmuch-jump--action ',(third action)) + (setq notmuch-jump--action ',fn) (exit-minibuffer))))) ;; By doing this in two passes (and checking if we already have a ;; binding) we avoid problems if the user specifies a binding which ;; is a prefix of another binding. - (dolist (action action-map) - (if (> (length (first action)) 1) - (let* ((key (elt (first action) 0)) + (pcase-dolist (`(,key ,name ,fn) action-map) + (if (> (length key) 1) + (let* ((key (elt key 0)) (keystr (string key)) (new-prompt (concat prompt (format-kbd-macro keystr) " ")) (action-submap nil)) (unless (lookup-key map keystr) - (dolist (act action-map) - (when (= key (elt (first act) 0)) - (push (list (substring (first act) 1) - (second act) - (third act)) - action-submap))) + (pcase-dolist (`(,k ,n ,f) action-map) + (when (= key (elt k 0)) + (push (list (substring k 1) n f) action-submap))) ;; We deal with backspace specially (push (list (kbd "DEL") "Backup" diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index e085a06b..01862f44 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -23,10 +23,12 @@ ;;; Code: +(require 'cl-lib) + (require 'mm-util) (require 'mm-view) (require 'mm-decode) -(require 'cl) + (require 'notmuch-compat) (unless (require 'notmuch-version nil t) @@ -574,7 +576,7 @@ for this message, if present." (defun notmuch-parts-filter-by-type (parts type) "Given a list of message parts, return a list containing the ones matching the given type." - (remove-if-not + (cl-remove-if-not (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type)) parts)) @@ -685,8 +687,8 @@ current buffer, if possible." ;; have symbols of the form :Header as keys, and the resulting alist will have ;; symbols of the form 'Header as keys. (defun notmuch-headers-plist-to-alist (plist) - (loop for (key value . rest) on plist by #'cddr - collect (cons (intern (substring (symbol-name key) 1)) value))) + (cl-loop for (key value . rest) on plist by #'cddr + collect (cons (intern (substring (symbol-name key) 1)) value))) (defun notmuch-face-ensure-list-form (face) "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 provided, it is taken from `process-command'." (let ((exit-status - (case (process-status proc) + (cl-case (process-status proc) ((exit) (process-exit-status proc)) ((signal) msg)))) (when exit-status @@ -848,7 +850,7 @@ for `call-process'. ARGS is as described for (let (stdin-string) (while (keywordp (car args)) - (case (car args) + (cl-case (car args) (:stdin-string (setq stdin-string (cadr args) args (cddr args))) (otherwise @@ -1026,8 +1028,4 @@ region if the region is active, or both `point' otherwise." (provide 'notmuch-lib) -;; Local Variables: -;; byte-compile-warnings: (not cl-functions) -;; End: - ;;; notmuch-lib.el ends here diff --git a/emacs/notmuch-maildir-fcc.el b/emacs/notmuch-maildir-fcc.el index ae56bacd..b9cca543 100644 --- a/emacs/notmuch-maildir-fcc.el +++ b/emacs/notmuch-maildir-fcc.el @@ -22,7 +22,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) + (require 'message) (require 'notmuch-lib) @@ -251,12 +252,12 @@ If CREATE is non-nil then create the folder if necessary." (let ((response (notmuch-read-char-choice "Insert failed: (r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " '(?r ?c ?i ?e)))) - (case response - (?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header)) - (?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't)) - (?i 't) - (?e (notmuch-maildir-fcc-with-notmuch-insert - (read-from-minibuffer "Fcc header: " fcc-header))))))))) + (cl-case response + (?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header)) + (?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't)) + (?i 't) + (?e (notmuch-maildir-fcc-with-notmuch-insert + (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? " fcc-header)) (response (notmuch-read-char-choice prompt '(?r ?c ?i ?e)))) - (case response - (?r (notmuch-maildir-fcc-file-fcc fcc-header)) - (?c (if (file-writable-p fcc-header) - (notmuch-maildir-fcc-create-maildir fcc-header) - (message "No permission to create %s." fcc-header) - (sit-for 2)) - (notmuch-maildir-fcc-file-fcc fcc-header)) - (?i 't) - (?e (notmuch-maildir-fcc-file-fcc - (read-from-minibuffer "Fcc header: " fcc-header))))))) + (cl-case response + (?r (notmuch-maildir-fcc-file-fcc fcc-header)) + (?c (if (file-writable-p fcc-header) + (notmuch-maildir-fcc-create-maildir fcc-header) + (message "No permission to create %s." fcc-header) + (sit-for 2)) + (notmuch-maildir-fcc-file-fcc fcc-header)) + (?i 't) + (?e (notmuch-maildir-fcc-file-fcc + (read-from-minibuffer "Fcc header: " fcc-header))))))) (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen) "Writes the current buffer to maildir destdir. If mark-seen is diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 76572b87..40a1e6bc 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -21,6 +21,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (require 'message) (require 'mm-view) (require 'format-spec) @@ -30,8 +32,6 @@ (require 'notmuch-draft) (require 'notmuch-message) -(eval-when-compile (require 'cl)) - (declare-function notmuch-show-insert-body "notmuch-show" (msg body depth)) (declare-function notmuch-fcc-header-setup "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 (let ((search-limit (search-forward "\n<#" nil t))) (message-goto-body) - (loop while (re-search-forward notmuch-mua-attachment-regexp search-limit t) - ;; For every instance of the "attachment" string - ;; found, examine the text properties. If the text - ;; has either a `face' or `syntax-table' property - ;; then it is quoted text and should *not* cause the - ;; user to be asked about a missing attachment. - if (let ((props (text-properties-at (match-beginning 0)))) - (not (or (memq 'syntax-table props) - (memq 'face props)))) - return t - finally return nil))) + (cl-loop while (re-search-forward notmuch-mua-attachment-regexp + search-limit t) + ;; For every instance of the "attachment" string + ;; found, examine the text properties. If the text + ;; has either a `face' or `syntax-table' property + ;; then it is quoted text and should *not* cause the + ;; user to be asked about a missing attachment. + if (let ((props (text-properties-at (match-beginning 0)))) + (not (or (memq 'syntax-table props) + (memq 'face props)))) + return t + finally return nil))) ;; ...but doesn't have a part with a filename... (save-excursion (message-goto-body) @@ -203,11 +204,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." - (loop for part in parts - 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/*") - do (notmuch-mua-reply-crypto (plist-get part :content)))) + (cl-loop for part in parts + 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/*") + do (notmuch-mua-reply-crypto (plist-get part :content)))) ;; 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 @@ -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. ;; See the comment above on notmuch-mua-insert-references. (let ((message-header-format-alist - (loop for pair in message-header-format-alist - if (eq (car pair) 'References) - collect (cons 'References - (apply-partially - 'notmuch-mua-insert-references - (cdr pair))) - else - collect pair))) + (cl-loop for pair in message-header-format-alist + if (eq (car pair) 'References) + collect (cons 'References + (apply-partially + 'notmuch-mua-insert-references + (cdr pair))) + else + collect pair))) (notmuch-mua-mail (plist-get reply-headers :To) (notmuch-sanitize (plist-get reply-headers :Subject)) (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. (notmuch-show-indent-multipart nil)) ;; We don't want sigstatus buttons (an information leak and usually wrong anyway). - (letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore) - ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) - (notmuch-show-insert-body original (plist-get original :body) 0) - (buffer-substring-no-properties (point-min) (point-max)))))) + (cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore) + ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) + (notmuch-show-insert-body original (plist-get original :body) 0) + (buffer-substring-no-properties (point-min) (point-max)))))) (set-mark (point)) (goto-char start) @@ -526,10 +527,9 @@ the From: address." ;; 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 - (loop for id in forward-queries - collect - (cons id - notmuch-message-forwarded-tags)))) + (cl-loop for id in forward-queries + collect + (cons id notmuch-message-forwarded-tags)))) ;; `message-forward-make-body' shows the User-agent header. Hide ;; it again. @@ -609,10 +609,10 @@ 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)) - (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc)) - (if exit - (message-send-and-exit arg) - (message-send arg))))) + (cl-letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc)) + (if exit + (message-send-and-exit arg) + (message-send arg))))) (defun notmuch-mua-send-and-exit (&optional arg) (interactive "P") diff --git a/emacs/notmuch-parser.el b/emacs/notmuch-parser.el index bb0379c1..dc9fbe2f 100644 --- a/emacs/notmuch-parser.el +++ b/emacs/notmuch-parser.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'cl) +(eval-when-compile (require 'cl-lib)) (defun notmuch-sexp-create-parser () "Return a new streaming S-expression parser. @@ -70,7 +70,7 @@ returns the value." ;; error to be consistent with all other code paths. (read (current-buffer)) ;; Go up a level and return an end token - (decf (notmuch-sexp--depth sp)) + (cl-decf (notmuch-sexp--depth sp)) (forward-char) 'end)) ((= (char-after) ?\() @@ -94,8 +94,8 @@ returns the value." (notmuch-sexp--partial-state sp))) ;; A complete value is available if we've ;; reached depth 0. - (depth (first new-state))) - (assert (>= depth 0)) + (depth (car new-state))) + (cl-assert (>= depth 0)) (if (= depth 0) ;; Reset partial parse state (setf (notmuch-sexp--partial-state sp) nil @@ -139,7 +139,7 @@ beginning of a list, throw invalid-read-syntax." (cond ((eobp) 'retry) ((= (char-after) ?\() (forward-char) - (incf (notmuch-sexp--depth sp)) + (cl-incf (notmuch-sexp--depth sp)) t) (t ;; 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)) (let (done) (while (not done) - (case notmuch-sexp--state + (cl-case notmuch-sexp--state (begin ;; Enter the list (if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry) @@ -190,7 +190,7 @@ move point in the input buffer." (result ;; Parse a result (let ((result (notmuch-sexp-read notmuch-sexp--parser))) - (case result + (cl-case result (retry (setq done t)) (end (setq notmuch-sexp--state 'end)) (t (with-current-buffer result-buffer @@ -204,8 +204,4 @@ move point in the input buffer." (provide 'notmuch-parser) -;; Local Variables: -;; byte-compile-warnings: (not cl-functions) -;; End: - ;;; notmuch-parser.el ends here diff --git a/emacs/notmuch-pkg.el.tmpl b/emacs/notmuch-pkg.el.tmpl index 3eb0e04e..9d0999c1 100644 --- a/emacs/notmuch-pkg.el.tmpl +++ b/emacs/notmuch-pkg.el.tmpl @@ -3,4 +3,5 @@ "notmuch" %VERSION% "Emacs based front-end (MUA) for notmuch" - '((emacs "24"))) + '((emacs "24") + (cl-lib "0.6.1"))) diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el index 079281c3..59931453 100644 --- a/emacs/notmuch-show.el +++ b/emacs/notmuch-show.el @@ -23,7 +23,10 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl-lib) + (require 'pcase)) + (require 'mm-view) (require 'message) (require 'mm-decode) @@ -429,17 +432,16 @@ parsing fails." (setq p-name (replace-regexp-in-string "\\\\" "" p-name)) ;; Outer single and double quotes, which might be nested. - (loop - with start-of-loop - do (setq start-of-loop p-name) + (cl-loop with start-of-loop + do (setq start-of-loop p-name) - when (string-match "^\"\\(.*\\)\"$" p-name) - do (setq p-name (match-string 1 p-name)) + when (string-match "^\"\\(.*\\)\"$" p-name) + do (setq p-name (match-string 1 p-name)) - when (string-match "^'\\(.*\\)'$" p-name) - do (setq p-name (match-string 1 p-name)) + when (string-match "^'\\(.*\\)'$" 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 ' then show just ;; 'foo@bar.com'. @@ -573,13 +575,13 @@ message at DEPTH in the current thread." ;; Recurse on sub-parts (let ((ctype (notmuch-split-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) (plist-get part :content))) ((equal ctype '("message" "rfc822")) (notmuch-show--register-cids 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) "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." (let ((descriptor (cdr (assoc cid notmuch-show--cids)))) (when descriptor - (let* ((msg (first descriptor)) - (part (second descriptor)) + (let* ((msg (car descriptor)) + (part (cadr descriptor)) ;; Request caching for this content, as some messages ;; reference the same cid: part many times (hundreds!). (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 (notmuch-show--get-cid-content cid)))) (when content-and-type - (insert (first content-and-type)) - (second content-and-type)))) + (insert (car content-and-type)) + (cadr content-and-type)))) ;; 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 ;; in enriched.el may be loaded a bit later and used instead (for the first time). (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)))) (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 ;; URL-decode it (see RFC 2392). (let ((cid (url-unhex-string url))) - (first (notmuch-show--get-cid-content cid)))))) + (car (notmuch-show--get-cid-content cid)))))) (shr-insert-document dom) 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) ;; Run the handlers until one of them succeeds. - (loop for handler in (notmuch-show-handlers-for content-type) - until (condition-case err - (funcall handler msg part content-type nth depth button) - ;; Specifying `debug' here lets the debugger run if - ;; `debug-on-error' is non-nil. - ((debug error) - (insert "!!! Bodypart handler `" (prin1-to-string handler) "' threw an error:\n" - "!!! " (error-message-string err) "\n") - nil)))) + (cl-loop for handler in (notmuch-show-handlers-for content-type) + until (condition-case err + (funcall handler msg part content-type nth depth button) + ;; Specifying `debug' here lets the debugger run if + ;; `debug-on-error' is non-nil. + ((debug error) + (insert "!!! Bodypart handler `" (prin1-to-string handler) + "' threw an error:\n" + "!!! " (error-message-string err) "\n") + nil)))) (defun notmuch-show-create-part-overlays (button beg 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 ;; front-sticky/rear-nonsticky. (notmuch-map-text-property beg end 'front-sticky - (lambda (v) (if (listp v) - (pushnew :notmuch-part v) - v))) + (lambda (v) + (if (listp v) + (cl-pushnew :notmuch-part v) + v))) (notmuch-map-text-property beg end 'rear-nonsticky - (lambda (v) (if (listp v) - (pushnew :notmuch-part v) - v)))) + (lambda (v) + (if (listp v) + (cl-pushnew :notmuch-part v) + v)))) (defun notmuch-show-lazy-part (part-args button) ;; 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))) (goto-char part-end) (delete-char 1) - (notmuch-show-record-part-information (second part-args) + (notmuch-show-record-part-information (cadr part-args) (button-start button) part-end) ;; 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 ;; 2392, content IDs are *global*, but it's okay if an MUA treats ;; 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)) @@ -1220,13 +1225,13 @@ buttons for a corresponding notmuch search." (url-unhex-string (match-string 0 mid-cid))))) (push (list (match-beginning 0) (match-end 0) (notmuch-id-to-query mid)) links))) - (dolist (link links) + (pcase-dolist (`(,beg ,end ,link) links) ;; Remove the overlay created by goto-address-mode - (remove-overlays (first link) (second link) 'goto-address t) - (make-text-button (first link) (second link) + (remove-overlays beg end 'goto-address t) + (make-text-button beg end :type 'notmuch-button-type 'action `(lambda (arg) - (notmuch-show ,(third link) current-prefix-arg)) + (notmuch-show ,link current-prefix-arg)) 'follow-link t 'help-echo "Mouse-1, RET: search for this message" 'face goto-address-mail-face))))) @@ -1387,9 +1392,9 @@ This includes: (defun notmuch-show-goto-message (msg-id) "Go to message with msg-id." (goto-char (point-min)) - (unless (loop if (string= msg-id (notmuch-show-get-message-id)) - return t - until (not (notmuch-show-goto-message-next))) + (unless (cl-loop if (string= msg-id (notmuch-show-get-message-id)) + return t + until (not (notmuch-show-goto-message-next))) (goto-char (point-min)) (message "Message-id not found.")) (notmuch-show-message-adjust)) @@ -1406,9 +1411,9 @@ This includes: ;; Open those that were open. (goto-char (point-min)) - (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))) + (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))) (dolist (win-msg-pair win-msg-alist) (with-selected-window (car win-msg-pair) @@ -1620,8 +1625,8 @@ of the current message." effects." (save-excursion (goto-char (point-min)) - (loop do (funcall function) - while (notmuch-show-goto-message-next)))) + (cl-loop do (funcall function) + while (notmuch-show-goto-message-next)))) ;; Functions relating to the visibility of messages and their ;; components. @@ -2177,9 +2182,9 @@ argument, hide all of the messages." (interactive) (save-excursion (goto-char (point-min)) - (loop do (notmuch-show-message-visible (notmuch-show-get-message-properties) - (not current-prefix-arg)) - until (not (notmuch-show-goto-message-next)))) + (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)) (defun notmuch-show-next-button () diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index 0500927d..bc83e3de 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -24,8 +24,12 @@ ;;; Code: ;; -(require 'cl) +(require 'cl-lib) +(eval-when-compile + (require 'pcase)) + (require 'crm) + (require 'notmuch-lib) (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 ;; Don't use assoc-default since there's no way to distinguish a ;; missing key from a present key with a null cdr. - (assoc* tag format-alist - :test (lambda (tag key) - (and (eq (string-match key tag) 0) - (= (match-end 0) (length tag))))))) + (cl-assoc tag format-alist + :test (lambda (tag key) + (and (eq (string-match key tag) 0) + (= (match-end 0) (length tag))))))) (defun notmuch-tag--do-format (tag formatted-tag formats) "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))) (when (eq formatted-tag 'missing) (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats)) - (over (case tag-state + (over (cl-case tag-state (deleted (notmuch-tag--get-formats tag notmuch-tag-deleted-formats)) (added (notmuch-tag--get-formats @@ -436,7 +440,7 @@ from TAGS if present." (dolist (tag-change tag-changes) (let ((op (string-to-char tag-change)) (tag (unless (string= tag-change "") (substring tag-change 1)))) - (case op + (cl-case op (?+ (unless (member tag result-tags) (push tag result-tags))) (?- (setq result-tags (delete tag result-tags))) @@ -511,22 +515,21 @@ and vice versa." ;; REVERSE is specified. (interactive "P") (let (action-map) - (dolist (binding notmuch-tagging-keys) - (let* ((tag-function (case major-mode + (pcase-dolist (`(,key ,tag ,name) notmuch-tagging-keys) + (let* ((tag-function (cl-case major-mode (notmuch-search-mode #'notmuch-search-tag) (notmuch-show-mode #'notmuch-show-tag) (notmuch-tree-mode #'notmuch-tree-tag))) - (key (first binding)) - (forward-tag-change (if (symbolp (second binding)) - (symbol-value (second binding)) - (second binding))) + (tag (if (symbolp tag) + (symbol-value tag) + tag)) (tag-change (if reverse - (notmuch-tag-change-list forward-tag-change 't) - forward-tag-change)) - (name (or (and (not (string= (third binding) "")) - (third binding)) - (and (symbolp (second binding)) - (symbol-name (second binding))))) + (notmuch-tag-change-list tag 't) + tag)) + (name (or (and (not (string= name "")) + name) + (and (symbolp name) + (symbol-name name)))) (name-string (if name (if reverse (concat "Reverse " name) name) @@ -546,7 +549,3 @@ and vice versa." ;; (provide 'notmuch-tag) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions) -;; End: diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index e5c23de2..254664c4 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -24,6 +24,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (require 'mail-parse) (require 'notmuch-lib) @@ -32,7 +34,6 @@ (require 'notmuch-tag) (require 'notmuch-parser) -(eval-when-compile (require 'cl)) (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)) @@ -721,10 +722,10 @@ found or nil if not." and call FUNCTION for side effects." (save-excursion (notmuch-tree-thread-top) - (loop collect (funcall function) - do (forward-line) - while (and (notmuch-tree-get-message-properties) - (not (notmuch-tree-get-prop :first)))))) + (cl-loop collect (funcall function) + do (forward-line) + while (and (notmuch-tree-get-message-properties) + (not (notmuch-tree-get-prop :first)))))) (defun notmuch-tree-get-messages-ids-thread-search () "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) "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest." (let ((n (length thread))) - (loop for tree in thread - for count from 1 to n - - do (notmuch-tree-insert-tree tree depth tree-status (eq count 1) (eq count n))))) + (cl-loop for tree in thread + for count from 1 to n + do (notmuch-tree-insert-tree tree depth tree-status + (eq count 1) + (eq count n))))) (defun notmuch-tree-insert-forest-thread (forest-thread) "Insert a single complete thread." diff --git a/emacs/notmuch.el b/emacs/notmuch.el index f5f03244..a980c7a2 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -65,7 +65,8 @@ ;; ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) + (require 'mm-view) (require 'message) @@ -132,7 +133,7 @@ there will be called at other points of notmuch execution." (or (equal (car disposition) "attachment") (and (equal (car disposition) "inline") (assq 'filename disposition))) - (incf count)))) + (cl-incf count)))) mm-handle) 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 (= BEG END), FN will be applied to the result containing point BEG." - - (lexical-let ((pos (notmuch-search-result-beginning beg)) - ;; End must be a marker in case fn changes the - ;; text. - (end (copy-marker end)) - ;; Make sure we examine at least one result, even if - ;; (= beg end). - (first t)) + (let ((pos (notmuch-search-result-beginning beg)) + ;; End must be a marker in case fn changes the + ;; text. + (end (copy-marker end)) + ;; Make sure we examine at least one result, even if + ;; (= beg end). + (first t)) ;; 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 ;; pos. @@ -478,10 +478,10 @@ is nil, include both matched and unmatched messages. If there are no messages in the region then return nil." (let ((query-list nil) (all (not only-matched))) (dolist (queries (notmuch-search-properties-in-region :query beg end)) - (when (first queries) - (push (first queries) query-list)) - (when (and all (second queries)) - (push (second queries) query-list))) + (when (car queries) + (push (car queries) query-list)) + (when (and all (cadr queries)) + (push (cadr queries) query-list))) (when query-list (concat "(" (mapconcat 'identity query-list ") or (") ")")))) @@ -568,12 +568,11 @@ thread." "Prompt for tag changes for the current thread or region. Returns (TAG-CHANGES REGION-BEGIN REGION-END)." - (let* ((region (notmuch-interactive-region)) - (beg (first region)) (end (second region)) - (prompt (if (= beg end) "Tag thread" "Tag region"))) - (cons (notmuch-read-tag-changes - (notmuch-search-get-tags-region beg end) prompt initial-input) - region))) + (pcase-let ((`(,beg ,end) (notmuch-interactive-region))) + (list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end) + (if (= beg end) "Tag thread" "Tag region") + initial-input) + beg end))) (defun notmuch-search-tag (tag-changes &optional beg end only-matched) "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 (longest (longest-length 0)) - (loop for tuple in notmuch-saved-searches - if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query)))) - (and (string-match (concat "^" quoted-query) query) - (> (length (match-string 0 query)) - longest-length))) - do (setq longest tuple)) + (cl-loop for tuple in notmuch-saved-searches + if (let ((quoted-query + (regexp-quote (notmuch-saved-search-get tuple :query)))) + (and (string-match (concat "^" quoted-query) query) + (> (length (match-string 0 query)) + longest-length))) + do (setq longest tuple)) longest)) (saved-search-name (notmuch-saved-search-get saved-search :name)) (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. PROMPT is the string to prompt with." - (lexical-let* + (let* ((all-tags (mapcar (lambda (tag) (notmuch-escape-boolean-term tag)) (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 (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types))))) (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-show-mode (notmuch-show-get-query)) (notmuch-tree-mode (notmuch-tree-get-query)))) @@ -1114,9 +1114,9 @@ notmuch buffers exist, run `notmuch'." (bury-buffer)) ;; Find the first notmuch buffer. - (setq first (loop for buffer in (buffer-list) - if (notmuch-interesting-buffer buffer) - return buffer)) + (setq first (cl-loop for buffer in (buffer-list) + if (notmuch-interesting-buffer buffer) + return buffer)) (if first ;; If the first one we found is any other than the starting diff --git a/test/T450-emacs-show.sh b/test/T450-emacs-show.sh index de1755d2..cca56ca3 100755 --- a/test/T450-emacs-show.sh +++ b/test/T450-emacs-show.sh @@ -177,7 +177,7 @@ test_emacs "(let ((notmuch-command \"$PWD/notmuch_fail\")) (let ((inhibit-read-only t)) (erase-buffer))) (condition-case err (notmuch-show \"*\") - (error (message \"%s\" (second err)))) + (error (message \"%s\" (cadr err)))) (notmuch-test-wait) (with-current-buffer \"*Messages*\" (test-output \"MESSAGES\")) diff --git a/test/emacs-attachment-warnings.el b/test/emacs-attachment-warnings.el index a3067b14..a23692d7 100644 --- a/test/emacs-attachment-warnings.el +++ b/test/emacs-attachment-warnings.el @@ -1,3 +1,4 @@ +(require 'cl-lib) (require 'notmuch-mua) (defun attachment-check-test (&optional fn) @@ -12,7 +13,8 @@ Return `t' if the message would be sent, otherwise `nil'" (condition-case nil ;; Force `y-or-n-p' to always return `nil', as if the user ;; 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) t) ('error nil)) diff --git a/test/test-lib.el b/test/test-lib.el index 9946010b..3ae7a090 100644 --- a/test/test-lib.el +++ b/test/test-lib.el @@ -20,7 +20,7 @@ ;; ;; Authors: Dmitry Kurochkin -(require 'cl) ;; This code is generally used uncompiled. +(require 'cl-lib) ;; `read-file-name' by default uses `completing-read' function to read ;; 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) "Feed notmuch-search-process-filter one character at a time." (let ((string (ad-get-arg 1))) - (loop for char across string - do (progn - (ad-set-arg 1 (char-to-string char)) - ad-do-it)))) + (cl-loop for char across string + do (progn + (ad-set-arg 1 (char-to-string char)) + ad-do-it)))) (defun notmuch-test-mark-links () "Enclose links in the current buffer with << and >>." @@ -162,10 +162,10 @@ nothing." ;; reporting differing elements of OUTPUT and EXPECTED ;; pairwise. This is expected to make analysis of failures ;; simpler. - (apply #'concat (loop for o in output - for e in expected - if (not (equal o e)) - collect (notmuch-test-report-unexpected o e)))) + (apply #'concat (cl-loop for o in output + for e in expected + if (not (equal o e)) + collect (notmuch-test-report-unexpected o e)))) (t (notmuch-test-report-unexpected output expected)))))