From d1ab0c7cbcda92114cce4d51b36aac5f07d26e4d Mon Sep 17 00:00:00 2001 From: William Carroll Date: Fri, 29 Jul 2022 21:12:59 -0700 Subject: feat(wpcarro/emacs): Package cycle.el This will likely break a few things since I've changed the names of a few functions to reflect their mutative APIs. Change-Id: If6279999fba50813b68e66d7713c12afd209eb90 Reviewed-on: https://cl.tvl.fyi/c/depot/+/6004 Reviewed-by: wpcarro Autosubmit: wpcarro Tested-by: BuildkiteCI --- users/wpcarro/emacs/.emacs.d/wpc/cycle.el | 224 ------------------------------ 1 file changed, 224 deletions(-) delete mode 100644 users/wpcarro/emacs/.emacs.d/wpc/cycle.el (limited to 'users/wpcarro/emacs/.emacs.d/wpc/cycle.el') diff --git a/users/wpcarro/emacs/.emacs.d/wpc/cycle.el b/users/wpcarro/emacs/.emacs.d/wpc/cycle.el deleted file mode 100644 index a1853ece1431..000000000000 --- a/users/wpcarro/emacs/.emacs.d/wpc/cycle.el +++ /dev/null @@ -1,224 +0,0 @@ -;;; cycle.el --- Simple module for working with cycles -*- lexical-binding: t -*- - -;; Author: William Carroll -;; Version: 0.0.1 -;; Package-Requires: ((emacs "24.3")) - -;;; Commentary: -;; Something like this may already exist, but I'm having trouble finding it, and -;; I think writing my own is a nice exercise for learning more Elisp. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dependencies -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(require 'prelude) -(require 'math) -(require 'maybe) -(require 'struct) -(require 'cl-lib) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Wish list -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; - TODO: Provide immutable variant. -;; - TODO: Replace mutable consumption with immutable variant. -;; - TODO: Replace indexing with (math-mod current cycle). - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Library -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; `current-index' tracks the current index -;; `xs' is the original list -(cl-defstruct cycle current-index previous-index xs) - -(defconst cycle-enable-tests? t - "When t, run the tests defined herein.") - -(defun cycle-from-list (xs) - "Create a cycle from a list of `XS'." - (if (= 0 (length xs)) - (make-cycle :current-index nil - :previous-index nil - :xs xs) - (make-cycle :current-index 0 - :previous-index nil - :xs xs))) - -(defun cycle-new (&rest xs) - "Create a cycle with XS as the values." - (cycle-from-list xs)) - -(defun cycle-to-list (xs) - "Return the list representation of a cycle, XS." - (cycle-xs xs)) - -(defun cycle--next-index<- (lo hi x) - "Return the next index in a cycle when moving downwards. -- `LO' is the lower bound. -- `HI' is the upper bound. -- `X' is the current index." - (if (< (- x 1) lo) - (- hi 1) - (- x 1))) - -(defun cycle--next-index-> (lo hi x) - "Return the next index in a cycle when moving upwards. -- `LO' is the lower bound. -- `HI' is the upper bound. -- `X' is the current index." - (if (>= (+ 1 x) hi) - lo - (+ 1 x))) - -(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))) - -;; TODO: Consider adding "!" to the function name herein since many of them -;; mutate the collection, and the APIs are beginning to confuse me. -(defun cycle-focus-previous! (xs) - "Jump to the item in XS that was most recently focused; return the cycle. -This will error when previous-index is nil. This function mutates the -underlying struct." - (let ((i (cycle-previous-index xs))) - (if (maybe-some? i) - (progn - (cycle-jump i xs) - (cycle-current xs)) - (error "Cannot focus the previous element since cycle-previous-index is nil")))) - -(defun cycle-next (xs) - "Return the next value in `XS' and update `current-index'." - (let* ((current-index (cycle-current-index xs)) - (next-index (cycle--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 (cycle--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'." - (nth (cycle-current-index cycle) (cycle-xs cycle))) - -(defun cycle-count (cycle) - "Return the length of `xs' in `CYCLE'." - (length (cycle-xs 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." - (let ((i (->> cycle - cycle-xs - (-find-index p)))) - (if i - (cycle-jump i cycle) - (error "No element in cycle matches predicate")))) - -(defun cycle-focus-item (x xs) - "Focus item, X, in cycle XS. -ITEM is the first item in XS that t for `equal'." - (cycle-focus (lambda (y) (equal x y)) xs)) - -(defun cycle-contains? (x xs) - "Return t if cycle, XS, has member X." - (->> xs - cycle-xs - (list-contains? x))) - -(defun cycle-empty? (xs) - "Return t if cycle XS has no elements." - (= 0 (length (cycle-xs xs)))) - -(defun cycle-focused? (xs) - "Return t if cycle XS has a non-nil value for current-index." - (maybe-some? (cycle-current-index xs))) - -(defun cycle-append (x xs) - "Add X to the left of the focused element in XS. -If there is no currently focused item, add X to the beginning of XS." - (if (cycle-empty? xs) - (progn - (struct-set! cycle xs (list x) xs) - (struct-set! cycle current-index 0 xs) - (struct-set! cycle previous-index nil xs)) - (let ((curr-i (cycle-current-index xs)) - (prev-i (cycle-previous-index xs))) - (if curr-i - (progn - (struct-set! cycle xs (-insert-at curr-i x (cycle-xs xs)) xs) - (when (and prev-i (>= prev-i curr-i)) - (struct-set! cycle previous-index (1+ prev-i) xs)) - (when curr-i (struct-set! cycle current-index (1+ curr-i) xs))) - (progn - (struct-set! cycle xs (cons x (cycle-xs xs)) xs) - (when prev-i (struct-set! cycle previous-index (1+ prev-i) xs)))) - xs))) - -(defun cycle-remove (x xs) - "Attempt to remove X from XS. - -X is found using `equal'. - -If X is the currently focused value, after it's deleted, current-index will be - nil. If X is the previously value, after it's deleted, previous-index will be - nil." - (let ((curr-i (cycle-current-index xs)) - (prev-i (cycle-previous-index xs)) - (rm-i (-elem-index x (cycle-xs xs)))) - (struct-set! cycle xs (-remove-at rm-i (cycle-xs xs)) xs) - (when prev-i - (when (> prev-i rm-i) (struct-set! cycle previous-index (1- prev-i) xs)) - (when (= prev-i rm-i) (struct-set! cycle previous-index nil xs))) - (when curr-i - (when (> curr-i rm-i) (struct-set! cycle current-index (1- curr-i) xs)) - (when (= curr-i rm-i) (struct-set! cycle current-index nil xs))) - xs)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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))) - (prelude-assert (= 2 (cycle-focus-previous! xs))) - (prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle-append 4 xs)))) - (prelude-assert (equal '(1 2 3) (cycle-xs (cycle-remove 4 xs)))) - (progn - (cycle-focus-item 3 xs) - (cycle-focus-item 2 xs) - (cycle-remove 1 xs) - (prelude-assert (= 2 (cycle-current xs))) - (prelude-assert (= 3 (cycle-previous-focus xs)))))) - -(provide 'cycle) -;;; cycle.el ends here -- cgit 1.4.1