procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Stefan Monnier 2019-05-22 23:21:47 -04:00
parent 03feb9376b
commit b95a5d194b
2 changed files with 63 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
lisp/allout-widgets.el
View file

@ -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)
))

94
lisp/allout.el
View file

@ -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