From b95a5d194b21254a6e41561621498be9f29cf08f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 22 May 2019 23:21:47 -0400 Subject: [PATCH] * lisp/allout.el, lisp/allout-widgets.el: Use cl-lib and pcase --- lisp/allout-widgets.el | 41 ++++++++---------- lisp/allout.el | 94 ++++++++++++++++++++---------------------- 2 files changed, 63 insertions(+), 72 deletions(-) diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 67fce325ff1..fd04c31f3b8 100644 --- a/lisp/allout-widgets.el +++ b/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) )) diff --git a/lisp/allout.el b/lisp/allout.el index b3b87e533b9..07608551886 100644 --- a/lisp/allout.el +++ b/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 -- 2.39.2