mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support cycle/{append,remove}

Browse source 
Supporting these functions was a little tricky. For example, how should we
handle calling cycle/remove on the item that is currently focused? After
attempting to be clever, I decided to just set the value to nil and let the
consumer decide what is best for them. I can always support a more opinionated
version that fallsback to previous-index if previous-index is set. But until I
have a better idea of how I'm going to consume this, I think nil is the best
option.
This commit is contained in:
William Carroll 2020-02-08 15:57:08 +00:00
parent f145bc9eb6
commit 8584059e7c
1 changed files with 49 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
emacs/.emacs.d/wpc/cycle.el
View file

@ -150,6 +150,46 @@ ITEM is the first item in XS that t for `equal'."
"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 (>= 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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -164,7 +204,15 @@ ITEM is the first item in XS that t for `equal'."
(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 (= 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