]> git.notmuchmail.org Git - notmuch/commitdiff
emacs: Use `cl-lib' instead of deprecated `cl'
authorJonas Bernoulli <jonas@bernoul.li>
Sat, 25 Apr 2020 20:18:07 +0000 (22:18 +0200)
committerDavid Bremner <david@tethera.net>
Mon, 27 Apr 2020 10:36:10 +0000 (07:36 -0300)
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.

16 files changed:
emacs/notmuch-company.el
emacs/notmuch-draft.el
emacs/notmuch-hello.el
emacs/notmuch-jump.el
emacs/notmuch-lib.el
emacs/notmuch-maildir-fcc.el
emacs/notmuch-mua.el
emacs/notmuch-parser.el
emacs/notmuch-pkg.el.tmpl
emacs/notmuch-show.el
emacs/notmuch-tag.el
emacs/notmuch-tree.el
emacs/notmuch.el
test/T450-emacs-show.sh
test/emacs-attachment-warnings.el
test/test-lib.el

index 3e12e7a9f729984899dc32e5cbf2cb1b8e930710..ac998f9b4496d39f157923846329e9f301e32848 100644 (file)
@@ -27,7 +27,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
 (require 'notmuch-lib)
 
 (defvar notmuch-company-last-prefix nil)
 (require 'notmuch-lib)
 
 (defvar notmuch-company-last-prefix nil)
@@ -65,7 +66,7 @@
   (require 'company)
   (let ((case-fold-search t)
        (completion-ignore-case t))
   (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 ".*")
       (interactive (company-begin-backend 'notmuch-company))
       (prefix (and (derived-mode-p 'message-mode)
                   (looking-back (concat notmuch-address-completion-headers-regexp ".*")
index e22e0d1638b7b206fe4bd08470ec5e04a707b7f7..504b33be44bcee8248ff2595d578103d51b23d34 100644 (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.
 
 `notmuch-draft-save-plaintext' controls the behaviour."
   "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.
        ((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.
index ab6ee79881f1a18fc3936a29331f04b3de58d5be..bdf584e66da66057dc0d2265d0baf9afb51af3da 100644 (file)
@@ -21,7 +21,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
 (require 'widget)
 (require 'wid-edit) ; For `widget-forward'.
 
 (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.
    ((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.
 
 (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))
 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)
     (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
                               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
     ;; 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)
     (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)))
       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)))
 
 (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
 
 (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))
                  (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)))
                                     (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)))
                   "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))
 
       (indent-rigidly start (point) notmuch-hello-indent))
     nil))
 
index 1cdf5b5090d7cb594f29338e3eb98cb56f64ceb1..92a5a2cca687986772cb7b49cd4603ba4a3c942c 100644 (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-hello)
 
 (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
          (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)))))
                   (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))
 
   ;; 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
       (setq 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)
-             (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)
            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)
   "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)
            `(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.
               (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)
                 (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"
              ;; We deal with backspace specially
              (push (list (kbd "DEL")
                          "Backup"
index e085a06bab1e58e7c35937c482e986c48d7d3a77..01862f442c43629027344b28b2a7aa18bea66abd 100644 (file)
 
 ;;; Code:
 
 
 ;;; Code:
 
+(require 'cl-lib)
+
 (require 'mm-util)
 (require 'mm-view)
 (require 'mm-decode)
 (require 'mm-util)
 (require 'mm-view)
 (require 'mm-decode)
-(require 'cl)
+
 (require 'notmuch-compat)
 
 (unless (require 'notmuch-version nil t)
 (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."
 (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))
 
    (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)
 ;; 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.
 
 (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
 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
           ((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))
 
   (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
        (: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)
 
 
 (provide 'notmuch-lib)
 
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
 ;;; notmuch-lib.el ends here
 ;;; notmuch-lib.el ends here
index ae56bacd50b549b395bf6c39460728b294fa6bf3..b9cca5431f741cdbc1cb182192a0a36820a81366 100644 (file)
@@ -22,7 +22,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
 (require 'message)
 
 (require 'notmuch-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))))
        (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))))
     (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
 
 (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen)
   "Writes the current buffer to maildir destdir. If mark-seen is
index 76572b87866172d078123052553746ddb5c109ae..40a1e6bc2a48b48718dea57ad3e8c375f7343564 100644 (file)
@@ -21,6 +21,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
+(eval-when-compile (require 'cl-lib))
+
 (require 'message)
 (require 'mm-view)
 (require 'format-spec)
 (require 'message)
 (require 'mm-view)
 (require 'format-spec)
@@ -30,8 +32,6 @@
 (require 'notmuch-draft)
 (require 'notmuch-message)
 
 (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" ())
 (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)
           ;; 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)
         ;; ...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."
 
 (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
 
 ;; 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
        ;; 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)
          (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).
                       ;; 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)
 
        (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
       ;; 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.
 
       ;; `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))
   (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")
 
 (defun notmuch-mua-send-and-exit (&optional arg)
   (interactive "P")
index bb0379c102f653c2df12b08afd012186f3003a3e..dc9fbe2f33911ec48294804de1098269a0f03426 100644 (file)
@@ -21,7 +21,7 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
-(require 'cl)
+(eval-when-compile (require 'cl-lib))
 
 (defun notmuch-sexp-create-parser ()
   "Return a new streaming S-expression parser.
 
 (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
             ;; 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) ?\()
           (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.
                                  (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
                 (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)
   (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
         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)
     (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)
        (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)))
        (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
             (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)
 
 
 (provide 'notmuch-parser)
 
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
 ;;; notmuch-parser.el ends here
 ;;; notmuch-parser.el ends here
index 3eb0e04e37d70fad7629bbccdb72ca1a462cb228..9d0999c122a9e20e2189766d0b600a3016458df7 100644 (file)
@@ -3,4 +3,5 @@
   "notmuch"
   %VERSION%
   "Emacs based front-end (MUA) for notmuch"
   "notmuch"
   %VERSION%
   "Emacs based front-end (MUA) for notmuch"
-  '((emacs "24")))
+  '((emacs "24")
+    (cl-lib "0.6.1")))
index 079281c341f0ea433d569d441f592ccea8058db6..59931453a018a4b7a5a58749e7d6447d696f2606 100644 (file)
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl-lib)
+  (require 'pcase))
+
 (require 'mm-view)
 (require 'message)
 (require 'mm-decode)
 (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.
        (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 <foo@bar.com>' then show just
       ;; 'foo@bar.com'.
 
       ;; If the address is 'foo@bar.com <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)))))
   ;; 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
           (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.
 
 (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
 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
             ;; 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
          (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
 
 
 ;; 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)
       ;; 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))))
 
                 (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)))
           ;; 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))
 
     (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.
 
 (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"
 
 (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
   ;; 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
   (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
 
 (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)
        (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
                                            (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.
   ;; 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))
 
 
   (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)))
                      (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 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)
                          :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)))))
                          '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))
 (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))
     (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))
 
     ;; 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)
 
     (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))
 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.
 
 ;; 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))
   (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 ()
   (force-window-update))
 
 (defun notmuch-show-next-button ()
index 0500927d37ce2b1e0173fb0f6ff7bc159a85018e..bc83e3de0fc3d30cc97f1325e2ebc87bc1bbfdeb 100644 (file)
 ;;; Code:
 ;;
 
 ;;; Code:
 ;;
 
-(require 'cl)
+(require 'cl-lib)
+(eval-when-compile
+  (require 'pcase))
+
 (require 'crm)
 (require 'crm)
+
 (require 'notmuch-lib)
 
 (declare-function notmuch-search-tag "notmuch" tag-changes)
 (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.
   (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."
 
 (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))
         (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
                    (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))))
     (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)))
          (?+ (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)
   ;; 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)))
                             (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
             (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)
             (name-string (if name
                              (if reverse (concat "Reverse " name)
                                name)
@@ -546,7 +549,3 @@ and vice versa."
 ;;
 
 (provide 'notmuch-tag)
 ;;
 
 (provide 'notmuch-tag)
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
index e5c23de260d478fc01f2f5d7af7f3aaf0e150120..254664c4718bfa0affbeb48b4e76054f3db022fa 100644 (file)
@@ -24,6 +24,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
+(eval-when-compile (require 'cl-lib))
+
 (require 'mail-parse)
 
 (require 'notmuch-lib)
 (require 'mail-parse)
 
 (require 'notmuch-lib)
@@ -32,7 +34,6 @@
 (require 'notmuch-tag)
 (require 'notmuch-parser)
 
 (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))
 (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)
  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."
 
 (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)))
 (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."
 
 (defun notmuch-tree-insert-forest-thread (forest-thread)
   "Insert a single complete thread."
index f5f0324485f63296ad43403eb8ede17bbda952e8..a980c7a212358a9e54943d90b1a3b4bcbd9e3e45 100644 (file)
@@ -65,7 +65,8 @@
 ;;
 ;;; Code:
 
 ;;
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
 (require 'mm-view)
 (require 'message)
 
 (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)))
               (or (equal (car disposition) "attachment")
                   (and (equal (car disposition) "inline")
                        (assq 'filename disposition)))
-              (incf count))))
+              (cl-incf count))))
      mm-handle)
     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."
 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.
     ;; 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))
 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 (") ")"))))
 
     (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)."
   "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.
 
 (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))
   (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)))
            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."
   "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" "*")))
       ((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))
                 (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))))
                           (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.
       (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
 
     (if first
        ;; If the first one we found is any other than the starting
index de1755d2da890d6891db54cdff0e35bd7e986f58..cca56ca32cd6875e6da4dbcd7b3b90932b3e3bef 100755 (executable)
@@ -177,7 +177,7 @@ test_emacs "(let ((notmuch-command \"$PWD/notmuch_fail\"))
                   (let ((inhibit-read-only t)) (erase-buffer)))
               (condition-case err
                   (notmuch-show \"*\")
                   (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\"))
               (notmuch-test-wait)
               (with-current-buffer \"*Messages*\"
                  (test-output \"MESSAGES\"))
index a3067b1463070f3dfdefcd958659e1cb7c965749..a23692d722e51d15d7020df3610dbda169ad2fdb 100644 (file)
@@ -1,3 +1,4 @@
+(require 'cl-lib)
 (require 'notmuch-mua)
 
 (defun attachment-check-test (&optional fn)
 (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".
       (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))
            (notmuch-mua-attachment-check)
            t)
        ('error nil))
index 9946010bfb9e37f1ff332493c3a55e3024233187..3ae7a0906efac2f2015492cce1286f188edd9e58 100644 (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
 ;; user input.  It does not respect `standard-input' variable which we
 
 ;; `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)))
 (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 >>."
 
 (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.
       ;; 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)))))
 
      (t
       (notmuch-test-report-unexpected output expected)))))