diff options
Diffstat (limited to 'users/wpcarro/emacs/pkgs')
58 files changed, 2960 insertions, 0 deletions
diff --git a/users/wpcarro/emacs/pkgs/al/al.el b/users/wpcarro/emacs/pkgs/al/al.el new file mode 100644 index 000000000000..4c37526c644a --- /dev/null +++ b/users/wpcarro/emacs/pkgs/al/al.el @@ -0,0 +1,227 @@ +;;; al.el --- Interface for working with associative lists -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "25.1")) + +;;; Commentary: +;; Firstly, a rant: +;; In most cases, I find Elisp's APIs to be confusing. There's a mixture of +;; overloaded functions that leak the implementation details (TODO: provide an +;; example of this.) of the abstract data type, which I find privileges those +;; "insiders" who spend disproportionately large amounts of time in Elisp land, +;; and other functions with little-to-no pattern about the order in which +;; arguments should be applied. In theory, however, most of these APIs could +;; and should be much simpler. This module represents a step in that direction. +;; +;; I'm modelling these APIs after Elixir's APIs. +;; +;; On my wishlist is to create protocols that will allow generic interfaces like +;; Enum protocols, etc. Would be nice to abstract over... +;; - associative lists (i.e. alists) +;; - property lists (i.e. plists) +;; - hash tables +;; ...with some dictionary or map-like interface. This will probably end up +;; being quite similar to the kv.el project but with differences at the API +;; layer. +;; +;; Similar libraries: +;; - map.el: Comes bundled with recent versions of Emacs. +;; - asoc.el: Helpers for working with alists. asoc.el is similar to alist.el +;; because it uses the "!" convention for signalling that a function mutates +;; the underlying data structure. +;; - ht.el: Hash table library. +;; - kv.el: Library for dealing with key-value collections. Note that map.el +;; has a similar typeclass because it works with lists, hash-tables, or +;; arrays. +;; - a.el: Clojure-inspired way of working with key-value data structures in +;; Elisp. Works with alists, hash-tables, and sometimes vectors. +;; +;; Some API design principles: +;; - The "noun" (i.e. alist) of the "verb" (i.e. function) comes last to improve +;; composability with the threading macro (i.e. `->>') and to improve consumers' +;; intuition with the APIs. Learn this once, know it always. +;; +;; - Every function avoids mutating the alist unless it ends with !. +;; +;; - CRUD operations will be named according to the following table: +;; - "create" *and* "set" +;; - "read" *and* "get" +;; - "update" +;; - "delete" *and* "remove" +;; +;; For better or worse, all of this code expects alists in the form of: +;; ((first-name . "William") (last-name . "Carroll")) +;; +;; Special thanks to github.com/alphapapa/emacs-package-dev-handbook for some of +;; the idiomatic ways to update alists. +;; +;; TODO: Include a section that compares alist.el to a.el from +;; github.com/plexus/a.el. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'dash) +(require 'list) +(require 'map) + +;; TODO: Support function aliases for: +;; - create/set +;; - read/get +;; - update +;; - delete/remove + +;; Support mutative variants of functions with an ! appendage to their name. + +;; Ensure that the same message about only updating the first occurrence of a +;; key is consistent throughout documentation using string interpolation or some +;; other mechanism. + +;; TODO: Consider wrapping all of this with `(cl-defstruct alist xs)'. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support a variadic version of this to easily construct alists. +(defun al-new () + "Return a new, empty alist." + '()) + +;; Create +;; TODO: See if this mutates. +(defun al-set (k v xs) + "Set K to V in 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 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)) + +;; Read +(defun al-get (k xs &optional default) + "Return the value at K in XS; otherwise, return nil or DEFAULT (if set). +Returns the first occurrence of K in XS since alists support multiple entries." + (if (not (al-has-key? k xs)) + default + (cdr (assoc 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 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 `al-upsert' if you're +interested in inserting a value when a key doesn't already exist." + (if (not (al-has-key? k xs)) + (error "Refusing to update: key does not exist in alist") + (al-set k (funcall f (al-get k xs)) xs))) + +(defun al-update! (k f xs) + "Call F on the entry at K in XS. +Mutative variant of `al-update'." + (al-set! k (funcall f (al-get k xs))xs)) + +;; TODO: Support this. +(defun al-upsert (k v f xs) + "If K exists in `XS' call `F' on the value otherwise insert `V'." + (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 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 `al-delete-all' and `al-dedupe'." + (remove (assoc k xs) xs)) + +(defun al-delete! (k xs) + "Delete the entry of K from XS. +Mutative variant of `al-delete'." + (delete (assoc k xs) xs)) + +;; Additions to the CRUD API +;; TODO: Implement this function. +(defun al-dedupe-keys (xs) + "Remove the entries in XS where the keys are `equal'.") + +(defun al-dedupe-entries (xs) + "Remove the entries in XS where the key-value pair are `equal'." + (delete-dups xs)) + +(defun al-keys (xs) + "Return a list of the keys in XS." + (mapcar 'car xs)) + +(defun al-values (xs) + "Return a list of the values in XS." + (mapcar 'cdr xs)) + +(defun al-has-key? (k xs) + "Return t if XS has a key `equal' to K." + (not (eq nil (assoc k xs)))) + +(defun al-has-value? (v xs) + "Return t if XS has a value of V." + (not (eq nil (rassoc v xs)))) + +(defun al-count (xs) + "Return the number of entries in XS." + (length 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 +first element that returns t." + (let ((result (list-find (lambda (x) (funcall p (car x) (cdr x))) xs))) + (if result + (car result) + nil))) + +(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 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 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." + (->> (al-keys xs) + (list-reduce acc + (lambda (k acc) + (funcall f k (al-get k xs) acc))))) + +(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." + (al-reduce a #'al-set b)) + +(provide 'al) +;;; al.el ends here diff --git a/users/wpcarro/emacs/pkgs/al/default.nix b/users/wpcarro/emacs/pkgs/al/default.nix new file mode 100644 index 000000000000..d88e0757a875 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/al/default.nix @@ -0,0 +1,28 @@ +{ pkgs, depot, ... }: + +let + al = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "al"; + version = "1.0.0"; + src = ./al.el; + packageRequires = + (with emacsPackages; [ + dash + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + list + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ al ]); +in +al.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/al/tests.el b/users/wpcarro/emacs/pkgs/al/tests.el new file mode 100644 index 000000000000..04fe4dcbb5a6 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/al/tests.el @@ -0,0 +1,53 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'al) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest al-has-key? () + (should (al-has-key? 'fname '((fname . "William")))) + (should (not (al-has-key? 'lname '((fname . "William")))))) + +(ert-deftest al-get () + (let ((xs (->> (al-new) + (al-set 'fname "John") + (al-set 'employed? nil)))) + (should (string= "John" (al-get 'fname xs))) + (should (string= "Cleese" (al-get 'lname xs "Cleese"))) + ;; Test that the value of nil is returned even when a default is defined, + ;; which could be a subtle bug in the typical Elisp pattern of supporting + ;; defaults with: (or foo default). + (should (eq nil (al-get 'employed? xs))) + (should (eq nil (al-get 'employed? xs "default"))))) + +(ert-deftest al-has-value? () + (should (al-has-value? "William" '((fname . "William")))) + (should (not (al-has-key? "John" '((fname . "William")))))) + +(ert-deftest al-map-keys () + (should + (equal '((2 . one) + (3 . two)) + (al-map-keys #'1+ + '((1 . one) + (2 . two)))))) + +(ert-deftest al-map-values () + (should (equal '((one . 2) + (two . 3)) + (al-map-values #'1+ + '((one . 1) + (two . 2)))))) + +(ert-deftest al-delete () + (let ((person (->> (al-new) + (al-set "fname" "John") + (al-set "lname" "Cleese") + (al-set "age" 82)))) + (should (al-has-key? "age" person)) + (should (not (al-has-key? "age" (al-delete "age" person)))))) diff --git a/users/wpcarro/emacs/pkgs/bag/bag.el b/users/wpcarro/emacs/pkgs/bag/bag.el new file mode 100644 index 000000000000..502f5672536e --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bag/bag.el @@ -0,0 +1,78 @@ +;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; What is a bag? A bag should be thought of as a frequency table. It's a way +;; to convert a list of something into a set that allows duplicates. Isn't +;; allowing duplicates the whole thing with Sets? Kind of. But the interface +;; of Sets is something that bags resemble, so multi-set isn't as bad of a name +;; as it may first seem. +;; +;; If you've used Python's collections.Counter, the concept of a bag should be +;; familiar already. +;; +;; Interface: +;; - add :: x -> Bag(x) -> Bag(x) +;; - remove :: x -> Bag(x) -> Bag(x) +;; - union :: Bag(x) -> Bag(x) -> Bag(x) +;; - difference :: Bag(x) -> Bag(x) -> Bag(x) + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'al) +(require 'list) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct bag xs) + +(defun bag-new () + "Create an empty bag." + (make-bag :xs (al-new))) + +(defun bag-from-list (xs) + "Map a list of `XS' into a bag." + (->> xs + (list-reduce (bag-new) #'bag-add))) + +(defun bag-add (x xs) + "Add X to XS." + (if (bag-contains? x xs) + (struct-update + bag xs (lambda (xs) (al-update x (lambda (x) (+ 1 x)) xs)) xs) + (struct-update bag xs (lambda (xs) (al-set x 1 xs)) xs))) + +(defun bag-remove (x xs) + "Remove X from XS. +This is a no-op is X doesn't exist in XS." + (when (bag-contains? x xs) + (struct-update bag xs (lambda (xs) (al-delete x xs)) xs))) + +(defun bag-count (x xs) + "Return the number of occurrences of X in XS." + (al-get x (bag-xs xs) 0)) + +(defun bag-total (xs) + "Return the total number of elements in XS." + (->> (bag-xs xs) + (al-reduce 0 (lambda (_key v acc) (+ acc v))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bag-contains? (x xs) + "Return t if XS has X." + (al-has-key? x (bag-xs xs))) + +(provide 'bag) +;;; bag.el ends here diff --git a/users/wpcarro/emacs/pkgs/bag/default.nix b/users/wpcarro/emacs/pkgs/bag/default.nix new file mode 100644 index 000000000000..3dedc27286d1 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bag/default.nix @@ -0,0 +1,26 @@ +{ pkgs, depot, ... }: + +let + bag = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "bag"; + version = "1.0.0"; + src = ./bag.el; + packageRequires = + (with depot.users.wpcarro.emacs.pkgs; [ + al + list + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ bag ]); +in +bag.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/bag/tests.el b/users/wpcarro/emacs/pkgs/bag/tests.el new file mode 100644 index 000000000000..4970f70815c9 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bag/tests.el @@ -0,0 +1,32 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'bag) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq fixture (bag-from-list '(1 1 1 2 2 3))) + +(ert-deftest bag-add () + (should (not (bag-contains? 4 fixture))) + (should (bag-contains? 4 (bag-add 4 fixture)))) + +(ert-deftest bag-remove () + (should (bag-contains? 1 fixture)) + (should (not (bag-contains? 3 (bag-remove 3 fixture))))) + +(ert-deftest bag-count () + (should (= 3 (bag-count 1 fixture))) + (should (= 2 (bag-count 2 fixture))) + (should (= 1 (bag-count 3 fixture)))) + +(ert-deftest bag-total () + (should (= 6 (bag-total fixture)))) + +(ert-deftest bag-contains? () + (should (bag-contains? 1 fixture)) + (should (not (bag-contains? 4 fixture)))) diff --git a/users/wpcarro/emacs/pkgs/bookmark/bookmark.el b/users/wpcarro/emacs/pkgs/bookmark/bookmark.el new file mode 100644 index 000000000000..ab9169a078d4 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bookmark/bookmark.el @@ -0,0 +1,50 @@ +;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; A more opinionated version of Emacs's builtin `jump-to-register'. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'project) +(require 'general) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct bookmark label path kbd) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; API +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bookmark-open (b) + "Open bookmark, B, as either a project directory or a regular directory." + (with-temp-buffer + (cd (bookmark-path b)) + (call-interactively #'project-find-file))) + +(defun bookmark-install-kbd (b) + "Define two functions to explore B and assign them to keybindings." + (eval `(defun ,(intern (format "bookmark-visit-%s" (bookmark-label b))) () + (interactive) + (find-file ,(bookmark-path b)))) + (eval `(defun ,(intern (format "bookmark-browse-%s" (bookmark-label b))) () + (interactive) + (bookmark-open ,b))) + (general-define-key + :prefix "<SPC>" + :states '(motion) + (format "J%s" (bookmark-kbd b)) `,(intern (format "bookmark-visit-%s" (bookmark-label b))) + (format "j%s" (bookmark-kbd b)) `,(intern (format "bookmark-browse-%s" (bookmark-label b))))) + +(provide 'bookmark) +;;; bookmark.el ends here diff --git a/users/wpcarro/emacs/pkgs/bookmark/default.nix b/users/wpcarro/emacs/pkgs/bookmark/default.nix new file mode 100644 index 000000000000..882481701fa2 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bookmark/default.nix @@ -0,0 +1,13 @@ +{ pkgs, depot, ... }: + +pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "bookmark"; + version = "1.0.0"; + src = ./bookmark.el; + packageRequires = (with pkgs.emacsPackages; [ + general + ]); + }) +{ } diff --git a/users/wpcarro/emacs/pkgs/bytes/bytes.el b/users/wpcarro/emacs/pkgs/bytes/bytes.el new file mode 100644 index 000000000000..b0d64795a074 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bytes/bytes.el @@ -0,0 +1,94 @@ +;;; bytes.el --- Working with byte values -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; Functions to help with human-readable representations of byte values. +;; +;; Usage: +;; See the test cases for example usage. Or better yet, I should use a type of +;; structured documentation that would allow me to expose a view into the test +;; suite here. Is this currently possible in Elisp? +;; +;; API: +;; - serialize :: Integer -> String +;; +;; Wish list: +;; - Rounding: e.g. (bytes (* 1024 1.7)) => "2KB" + +;;; Code: + +;; TODO: Support -ibabyte variants like Gibibyte (GiB). + +;; Ranges: +;; B: [ 0, 1e3) +;; KB: [ 1e3, 1e6) +;; MB: [ 1e6, 1e6) +;; GB: [ 1e9, 1e12) +;; TB: [1e12, 1e15) +;; PB: [1e15, 1e18) +;; +;; Note: I'm currently not support exabytes because that causes the integer to +;; overflow. I imagine a larger integer type may exist, but for now, I'll +;; treat this as a YAGNI. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'tuple) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst bytes-kb (expt 2 10) + "Number of bytes in a kilobyte.") + +(defconst bytes-mb (expt 2 20) + "Number of bytes in a megabytes.") + +(defconst bytes-gb (expt 2 30) + "Number of bytes in a gigabyte.") + +(defconst bytes-tb (expt 2 40) + "Number of bytes in a terabyte.") + +(defconst bytes-pb (expt 2 50) + "Number of bytes in a petabyte.") + +(defconst bytes-eb (expt 2 60) + "Number of bytes in an exabyte.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bytes-classify (x) + "Return unit that closest fits byte count, X." + (cond + ((and (>= x 0) (< x bytes-kb)) 'byte) + ((and (>= x bytes-kb) (< x bytes-mb)) 'kilobyte) + ((and (>= x bytes-mb) (< x bytes-gb)) 'megabyte) + ((and (>= x bytes-gb) (< x bytes-tb)) 'gigabyte) + ((and (>= x bytes-tb) (< x bytes-pb)) 'terabyte) + ((and (>= x bytes-pb) (< x bytes-eb)) 'petabyte))) + +(defun bytes-to-string (x) + "Convert integer X into a human-readable string." + (let ((base-and-unit + (pcase (bytes-classify x) + ('byte (tuple-from 1 "B")) + ('kilobyte (tuple-from bytes-kb "KB")) + ('megabyte (tuple-from bytes-mb "MB")) + ('gigabyte (tuple-from bytes-gb "GB")) + ('terabyte (tuple-from bytes-tb "TB")) + ('petabyte (tuple-from bytes-pb "PB"))))) + (format "%d%s" + (round x (tuple-first base-and-unit)) + (tuple-second base-and-unit)))) + +(provide 'bytes) +;;; bytes.el ends here diff --git a/users/wpcarro/emacs/pkgs/bytes/default.nix b/users/wpcarro/emacs/pkgs/bytes/default.nix new file mode 100644 index 000000000000..4e9f52d9b927 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bytes/default.nix @@ -0,0 +1,25 @@ +{ pkgs, depot, ... }: + +let + bytes = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "bytes"; + version = "1.0.0"; + src = ./bytes.el; + packageRequires = + (with depot.users.wpcarro.emacs.pkgs; [ + tuple + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ bytes ]); +in +bytes.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/bytes/tests.el b/users/wpcarro/emacs/pkgs/bytes/tests.el new file mode 100644 index 000000000000..9b71a466c736 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/bytes/tests.el @@ -0,0 +1,18 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'bytes) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest bytes-to-string () + (should (equal "1000B" (bytes-to-string 1000))) + (should (equal "2KB" (bytes-to-string (* 2 bytes-kb)))) + (should (equal "17MB" (bytes-to-string (* 17 bytes-mb)))) + (should (equal "419GB" (bytes-to-string (* 419 bytes-gb)))) + (should (equal "999TB" (bytes-to-string (* 999 bytes-tb)))) + (should (equal "2PB" (bytes-to-string (* 2 bytes-pb))))) diff --git a/users/wpcarro/emacs/pkgs/cycle/README.md b/users/wpcarro/emacs/pkgs/cycle/README.md new file mode 100644 index 000000000000..416900d2532b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/cycle/README.md @@ -0,0 +1,7 @@ +# cycle.el + +[](https://buildkite.com/tvl/depot) + +Cycle data structure exposing mutable and (coming soon!) immutable APIs. + +[](https://asciinema.org/a/FvFujpRpYjV9qCSGvk3uobOpV) diff --git a/users/wpcarro/emacs/pkgs/cycle/cycle.el b/users/wpcarro/emacs/pkgs/cycle/cycle.el new file mode 100644 index 000000000000..2f5b252a0d6a --- /dev/null +++ b/users/wpcarro/emacs/pkgs/cycle/cycle.el @@ -0,0 +1,194 @@ +;;; cycle.el --- Simple module for working with cycles -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; 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 'dash) +(require 'struct) +(require 'cl-lib) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish list +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Provide immutable variant. +;; - TODO: Replace mutable consumption with immutable variant. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; `current-index' tracks the current index +;; `xs' is the original list +(cl-defstruct cycle current-index previous-index xs) + +(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-previous-focus (cycle) + "Return the previously focused entry in CYCLE." + (let ((i (cycle-previous-index cycle))) + (when i (nth i (cycle-xs cycle))))) + +(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 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 (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-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)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun cycle-contains? (x xs) + "Return t if cycle, XS, has member X." + (not (null (-contains? (cycle-xs xs) 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." + (not (null (cycle-current-index xs)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helper Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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) +;;; cycle.el ends here diff --git a/users/wpcarro/emacs/pkgs/cycle/default.nix b/users/wpcarro/emacs/pkgs/cycle/default.nix new file mode 100644 index 000000000000..7ef3b431ada6 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/cycle/default.nix @@ -0,0 +1,36 @@ +{ 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; [ + struct + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + epkgs.dash + cycle + ]); +in +cycle.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; + passthru.meta.ci.extraSteps.github = depot.tools.releases.filteredGitPush { + filter = ":/users/wpcarro/emacs/pkgs/cycle"; + remote = "git@github.com:wpcarro/cycle.el.git"; + ref = "refs/heads/canon"; + }; +}) diff --git a/users/wpcarro/emacs/pkgs/cycle/tests.el b/users/wpcarro/emacs/pkgs/cycle/tests.el new file mode 100644 index 000000000000..29c0e2a0d582 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/cycle/tests.el @@ -0,0 +1,79 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'cycle) +(require 'dash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq xs (cycle-new 1 2 3)) + +(ert-deftest cycle-initializes-properly () + (should (= 3 (cycle-count xs))) + (should (null (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)))) diff --git a/users/wpcarro/emacs/pkgs/fs/default.nix b/users/wpcarro/emacs/pkgs/fs/default.nix new file mode 100644 index 000000000000..e6afd107e96b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/fs/default.nix @@ -0,0 +1,29 @@ +{ pkgs, depot, ... }: + +let + fs = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "fs"; + version = "1.0.0"; + src = ./fs.el; + packageRequires = + (with emacsPackages; [ + dash + f + s + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + fs + ]); +in +fs.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/fs/fs.el b/users/wpcarro/emacs/pkgs/fs/fs.el new file mode 100644 index 000000000000..125c1f1007bd --- /dev/null +++ b/users/wpcarro/emacs/pkgs/fs/fs.el @@ -0,0 +1,47 @@ +;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.1")) + +;;; Commentary: +;; Ergonomic alternatives for working with the filesystem. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'dash) +(require 'f) +(require 's) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun fs-ensure-file (path) + "Ensure that a file and its directories in `PATH' exist. +Will error for inputs with a trailing slash." + (when (s-ends-with? "/" path) + (error (format "Input path has trailing slash: %s" path))) + (->> path + f-dirname + fs-ensure-dir) + (f-touch path)) + +(defun fs-ensure-dir (path) + "Ensure that a directory and its ancestor directories in `PATH' exist." + (->> path + f-split + (apply #'f-mkdir))) + +(defun fs-ls (dir &optional full-path?) + "List the files in `DIR' one-level deep. +Should behave similarly in spirit to the Unix command, ls. +If `FULL-PATH?' is set, return the full-path of the files." + (-drop 2 (directory-files dir full-path?))) + +(provide 'fs) +;;; fs.el ends here diff --git a/users/wpcarro/emacs/pkgs/fs/tests.el b/users/wpcarro/emacs/pkgs/fs/tests.el new file mode 100644 index 000000000000..adef11a607ae --- /dev/null +++ b/users/wpcarro/emacs/pkgs/fs/tests.el @@ -0,0 +1,26 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'fs) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest fs-test-ensure-file () + (let ((file "/tmp/file/a/b/c/file.txt")) + ;; Ensure this file doesn't exist first to prevent false-positives. + (f-delete file t) + (fs-ensure-file file) + (should (and (f-exists? file) + (f-file? file))))) + +(ert-deftest fs-test-ensure-dir () + (let ((dir "/tmp/dir/a/b/c")) + ;; Ensure the directory doesn't exist. + (f-delete dir t) + (fs-ensure-dir dir) + (should (and (f-exists? dir) + (f-dir? dir))))) diff --git a/users/wpcarro/emacs/pkgs/list/README.md b/users/wpcarro/emacs/pkgs/list/README.md new file mode 100644 index 000000000000..7afa8494fb7a --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/README.md @@ -0,0 +1,19 @@ +# list.el + +Functions for working with lists in Elisp. + +## Wish List + +Here are some additional functions that I'd like to support. + +- **TODO**: delete_at/2 +- **TODO**: flatten/1 +- **TODO**: flatten/2 +- **TODO**: foldl/3 +- **TODO**: foldr/3 +- **TODO**: insert_at/3 +- **TODO**: pop_at/3 +- **TODO**: replace_at/3 +- **TODO**: starts_with?/2 +- **TODO**: update_at/3 +- **TODO**: zip/1 diff --git a/users/wpcarro/emacs/pkgs/list/default.nix b/users/wpcarro/emacs/pkgs/list/default.nix new file mode 100644 index 000000000000..1be0b901eb3e --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/default.nix @@ -0,0 +1,26 @@ +{ pkgs, depot, ... }: + +let + list = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "list"; + version = "1.0.0"; + src = ./list.el; + packageRequires = + (with depot.users.wpcarro.emacs.pkgs; [ + maybe + set + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ list ]); +in +list.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/list/list.el b/users/wpcarro/emacs/pkgs/list/list.el new file mode 100644 index 000000000000..18be5f0a716c --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/list.el @@ -0,0 +1,219 @@ +;;; list.el --- Functions for working with lists -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; Since I prefer having the `list-' namespace, I wrote this module to wrap many +;; of the functions that are defined in the the global namespace in Elisp. I +;; sometimes forget the names of these functions, so it's nice for them to be +;; organized like this. +;; +;; Motivation: +;; Here are some examples of function names where I prefer more modern +;; alternatives: +;; - `car': Return the first element (i.e. "head") of a linked list +;; - `cdr': Return the tail of a linked list + +;; As are most APIs for standard libraries that I write, this is influenced by +;; Elixir's standard library. +;; +;; Similar libraries: +;; - dash.el: Excellent and widely adopted library for working with lists. +;; - list-utils.el: Utility library that covers things that dash.el may not +;; cover. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'maybe) +(require 'set) +(require 'set) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list-new () + "Return a new, empty list." + '()) + +(defun list-concat (&rest lists) + "Joins `LISTS' into on list." + (apply #'append lists)) + +(defun list-duplicate (n x) + "Duplicates the given element, X, N times in a list." + (list-map (lambda (_) x) (number-sequence 1 n))) + +(defun list-join (joint xs) + "Join a list of strings, XS, with JOINT." + (if (list-empty? xs) + "" + (list-reduce (list-first xs) + (lambda (x acc) + (format "%s%s%s" acc joint x)) + (list-tail xs)))) + +(defun list-length (xs) + "Return the number of elements in `XS'." + (length xs)) + +(defun list-get (i xs) + "Return the value in `XS' at `I', or nil." + (nth i xs)) + +(defun list-first (xs &optional default) + "Alias for `list-head' for `XS'." + (if (list-empty? xs) + default + (car xs))) + +(defun list-last (xs &optional default) + "Returns the last element in XS or DEFAULT if empty." + (if (list-empty? xs) + default + (nth (- (length xs) 1) xs))) + +(defun list-tail (xs) + "Return the tail of `XS'." + (cdr xs)) + +(defun list-reverse (xs) + "Reverses `XS'." + (reverse xs)) + +(defun list-cons (x xs) + "Add `X' to the head of `XS'." + (cons x xs)) + +(defun list-delete (x xs) + "Deletes the given element, X, from XS. +Returns a new list without X. If X occurs more than once, only the first + occurrence is removed." + (let ((deleted? nil)) + (list-reject (lambda (y) + (if deleted? nil + (when (equal x y) + (setq deleted? t) t))) + xs))) + +(defun list-filter (p xs) + "Return a subset of XS where predicate P returned t." + (list--assert-instance xs) + (seq-filter p xs)) + +(defun list-map (f xs) + "Call `F' on each element of `XS'." + (list--assert-instance xs) + (seq-map f xs)) + +(defun list-reduce (acc f xs) + "Return over `XS' calling `F' on an element in `XS'and `ACC'." + (list--assert-instance xs) + (seq-reduce (lambda (acc x) (funcall f x acc)) xs acc)) + +(defun list-map-indexed (f xs) + "Call `F' on each element of `XS' along with its index." + (list-reverse + (cdr + (list-reduce '(0 . nil) + (lambda (x acc) + (let ((i (car acc)) + (result (cdr acc))) + `(,(+ 1 i) . ,(cons (funcall f x i) result)))) + xs)))) + +(defun list-reject (p xs) + "Return a subset of XS where predicate of P return nil." + (list-filter (lambda (x) (not (funcall p x))) xs)) + +(defun list-find (p xs) + "Return the first x in XS that passes P or nil." + (list--assert-instance xs) + (seq-find p xs)) + +(defun list-dedupe-adjacent (xs) + "Return XS without adjacent duplicates." + (list-reverse + (list-reduce (list (list-first xs)) + (lambda (x acc) + (if (equal x (list-first acc)) + acc + (list-cons x acc))) + xs))) + +(defun list-chunk (n xs) + "Chunk XS into lists of size N." + (if (> n (length xs)) + (list xs) + (let* ((xs (list-reduce '(:curr () :result ()) + (lambda (x acc) + (let ((curr (plist-get acc :curr)) + (result (plist-get acc :result))) + (if (= (- n 1) (length curr)) + `(:curr () :result ,(list-cons (list-reverse (list-cons x curr)) result)) + `(:curr ,(list-cons x curr) :result + ,result)))) xs)) + (curr (plist-get xs :curr)) + (result (plist-get xs :result))) + (list-reverse (if curr (list-cons curr result) result))))) + +(defun list-wrap (xs) + "Wraps XS in a list if it is not a list already." + (if (list-instance? xs) + xs + (list xs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list-instance? (xs) + "Return t if `XS' is a list. +Be leery of using this with things like alists. Many data structures in Elisp + are implemented using linked lists." + (listp xs)) + +(defun list-empty? (xs) + "Return t if XS are empty." + (= 0 (list-length xs))) + +(defun list-all? (p xs) + "Return t if all `XS' pass the predicate, `P'." + (if (list-empty? xs) + t + (and (maybe-some? (funcall p (car xs))) + (list-all? p (cdr xs))))) + +(defun list-any? (p xs) + "Return t if any `XS' pass the predicate, `P'." + (if (list-empty? xs) + nil + (or (maybe-some? (funcall p (car xs))) + (list-any? p (cdr xs))))) + +(defun list-contains? (x xs) + "Return t if X is in XS using `equal'." + (list--assert-instance xs) + (maybe-some? (seq-contains-p xs x))) + +(defun list-xs-distinct-by? (f xs) + "Return t if all elements in XS are distinct after applying F to each." + (= (length xs) + (set-count (set-from-list (list-map f xs))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun list--assert-instance (xs) + (unless (list-instance? xs) + (error (format "Assertion failed: argument is not a list: %s" xs)))) + +(provide 'list) +;;; list.el ends here diff --git a/users/wpcarro/emacs/pkgs/list/tests.el b/users/wpcarro/emacs/pkgs/list/tests.el new file mode 100644 index 000000000000..4b4579688331 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/list/tests.el @@ -0,0 +1,107 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'list) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq xs '(1 2 3 4 5)) + +(ert-deftest list-length () + (should (= 0 (list-length '()))) + (should (= 5 (list-length xs)))) + +(ert-deftest list-reduce () + (should (= 16 (list-reduce 1 (lambda (x acc) (+ x acc)) xs)))) + +(ert-deftest list-map () + (should + (equal '(2 4 6 8 10) + (list-map (lambda (x) (* x 2)) xs)))) + +(ert-deftest list-xs-distinct-by? () + (should + (equal t (list-xs-distinct-by? + (lambda (x) (plist-get x :kbd)) + '((:kbd "C-a" :name "foo") + (:kbd "C-b" :name "foo")))))) + +(ert-deftest list-dedupe-adjacent () + (should (equal '(1 2 3 4 3 5) + (list-dedupe-adjacent '(1 1 1 2 2 3 4 4 3 5 5))))) + +(ert-deftest list-contains? () + ;; Assert returns t or nil + (should (equal t (list-contains? 1 xs))) + (should (equal nil (list-contains? 100 xs)))) + +(ert-deftest list-join () + (should (equal "foo-bar-baz" + (list-join "-" '("foo" "bar" "baz"))))) + +(ert-deftest list-chunk () + (should (equal '((1 2 3 4 5 6)) + (list-chunk 7 '(1 2 3 4 5 6)))) + (should (equal '((1) (2) (3) (4) (5) (6)) + (list-chunk 1 '(1 2 3 4 5 6)))) + (should (equal '((1 2 3) (4 5 6)) + (list-chunk 3 '(1 2 3 4 5 6)))) + (should (equal '((1 2) (3 4) (5 6)) + (list-chunk 2 '(1 2 3 4 5 6))))) + +(ert-deftest list-find () + (should (equal 2 (list-find (lambda (x) (= 2 x)) '(1 2 3 4))))) + +(ert-deftest list-all? () + (should (equal t (list-all? (lambda (x) (= 2 x)) nil))) + (should (null (list-all? (lambda (x) (= 2 x)) '(1 2 3)))) + (should (equal t (list-all? (lambda (x) (= 2 x)) '(2 2 2 2))))) + +(ert-deftest list-any? () + (should (null (list-any? (lambda (x) (= 2 x)) nil))) + (should (equal t (list-any? (lambda (x) (= 2 x)) '(1 2 3)))) + (should (null (list-any? (lambda (x) (= 4 x)) '(1 2 3))))) + +(ert-deftest list-duplicate () + (should (equal '() (list-duplicate 0 "hello"))) + (should (equal '("hi") (list-duplicate 1 "hi"))) + (should (equal '("bye" "bye") (list-duplicate 2 "bye"))) + (should (equal '((1 2) (1 2) (1 2)) (list-duplicate 3 '(1 2))))) + +(ert-deftest list-first () + (should (null (list-first '()))) + (should (equal 1 (list-first '() 1))) + (should (equal 1 (list-first '(1)))) + (should (equal 1 (list-first '(1) 2))) + (should (equal 1 (list-first '(1 2 3))))) + +(ert-deftest list-last () + (should (null (list-last '()))) + (should (equal 1 (list-last '() 1))) + (should (equal 1 (list-last '(1)))) + (should (equal 1 (list-last '(1) 2))) + (should (equal 3 (list-last '(1 2 3))))) + +(ert-deftest list-wrap () + (should (equal '("hello") (list-wrap "hello"))) + (should (equal '(1 2 3) (list-wrap '(1 2 3)))) + (should (equal '() (list-wrap nil)))) + +(ert-deftest list-delete () + (should (equal '(b c) (list-delete 'a '(a b c)))) + (should (equal '(a b c) (list-delete 'd '(a b c)))) + (should (equal '(a b c) (list-delete 'b '(a b b c)))) + (should (equal '() (list-delete 'b '())))) + +(ert-deftest list-concat () + (should (equal '(1 2 3 4 5) (list-concat '(1) '(2 3) '(4 5)))) + (should (equal '(1 2 3) (list-concat '() '(1 2 3))))) + +;; TODO(wpcarro): Supoprt this. +;; (ert-deftest list-zip () +;; (should (equal '((1 3 5) (2 4 6)) (list-zip '(1 2) '(3 4) '(5 6)))) +;; (should (equal '((1 3 5)) (list-zip '(1 2) '(3) '(5 6))))) diff --git a/users/wpcarro/emacs/pkgs/macros/default.nix b/users/wpcarro/emacs/pkgs/macros/default.nix new file mode 100644 index 000000000000..d2811ed39fc6 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/macros/default.nix @@ -0,0 +1,10 @@ +{ pkgs, depot, ... }: + +pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "macros"; + version = "1.0.0"; + src = ./macros.el; + }) +{ } diff --git a/users/wpcarro/emacs/pkgs/macros/macros.el b/users/wpcarro/emacs/pkgs/macros/macros.el new file mode 100644 index 000000000000..3642686eeb4b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/macros/macros.el @@ -0,0 +1,45 @@ +;;; macros.el --- Helpful variables for making my ELisp life more enjoyable -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; This file contains helpful variables that I use in my ELisp development. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro macros-enable (mode) + "Helper for enabling `MODE'. +Useful in `add-hook' calls. Some modes, like `linum-mode' need to be called as +`(linum-mode 1)', so `(add-hook mode #'linum-mode)' won't work." + `#'(lambda nil (,mode 1))) + +(defmacro macros-disable (mode) + "Helper for disabling `MODE'. +Useful in `add-hook' calls." + `#'(lambda nil (,mode -1))) + +(defmacro macros-add-hook-before-save (mode f) + "Register a hook, `F', for a mode, `MODE' more conveniently. +Usage: (macros-add-hook-before-save 'reason-mode-hook #'refmt-before-save)" + `(add-hook ,mode + (lambda () + (add-hook 'before-save-hook ,f)))) + +(defmacro macros-comment (&rest _) + "Empty comment s-expresion where `BODY' is ignored." + `nil) + +(defmacro macros-support-file-extension (ext mode) + "Register MODE to automatically load with files ending with EXT extension. +Usage: (macros-support-file-extension \"pb\" protobuf-mode)" + (let ((extension (format "\\.%s\\'" ext))) + `(add-to-list 'auto-mode-alist '(,extension . ,mode)))) + +(provide 'macros) +;;; macros.el ends here diff --git a/users/wpcarro/emacs/pkgs/math/default.nix b/users/wpcarro/emacs/pkgs/math/default.nix new file mode 100644 index 000000000000..9167d61d4edc --- /dev/null +++ b/users/wpcarro/emacs/pkgs/math/default.nix @@ -0,0 +1,30 @@ +{ pkgs, depot, ... }: + +let + math = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "math"; + version = "1.0.0"; + src = ./math.el; + packageRequires = + (with emacsPackages; [ + dash + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + maybe + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + math + ]); +in +math.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/math/math.el b/users/wpcarro/emacs/pkgs/math/math.el new file mode 100644 index 000000000000..dbc527928a30 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/math/math.el @@ -0,0 +1,63 @@ +;;; math.el --- Math stuffs -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; Containing some useful mathematical functions. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'dash) +(require 'maybe) +(require 'cl-lib) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst math-pi pi + "The number pi.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: Support all three arguments. +;; Int -> Int -> Int -> Boolean +(cl-defun math-triangle-of-power (&key base power result) + (cond + ((-all? #'maybe-some? (list base power result)) + (error "All three arguments should not be set")) + ((-all? #'maybe-some? (list power result)) + (message "power and result")) + ((-all? #'maybe-some? (list base result)) + (log result base)) + ((-all? #'maybe-some? (list base power)) + (expt base power)) + (t + (error "Two of the three arguments must be set")))) + +(defun math-mod (x y) + "Return X mod Y." + (mod x y)) + +(defun math-exp (x y) + "Return X raised to the Y." + (expt x y)) + +(defun math-round (x) + "Round X to nearest ones digit." + (round x)) + +(defun math-floor (x) + "Floor value X." + (floor x)) + +(provide 'math) +;;; math.el ends here diff --git a/users/wpcarro/emacs/pkgs/math/tests.el b/users/wpcarro/emacs/pkgs/math/tests.el new file mode 100644 index 000000000000..ef3430c9131b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/math/tests.el @@ -0,0 +1,25 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'math) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest math-mod () + (should (= 0 (math-mod 9 3))) + (should (= 4 (math-mod 9 5)))) + +(ert-deftest math-exp () + (should (= 9 (math-exp 3 2))) + (should (= 8 (math-exp 2 3)))) + +(ert-deftest math-round () + (should (= 10 (math-round 9.5))) + (should (= 9 (math-round 9.45)))) + +(ert-deftest math-floor () + (should (= 9 (math-floor 9.5)))) diff --git a/users/wpcarro/emacs/pkgs/maybe/default.nix b/users/wpcarro/emacs/pkgs/maybe/default.nix new file mode 100644 index 000000000000..68e058b42b19 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/maybe/default.nix @@ -0,0 +1,24 @@ +{ pkgs, depot, ... }: + +let + maybe = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "maybe"; + version = "1.0.0"; + src = ./maybe.el; + packageRequires = [ ]; + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + maybe + ]); +in +maybe.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/maybe/maybe.el b/users/wpcarro/emacs/pkgs/maybe/maybe.el new file mode 100644 index 000000000000..581568d8ccba --- /dev/null +++ b/users/wpcarro/emacs/pkgs/maybe/maybe.el @@ -0,0 +1,54 @@ +;;; maybe.el --- Library for dealing with nil values -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; Inspired by Elm's Maybe library. +;; +;; For now, a Nothing value will be defined exclusively as a nil value. I'm +;; uninterested in supported falsiness in this module even at risk of going +;; against the LISP grain. +;; +;; I'm avoiding introducing a struct to handle the creation of Just and Nothing +;; variants of Maybe. Perhaps this is a mistake in which case this file would +;; be more aptly named nil.el. I may change that. Because of this limitation, +;; functions in Elm's Maybe library like andThen, which is the monadic bind for +;; the Maybe type, doesn't have a home here since we cannot compose multiple +;; Nothing or Just values without a struct or some other construct. +;; +;; Possible names for the variants of a Maybe. +;; None | Some +;; Nothing | Something +;; None | Just +;; Nil | Set +;; +;; NOTE: In Elisp, values like '() (i.e. the empty list) are aliases for nil. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun maybe-nil? (x) + "Return t if X is nil." + (null x)) + +(defun maybe-some? (x) + "Return t when X is non-nil." + (not (maybe-nil? x))) + +(defun maybe-default (default x) + "Return DEFAULT when X is nil." + (if (maybe-nil? x) default x)) + +(defun maybe-map (f x) + "Apply F to X if X is not nil." + (if (maybe-some? x) + (funcall f x) + x)) + +(provide 'maybe) +;;; maybe.el ends here diff --git a/users/wpcarro/emacs/pkgs/maybe/tests.el b/users/wpcarro/emacs/pkgs/maybe/tests.el new file mode 100644 index 000000000000..c0463cc65a53 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/maybe/tests.el @@ -0,0 +1,25 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'maybe) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest maybe-nil? () + (should (maybe-nil? nil)) + (should (not (maybe-nil? t)))) + +(ert-deftest maybe-some? () + (should (maybe-some? '(1 2 3))) + (should (not (maybe-some? nil)))) + +(ert-deftest maybe-default () + (should (string= "some" (maybe-default "some" nil))) + (should (= 10 (maybe-default 1 10)))) + +(ert-deftest maybe-map () + (should (eq nil (maybe-map (lambda (x) (* x 2)) nil))) + (should (= 4 (maybe-map (lambda (x) (* x 2)) 2)))) diff --git a/users/wpcarro/emacs/pkgs/passage/README.md b/users/wpcarro/emacs/pkgs/passage/README.md new file mode 100644 index 000000000000..51f7bd6efda4 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/passage/README.md @@ -0,0 +1,12 @@ +# passage.el + +Emacs support for `passage`. + +## Alternative Packages + +If you're looking for more feature-complete, configurable alternatives, +check-out the following packages: + +- `ivy-pass.el` +- `password-store.el` +- `pass.el` diff --git a/users/wpcarro/emacs/pkgs/passage/default.nix b/users/wpcarro/emacs/pkgs/passage/default.nix new file mode 100644 index 000000000000..ac87f193b4e2 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/passage/default.nix @@ -0,0 +1,12 @@ +{ pkgs, depot, ... }: + +pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "passage"; + version = "1.0.0"; + src = ./passage.el; + packageRequires = (with emacsPackages; [ dash f s ]); + } + ) +{ } diff --git a/users/wpcarro/emacs/pkgs/passage/passage.el b/users/wpcarro/emacs/pkgs/passage/passage.el new file mode 100644 index 000000000000..4a43920e0bed --- /dev/null +++ b/users/wpcarro/emacs/pkgs/passage/passage.el @@ -0,0 +1,65 @@ +;;; passage.el --- Emacs passage support -*- lexical-binding: t; -*- + +;; Copyright (C) 2022-2023 William Carroll <wpcarro@gmail.com> + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 1.0.0 + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package provides functions for working with passage. + +;;; Code: + +(require 'dash) +(require 'f) +(require 's) + +(defgroup passage nil + "Customization options for `passage'." + :prefix "passage-" + :group 'vterm) + +(defcustom passage-store + "~/.passage/store" + "Path to the passage store directory." + :type 'string + :group 'passage) + +(defcustom passage-executable + (or (executable-find "passage") + "/nix/store/jgffkfdiiwiqa4zqpxn3691mx9xc6axa-passage-unstable-2022-05-01/bin/passage") + "Path to passage executable." + :type 'string + :group 'passage) + +(defun passage-select () + "Select an entry and copy its password to the kill ring." + (interactive) + (let ((key (completing-read "Copy password of entry: " + (-map (lambda (x) + (f-no-ext (f-relative x passage-store))) + (f-files passage-store nil t))))) + (kill-new + (s-trim-right + (shell-command-to-string + (format "%s show %s | head -1" passage-executable key)))) + (message "[passage.el] Copied \"%s\"!" key))) + +(provide 'passage) +;;; passage.el ends here diff --git a/users/wpcarro/emacs/pkgs/set/default.nix b/users/wpcarro/emacs/pkgs/set/default.nix new file mode 100644 index 000000000000..319ba9274423 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/set/default.nix @@ -0,0 +1,32 @@ +{ pkgs, depot, ... }: + +let + set = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "set"; + version = "1.0.0"; + src = ./set.el; + packageRequires = + (with emacsPackages; [ + dash + ht + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + struct + ]); + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + epkgs.dash + set + ]); +in +set.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/set/set.el b/users/wpcarro/emacs/pkgs/set/set.el new file mode 100644 index 000000000000..2d6e14917a45 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/set/set.el @@ -0,0 +1,116 @@ +;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; The set data structure is a collection that deduplicates its elements. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cl-lib) +(require 'dash) +(require 'ht) ;; friendlier API for hash-tables +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Wish List +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; - TODO: Support enum protocol for set. +;; - TODO: Prefer a different hash-table library that doesn't rely on mutative +;; code. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct set xs) + +(defun set-from-list (xs) + "Create a new set from the list XS." + (make-set :xs (->> xs + (-map (lambda (x) (cons x nil))) + ht-from-alist))) + +(defun set-new (&rest args) + "Create a new set from ARGS." + (set-from-list args)) + +(defun set-to-list (xs) + "Map set XS into a list." + (->> xs + set-xs + ht-keys)) + +(defun set-add (x xs) + "Add X to set XS." + (struct-update set + xs + (lambda (table) + (let ((table-copy (ht-copy table))) + (ht-set table-copy x nil) + table-copy)) + xs)) + +;; TODO: Ensure all `*/reduce' functions share the same API. +(defun set-reduce (acc f xs) + "Return a new set by calling F on each element of XS and ACC." + (->> xs + set-to-list + (-reduce-from (lambda (acc x) (funcall f x acc)) acc))) + +(defun set-intersection (a b) + "Return the set intersection between A and B." + (set-reduce (set-new) + (lambda (x acc) + (if (set-contains? x b) + (set-add x acc) + acc)) + a)) + +(defun set-count (xs) + "Return the number of elements in XS." + (->> xs + set-xs + ht-size)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun set-empty? (xs) + "Return t if XS has no elements in it." + (= 0 (set-count xs))) + +(defun set-contains? (x xs) + "Return t if set XS has X." + (ht-contains? (set-xs xs) x)) + +;; TODO: Prefer using `ht.el' functions for this. +(defun set-equal? (a b) + "Return t if A and B share the name members." + (ht-equal? (set-xs a) + (set-xs b))) + +(defun set-distinct? (a b) + "Return t if A and B have no shared members." + (set-empty? (set-intersection a b))) + +(defun set-superset? (a b) + "Return t if A has all of the members of B." + (->> b + set-to-list + (-all? (lambda (x) (set-contains? x a))))) + +(defun set-subset? (a b) + "Return t if each member of set A is present in set B." + (set-superset? b a)) + +(provide 'set) +;;; set.el ends here diff --git a/users/wpcarro/emacs/pkgs/set/tests.el b/users/wpcarro/emacs/pkgs/set/tests.el new file mode 100644 index 000000000000..7f5c2ae3ffd9 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/set/tests.el @@ -0,0 +1,69 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'dash) +(require 'set) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest set-from-list () + (should (equal '(1 2 3) + (->> '(1 2 3 1 2 3) + set-from-list + set-to-list)))) + +(ert-deftest set-distinct? () + (should (set-distinct? (set-new 'one 'two 'three) + (set-new 'a 'b 'c))) + (should (not + (set-distinct? (set-new 1 2 3) + (set-new 3 4 5)))) + (should (not + (set-distinct? (set-new 1 2 3) + (set-new 1 2 3))))) + +(ert-deftest set-equal? () + (should (not (set-equal? (set-new 'a 'b 'c) + (set-new 'x 'y 'z)))) + (should (not (set-equal? (set-new 'a 'b 'c) + (set-new 'a 'b)))) + (should (set-equal? (set-new 'a 'b 'c) + (set-new 'a 'b 'c)))) + +(ert-deftest set-intersection () + (should (set-equal? (set-new 2 3) + (set-intersection (set-new 1 2 3) + (set-new 2 3 4))))) + +(ert-deftest set-to/from-list () + (should (equal '(1 2 3) + (->> '(1 1 2 2 3 3) + set-from-list + set-to-list)))) + +(ert-deftest set-subset? () + (should (not (set-subset? (set-new "black" "grey") + (set-new "red" "green" "blue")))) + (should (set-subset? (set-new "red") + (set-new "red" "green" "blue")))) + +(ert-deftest set-superset? () + (let ((primary-colors (set-new "red" "green" "blue"))) + (should (not (set-superset? primary-colors + (set-new "black" "grey")))) + (should (set-superset? primary-colors + (set-new "red" "green" "blue"))) + (should (set-superset? primary-colors + (set-new "red" "blue"))))) + +(ert-deftest set-empty? () + (should (set-empty? (set-new))) + (should (not (set-empty? (set-new 1 2 3))))) + +(ert-deftest set-count () + (should (= 0 (set-count (set-new)))) + (should (= 2 (set-count (set-new 1 1 2 2))))) diff --git a/users/wpcarro/emacs/pkgs/string/default.nix b/users/wpcarro/emacs/pkgs/string/default.nix new file mode 100644 index 000000000000..406cccdfcb58 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/string/default.nix @@ -0,0 +1,27 @@ +{ pkgs, depot, ... }: + +let + string = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "string"; + version = "1.0.0"; + src = ./string.el; + packageRequires = [ + emacsPackages.dash + emacsPackages.s + ]; + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + string + ]); +in +string.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/string/string.el b/users/wpcarro/emacs/pkgs/string/string.el new file mode 100644 index 000000000000..30da1805e83f --- /dev/null +++ b/users/wpcarro/emacs/pkgs/string/string.el @@ -0,0 +1,98 @@ +;;; string.el --- Library for working with strings -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; Library for working with strings. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 's) +(require 'dash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun string-split (y x) + "Map string X into a list of strings that were separated by Y." + (s-split y x)) + +(defun string-format (x &rest args) + "Format template string X with ARGS." + (apply #'format (cons x args))) + +(defun string-concat (&rest strings) + "Joins `STRINGS' into onto string." + (apply #'s-concat strings)) + +(defun string-to-symbol (string) + "Maps `STRING' to a symbol." + (intern string)) + +(defun string-from-symbol (symbol) + "Maps `SYMBOL' into a string." + (symbol-name symbol)) + +(defun string-prepend (prefix x) + "Prepend `PREFIX' onto `X'." + (s-concat prefix x)) + +(defun string-append (postfix x) + "Appen `POSTFIX' onto `X'." + (s-concat x postfix)) + +(defun string-surround (s x) + "Surrounds `X' one each side with `S'." + (->> x + (string-prepend s) + (string-append s))) + +;; TODO: Define a macro for defining a function and a test. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Casing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun string-caps->kebab (x) + "Change the casing of `X' from CAP_CASE to kebab-case." + (->> x + s-downcase + (s-replace "_" "-"))) + +(defun string-kebab->caps (x) + "Change the casing of X from CAP_CASE to kebab-case." + (->> x + s-upcase + (s-replace "-" "_"))) + +(defun string-lower->caps (x) + "Change the casing of X from lowercase to CAPS_CASE." + (->> x + s-upcase + (s-replace " " "_"))) + +(defun string-lower->kebab (x) + "Change the casing of `X' from lowercase to kebab-case." + (s-replace " " "-" x)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun string-instance? (x) + "Return t if X is a string." + (stringp x)) + +(defun string-contains? (c x) + "Return t if X is in C." + (s-contains? c x)) + +(provide 'string) +;;; string.el ends here diff --git a/users/wpcarro/emacs/pkgs/string/tests.el b/users/wpcarro/emacs/pkgs/string/tests.el new file mode 100644 index 000000000000..351e305466d3 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/string/tests.el @@ -0,0 +1,22 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'string) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest string-caps->kebab () + (should (string= "foo-bar-baz" (string-caps->kebab "FOO_BAR_BAZ")))) + +(ert-deftest string-kebab->caps () + (should (string= "FOO_BAR_BAZ" (string-kebab->caps "foo-bar-baz")))) + +(ert-deftest string-lower->caps () + (should (string= "FOO_BAR_BAZ" (string-lower->caps "foo bar baz")))) + +(ert-deftest string-lower->kebab () + (should (string= "foo-bar-baz" (string-lower->kebab "foo bar baz")))) diff --git a/users/wpcarro/emacs/pkgs/struct/README.md b/users/wpcarro/emacs/pkgs/struct/README.md new file mode 100644 index 000000000000..34dac6614cd1 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/README.md @@ -0,0 +1,6 @@ +# struct.el + +[](https://buildkite.com/tvl/depot) + +Provides new macros exposing immutable and mutable interfaces for working with +structs in Elisp. diff --git a/users/wpcarro/emacs/pkgs/struct/default.nix b/users/wpcarro/emacs/pkgs/struct/default.nix new file mode 100644 index 000000000000..558ebd0a3d20 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/default.nix @@ -0,0 +1,29 @@ +{ pkgs, depot, ... }: + +let + struct = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "struct"; + version = "1.0.0"; + src = ./struct.el; + packageRequires = [ ]; + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + struct + ]); +in +struct.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; + passthru.meta.ci.extraSteps.github = depot.tools.releases.filteredGitPush { + filter = ":/users/wpcarro/emacs/pkgs/struct"; + remote = "git@github.com:wpcarro/struct.el.git"; + ref = "refs/heads/canon"; + }; +}) diff --git a/users/wpcarro/emacs/pkgs/struct/struct.el b/users/wpcarro/emacs/pkgs/struct/struct.el new file mode 100644 index 000000000000..5d6572bf6dde --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/struct.el @@ -0,0 +1,65 @@ +;;; struct.el --- Helpers for working with structs -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 1.0.0 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; Provides new macros for working with structs. Also provides adapter +;; interfaces to existing struct macros, that should have more intuitive +;; interfaces. +;; +;; Sometimes `setf' just isn't enough. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro struct-update (type field f xs) + "Apply F to FIELD in XS, which is a struct of TYPE. +This is immutable." + (let ((copier (struct--copier-for type)) + (accessor (struct--accessor-for type field))) + `(let ((copy (,copier ,xs))) + (setf (,accessor copy) (funcall ,f (,accessor copy))) + copy))) + +(defmacro struct-update! (type field f xs) + "Mutably apply F to FIELD in XS." + (let ((accessor (struct--accessor-for type field))) + `(progn + (setf (,accessor ,xs) (funcall ,f (,accessor ,xs))) + ,xs))) + +(defmacro struct-set (type field x xs) + "Immutably set FIELD in XS (struct TYPE) to X." + (let ((copier (struct--copier-for type)) + (accessor (struct--accessor-for type field))) + `(let ((copy (,copier ,xs))) + (setf (,accessor copy) ,x) + copy))) + +(defmacro struct-set! (type field x xs) + "Set FIELD in XS (struct TYPE) to X mutably. +This is an adapter interface to `setf'." + (let ((accessor (struct--accessor-for type field))) + `(progn + (setf (,accessor ,xs) ,x) + ,xs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helper Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun struct--copier-for (type) + (intern (format "copy-%s" (symbol-name type)))) + +(defun struct--accessor-for (type field) + (intern (format "%s-%s" + (symbol-name type) + (symbol-name field)))) + +(provide 'struct) +;;; struct.el ends here diff --git a/users/wpcarro/emacs/pkgs/struct/tests.el b/users/wpcarro/emacs/pkgs/struct/tests.el new file mode 100644 index 000000000000..a7ddb52c46d6 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/struct/tests.el @@ -0,0 +1,44 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'struct) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct dummy name age) + +(ert-deftest struct-update () + (let* ((test (make-dummy :name "Roofus" :age 19)) + (result (struct-update dummy name #'upcase test))) + ;; test + (should (string= "Roofus" (dummy-name test))) + (should (= 19 (dummy-age test))) + ;; result + (should (string= "ROOFUS" (dummy-name result))) + (should (= 19 (dummy-age result))))) + +(ert-deftest struct-update! () + (let ((test (make-dummy :name "Roofus" :age 19))) + (struct-update! dummy name #'upcase test) + (should (string= "ROOFUS" (dummy-name test))) + (should (= 19 (dummy-age test))))) + +(ert-deftest struct-set () + (let* ((test (make-dummy :name "Roofus" :age 19)) + (result (struct-set dummy name "Shoofus" test))) + ;; test + (should (string= "Roofus" (dummy-name test))) + (should (= 19 (dummy-age test))) + ;; result + (should (string= "Shoofus" (dummy-name result))) + (should (= 19 (dummy-age result))))) + +(ert-deftest struct-set! () + (let ((test (make-dummy :name "Roofus" :age 19))) + (struct-set! dummy name "Doofus" test) + (should (string= "Doofus" (dummy-name test))) + (should (= 19 (dummy-age test))))) diff --git a/users/wpcarro/emacs/pkgs/symbol/default.nix b/users/wpcarro/emacs/pkgs/symbol/default.nix new file mode 100644 index 000000000000..9334697e3203 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/symbol/default.nix @@ -0,0 +1,24 @@ +{ pkgs, depot, ... }: + +let + symbol = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "symbol"; + version = "1.0.0"; + src = ./symbol.el; + packageRequires = [ ]; + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ + symbol + ]); +in +symbol.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/symbol/symbol.el b/users/wpcarro/emacs/pkgs/symbol/symbol.el new file mode 100644 index 000000000000..4b16351831c9 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/symbol/symbol.el @@ -0,0 +1,38 @@ +;;; symbol.el --- Library for working with symbols -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; Library for working with symbols. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun symbol-to-string (symbol) + "Map `SYMBOL' into a string." + (symbol-name symbol)) + +(defun symbol-from-string (string) + "Map `STRING' into a symbol." + (intern string)) + +(defun symbol-as-string (f x) + "Treat the symbol, X, as a string while applying F to it. +Coerce back to a symbol on the way out." + (symbol-from-string (funcall f (symbol-to-string x)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun symbol-instance? (x) + "Return t if X is a symbol." + (symbolp x)) + +(provide 'symbol) +;;; symbol.el ends here diff --git a/users/wpcarro/emacs/pkgs/symbol/tests.el b/users/wpcarro/emacs/pkgs/symbol/tests.el new file mode 100644 index 000000000000..b10362b162c7 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/symbol/tests.el @@ -0,0 +1,22 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'symbol) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest symbol-to-string () + (should (string= "foo" (symbol-to-string 'foo)))) + +(ert-deftest symbol-from-string () + (should (eq 'foo (symbol-from-string "foo")))) + +(ert-deftest symbol-as-string () + (should (eq 'foo-hook + (symbol-as-string + (lambda (x) (format "%s-hook" x)) + 'foo)))) diff --git a/users/wpcarro/emacs/pkgs/theme/default.nix b/users/wpcarro/emacs/pkgs/theme/default.nix new file mode 100644 index 000000000000..aea639436961 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/theme/default.nix @@ -0,0 +1,14 @@ +{ pkgs, depot, ... }: + +pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "theme"; + version = "1.0.0"; + src = ./theme.el; + packageRequires = + (with depot.users.wpcarro.emacs.pkgs; [ + cycle + ]); + }) +{ } diff --git a/users/wpcarro/emacs/pkgs/theme/theme.el b/users/wpcarro/emacs/pkgs/theme/theme.el new file mode 100644 index 000000000000..32f2c89a4d0b --- /dev/null +++ b/users/wpcarro/emacs/pkgs/theme/theme.el @@ -0,0 +1,78 @@ +;;; theme.el --- Colors and stuff -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24.3")) + +;;; Commentary: +;; +;; Cycle through a whitelist of themes. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cycle) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup theme nil + "Customization options for `theme'." + :group 'theme) + +(defcustom theme-whitelist + (cycle-from-list (custom-available-themes)) + "The whitelist of themes through which to cycle." + :type '(cycle symbol) + :group 'theme) + +(defcustom theme-after-change + nil + "Hook invoked after a new theme is loaded" + :type 'hook + :group 'theme) + +(defun theme-whitelist-set (theme) + "Focus the THEME in the `theme-whitelist' cycle." + (cycle-focus! (lambda (x) (equal x theme)) theme-whitelist) + (theme--set (cycle-current theme-whitelist))) + +(defun theme-select () + "Load a theme using `completing-read'." + (interactive) + (let ((theme (completing-read "Theme: " (cycle-to-list theme-whitelist)))) + (theme--disable-all) + (theme--set (intern theme)))) + +(defun theme-next () + "Disable the currently active theme and load the next theme." + (interactive) + (disable-theme (cycle-current theme-whitelist)) + (theme--set (cycle-next! theme-whitelist)) + (message (format "Active theme: %s" (cycle-current theme-whitelist)))) + +(defun theme-prev () + "Disable the currently active theme and load the previous theme." + (interactive) + (disable-theme (cycle-current theme-whitelist)) + (theme--set (cycle-prev! theme-whitelist)) + (message (format "Active theme: %s" (cycle-current theme-whitelist)))) + +(defun theme--disable-all () + "Disable all currently enabled themes." + (interactive) + (dolist (x custom-enabled-themes) + (disable-theme x))) + +(defun theme--set (theme) + "Call `load-theme' with `THEME', ensuring that the line numbers are bright. +There is no hook that I'm aware of to handle this more elegantly." + (load-theme theme t) + (run-hooks 'theme-after-change)) + +(provide 'theme) +;;; theme.el ends here diff --git a/users/wpcarro/emacs/pkgs/tuple/default.nix b/users/wpcarro/emacs/pkgs/tuple/default.nix new file mode 100644 index 000000000000..0626370e4795 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/tuple/default.nix @@ -0,0 +1,10 @@ +{ pkgs, depot, ... }: + +pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "tuple"; + version = "1.0.0"; + src = ./tuple.el; + }) +{ } diff --git a/users/wpcarro/emacs/pkgs/tuple/tuple.el b/users/wpcarro/emacs/pkgs/tuple/tuple.el new file mode 100644 index 000000000000..848c6fa48b15 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/tuple/tuple.el @@ -0,0 +1,93 @@ +;;; tuple.el --- Tuple API for Elisp -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "25.1")) + +;;; Commentary: +;; Work with cons cells with two elements with a familiar API for those who have +;; worked with tuples before. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl-defstruct tuple first second) + +;; Create +(defun tuple-new () + "Return an empty tuple." + (make-tuple :first nil + :second nil)) + +(defun tuple-from (a b) + "Return a new tuple from A and B." + (make-tuple :first a + :second b)) + +(defun tuple-from-dotted (dp) + "Convert dotted pair, DP, into a tuple." + (tuple-from (car dp) (cdr dp))) + +;; Read +(defun tuple-first (pair) + "Return the first element of PAIR." + (tuple-first pair)) + +(defun tuple-second (pair) + "Return the second element of PAIR." + (tuple-second pair)) + +;; Update +(defun tuple-map-each (f g pair) + "Apply F to first, G to second in PAIR." + (->> pair + (tuple-map-first f) + (tuple-map-second g))) + +(defun tuple-map (f pair) + "Apply F to PAIR." + (let ((pair-copy (copy-tuple pair))) + (funcall f pair-copy))) + +(defun tuple-map-first (f pair) + "Apply function F to the first element of PAIR." + (let ((pair-copy (copy-tuple pair))) + (setf (tuple-first pair-copy) (funcall f (tuple-first pair-copy))) + pair-copy)) + +(defun tuple-map-second (f pair) + "Apply function F to the second element of PAIR." + (let ((pair-copy (copy-tuple pair))) + (setf (tuple-second pair-copy) (funcall f (tuple-second pair-copy))) + pair-copy)) + +(defun tuple-set-first (a pair) + "Return a new tuple with the first element set as A in PAIR." + (tuple-map-first (lambda (_) a) pair)) + +(defun tuple-set-second (b pair) + "Return a new tuple with the second element set as B in PAIR." + (tuple-map-second (lambda (_) b) pair)) + +;; Delete +(defun tuple-delete-first (pair) + "Return PAIR with the first element set to nil." + (tuple-set-first nil pair)) + +(defun tuple-delete-second (pair) + "Return PAIR with the second element set to nil." + (tuple-set-second nil pair)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tuple-instance? (x) + "Return t if X is a tuple." + (tuple-p x)) + +(provide 'tuple) +;;; tuple.el ends here diff --git a/users/wpcarro/emacs/pkgs/vector/default.nix b/users/wpcarro/emacs/pkgs/vector/default.nix new file mode 100644 index 000000000000..c0a475aaaa82 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/vector/default.nix @@ -0,0 +1,21 @@ +{ pkgs, depot, ... }: + +let + vector = pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "vector"; + version = "1.0.0"; + src = ./vector.el; + }) + { }; + + emacs = (pkgs.emacsPackagesFor pkgs.emacs28).emacsWithPackages (epkgs: [ vector ]); +in +vector.overrideAttrs (_old: { + doCheck = true; + checkPhase = '' + ${emacs}/bin/emacs -batch \ + -l ert -l ${./tests.el} -f ert-run-tests-batch-and-exit + ''; +}) diff --git a/users/wpcarro/emacs/pkgs/vector/tests.el b/users/wpcarro/emacs/pkgs/vector/tests.el new file mode 100644 index 000000000000..ffa983188229 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/vector/tests.el @@ -0,0 +1,20 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ert) +(require 'vector) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ert-deftest vector-misc-tests () + (let ((xs [1 2 3]) + (ys [1 2 3])) + (should (= 1 (vector-get 0 ys))) + (vector-set 0 4 ys) + (should (= 1 (vector-get 0 ys))) + (should (= 1 (vector-get 0 xs))) + (vector-set! 0 4 xs) + (should (= 4 (vector-get 0 xs))))) diff --git a/users/wpcarro/emacs/pkgs/vector/vector.el b/users/wpcarro/emacs/pkgs/vector/vector.el new file mode 100644 index 000000000000..87f38d7d93e2 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/vector/vector.el @@ -0,0 +1,58 @@ +;;; vector.el --- Working with Elisp's Vector data type -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "25.1")) + +;;; Commentary: +;; It might be best to think of Elisp vectors as tuples in languages like +;; Haskell or Erlang. +;; +;; Not surprisingly, this API is modelled after Elixir's Tuple API. +;; +;; Some Elisp trivia: +;; - "Array": Usually means vector or string. +;; - "Sequence": Usually means list or "array" (see above). +;; +;; It might be a good idea to think of Array and Sequence as typeclasses in +;; Elisp. This is perhaps more similar to Elixir's notion of the Enum protocol. +;; +;; Intentionally not supporting a to-list function, because tuples can contain +;; heterogenous types whereas lists should contain homogenous types. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Library +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun vector-concat (&rest args) + "Return a new vector composed of all vectors in `ARGS'." + (apply #'vconcat args)) + +(defun vector-prepend (x xs) + "Add `X' to the beginning of `XS'." + (vector-concat `[,x] xs)) + +(defun vector-append (x xs) + "Add `X' to the end of `XS'." + (vector-concat xs `[,x])) + +(defun vector-get (i xs) + "Return the value in `XS' at index, `I'." + (aref xs i)) + +(defun vector-set (i v xs) + "Set index `I' to value `V' in `XS'. +Returns a copy of `XS' with the updates." + (let ((copy (vconcat [] xs))) + (aset copy i v) + copy)) + +(defun vector-set! (i v xs) + "Set index `I' to value `V' in `XS'. +This function mutates XS." + (aset xs i v)) + +(provide 'vector) +;;; vector.el ends here diff --git a/users/wpcarro/emacs/pkgs/vterm-mgt/README.md b/users/wpcarro/emacs/pkgs/vterm-mgt/README.md new file mode 100644 index 000000000000..b855826929ca --- /dev/null +++ b/users/wpcarro/emacs/pkgs/vterm-mgt/README.md @@ -0,0 +1,17 @@ +# vterm-mgt.el + +[](https://buildkite.com/tvl/depot) + +[emacs-libvterm](https://github.com/akermu/emacs-libvterm) is a feature-complete +terminal emulator inside Emacs based on libvterm. + +`vterm-mgt.el`, adds functionality on top of `vterm` to allow you to: + +* find-or-create `vterm` instances +* fuzzily switch between existing `vterm` buffers +* cycle through existing `vterm` instances +* easily rename `vterm` buffers + +## Alternatives to vterm-mgt.el + +* [multi-vterm](https://github.com/suonlight/multi-vterm) diff --git a/users/wpcarro/emacs/pkgs/vterm-mgt/default.nix b/users/wpcarro/emacs/pkgs/vterm-mgt/default.nix new file mode 100644 index 000000000000..88eb5502042a --- /dev/null +++ b/users/wpcarro/emacs/pkgs/vterm-mgt/default.nix @@ -0,0 +1,19 @@ +{ pkgs, depot, ... }: + +pkgs.emacsPackages.trivialBuild { + pname = "vterm-mgt"; + version = "1.0.0"; + src = ./vterm-mgt.el; + packageRequires = + (with pkgs.emacsPackages; [ + vterm + ]) ++ + (with depot.users.wpcarro.emacs.pkgs; [ + cycle + ]); + passthru.meta.ci.extraSteps.github = depot.tools.releases.filteredGitPush { + filter = ":/users/wpcarro/emacs/pkgs/vterm-mgt"; + remote = "git@github.com:wpcarro/vterm-mgt.el.git"; + ref = "refs/heads/canon"; + }; +} diff --git a/users/wpcarro/emacs/pkgs/vterm-mgt/vterm-mgt.el b/users/wpcarro/emacs/pkgs/vterm-mgt/vterm-mgt.el new file mode 100644 index 000000000000..c082e54a5976 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/vterm-mgt/vterm-mgt.el @@ -0,0 +1,140 @@ +;;; vterm-mgt.el --- Help me manage my vterm instances -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "25.1")) + +;;; Commentary: +;; Supporting functions to instantiate vterm buffers, kill existing vterm +;; buffers, rename vterm buffers, cycle forwards and backwards through vterm +;; buffers. +;; +;; Many of the functions defined herein are intended to be bound to +;; `vterm-mode-map'. Some assertions are made to guard against calling +;; functions that are intended to be called from outside of a vterm buffer. +;; These assertions shouldn't error when the functions are bound to +;; `vterm-mode-map'. If for some reason, you'd like to bind these functions to +;; a separate keymap, caveat emptor. + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dependencies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'cycle) +(require 'vterm) +(require 'seq) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Configuration +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup vterm-mgt nil + "Customization options for `vterm-mgt'." + :group 'vterm) + +(defcustom vterm-mgt-scroll-on-focus nil + "When t, call `end-of-buffer' after focusing a vterm instance." + :type '(boolean) + :group 'vterm-mgt) + +(defconst vterm-mgt--instances (cycle-new) + "A cycle tracking all of my vterm instances.") + +(defun vterm-mgt--instance? (b) + "Return t if the buffer B is a vterm instance." + (equal 'vterm-mode (buffer-local-value 'major-mode b))) + +(defun vterm-mgt--assert-vterm-buffer () + "Error when the `current-buffer' is not a vterm buffer." + (unless (vterm-mgt--instance? (current-buffer)) + (error "Current buffer is not a vterm buffer"))) + +(defun vterm-mgt-next () + "Replace the current buffer with the next item in `vterm-mgt--instances'. +This function should be called from a buffer running vterm." + (interactive) + (vterm-mgt--assert-vterm-buffer) + (vterm-mgt-reconcile-state) + (cycle-focus-item! (current-buffer) vterm-mgt--instances) + (switch-to-buffer (cycle-next! vterm-mgt--instances)) + (when vterm-mgt-scroll-on-focus (end-of-buffer))) + +(defun vterm-mgt-prev () + "Replace the current buffer with the previous item in `vterm-mgt--instances'. +This function should be called from a buffer running vterm." + (interactive) + (vterm-mgt--assert-vterm-buffer) + (vterm-mgt-reconcile-state) + (cycle-focus-item! (current-buffer) vterm-mgt--instances) + (switch-to-buffer (cycle-prev! vterm-mgt--instances)) + (when vterm-mgt-scroll-on-focus (end-of-buffer))) + +(defun vterm-mgt-instantiate () + "Create a new vterm instance. + +Prefer calling this function instead of `vterm'. This function ensures that the + newly created instance is added to `vterm-mgt--instances'. + +If however you must call `vterm', if you'd like to cycle through vterm + instances, make sure you call `vterm-mgt-reconcile-state' to allow vterm-mgt + to collect any untracked vterm instances." + (interactive) + (vterm-mgt-reconcile-state) + (let ((buffer (vterm t))) + (cycle-append! buffer vterm-mgt--instances) + (cycle-focus-item! buffer vterm-mgt--instances))) + +(defun vterm-mgt-kill () + "Kill the current buffer and remove it from `vterm-mgt--instances'. +This function should be called from a buffer running vterm." + (interactive) + (vterm-mgt--assert-vterm-buffer) + (let* ((buffer (current-buffer))) + (when (kill-buffer buffer) + (vterm-mgt-reconcile-state)))) + +(defun vterm-mgt-find-or-create () + "Call `switch-to-buffer' on a focused vterm instance if there is one. + +When `cycle-focused?' returns nil, focus the first item in the cycle. When +there are no items in the cycle, call `vterm-mgt-instantiate' to create a vterm +instance." + (interactive) + (vterm-mgt-reconcile-state) + (if (cycle-empty? vterm-mgt--instances) + (vterm-mgt-instantiate) + (if (cycle-focused? vterm-mgt--instances) + (switch-to-buffer (cycle-current vterm-mgt--instances)) + (progn + (cycle-jump! 0 vterm-mgt--instances) + (switch-to-buffer (cycle-current vterm-mgt--instances)))))) + +(defun vterm-mgt-rename-buffer (name) + "Rename the current buffer ensuring that its NAME is wrapped in *vterm<...>*. +This function should be called from a buffer running vterm." + (interactive "SRename vterm buffer: ") + (vterm-mgt--assert-vterm-buffer) + (rename-buffer (format "*vterm<%s>*" name))) + +(defun vterm-mgt-reconcile-state () + "Fill `vterm-mgt--instances' with the existing vterm buffers. + +If for whatever reason, the state of `vterm-mgt--instances' is corrupted and + misaligns with the state of vterm buffers in Emacs, use this function to + restore the state." + (interactive) + (setq vterm-mgt--instances + (cycle-from-list (seq-filter #'vterm-mgt--instance? (buffer-list))))) + +(defun vterm-mgt-select () + "Select a vterm instance by name from the list in `vterm-mgt--instances'." + (interactive) + (vterm-mgt-reconcile-state) + (switch-to-buffer + (completing-read "Switch to vterm: " + (seq-map #'buffer-name (cycle-to-list vterm-mgt--instances))))) + +(provide 'vterm-mgt) +;;; vterm-mgt.el ends here diff --git a/users/wpcarro/emacs/pkgs/zle/default.nix b/users/wpcarro/emacs/pkgs/zle/default.nix new file mode 100644 index 000000000000..9d4820a9445e --- /dev/null +++ b/users/wpcarro/emacs/pkgs/zle/default.nix @@ -0,0 +1,10 @@ +{ pkgs, ... }: + +pkgs.callPackage + ({ emacsPackages }: + emacsPackages.trivialBuild { + pname = "zle"; + version = "1.0.0"; + src = ./zle.el; + }) +{ } diff --git a/users/wpcarro/emacs/pkgs/zle/zle.el b/users/wpcarro/emacs/pkgs/zle/zle.el new file mode 100644 index 000000000000..21a6e35f13d3 --- /dev/null +++ b/users/wpcarro/emacs/pkgs/zle/zle.el @@ -0,0 +1,90 @@ +;;; zle.el --- Functions to mimmick my ZLE KBDs -*- lexical-binding: t -*- + +;; Author: William Carroll <wpcarro@gmail.com> +;; Version: 0.0.1 +;; Package-Requires: ((emacs "24")) + +;;; Commentary: +;; This is primarily for personal use. The keybindings that I choose are those +;; that feel slightly mnemonic while also not shadowing important bindings. +;; It's quite possible that our tastes will differ here. +;; +;; All of these keybindings are intended to shave off milliseconds off your +;; typing. I don't expect these numbers to sum up to a meaningful amount. The +;; primary reason that I wrote this, is that it introduces a small amount of +;; structural editing to my workflow. I've been using these exact keybindings +;; on the command line, and I find them subtely delightful to use. So much so +;; that I decided to bring them to my Emacs configuration. +;; +;; ZLE is the Z-shell line editor. I have some KBDs and functions that I often +;; want in Emacs. +;; +;; Usage: +;; Consider running `(zle-minor-mode)' to run this globally. Depending on your +;; configuration, it could be non-disruptive, disruptive, or extremely +;; disruptive. + +;;; Code: + +;; subshell (C-j) +(defun zle-subshell () + "Insert the characters necessary to create a subshell." + (interactive) + (insert-char ?$) + (insert-char ?\() + (save-excursion + (insert-char ?\)))) + +;; variable (C-v) +(defun zle-variable () + "Insert the characters to reference a variable." + (interactive) + (insert-char ?$) + (insert-char ?{) + (save-excursion + (insert-char ?}))) + +;; 2x dash (C-M--) +(defun zle-dash-dash () + "Insert the characters for flags with 2x dashes." + (interactive) + (insert-char ? ) + (insert-char ?-) + (insert-char ?-)) + +;; 1x quotes (M-') +(defun zle-single-quote () + "Insert the characters to quickly create single quotes." + (interactive) + (insert-char ? ) + (insert-char ?') + (save-excursion + (insert-char ?'))) + +;; 2x quotes (M-") +(defun zle-double-quote () + "Insert the characters to quickly create double quotes." + (interactive) + (insert-char ? ) + (insert-char ?\") + (save-excursion + (insert-char ?\"))) + +(defvar zle-kbds + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-j") #'zle-subshell) + (define-key map (kbd "C-v") #'zle-variable) + (define-key map (kbd "C-M--") #'zle-dash-dash) + (define-key map (kbd "M-'") #'zle-single-quote) + (define-key map (kbd "M-\"") #'zle-double-quote) + map) + "Keybindings shaving milliseconds off of typing.") + +(define-minor-mode zle-minor-mode + "A minor mode mirroring my ZLE keybindings." + :init-value nil + :lighter " zle" + :keymap zle-kbds) + +(provide 'zle) +;;; zle.el ends here |