Support cycle/{append,remove}
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:
		
							parent
							
								
									f145bc9eb6
								
							
						
					
					
						commit
						8584059e7c
					
				
					 1 changed files with 49 additions and 1 deletions
				
			
		| 
						 | 
					@ -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."
 | 
					  "Return t if cycle XS has a non-nil value for current-index."
 | 
				
			||||||
  (maybe/some? (cycle-current-index xs)))
 | 
					  (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
 | 
					;; 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 (= 2 (->> xs (cycle/jump 1) cycle/current)))
 | 
				
			||||||
    (prelude/assert (= 3 (->> xs (cycle/jump 2) cycle/current)))
 | 
					    (prelude/assert (= 3 (->> xs (cycle/jump 2) cycle/current)))
 | 
				
			||||||
    (prelude/assert (= 2 (cycle/previous-focus xs)))
 | 
					    (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)
 | 
					(provide 'cycle)
 | 
				
			||||||
;;; cycle.el ends here
 | 
					;;; cycle.el ends here
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue