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 <wpcarro@gmail.com> Autosubmit: wpcarro <wpcarro@gmail.com> Tested-by: BuildkiteCI
This commit is contained in:
parent
65fb82097b
commit
d1ab0c7cbc
10 changed files with 188 additions and 95 deletions
|
@ -143,12 +143,12 @@ Return a reference to that buffer."
|
||||||
(defun buffer-cycle-next ()
|
(defun buffer-cycle-next ()
|
||||||
"Cycle forward through the `buffer-source-code-buffers'."
|
"Cycle forward through the `buffer-source-code-buffers'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(buffer-cycle #'cycle-next))
|
(buffer-cycle #'cycle-next!))
|
||||||
|
|
||||||
(defun buffer-cycle-prev ()
|
(defun buffer-cycle-prev ()
|
||||||
"Cycle backward through the `buffer-source-code-buffers'."
|
"Cycle backward through the `buffer-source-code-buffers'."
|
||||||
(interactive)
|
(interactive)
|
||||||
(buffer-cycle #'cycle-prev))
|
(buffer-cycle #'cycle-prev!))
|
||||||
|
|
||||||
(defun buffer-ivy-source-code ()
|
(defun buffer-ivy-source-code ()
|
||||||
"Use `ivy-read' to choose among all open source code buffers."
|
"Use `ivy-read' to choose among all open source code buffers."
|
||||||
|
|
|
@ -51,7 +51,7 @@ There is no hook that I'm aware of to handle this more elegantly."
|
||||||
|
|
||||||
(defun colorscheme-whitelist-set (colorscheme)
|
(defun colorscheme-whitelist-set (colorscheme)
|
||||||
"Focus the COLORSCHEME in the `colorscheme-whitelist' cycle."
|
"Focus the COLORSCHEME in the `colorscheme-whitelist' cycle."
|
||||||
(cycle-focus (lambda (x) (equal x colorscheme)) colorscheme-whitelist)
|
(cycle-focus! (lambda (x) (equal x colorscheme)) colorscheme-whitelist)
|
||||||
(colorscheme-set (colorscheme-current)))
|
(colorscheme-set (colorscheme-current)))
|
||||||
|
|
||||||
(defun colorscheme-ivy-select ()
|
(defun colorscheme-ivy-select ()
|
||||||
|
@ -66,8 +66,8 @@ There is no hook that I'm aware of to handle this more elegantly."
|
||||||
Cycle prev otherwise."
|
Cycle prev otherwise."
|
||||||
(disable-theme (cycle-current colorscheme-whitelist))
|
(disable-theme (cycle-current colorscheme-whitelist))
|
||||||
(let ((theme (if forward?
|
(let ((theme (if forward?
|
||||||
(cycle-next colorscheme-whitelist)
|
(cycle-next! colorscheme-whitelist)
|
||||||
(cycle-prev colorscheme-whitelist))))
|
(cycle-prev! colorscheme-whitelist))))
|
||||||
(colorscheme-set theme)
|
(colorscheme-set theme)
|
||||||
(message (s-concat "Active theme: " (symbol-to-string theme)))))
|
(message (s-concat "Active theme: " (symbol-to-string theme)))))
|
||||||
|
|
||||||
|
|
|
@ -68,8 +68,8 @@
|
||||||
(cl-defun fonts-cycle (&key forward?)
|
(cl-defun fonts-cycle (&key forward?)
|
||||||
"Cycle forwards when `FORWARD?' non-nil."
|
"Cycle forwards when `FORWARD?' non-nil."
|
||||||
(let ((font (if forward?
|
(let ((font (if forward?
|
||||||
(cycle-next fonts-whitelist)
|
(cycle-next! fonts-whitelist)
|
||||||
(cycle-prev fonts-whitelist))))
|
(cycle-prev! fonts-whitelist))))
|
||||||
(message (s-concat "Active font: " font))
|
(message (s-concat "Active font: " font))
|
||||||
(fonts-set font)))
|
(fonts-set font)))
|
||||||
|
|
||||||
|
@ -93,7 +93,7 @@
|
||||||
"Focuses the FONT in the `fonts-whitelist' cycle.
|
"Focuses the FONT in the `fonts-whitelist' cycle.
|
||||||
The size of the font is determined by `fonts-size'."
|
The size of the font is determined by `fonts-size'."
|
||||||
(prelude-assert (cycle-contains? font fonts-whitelist))
|
(prelude-assert (cycle-contains? font fonts-whitelist))
|
||||||
(cycle-focus (lambda (x) (equal x font)) fonts-whitelist)
|
(cycle-focus! (lambda (x) (equal x font)) fonts-whitelist)
|
||||||
(fonts-set (fonts-current) fonts-size))
|
(fonts-set (fonts-current) fonts-size))
|
||||||
|
|
||||||
(defun fonts-ivy-select ()
|
(defun fonts-ivy-select ()
|
||||||
|
|
|
@ -135,7 +135,7 @@
|
||||||
(with-current-buffer (current-buffer)
|
(with-current-buffer (current-buffer)
|
||||||
(let ((cycle (irc-channel->cycle irc-server->channels (buffer-name))))
|
(let ((cycle (irc-channel->cycle irc-server->channels (buffer-name))))
|
||||||
(erc-join-channel
|
(erc-join-channel
|
||||||
(cycle-next cycle))
|
(cycle-next! cycle))
|
||||||
(irc-message
|
(irc-message
|
||||||
(string-format "Current IRC channel: %s" (cycle-current cycle))))))
|
(string-format "Current IRC channel: %s" (cycle-current cycle))))))
|
||||||
|
|
||||||
|
@ -145,7 +145,7 @@
|
||||||
(with-current-buffer (current-buffer)
|
(with-current-buffer (current-buffer)
|
||||||
(let ((cycle (irc-channel->cycle irc-server->channels (buffer-name))))
|
(let ((cycle (irc-channel->cycle irc-server->channels (buffer-name))))
|
||||||
(erc-join-channel
|
(erc-join-channel
|
||||||
(cycle-prev cycle))
|
(cycle-prev! cycle))
|
||||||
(irc-message
|
(irc-message
|
||||||
(string-format "Current IRC channel: %s" (cycle-current cycle))))))
|
(string-format "Current IRC channel: %s" (cycle-current cycle))))))
|
||||||
|
|
||||||
|
|
|
@ -55,8 +55,8 @@ This function should be called from a buffer running vterm."
|
||||||
(interactive)
|
(interactive)
|
||||||
(vterm-mgt--assert-vterm-buffer)
|
(vterm-mgt--assert-vterm-buffer)
|
||||||
(vterm-mgt-reconcile-state)
|
(vterm-mgt-reconcile-state)
|
||||||
(cycle-focus-item (current-buffer) vterm-mgt--instances)
|
(cycle-focus-item! (current-buffer) vterm-mgt--instances)
|
||||||
(switch-to-buffer (cycle-next vterm-mgt--instances))
|
(switch-to-buffer (cycle-next! vterm-mgt--instances))
|
||||||
(when vterm-mgt-scroll-on-focus (end-of-buffer)))
|
(when vterm-mgt-scroll-on-focus (end-of-buffer)))
|
||||||
|
|
||||||
(defun vterm-mgt-prev ()
|
(defun vterm-mgt-prev ()
|
||||||
|
@ -65,8 +65,8 @@ This function should be called from a buffer running vterm."
|
||||||
(interactive)
|
(interactive)
|
||||||
(vterm-mgt--assert-vterm-buffer)
|
(vterm-mgt--assert-vterm-buffer)
|
||||||
(vterm-mgt-reconcile-state)
|
(vterm-mgt-reconcile-state)
|
||||||
(cycle-focus-item (current-buffer) vterm-mgt--instances)
|
(cycle-focus-item! (current-buffer) vterm-mgt--instances)
|
||||||
(switch-to-buffer (cycle-prev vterm-mgt--instances))
|
(switch-to-buffer (cycle-prev! vterm-mgt--instances))
|
||||||
(when vterm-mgt-scroll-on-focus (end-of-buffer)))
|
(when vterm-mgt-scroll-on-focus (end-of-buffer)))
|
||||||
|
|
||||||
(defun vterm-mgt-instantiate ()
|
(defun vterm-mgt-instantiate ()
|
||||||
|
@ -81,8 +81,8 @@ If however you must call `vterm', if you'd like to cycle through vterm
|
||||||
(interactive)
|
(interactive)
|
||||||
(vterm-mgt-reconcile-state)
|
(vterm-mgt-reconcile-state)
|
||||||
(let ((buffer (vterm t)))
|
(let ((buffer (vterm t)))
|
||||||
(cycle-append buffer vterm-mgt--instances)
|
(cycle-append! buffer vterm-mgt--instances)
|
||||||
(cycle-focus-item buffer vterm-mgt--instances)))
|
(cycle-focus-item! buffer vterm-mgt--instances)))
|
||||||
|
|
||||||
(defun vterm-mgt-kill ()
|
(defun vterm-mgt-kill ()
|
||||||
"Kill the current buffer and remove it from `vterm-mgt--instances'.
|
"Kill the current buffer and remove it from `vterm-mgt--instances'.
|
||||||
|
@ -106,7 +106,7 @@ instance."
|
||||||
(if (cycle-focused? vterm-mgt--instances)
|
(if (cycle-focused? vterm-mgt--instances)
|
||||||
(switch-to-buffer (cycle-current vterm-mgt--instances))
|
(switch-to-buffer (cycle-current vterm-mgt--instances))
|
||||||
(progn
|
(progn
|
||||||
(cycle-jump 0 vterm-mgt--instances)
|
(cycle-jump! 0 vterm-mgt--instances)
|
||||||
(switch-to-buffer (cycle-current vterm-mgt--instances))))))
|
(switch-to-buffer (cycle-current vterm-mgt--instances))))))
|
||||||
|
|
||||||
(defun vterm-mgt-rename-buffer (name)
|
(defun vterm-mgt-rename-buffer (name)
|
||||||
|
|
|
@ -97,12 +97,12 @@
|
||||||
(defun window-manager-next-workspace ()
|
(defun window-manager-next-workspace ()
|
||||||
"Cycle forwards to the next workspace."
|
"Cycle forwards to the next workspace."
|
||||||
(interactive)
|
(interactive)
|
||||||
(window-manager--change-workspace (cycle-next window-manager--workspaces)))
|
(window-manager--change-workspace (cycle-next! window-manager--workspaces)))
|
||||||
|
|
||||||
(defun window-manager-prev-workspace ()
|
(defun window-manager-prev-workspace ()
|
||||||
"Cycle backwards to the previous workspace."
|
"Cycle backwards to the previous workspace."
|
||||||
(interactive)
|
(interactive)
|
||||||
(window-manager--change-workspace (cycle-prev window-manager--workspaces)))
|
(window-manager--change-workspace (cycle-prev! window-manager--workspaces)))
|
||||||
|
|
||||||
;; Here is the code required to toggle EXWM's modes.
|
;; Here is the code required to toggle EXWM's modes.
|
||||||
(defun window-manager--line-mode ()
|
(defun window-manager--line-mode ()
|
||||||
|
@ -120,7 +120,7 @@
|
||||||
(interactive)
|
(interactive)
|
||||||
(with-current-buffer (window-buffer)
|
(with-current-buffer (window-buffer)
|
||||||
(when (eq major-mode 'exwm-mode)
|
(when (eq major-mode 'exwm-mode)
|
||||||
(funcall (cycle-next window-manager--modes)))))
|
(funcall (cycle-next! window-manager--modes)))))
|
||||||
|
|
||||||
(defun window-manager--label->index (label workspaces)
|
(defun window-manager--label->index (label workspaces)
|
||||||
"Return the index of the workspace in WORKSPACES named LABEL."
|
"Return the index of the workspace in WORKSPACES named LABEL."
|
||||||
|
@ -152,7 +152,7 @@ Currently using super- as the prefix for switching workspaces."
|
||||||
|
|
||||||
(defun window-manager--switch (label)
|
(defun window-manager--switch (label)
|
||||||
"Switch to a named workspaces using LABEL."
|
"Switch to a named workspaces using LABEL."
|
||||||
(cycle-focus (lambda (x)
|
(cycle-focus! (lambda (x)
|
||||||
(equal label
|
(equal label
|
||||||
(window-manager-named-workspace-label x)))
|
(window-manager-named-workspace-label x)))
|
||||||
window-manager--workspaces)
|
window-manager--workspaces)
|
||||||
|
|
|
@ -26,6 +26,7 @@ let
|
||||||
wpcarrosEmacs = emacsWithPackages (epkgs:
|
wpcarrosEmacs = emacsWithPackages (epkgs:
|
||||||
(with wpcarro.emacs.pkgs; [
|
(with wpcarro.emacs.pkgs; [
|
||||||
al
|
al
|
||||||
|
cycle
|
||||||
list
|
list
|
||||||
maybe
|
maybe
|
||||||
set
|
set
|
||||||
|
|
|
@ -14,9 +14,9 @@
|
||||||
;; Dependencies
|
;; Dependencies
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(require 'prelude)
|
(require 'dash)
|
||||||
(require 'math)
|
|
||||||
(require 'maybe)
|
(require 'maybe)
|
||||||
|
(require 'list)
|
||||||
(require 'struct)
|
(require 'struct)
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
|
|
||||||
|
@ -26,7 +26,6 @@
|
||||||
|
|
||||||
;; - TODO: Provide immutable variant.
|
;; - TODO: Provide immutable variant.
|
||||||
;; - TODO: Replace mutable consumption with immutable variant.
|
;; - TODO: Replace mutable consumption with immutable variant.
|
||||||
;; - TODO: Replace indexing with (math-mod current cycle).
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Library
|
;; Library
|
||||||
|
@ -36,9 +35,6 @@
|
||||||
;; `xs' is the original list
|
;; `xs' is the original list
|
||||||
(cl-defstruct cycle current-index previous-index xs)
|
(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)
|
(defun cycle-from-list (xs)
|
||||||
"Create a cycle from a list of `XS'."
|
"Create a cycle from a list of `XS'."
|
||||||
(if (= 0 (length xs))
|
(if (= 0 (length xs))
|
||||||
|
@ -57,24 +53,6 @@
|
||||||
"Return the list representation of a cycle, XS."
|
"Return the list representation of a cycle, XS."
|
||||||
(cycle-xs 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)
|
(defun cycle-previous-focus (cycle)
|
||||||
"Return the previously focused entry in CYCLE."
|
"Return the previously focused entry in CYCLE."
|
||||||
(let ((i (cycle-previous-index cycle)))
|
(let ((i (cycle-previous-index cycle)))
|
||||||
|
@ -82,8 +60,6 @@
|
||||||
(nth i (cycle-xs cycle))
|
(nth i (cycle-xs cycle))
|
||||||
nil)))
|
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)
|
(defun cycle-focus-previous! (xs)
|
||||||
"Jump to the item in XS that was most recently focused; return the cycle.
|
"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
|
This will error when previous-index is nil. This function mutates the
|
||||||
|
@ -91,11 +67,11 @@ underlying struct."
|
||||||
(let ((i (cycle-previous-index xs)))
|
(let ((i (cycle-previous-index xs)))
|
||||||
(if (maybe-some? i)
|
(if (maybe-some? i)
|
||||||
(progn
|
(progn
|
||||||
(cycle-jump i xs)
|
(cycle-jump! i xs)
|
||||||
(cycle-current xs))
|
(cycle-current xs))
|
||||||
(error "Cannot focus the previous element since cycle-previous-index is nil"))))
|
(error "Cannot focus the previous element since cycle-previous-index is nil"))))
|
||||||
|
|
||||||
(defun cycle-next (xs)
|
(defun cycle-next! (xs)
|
||||||
"Return the next value in `XS' and update `current-index'."
|
"Return the next value in `XS' and update `current-index'."
|
||||||
(let* ((current-index (cycle-current-index xs))
|
(let* ((current-index (cycle-current-index xs))
|
||||||
(next-index (cycle--next-index-> 0 (cycle-count xs) current-index)))
|
(next-index (cycle--next-index-> 0 (cycle-count xs) current-index)))
|
||||||
|
@ -103,7 +79,7 @@ underlying struct."
|
||||||
(struct-set! cycle current-index next-index xs)
|
(struct-set! cycle current-index next-index xs)
|
||||||
(nth next-index (cycle-xs xs))))
|
(nth next-index (cycle-xs xs))))
|
||||||
|
|
||||||
(defun cycle-prev (xs)
|
(defun cycle-prev! (xs)
|
||||||
"Return the previous value in `XS' and update `current-index'."
|
"Return the previous value in `XS' and update `current-index'."
|
||||||
(let* ((current-index (cycle-current-index xs))
|
(let* ((current-index (cycle-current-index xs))
|
||||||
(next-index (cycle--next-index<- 0 (cycle-count xs) current-index)))
|
(next-index (cycle--next-index<- 0 (cycle-count xs) current-index)))
|
||||||
|
@ -119,43 +95,29 @@ underlying struct."
|
||||||
"Return the length of `xs' in `CYCLE'."
|
"Return the length of `xs' in `CYCLE'."
|
||||||
(length (cycle-xs cycle)))
|
(length (cycle-xs cycle)))
|
||||||
|
|
||||||
(defun cycle-jump (i xs)
|
(defun cycle-jump! (i xs)
|
||||||
"Jump to the I index of XS."
|
"Jump to the I index of XS."
|
||||||
(let ((current-index (cycle-current-index xs))
|
(let ((current-index (cycle-current-index xs))
|
||||||
(next-index (math-mod i (cycle-count xs))))
|
(next-index (mod i (cycle-count xs))))
|
||||||
(struct-set! cycle previous-index current-index xs)
|
(struct-set! cycle previous-index current-index xs)
|
||||||
(struct-set! cycle current-index next-index xs))
|
(struct-set! cycle current-index next-index xs))
|
||||||
xs)
|
xs)
|
||||||
|
|
||||||
(defun cycle-focus (p cycle)
|
(defun cycle-focus! (p cycle)
|
||||||
"Focus the element in CYCLE for which predicate, P, is t."
|
"Focus the element in CYCLE for which predicate, P, is t."
|
||||||
(let ((i (->> cycle
|
(let ((i (->> cycle
|
||||||
cycle-xs
|
cycle-xs
|
||||||
(-find-index p))))
|
(-find-index p))))
|
||||||
(if i
|
(if i
|
||||||
(cycle-jump i cycle)
|
(cycle-jump! i cycle)
|
||||||
(error "No element in cycle matches predicate"))))
|
(error "No element in cycle matches predicate"))))
|
||||||
|
|
||||||
(defun cycle-focus-item (x xs)
|
(defun cycle-focus-item! (x xs)
|
||||||
"Focus item, X, in cycle XS.
|
"Focus item, X, in cycle XS.
|
||||||
ITEM is the first item in XS that t for `equal'."
|
ITEM is the first item in XS that t for `equal'."
|
||||||
(cycle-focus (lambda (y) (equal x y)) xs))
|
(cycle-focus! (lambda (y) (equal x y)) xs))
|
||||||
|
|
||||||
(defun cycle-contains? (x xs)
|
(defun cycle-append! (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.
|
"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 there is no currently focused item, add X to the beginning of XS."
|
||||||
(if (cycle-empty? xs)
|
(if (cycle-empty? xs)
|
||||||
|
@ -176,7 +138,7 @@ If there is no currently focused item, add X to the beginning of XS."
|
||||||
(when prev-i (struct-set! cycle previous-index (1+ prev-i) xs))))
|
(when prev-i (struct-set! cycle previous-index (1+ prev-i) xs))))
|
||||||
xs)))
|
xs)))
|
||||||
|
|
||||||
(defun cycle-remove (x xs)
|
(defun cycle-remove! (x xs)
|
||||||
"Attempt to remove X from XS.
|
"Attempt to remove X from XS.
|
||||||
|
|
||||||
X is found using `equal'.
|
X is found using `equal'.
|
||||||
|
@ -197,28 +159,44 @@ If X is the currently focused value, after it's deleted, current-index will be
|
||||||
xs))
|
xs))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Tests
|
;; Predicates
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(when cycle-enable-tests?
|
(defun cycle-contains? (x xs)
|
||||||
(let ((xs (cycle-new 1 2 3)))
|
"Return t if cycle, XS, has member X."
|
||||||
(prelude-assert (maybe-nil? (cycle-previous-focus xs)))
|
(->> xs
|
||||||
(prelude-assert (= 1 (cycle-current xs)))
|
cycle-xs
|
||||||
(prelude-assert (= 2 (cycle-next xs)))
|
(list-contains? x)))
|
||||||
(prelude-assert (= 1 (cycle-previous-focus xs)))
|
|
||||||
(prelude-assert (= 1 (->> xs (cycle-jump 0) cycle-current)))
|
(defun cycle-empty? (xs)
|
||||||
(prelude-assert (= 2 (->> xs (cycle-jump 1) cycle-current)))
|
"Return t if cycle XS has no elements."
|
||||||
(prelude-assert (= 3 (->> xs (cycle-jump 2) cycle-current)))
|
(= 0 (length (cycle-xs xs))))
|
||||||
(prelude-assert (= 2 (cycle-previous-focus xs)))
|
|
||||||
(prelude-assert (= 2 (cycle-focus-previous! xs)))
|
(defun cycle-focused? (xs)
|
||||||
(prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle-append 4 xs))))
|
"Return t if cycle XS has a non-nil value for current-index."
|
||||||
(prelude-assert (equal '(1 2 3) (cycle-xs (cycle-remove 4 xs))))
|
(maybe-some? (cycle-current-index xs)))
|
||||||
(progn
|
|
||||||
(cycle-focus-item 3 xs)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(cycle-focus-item 2 xs)
|
;; Helper Functions
|
||||||
(cycle-remove 1 xs)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(prelude-assert (= 2 (cycle-current xs)))
|
|
||||||
(prelude-assert (= 3 (cycle-previous-focus 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)))
|
||||||
|
|
||||||
(provide 'cycle)
|
(provide 'cycle)
|
||||||
;;; cycle.el ends here
|
;;; cycle.el ends here
|
34
users/wpcarro/emacs/pkgs/cycle/default.nix
Normal file
34
users/wpcarro/emacs/pkgs/cycle/default.nix
Normal file
|
@ -0,0 +1,34 @@
|
||||||
|
{ pkgs, depot, ... }:
|
||||||
|
|
||||||
|
let
|
||||||
|
cycle = pkgs.callPackage
|
||||||
|
({ emacsPackages }:
|
||||||
|
emacsPackages.trivialBuild {
|
||||||
|
pname = "cycle";
|
||||||
|
version = "1.0.0";
|
||||||
|
src = ./cycle.el;
|
||||||
|
packageRequires =
|
||||||
|
(with emacsPackages; [
|
||||||
|
dash
|
||||||
|
]) ++
|
||||||
|
(with depot.users.wpcarro.emacs.pkgs; [
|
||||||
|
list
|
||||||
|
maybe
|
||||||
|
struct
|
||||||
|
]);
|
||||||
|
})
|
||||||
|
{ };
|
||||||
|
|
||||||
|
emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [
|
||||||
|
epkgs.dash
|
||||||
|
depot.users.wpcarro.emacs.pkgs.maybe
|
||||||
|
cycle
|
||||||
|
]);
|
||||||
|
in
|
||||||
|
cycle.overrideAttrs (_old: {
|
||||||
|
doCheck = true;
|
||||||
|
checkPhase = ''
|
||||||
|
${emacs}/bin/emacs -batch \
|
||||||
|
-l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit
|
||||||
|
'';
|
||||||
|
})
|
80
users/wpcarro/emacs/pkgs/cycle/tests.el
Normal file
80
users/wpcarro/emacs/pkgs/cycle/tests.el
Normal file
|
@ -0,0 +1,80 @@
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Dependencies
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(require 'ert)
|
||||||
|
(require 'cycle)
|
||||||
|
(require 'dash)
|
||||||
|
(require 'maybe)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(setq xs (cycle-new 1 2 3))
|
||||||
|
|
||||||
|
(ert-deftest cycle-initializes-properly ()
|
||||||
|
(should (= 3 (cycle-count xs)))
|
||||||
|
(should (maybe-nil? (cycle-previous-focus xs)))
|
||||||
|
(should (cycle-contains? 1 xs))
|
||||||
|
(should (cycle-contains? 2 xs))
|
||||||
|
(should (cycle-contains? 3 xs)))
|
||||||
|
|
||||||
|
(ert-deftest cycle-contains? ()
|
||||||
|
;; Returns t or nil
|
||||||
|
(should (eq t (cycle-contains? 1 xs)))
|
||||||
|
(should (eq t (cycle-contains? 2 xs)))
|
||||||
|
(should (eq t (cycle-contains? 3 xs)))
|
||||||
|
(should (eq nil (cycle-contains? 4 xs))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-empty? ()
|
||||||
|
(should (eq t (cycle-empty? (cycle-new))))
|
||||||
|
(should (eq nil (cycle-empty? xs))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-current ()
|
||||||
|
(should (= 1 (cycle-current xs))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-next! ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(should (= 2 (cycle-next! xs)))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-prev! ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(cycle-next! xs)
|
||||||
|
(should (= 1 (cycle-prev! xs)))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-previous-focus ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(cycle-focus-item! 2 xs)
|
||||||
|
(cycle-next! xs)
|
||||||
|
(should (= 2 (cycle-previous-focus xs)))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-jump! ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(should (= 1 (->> xs (cycle-jump! 0) cycle-current)))
|
||||||
|
(should (= 2 (->> xs (cycle-jump! 1) cycle-current)))
|
||||||
|
(should (= 3 (->> xs (cycle-jump! 2) cycle-current)))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-focus-previous! ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(cycle-focus-item! 2 xs)
|
||||||
|
(cycle-next! xs)
|
||||||
|
(should (= 2 (cycle-previous-focus xs)))
|
||||||
|
(should (= 2 (cycle-focus-previous! xs)))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-append! ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(cycle-focus-item! 2 xs)
|
||||||
|
(cycle-append! 4 xs)
|
||||||
|
(should (equal '(1 4 2 3) (cycle-xs xs)))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-remove! ()
|
||||||
|
(let ((xs (cycle-from-list '(1 2 3))))
|
||||||
|
(should (equal '(1 2) (cycle-xs (cycle-remove! 3 xs))))))
|
||||||
|
|
||||||
|
(ert-deftest cycle-misc ()
|
||||||
|
(cycle-focus-item! 3 xs)
|
||||||
|
(cycle-focus-item! 2 xs)
|
||||||
|
(cycle-remove! 1 xs)
|
||||||
|
(should (= 2 (cycle-current xs)))
|
||||||
|
(should (= 3 (cycle-previous-focus xs))))
|
Loading…
Reference in a new issue