* lisp/allout.el, lisp/allout-widgets.el: Use cl-lib and pcase

Author: monnier

lisp/allout-widgets.el

@@ -70,12 +70,7 @@
 (require 'allout)
 (require 'widget)
 (require 'wid-edit)
-
-(eval-when-compile
-  (progn
-    (require 'overlay)
-    (require 'cl)
-    ))
+(eval-when-compile (require 'cl-lib))
 
 ;;;_ : internal variables needed before user-customization variables
 ;;; In order to enable activation of allout-widgets-mode via customization,
@@ -960,7 +955,7 @@ posting threshold criteria."
         (when changes-pending
           (while changes-record
             (setq entry (pop changes-record))
-            (case (car entry)
+            (pcase (car entry)
               (:exposed (push entry exposures))
               (:added (push entry additions))
               (:deleted (push entry deletions))
@@ -1378,34 +1373,34 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES."
 
     ;; fresh:
     (setq ranges nil)
-    (assert (equal (funcall try 3 5) '(nil ((3 5)))))
+    (cl-assert (equal (funcall try 3 5) '(nil ((3 5)))))
     ;; add range at end:
-    (assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
+    (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
     ;; add range at beginning:
-    (assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
+    (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
     ;; insert range somewhere in the middle:
-    (assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
+    (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
     ;; consolidate some:
-    (assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
+    (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
     ;; add more:
-    (assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
+    (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
     ;; add more:
-    (assert (equal (funcall try 20 22)
+    (cl-assert (equal (funcall try 20 22)
                    '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
     ;; encompass more:
-    (assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
+    (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
     ;; encompass all:
-    (assert (equal (funcall try 2 25) '(t ((1 25)))))
+    (cl-assert (equal (funcall try 2 25) '(t ((1 25)))))
 
     ;; fresh slate:
     (setq ranges nil)
-    (assert (equal (funcall try 20 25) '(nil ((20 25)))))
-    (assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
-    (assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
-    (assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
-    (assert (equal (funcall try 10 30) '(t ((10 35)))))
-    (assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
-    (assert (equal (funcall try 2 100) '(t ((2 100)))))
+    (cl-assert (equal (funcall try 20 25) '(nil ((20 25)))))
+    (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
+    (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
+    (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
+    (cl-assert (equal (funcall try 10 30) '(t ((10 35)))))
+    (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
+    (cl-assert (equal (funcall try 2 100) '(t ((2 100)))))
 
     (setq ranges nil)
     ))

lisp/allout.el

@@ -79,12 +79,7 @@
 
 ;;;_* Dependency loads
 (require 'overlay)
-(eval-when-compile
-  ;; `cl' is required for `assert'.  `assert' is not covered by a standard
-  ;; autoload, but it is a macro, so that eval-when-compile is sufficient
-  ;; to byte-compile it in, or to do the require when the buffer evalled.
-  (require 'cl)
-  )
+(eval-when-compile (require 'cl-lib))
 
 ;;;_* USER CUSTOMIZATION VARIABLES:
 
@@ -6122,13 +6117,13 @@ signal."
                                                           (point-max))))
     ;; determine key mode and, if keypair, recipients:
     (setq recipients
-          (case keypair-mode
+          (pcase keypair-mode
 
-            (decrypting nil)
+            ('decrypting nil)
 
-            (default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
+            ('default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
 
-            ((prompt prompt-save)
+            ((or 'prompt 'prompt-save)
              (save-window-excursion
                (epa-select-keys epg-context keypair-message)))))
 
@@ -6786,6 +6781,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
 (defvar allout-tests-locally-true nil
   "Fodder for allout resumptions tests -- defvar just for byte compiler.")
 (defun allout-test-resumptions ()
+  ;; FIXME: Use ERT.
   "Exercise allout resumptions."
   ;; for each resumption case, we also test that the right local/global
   ;; scopes are affected during resumption effects:
@@ -6794,48 +6790,48 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
   (with-temp-buffer
     (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
     (allout-add-resumptions '(allout-tests-globally-unbound t))
-    (assert (not (default-boundp 'allout-tests-globally-unbound)))
-    (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
-    (assert (boundp 'allout-tests-globally-unbound))
-    (assert (equal allout-tests-globally-unbound t))
+    (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
+    (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
+    (cl-assert (boundp 'allout-tests-globally-unbound))
+    (cl-assert (equal allout-tests-globally-unbound t))
     (allout-do-resumptions)
-    (assert (not (local-variable-p 'allout-tests-globally-unbound
+    (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
                                    (current-buffer))))
-    (assert (not (boundp 'allout-tests-globally-unbound))))
+    (cl-assert (not (boundp 'allout-tests-globally-unbound))))
 
   ;; ensure that variable with prior global value is resumed
   (with-temp-buffer
     (allout-tests-obliterate-variable 'allout-tests-globally-true)
     (setq allout-tests-globally-true t)
     (allout-add-resumptions '(allout-tests-globally-true nil))
-    (assert (equal (default-value 'allout-tests-globally-true) t))
-    (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
-    (assert (equal allout-tests-globally-true nil))
+    (cl-assert (equal (default-value 'allout-tests-globally-true) t))
+    (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
+    (cl-assert (equal allout-tests-globally-true nil))
     (allout-do-resumptions)
-    (assert (not (local-variable-p 'allout-tests-globally-true
+    (cl-assert (not (local-variable-p 'allout-tests-globally-true
                                    (current-buffer))))
-    (assert (boundp 'allout-tests-globally-true))
-    (assert (equal allout-tests-globally-true t)))
+    (cl-assert (boundp 'allout-tests-globally-true))
+    (cl-assert (equal allout-tests-globally-true t)))
 
   ;; ensure that prior local value is resumed
   (with-temp-buffer
     (allout-tests-obliterate-variable 'allout-tests-locally-true)
     (set (make-local-variable 'allout-tests-locally-true) t)
-    (assert (not (default-boundp 'allout-tests-locally-true))
+    (cl-assert (not (default-boundp 'allout-tests-locally-true))
             nil (concat "Test setup mistake -- variable supposed to"
                         " not have global binding, but it does."))
-    (assert (local-variable-p 'allout-tests-locally-true (current-buffer))
+    (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))
             nil (concat "Test setup mistake -- variable supposed to have"
                         " local binding, but it lacks one."))
     (allout-add-resumptions '(allout-tests-locally-true nil))
-    (assert (not (default-boundp 'allout-tests-locally-true)))
-    (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
-    (assert (equal allout-tests-locally-true nil))
+    (cl-assert (not (default-boundp 'allout-tests-locally-true)))
+    (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
+    (cl-assert (equal allout-tests-locally-true nil))
     (allout-do-resumptions)
-    (assert (boundp 'allout-tests-locally-true))
-    (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
-    (assert (equal allout-tests-locally-true t))
-    (assert (not (default-boundp 'allout-tests-locally-true))))
+    (cl-assert (boundp 'allout-tests-locally-true))
+    (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
+    (cl-assert (equal allout-tests-locally-true t))
+    (cl-assert (not (default-boundp 'allout-tests-locally-true))))
 
   ;; ensure that last of multiple resumptions holds, for various scopes.
   (with-temp-buffer
@@ -6851,27 +6847,27 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
                             '(allout-tests-globally-true 3)
                             '(allout-tests-locally-true 4))
     ;; reestablish many of the basic conditions are maintained after re-add:
-    (assert (not (default-boundp 'allout-tests-globally-unbound)))
-    (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
-    (assert (equal allout-tests-globally-unbound 2))
-    (assert (default-boundp 'allout-tests-globally-true))
-    (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
-    (assert (equal allout-tests-globally-true 3))
-    (assert (not (default-boundp 'allout-tests-locally-true)))
-    (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
-    (assert (equal allout-tests-locally-true 4))
+    (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
+    (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
+    (cl-assert (equal allout-tests-globally-unbound 2))
+    (cl-assert (default-boundp 'allout-tests-globally-true))
+    (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
+    (cl-assert (equal allout-tests-globally-true 3))
+    (cl-assert (not (default-boundp 'allout-tests-locally-true)))
+    (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
+    (cl-assert (equal allout-tests-locally-true 4))
     (allout-do-resumptions)
-    (assert (not (local-variable-p 'allout-tests-globally-unbound
+    (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
                                    (current-buffer))))
-    (assert (not (boundp 'allout-tests-globally-unbound)))
-    (assert (not (local-variable-p 'allout-tests-globally-true
+    (cl-assert (not (boundp 'allout-tests-globally-unbound)))
+    (cl-assert (not (local-variable-p 'allout-tests-globally-true
                                    (current-buffer))))
-    (assert (boundp 'allout-tests-globally-true))
-    (assert (equal allout-tests-globally-true t))
-    (assert (boundp 'allout-tests-locally-true))
-    (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
-    (assert (equal allout-tests-locally-true t))
-    (assert (not (default-boundp 'allout-tests-locally-true))))
+    (cl-assert (boundp 'allout-tests-globally-true))
+    (cl-assert (equal allout-tests-globally-true t))
+    (cl-assert (boundp 'allout-tests-locally-true))
+    (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
+    (cl-assert (equal allout-tests-locally-true t))
+    (cl-assert (not (default-boundp 'allout-tests-locally-true))))
 
   ;; ensure that deliberately unbinding registered variables doesn't foul things
   (with-temp-buffer