diff options
-rw-r--r-- | emacs/.emacs.d/wpc/al.el (renamed from emacs/.emacs.d/wpc/alist.el) | 117 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/bag.el | 5 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/device.el | 4 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/irc.el | 24 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/ivy-helpers.el | 1 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/kbd.el | 10 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/laptop-battery.el | 4 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/scope.el | 16 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/window-manager.el | 7 | ||||
-rw-r--r-- | emacs/.emacs.d/wpc/wpc-ui.el | 4 |
10 files changed, 84 insertions, 108 deletions
diff --git a/emacs/.emacs.d/wpc/alist.el b/emacs/.emacs.d/wpc/al.el index dd4b10133d53..92e1caa413f5 100644 --- a/emacs/.emacs.d/wpc/alist.el +++ b/emacs/.emacs.d/wpc/al.el @@ -1,4 +1,4 @@ -;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*- +;;; al.el --- Interface for working with associative lists -*- lexical-binding: t -*- ;; Author: William Carroll <wpcarro@gmail.com> ;; Version: 0.0.1 @@ -66,7 +66,6 @@ ;; Dependencies: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'maybe) (require 'macros) (require 'dash) (require 'tuple) @@ -90,7 +89,7 @@ ;; Constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst alist-enable-tests? t +(defconst al-enable-tests? t "When t, run the test suite.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -98,104 +97,105 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: Support a variadic version of this to easily construct alists. -(defun alist-new () +(defun al-new () "Return a new, empty alist." '()) ;; Create ;; TODO: See if this mutates. -(defun alist-set (k v xs) +(defun al-set (k v xs) "Set K to V in XS." - (if (alist-has-key? k xs) + (if (al-has-key? k xs) (progn + ;; Note: this is intentional `alist-get' and not `al-get'. (setf (alist-get k xs) v) xs) (list-cons `(,k . ,v) xs))) -(defun alist-set! (k v xs) +(defun al-set! (k v xs) "Set K to V in XS mutatively. Note that this doesn't append to the alist in the way that most alists handle writing. If the k already exists in XS, it is overwritten." (map-delete xs k) - (map-put xs k v)) + (map-put! xs k v)) ;; Read -(defun alist-get (k xs) +(defun al-get (k xs) "Return the value at K in XS; otherwise, return nil. Returns the first occurrence of K in XS since alists support multiple entries." (cdr (assoc k xs))) -(defun alist-get-entry (k xs) +(defun al-get-entry (k xs) "Return the first key-value pair at K in XS." (assoc k xs)) ;; Update ;; TODO: Add warning about only the first occurrence being updated in the ;; documentation. -(defun alist-update (k f xs) +(defun al-update (k f xs) "Apply F to the value stored at K in XS. -If `K' is not in `XS', this function errors. Use `alist-upsert' if you're +If `K' is not in `XS', this function errors. Use `al-upsert' if you're interested in inserting a value when a key doesn't already exist." - (if (maybe-nil? (alist-get k xs)) + (if (not (al-has-key? k xs)) (error "Refusing to update: key does not exist in alist") - (alist-set k (funcall f (alist-get k xs)) xs))) + (al-set k (funcall f (al-get k xs)) xs))) -(defun alist-update! (k f xs) +(defun al-update! (k f xs) "Call F on the entry at K in XS. -Mutative variant of `alist-update'." - (alist-set! k (funcall f (alist-get k xs))xs)) +Mutative variant of `al-update'." + (al-set! k (funcall f (al-get k xs))xs)) ;; TODO: Support this. -(defun alist-upsert (k v f xs) +(defun al-upsert (k v f xs) "If K exists in `XS' call `F' on the value otherwise insert `V'." - (if (alist-get k xs) - (alist-update k f xs) - (alist-set k v xs))) + (if (al-has-key? k xs) + (al-update k f xs) + (al-set k v xs))) ;; Delete ;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs. -(defun alist-delete (k xs) +(defun al-delete (k xs) "Deletes the entry of K from XS. This only removes the first occurrence of K, since alists support multiple - key-value entries. See `alist-delete-all' and `alist-dedupe'." + key-value entries. See `al-delete-all' and `al-dedupe'." (remove (assoc k xs) xs)) -(defun alist-delete! (k xs) +(defun al-delete! (k xs) "Delete the entry of K from XS. -Mutative variant of `alist-delete'." +Mutative variant of `al-delete'." (delete (assoc k xs) xs)) ;; Additions to the CRUD API ;; TODO: Implement this function. -(defun alist-dedupe-keys (xs) +(defun al-dedupe-keys (xs) "Remove the entries in XS where the keys are `equal'.") -(defun alist-dedupe-entries (xs) +(defun al-dedupe-entries (xs) "Remove the entries in XS where the key-value pair are `equal'." (delete-dups xs)) -(defun alist-keys (xs) +(defun al-keys (xs) "Return a list of the keys in XS." (mapcar 'car xs)) -(defun alist-values (xs) +(defun al-values (xs) "Return a list of the values in XS." (mapcar 'cdr xs)) -(defun alist-has-key? (k xs) +(defun al-has-key? (k xs) "Return t if XS has a key `equal' to K." (maybe-some? (assoc k xs))) -(defun alist-has-value? (v xs) +(defun al-has-value? (v xs) "Return t if XS has a value of V." (maybe-some? (rassoc v xs))) -(defun alist-count (xs) +(defun al-count (xs) "Return the number of entries in XS." (length xs)) -;; TODO: Should I support `alist-find-key' and `alist-find-value' variants? -(defun alist-find (p xs) +;; TODO: Should I support `al-find-key' and `al-find-value' variants? +(defun al-find (p xs) "Find an element in XS. Apply a predicate fn, P, to each key and value in XS and return the key of the @@ -205,76 +205,51 @@ first element that returns t." (car result) nil))) -(defun alist-map-keys (f xs) +(defun al-map-keys (f xs) "Call F on the values in XS, returning a new alist." (list-map (lambda (x) `(,(funcall f (car x)) . ,(cdr x))) xs)) -(defun alist-map-values (f xs) +(defun al-map-values (f xs) "Call F on the values in XS, returning a new alist." (list-map (lambda (x) `(,(car x) . ,(funcall f (cdr x)))) xs)) -(defun alist-reduce (acc f xs) +(defun al-reduce (acc f xs) "Return a new alist by calling F on k v and ACC from XS. F should return a tuple. See tuple.el for more information." - (->> (alist-keys xs) + (->> (al-keys xs) (list-reduce acc (lambda (k acc) - (funcall f k (alist-get k xs) acc))))) + (funcall f k (al-get k xs) acc))))) -(defun alist-merge (a b) +(defun al-merge (a b) "Return a new alist with a merge of alists, A and B. In this case, the last writer wins, which is B." - (alist-reduce a #'alist-set b)) - -;; TODO: Support `-all' variants like: -;; - get-all -;; - delete-all -;; - update-all - -;; Scratch-pad -(macros-comment - (progn - (setq person '((first-name . "William") - (first-name . "William") - (last-name . "Carroll") - (last-name . "Another"))) - (alist-set 'last-name "Van Gogh" person) - (alist-get 'last-name person) - (alist-update 'last-name (lambda (x) "whoops") person) - (alist-delete 'first-name person) - (alist-keys person) - (alist-values person) - (alist-count person) - (alist-has-key? 'first-name person) - (alist-has-value? "William" person) - ;; (alist-dedupe-keys person) - (alist-dedupe-entries person) - (alist-count person))) + (al-reduce a #'al-set b)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(when alist-enable-tests? +(when al-enable-tests? (prelude-assert (equal '((2 . one) (3 . two)) - (alist-map-keys #'1+ + (al-map-keys #'1+ '((1 . one) (2 . two))))) (prelude-assert (equal '((one . 2) (two . 3)) - (alist-map-values #'1+ + (al-map-values #'1+ '((one . 1) (two . 2)))))) ;; TODO: Support test cases for the entire API. -(provide 'alist) -;;; alist.el ends here +(provide 'al) +;;; al.el ends here diff --git a/emacs/.emacs.d/wpc/bag.el b/emacs/.emacs.d/wpc/bag.el index 3061f01a7492..38a09d94f900 100644 --- a/emacs/.emacs.d/wpc/bag.el +++ b/emacs/.emacs.d/wpc/bag.el @@ -27,6 +27,7 @@ ;; Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(require 'al) (require 'number) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -42,11 +43,11 @@ (defun bag-new () "Create an empty bag." - (make-bag :xs (alist-new))) + (make-bag :xs (al-new))) (defun bag-contains? (x xs) "Return t if XS has X." - (alist-has-key? x (bag-xs xs))) + (al-has-key? x (bag-xs xs))) ;; TODO: Tabling this for now since working with structs seems to be ;; disappointingly difficult. Where is `struct-update'? diff --git a/emacs/.emacs.d/wpc/device.el b/emacs/.emacs.d/wpc/device.el index 5d2f2606d7b3..0e7992fd79e7 100644 --- a/emacs/.emacs.d/wpc/device.el +++ b/emacs/.emacs.d/wpc/device.el @@ -15,7 +15,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'dash) -(require 'alist) +(require 'al) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Library @@ -30,7 +30,7 @@ (defun device-classify () "Return the device symbol for the current host or nil if not supported." - (alist-get system-name device-hostname->device)) + (al-get system-name device-hostname->device)) (defun device-work-laptop? () "Return t if current device is work laptop." diff --git a/emacs/.emacs.d/wpc/irc.el b/emacs/.emacs.d/wpc/irc.el index 1dfffd329b81..ce6f0cfa313b 100644 --- a/emacs/.emacs.d/wpc/irc.el +++ b/emacs/.emacs.d/wpc/irc.el @@ -18,7 +18,7 @@ (require 'cycle) (require 'string) (require 'prelude) -(require 'alist) +(require 'al) (require 'set) (require 'maybe) (require 'macros) @@ -53,24 +53,24 @@ (prelude-assert (set-distinct? (set-from-list (cycle-to-list - (alist-get "irc.freenode.net" - irc-server->channels))) + (al-get "irc.freenode.net" + irc-server->channels))) (set-from-list (cycle-to-list - (alist-get "irc.corp.google.com" - irc-server->channels))))) + (al-get "irc.corp.google.com" + irc-server->channels))))) (defun irc-channel->server (server->channels channel) "Using SERVER->CHANNELS, resolve an IRC server from a given CHANNEL." - (let ((result (alist-find (lambda (k v) (cycle-contains? channel v)) - server->channels))) + (let ((result (al-find (lambda (k v) (cycle-contains? channel v)) + server->channels))) (prelude-assert (maybe-some? result)) result)) (defun irc-channel->cycle (server->channels channel) "Using SERVER->CHANNELS, resolve an IRC's channels cycle from CHANNEL." - (alist-get (irc-channel->server server->channels channel) - server->channels)) + (al-get (irc-channel->server server->channels channel) + server->channels)) ;; Setting `erc-join-buffer' to 'bury prevents erc from stealing focus of the ;; current buffer when it connects to IRC servers. @@ -79,9 +79,9 @@ ;; TODO: Here is another horrible hack that should be revisted. (setq erc-autojoin-channels-alist (->> irc-server->channels - (alist-map-values #'cycle-to-list) - (alist-map-keys (>-> (s-chop-prefix "irc.") - (s-chop-suffix ".net"))))) + (al-map-values #'cycle-to-list) + (al-map-keys (>-> (s-chop-prefix "irc.") + (s-chop-suffix ".net"))))) (defcustom irc-install-kbds? t "When t, install the keybindings defined herein.") diff --git a/emacs/.emacs.d/wpc/ivy-helpers.el b/emacs/.emacs.d/wpc/ivy-helpers.el index 8b53c62fd643..c215337f00b1 100644 --- a/emacs/.emacs.d/wpc/ivy-helpers.el +++ b/emacs/.emacs.d/wpc/ivy-helpers.el @@ -12,7 +12,6 @@ ;; Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'alist) (require 'tuple) (require 'string) diff --git a/emacs/.emacs.d/wpc/kbd.el b/emacs/.emacs.d/wpc/kbd.el index d3a4224e432d..b456f30cba89 100644 --- a/emacs/.emacs.d/wpc/kbd.el +++ b/emacs/.emacs.d/wpc/kbd.el @@ -23,7 +23,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'prelude) -(require 'alist) +(require 'al) (require 'set) (require 'string) @@ -38,9 +38,9 @@ ;; Assert that no keybindings are colliding. (prelude-assert - (= (alist-count kbd-prefixes) + (= (al-count kbd-prefixes) (->> kbd-prefixes - alist-values + al-values set-from-list set-count))) @@ -53,10 +53,10 @@ Values for F include: - workspace - x11" - (prelude-assert (alist-has-key? f kbd-prefixes)) + (prelude-assert (al-has-key? f kbd-prefixes)) (string-format "%s-%s" - (alist-get f kbd-prefixes) + (al-get f kbd-prefixes) x)) (defun kbd-for (f x) diff --git a/emacs/.emacs.d/wpc/laptop-battery.el b/emacs/.emacs.d/wpc/laptop-battery.el index 7347b5ab5b30..91b2e3125001 100644 --- a/emacs/.emacs.d/wpc/laptop-battery.el +++ b/emacs/.emacs.d/wpc/laptop-battery.el @@ -27,7 +27,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'battery) -(require 'alist) +(require 'al) (require 'maybe) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -42,7 +42,7 @@ "Return the current percentage of the battery." (->> battery-status-function funcall - (alist-get 112))) + (al-get 112))) (defun laptop-battery-print-percentage () "Return the current percentage of the battery." diff --git a/emacs/.emacs.d/wpc/scope.el b/emacs/.emacs.d/wpc/scope.el index e8a2ad2ecc8d..267baac9fb14 100644 --- a/emacs/.emacs.d/wpc/scope.el +++ b/emacs/.emacs.d/wpc/scope.el @@ -17,7 +17,7 @@ ;; Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'alist) +(require 'al) (require 'stack) (require 'struct) (require '>) @@ -31,7 +31,7 @@ (defun scope-new () "Return an empty scope." (make-scope :scopes (->> (stack-new) - (stack-push (alist-new))))) + (stack-push (al-new))))) (defun scope-flatten (xs) "Return a flattened representation of the scope, XS. @@ -39,15 +39,15 @@ The newest bindings eclipse the oldest." (->> xs scope-scopes stack-to-list - (list-reduce (alist-new) + (list-reduce (al-new) (lambda (scope acc) - (alist-merge acc scope))))) + (al-merge acc scope))))) (defun scope-push-new (xs) "Push a new, empty scope onto XS." (struct-update scope scopes - (>-> (stack-push (alist-new))) + (>-> (stack-push (al-new))) xs)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -58,7 +58,7 @@ The newest bindings eclipse the oldest." "Return K from XS if it's in scope." (->> xs scope-flatten - (alist-get k))) + (al-get k))) (defun scope-current (xs) "Return the newest scope from XS." @@ -75,7 +75,7 @@ The newest bindings eclipse the oldest." "Set value, V, at key, K, in XS for the current scope." (struct-update scope scopes - (>-> (stack-map-top (>-> (alist-set k v)))) + (>-> (stack-map-top (>-> (al-set k v)))) xs)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -96,7 +96,7 @@ The newest bindings eclipse the oldest." "Return t if K is in scope of XS." (->> xs scope-flatten - (alist-has-key? k))) + (al-has-key? k))) ;; TODO: Find a faster way to write aliases like this. (defun scope-instance? (xs) diff --git a/emacs/.emacs.d/wpc/window-manager.el b/emacs/.emacs.d/wpc/window-manager.el index 5c109cb53cad..a648ac875eea 100644 --- a/emacs/.emacs.d/wpc/window-manager.el +++ b/emacs/.emacs.d/wpc/window-manager.el @@ -21,6 +21,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'alert) +(require 'al) (require 'prelude) (require 'string) (require 'cycle) @@ -285,8 +286,8 @@ Ivy is used to capture the user's input." (funcall (lambda () (shell-command - (alist-get (ivy-read "System: " (alist-keys name->cmd)) - name->cmd)))))) + (al-get (ivy-read "System: " (al-keys name->cmd)) + name->cmd)))))) (defun window-manager--label->index (label workspaces) "Return the index of the workspace in WORKSPACES named LABEL." @@ -356,7 +357,7 @@ predicate." buffer))))) (label (completing-read "Switch to EXWM buffer: " buffer-alist))) (exwm-workspace-switch-to-buffer - (alist-get label buffer-alist nil nil #'string=)))) + (al-get label buffer-alist)))) (when window-manager--install-kbds? (progn diff --git a/emacs/.emacs.d/wpc/wpc-ui.el b/emacs/.emacs.d/wpc/wpc-ui.el index 31b9c5f7e656..d315dca9aeb9 100644 --- a/emacs/.emacs.d/wpc/wpc-ui.el +++ b/emacs/.emacs.d/wpc/wpc-ui.el @@ -16,7 +16,7 @@ (require 'constants) (require 'prelude) -(require 'alist) +(require 'al) (require 'fonts) (require 'colorscheme) (require 'device) @@ -91,7 +91,7 @@ :config (counsel-mode t) (ivy-mode t) - (alist-set! #'counsel-M-x "" ivy-initial-inputs-alist) + (al-set! #'counsel-M-x "" ivy-initial-inputs-alist) ;; prefer using `helpful' variants (progn (setq counsel-describe-function-function #'helpful-callable) |