diff options
| -rw-r--r-- | configs/shared/.emacs.d/wpc/cycle.el | 76 |
1 files changed, 56 insertions, 20 deletions
diff --git a/configs/shared/.emacs.d/wpc/cycle.el b/configs/shared/.emacs.d/wpc/cycle.el index 894626383049..d469ee34c705 100644 --- a/configs/shared/.emacs.d/wpc/cycle.el +++ b/configs/shared/.emacs.d/wpc/cycle.el @@ -7,8 +7,13 @@ ;;; Code: -(require 'struct) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'prelude) (require 'math) +(require 'maybe) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wish list @@ -24,16 +29,21 @@ ;; `current-index' tracks the current index ;; `xs' is the original list -(cl-defstruct cycle current-index xs) +(cl-defstruct cycle current-index previous-index xs) + +(defconst cycle/enable-tests? t + "When t, run the tests defined herein.") (defun cycle/new (&rest xs) "Create an empty cycle." (make-cycle :current-index 0 + :previous-index nil :xs xs)) (defun cycle/from-list (xs) "Create a cycle from a list of `XS'." (make-cycle :current-index 0 + :previous-index nil :xs xs)) (defun cycle/to-list (xs) @@ -58,19 +68,28 @@ lo (+ 1 x))) -(defun cycle/prev (cycle) - "Return the previous value in `CYCLE' and update `current-index'." - (let* ((current-index (cycle-current-index cycle)) - (next-index (next-index<- 0 (cycle/count cycle) current-index))) - (setf (cycle-current-index cycle) next-index) - (nth next-index (cycle-xs cycle)))) - -(defun cycle/next (cycle) - "Return the next value in `CYCLE' and update `current-index'." - (let* ((current-index (cycle-current-index cycle)) - (next-index (next-index-> 0 (cycle/count cycle) current-index))) - (setf (cycle-current-index cycle) next-index) - (nth next-index (cycle-xs cycle)))) +(defun cycle/previous-focus (cycle) + "Return the previously focused entry in CYCLE." + (let ((i (cycle-previous-index cycle))) + (if (maybe/some? i) + (nth i (cycle-xs cycle)) + nil))) + +(defun cycle/next (xs) + "Return the next value in `XS' and update `current-index'." + (let* ((current-index (cycle-current-index xs)) + (next-index (next-index-> 0 (cycle/count xs) current-index))) + (struct/set! cycle previous-index current-index xs) + (struct/set! cycle current-index next-index xs) + (nth next-index (cycle-xs xs)))) + +(defun cycle/prev (xs) + "Return the previous value in `XS' and update `current-index'." + (let* ((current-index (cycle-current-index xs)) + (next-index (next-index<- 0 (cycle/count xs) current-index))) + (struct/set! cycle previous-index current-index xs) + (struct/set! cycle current-index next-index xs) + (nth next-index (cycle-xs xs)))) (defun cycle/current (cycle) "Return the current value in `CYCLE'." @@ -80,11 +99,13 @@ "Return the length of `xs' in `CYCLE'." (length (cycle-xs cycle))) -(defun cycle/jump (i cycle) - "Jump to the I index of CYCLE." - (setf (cycle-current-index cycle) - (math/mod i (cycle/count cycle))) - cycle) +(defun cycle/jump (i xs) + "Jump to the I index of XS." + (let ((current-index (cycle-current-index xs)) + (next-index (math/mod i (cycle/count xs)))) + (struct/set! cycle previous-index current-index xs) + (struct/set! cycle current-index next-index xs)) + xs) (defun cycle/focus (p cycle) "Focus the element in CYCLE for which predicate, P, is t." @@ -101,5 +122,20 @@ cycle-xs (list/contains? x))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when cycle/enable-tests? + (let ((xs (cycle/new 1 2 3))) + (prelude/assert (maybe/nil? (cycle/previous-focus xs))) + (prelude/assert (= 1 (cycle/current xs))) + (prelude/assert (= 2 (cycle/next xs))) + (prelude/assert (= 1 (cycle/previous-focus xs))) + (prelude/assert (= 1 (->> xs (cycle/jump 0) cycle/current))) + (prelude/assert (= 2 (->> xs (cycle/jump 1) cycle/current))) + (prelude/assert (= 3 (->> xs (cycle/jump 2) cycle/current))) + (prelude/assert (= 2 (cycle/previous-focus xs))))) + (provide 'cycle) ;;; cycle.el ends here |