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

More Elisp linting

Browse source 
This should cover most of the remaining linting errors. After this, I expect
fewer than ten linting errors.
This commit is contained in:
William Carroll 2020-09-01 10:17:43 +01:00
parent a638e15c0d
commit fb5ec068dd
47 changed files with 1049 additions and 989 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
emacs/.emacs.d/snippets/rjsx-mode/redux-action
View file

@ -2,4 +2,4 @@
# name: redux-action
# key: rax
# --
export const ${1:$$(string-lower->caps yas-text)} = '`(downcase (buffer-dirname))`/${1:$(string-caps->kebab yas-text)}'
export const ${1:$$(string-lower->caps yas-text)} = '`(downcase (functions-buffer-dirname))`/${1:$(string-caps->kebab yas-text)}'

2
emacs/.emacs.d/snippets/rjsx-mode/typed-redux-action
View file

@ -2,4 +2,4 @@
# name: typed-redux-action
# key: trax
# --
export const ${1:$$(string-lower->caps yas-text)}: '`(downcase (buffer-dirname))`/${1:$(string-caps->kebab yas-text)}' = '`(downcase (buffer-dirname))`/${1:$(string-caps->kebab yas-text)}'
export const ${1:$$(string-lower->caps yas-text)}: '`(downcase (functions-buffer-dirname))`/${1:$(string-caps->kebab yas-text)}' = '`(downcase (buffer-dirname))`/${1:$(string-caps->kebab yas-text)}'

120
emacs/.emacs.d/wpc/alist.el
View file

@ -1,5 +1,9 @@
;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "25.1"))
;;; Commentary:
;; Firstly, a rant:
@ -89,7 +93,7 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst alist/enable-tests? t
(defconst alist-enable-tests? t
"When t, run the test suite.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -97,21 +101,21 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO: Support a variadic version of this to easily construct alists.
(defun alist/new ()
(defun alist-new ()
"Return a new, empty alist."
'())
;; Create
;; TODO: See if this mutates.
(defun alist/set (k v xs)
(defun alist-set (k v xs)
"Set K to V in XS."
(if (alist/has-key? k xs)
(if (alist-has-key? k xs)
(progn
(setf (alist-get k xs) v)
xs)
(list/cons `(,k . ,v) xs)))
(list-cons `(,k . ,v) xs)))
(defun alist/set! (k v xs)
(defun alist-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."
@ -119,113 +123,113 @@ Note that this doesn't append to the alist in the way that most alists handle
(map-put xs k v))
;; Read
(defun alist/get (k xs)
(defun alist-get (k xs)
"Return the value at K in XS; otherwise, return nil.
Returns the first occurrence of K in XS since alists support multiple entries."
(cdr (assoc k xs)))
(defun alist/get-entry (k xs)
(defun alist-get-entry (k xs)
"Return the first key-value pair at K in XS."
(assoc k xs))
;; Update
;; TODO: Add warning about only the first occurrence being updated in the
;; documentation.
(defun alist/update (k f xs)
(defun alist-update (k f xs)
"Apply F to the value stored at K in XS.
If `K' is not in `XS', this function errors. Use `alist/upsert' if you're
If `K' is not in `XS', this function errors. Use `alist-upsert' if you're
interested in inserting a value when a key doesn't already exist."
(if (maybe-nil? (alist/get k xs))
(if (maybe-nil? (alist-get k xs))
(error "Refusing to update: key does not exist in alist")
(alist/set k (funcall f (alist/get k xs)) xs)))
(alist-set k (funcall f (alist-get k xs)) xs)))
(defun alist/update! (k f xs)
(defun alist-update! (k f xs)
"Call F on the entry at K in XS.
Mutative variant of `alist/update'."
(alist/set! k (funcall f (alist/get k xs))xs))
Mutative variant of `alist-update'."
(alist-set! k (funcall f (alist-get k xs))xs))
;; TODO: Support this.
(defun alist/upsert (k v f xs)
(defun alist-upsert (k v f xs)
"If K exists in `XS' call `F' on the value otherwise insert `V'."
(if (alist/get k xs)
(alist/update k f xs)
(alist/set k v xs)))
(if (alist-get k xs)
(alist-update k f xs)
(alist-set k v xs)))
;; Delete
;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs.
(defun alist/delete (k xs)
(defun alist-delete (k xs)
"Deletes the entry of K from XS.
This only removes the first occurrence of K, since alists support multiple
key-value entries. See `alist/delete-all' and `alist/dedupe'."
key-value entries. See `alist-delete-all' and `alist-dedupe'."
(remove (assoc k xs) xs))
(defun alist/delete! (k xs)
(defun alist-delete! (k xs)
"Delete the entry of K from XS.
Mutative variant of `alist/delete'."
Mutative variant of `alist-delete'."
(delete (assoc k xs) xs))
;; Additions to the CRUD API
;; TODO: Implement this function.
(defun alist/dedupe-keys (xs)
(defun alist-dedupe-keys (xs)
"Remove the entries in XS where the keys are `equal'.")
(defun alist/dedupe-entries (xs)
(defun alist-dedupe-entries (xs)
"Remove the entries in XS where the key-value pair are `equal'."
(delete-dups xs))
(defun alist/keys (xs)
(defun alist-keys (xs)
"Return a list of the keys in XS."
(mapcar 'car xs))
(defun alist/values (xs)
(defun alist-values (xs)
"Return a list of the values in XS."
(mapcar 'cdr xs))
(defun alist/has-key? (k xs)
(defun alist-has-key? (k xs)
"Return t if XS has a key `equal' to K."
(maybe-some? (assoc k xs)))
(defun alist/has-value? (v xs)
(defun alist-has-value? (v xs)
"Return t if XS has a value of V."
(maybe-some? (rassoc v xs)))
(defun alist/count (xs)
(defun alist-count (xs)
"Return the number of entries in XS."
(length xs))
;; TODO: Should I support `alist/find-key' and `alist/find-value' variants?
(defun alist/find (p xs)
;; TODO: Should I support `alist-find-key' and `alist-find-value' variants?
(defun alist-find (p 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)))
(let ((result (list-find (lambda (x) (funcall p (car x) (cdr x))) xs)))
(if result
(car result)
nil)))
(defun alist/map-keys (f xs)
(defun alist-map-keys (f xs)
"Call F on the values in XS, returning a new alist."
(list/map (lambda (x)
(list-map (lambda (x)
`(,(funcall f (car x)) . ,(cdr x)))
xs))
(defun alist/map-values (f xs)
(defun alist-map-values (f xs)
"Call F on the values in XS, returning a new alist."
(list/map (lambda (x)
(list-map (lambda (x)
`(,(car x) . ,(funcall f (cdr x))))
xs))
(defun alist/reduce (acc f xs)
(defun alist-reduce (acc f xs)
"Return a new alist by calling F on k v and ACC from XS.
F should return a tuple. See tuple.el for more information."
(->> (alist/keys xs)
(list/reduce acc
(->> (alist-keys xs)
(list-reduce acc
(lambda (k acc)
(funcall f k (alist/get k xs) acc)))))
(funcall f k (alist-get k xs) acc)))))
(defun alist/merge (a b)
(defun alist-merge (a b)
"Return a new alist with a merge of alists, A and B.
In this case, the last writer wins, which is B."
(alist/reduce a #'alist/set b))
(alist-reduce a #'alist-set b))
;; TODO: Support `-all' variants like:
;; - get-all
@ -239,34 +243,34 @@ In this case, the last writer wins, which is B."
(first-name . "William")
(last-name . "Carroll")
(last-name . "Another")))
(alist/set 'last-name "Van Gogh" person)
(alist/get 'last-name person)
(alist/update 'last-name (lambda (x) "whoops") person)
(alist/delete 'first-name person)
(alist/keys person)
(alist/values person)
(alist/count person)
(alist/has-key? 'first-name person)
(alist/has-value? "William" person)
;; (alist/dedupe-keys person)
(alist/dedupe-entries person)
(alist/count person)))
(alist-set 'last-name "Van Gogh" person)
(alist-get 'last-name person)
(alist-update 'last-name (lambda (x) "whoops") person)
(alist-delete 'first-name person)
(alist-keys person)
(alist-values person)
(alist-count person)
(alist-has-key? 'first-name person)
(alist-has-value? "William" person)
;; (alist-dedupe-keys person)
(alist-dedupe-entries person)
(alist-count person)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when alist/enable-tests?
(when alist-enable-tests?
(prelude-assert
(equal '((2 . one)
(3 . two))
(alist/map-keys #'1+
(alist-map-keys #'1+
'((1 . one)
(2 . two)))))
(prelude-assert
(equal '((one . 2)
(two . 3))
(alist/map-values #'1+
(alist-map-values #'1+
'((one . 1)
(two . 2))))))

26
emacs/.emacs.d/wpc/bag.el
View file

@ -1,5 +1,9 @@
;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; What is a bag? A bag should be thought of as a frequency table. It's a way
@ -31,36 +35,36 @@
(cl-defstruct bag xs)
(defun bag/update (f xs)
(defun bag-update (f xs)
"Call F on alist in XS."
(let ((ys (bag-xs xs)))
(setf (bag-xs xs) (funcall f ys))))
(defun bag/new ()
(defun bag-new ()
"Create an empty bag."
(make-bag :xs (alist/new)))
(make-bag :xs (alist-new)))
(defun bag/contains? (x xs)
(defun bag-contains? (x xs)
"Return t if XS has X."
(alist/has-key? x (bag-xs xs)))
(alist-has-key? x (bag-xs xs)))
;; TODO: Tabling this for now since working with structs seems to be
;; disappointingly difficult. Where is `struct-update'?
;; (defun bag/add (x xs)
;; (defun bag-add (x xs)
;; "Add X to XS.")
;; TODO: What do we name delete vs. remove?
;; (defun bag/remove (x xs)
;; (defun bag-remove (x xs)
;; "Remove X from XS.
;; This is a no-op is X doesn't exist in XS.")
(defun bag/from-list (xs)
(defun bag-from-list (xs)
"Map a list of `XS' into a bag."
(->> xs
(list/reduce
(bag/new)
(list-reduce
(bag-new)
(lambda (x acc)
(bag/add x 1 #'number/inc acc)))))
(bag-add x 1 #'number-inc acc)))))
(provide 'bag)
;;; bag.el ends here

32
emacs/.emacs.d/wpc/bookmark.el
View file

@ -1,5 +1,9 @@
;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; After enjoying and relying on Emacs's builtin `jump-to-register' command, I'd
@ -29,7 +33,7 @@
(cl-defstruct bookmark label path kbd)
(defconst bookmark/install-kbds? t
(defconst bookmark-install-kbds? t
"When t, install keybindings.")
;; TODO: Consider hosting this function somewhere other than here, since it
@ -38,7 +42,7 @@
;; `counsel-projectile-switch-project-action'. See the noise I made on GH for
;; more context: https://github.com/ericdanan/counsel-projectile/issues/137
(defun bookmark/handle-directory-dwim (path)
(defun bookmark-handle-directory-dwim (path)
"Open PATH as either a project directory or a regular directory.
If PATH is `projectile-project-p', open with `counsel-projectile-find-file'.
Otherwise, open with `counsel-find-file'."
@ -49,19 +53,19 @@ Otherwise, open with `counsel-find-file'."
(let ((ivy-extra-directories nil))
(counsel-find-file path))))
(defconst bookmark/handle-directory #'bookmark/handle-directory-dwim
(defconst bookmark-handle-directory #'bookmark-handle-directory-dwim
"Function to call when a bookmark points to a directory.")
(defconst bookmark/handle-file #'counsel-find-file-action
(defconst bookmark-handle-file #'counsel-find-file-action
"Function to call when a bookmark points to a file.")
(defconst bookmark/whitelist
(defconst bookmark-whitelist
(list
(make-bookmark :label "briefcase"
:path constants/briefcase
:path constants-briefcase
:kbd "b")
(make-bookmark :label "current project"
:path constants/current-project
:path constants-current-project
:kbd "p"))
"List of registered bookmarks.")
@ -69,18 +73,18 @@ Otherwise, open with `counsel-find-file'."
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bookmark/open (b)
(defun bookmark-open (b)
"Open bookmark, B, in a new buffer or an ivy minibuffer."
(let ((path (bookmark-path b)))
(cond
((f-directory? path)
(funcall bookmark/handle-directory path))
(funcall bookmark-handle-directory path))
((f-file? path)
(funcall bookmark/handle-file path)))))
(funcall bookmark-handle-file path)))))
(when bookmark/install-kbds?
(->> bookmark/whitelist
(list/map
(when bookmark-install-kbds?
(->> bookmark-whitelist
(list-map
(lambda (b)
(general-define-key
:prefix "<SPC>"
@ -88,7 +92,7 @@ Otherwise, open with `counsel-find-file'."
(string-concat "j" (bookmark-kbd b))
;; TODO: Consider `cl-labels' so `which-key' minibuffer is more
;; helpful.
(lambda () (interactive) (bookmark/open b)))))))
(lambda () (interactive) (bookmark-open b)))))))
(provide 'bookmark)
;;; bookmark.el ends here

116
emacs/.emacs.d/wpc/buffer.el
View file

@ -1,5 +1,9 @@
;;; buffer.el --- Working with Emacs buffers -*- lexical-binding: t -*-
;;; buffer.el --- Working with buffers -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Utilities for CRUDing buffers in Emacs.
@ -33,14 +37,14 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst buffer/enable-tests? t
(defconst buffer-enable-tests? t
"When t, run the test suite.")
(defconst buffer/install-kbds? t
(defconst buffer-install-kbds? t
"When t, install the keybindings defined herein.")
(defconst buffer/source-code-blacklist
(set/new 'dired-mode
(defconst buffer-source-code-blacklist
(set-new 'dired-mode
'erc-mode
'vterm-mode
'magit-status-mode
@ -51,140 +55,140 @@
'fundamental-mode)
"A blacklist of major-modes to ignore for listing source code buffers.")
(defconst buffer/source-code-timeout 2
(defconst buffer-source-code-timeout 2
"Number of seconds to wait before invalidating the cycle.")
(cl-defstruct source-code-cycle cycle last-called)
(defun buffer/emacs-generated? (name)
(defun buffer-emacs-generated? (name)
"Return t if buffer, NAME, is an Emacs-generated buffer.
Some buffers are Emacs-generated but are surrounded by whitespace."
(let ((trimmed (s-trim name)))
(and (s-starts-with? "*" trimmed))))
(defun buffer/find (buffer-or-name)
(defun buffer-find (buffer-or-name)
"Find a buffer by its BUFFER-OR-NAME."
(get-buffer buffer-or-name))
(defun buffer/major-mode (name)
(defun buffer-major-mode (name)
"Return the active `major-mode' in buffer, NAME."
(with-current-buffer (buffer/find name)
(with-current-buffer (buffer-find name)
major-mode))
(defun buffer/source-code-buffers ()
(defun buffer-source-code-buffers ()
"Return a list of source code buffers.
This will ignore Emacs-generated buffers, like *Messages*. It will also ignore
any buffer whose major mode is defined in `buffer/source-code-blacklist'."
any buffer whose major mode is defined in `buffer-source-code-blacklist'."
(->> (buffer-list)
(list/map #'buffer-name)
(list/reject #'buffer/emacs-generated?)
(list/reject (lambda (name)
(set/contains? (buffer/major-mode name)
buffer/source-code-blacklist)))))
(list-map #'buffer-name)
(list-reject #'buffer-emacs-generated?)
(list-reject (lambda (name)
(set-contains? (buffer-major-mode name)
buffer-source-code-blacklist)))))
(defvar buffer/source-code-cycle-state
(defvar buffer-source-code-cycle-state
(make-source-code-cycle
:cycle (cycle/from-list (buffer/source-code-buffers))
:cycle (cycle-from-list (buffer-source-code-buffers))
:last-called (ts-now))
"State used to manage cycling between source code buffers.")
(defun buffer/exists? (name)
(defun buffer-exists? (name)
"Return t if buffer, NAME, exists."
(maybe-some? (buffer/find name)))
(maybe-some? (buffer-find name)))
(defun buffer/new (name)
(defun buffer-new (name)
"Return a newly created buffer NAME."
(generate-new-buffer name))
(defun buffer/find-or-create (name)
(defun buffer-find-or-create (name)
"Find or create buffer, NAME.
Return a reference to that buffer."
(let ((x (buffer/find name)))
(let ((x (buffer-find name)))
(if (maybe-some? x)
x
(buffer/new name))))
(buffer-new name))))
;; TODO: Should this consume: `display-buffer' or `switch-to-buffer'?
(defun buffer/show (buffer-or-name)
(defun buffer-show (buffer-or-name)
"Display the BUFFER-OR-NAME, which is either a buffer reference or its name."
(display-buffer buffer-or-name))
;; TODO: Move this and `buffer/cycle-prev' into a separate module that
;; TODO: Move this and `buffer-cycle-prev' into a separate module that
;; encapsulates all of this behavior.
(defun buffer/cycle (cycle-fn)
"Cycle forwards or backwards through `buffer/source-code-buffers'."
(defun buffer-cycle (cycle-fn)
"Cycle forwards or backwards through `buffer-source-code-buffers'."
(let ((last-called (source-code-cycle-last-called
buffer/source-code-cycle-state))
buffer-source-code-cycle-state))
(cycle (source-code-cycle-cycle
buffer/source-code-cycle-state)))
buffer-source-code-cycle-state)))
(if (> (ts-diff (ts-now) last-called)
buffer/source-code-timeout)
buffer-source-code-timeout)
(progn
(struct-set! source-code-cycle
cycle
(cycle/from-list (buffer/source-code-buffers))
buffer/source-code-cycle-state)
(cycle-from-list (buffer-source-code-buffers))
buffer-source-code-cycle-state)
(let ((cycle (source-code-cycle-cycle
buffer/source-code-cycle-state)))
buffer-source-code-cycle-state)))
(funcall cycle-fn cycle)
(switch-to-buffer (cycle/current cycle)))
(switch-to-buffer (cycle-current cycle)))
(struct-set! source-code-cycle
last-called
(ts-now)
buffer/source-code-cycle-state))
buffer-source-code-cycle-state))
(progn
(funcall cycle-fn cycle)
(switch-to-buffer (cycle/current cycle))))))
(switch-to-buffer (cycle-current cycle))))))
(defun buffer/cycle-next ()
"Cycle forward through the `buffer/source-code-buffers'."
(defun buffer-cycle-next ()
"Cycle forward through the `buffer-source-code-buffers'."
(interactive)
(buffer/cycle #'cycle/next))
(buffer-cycle #'cycle-next))
(defun buffer/cycle-prev ()
"Cycle backward through the `buffer/source-code-buffers'."
(defun buffer-cycle-prev ()
"Cycle backward through the `buffer-source-code-buffers'."
(interactive)
(buffer/cycle #'cycle/prev))
(buffer-cycle #'cycle-prev))
(defun buffer/ivy-source-code ()
(defun buffer-ivy-source-code ()
"Use `ivy-read' to choose among all open source code buffers."
(interactive)
(ivy-read "Source code buffer: "
(-drop 1 (buffer/source-code-buffers))
(-drop 1 (buffer-source-code-buffers))
:sort nil
:action #'switch-to-buffer))
(defun buffer/show-previous ()
(defun buffer-show-previous ()
"Call `switch-to-buffer' on the previously visited buffer.
This function ignores Emacs-generated buffers, i.e. the ones that look like
this: *Buffer*. It also ignores buffers that are `dired-mode' or `erc-mode'.
This blacklist can easily be changed."
(interactive)
(let* ((xs (buffer/source-code-buffers))
(candidate (list/get 1 xs)))
(let* ((xs (buffer-source-code-buffers))
(candidate (list-get 1 xs)))
(prelude-assert (maybe-some? candidate))
(switch-to-buffer candidate)))
(when buffer/install-kbds?
(when buffer-install-kbds?
(general-define-key
:states '(normal)
"C-f" #'buffer/cycle-next
"C-b" #'buffer/cycle-prev)
"C-f" #'buffer-cycle-next
"C-b" #'buffer-cycle-prev)
(general-define-key
:prefix "<SPC>"
:states '(normal)
"b" #'buffer/ivy-source-code
"<SPC>" #'buffer/show-previous
"b" #'buffer-ivy-source-code
"<SPC>" #'buffer-show-previous
"k" #'kill-buffer))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when buffer/enable-tests?
(when buffer-enable-tests?
(prelude-assert
(list/all? #'buffer/emacs-generated?
(list-all? #'buffer-emacs-generated?
'("*scratch*"
"*Messages*"
"*shell*"

58
emacs/.emacs.d/wpc/bytes.el
View file

@ -1,5 +1,9 @@
;;; bytes.el --- Working with byte values -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Functions to help with human-readable representations of byte values.
@ -40,49 +44,49 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst bytes/kb (math/exp 2 10)
(defconst bytes-kb (math-exp 2 10)
"Number of bytes in a kilobyte.")
(defconst bytes/mb (math/exp 2 20)
(defconst bytes-mb (math-exp 2 20)
"Number of bytes in a megabytes.")
(defconst bytes/gb (math/exp 2 30)
(defconst bytes-gb (math-exp 2 30)
"Number of bytes in a gigabyte.")
(defconst bytes/tb (math/exp 2 40)
(defconst bytes-tb (math-exp 2 40)
"Number of bytes in a terabyte.")
(defconst bytes/pb (math/exp 2 50)
(defconst bytes-pb (math-exp 2 50)
"Number of bytes in a petabyte.")
(defconst bytes/eb (math/exp 2 60)
(defconst bytes-eb (math-exp 2 60)
"Number of bytes in an exabyte.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bytes/classify (x)
(defun bytes-classify (x)
"Return unit that closest fits byte count, X."
(prelude-assert (number/whole? x))
(prelude-assert (number-whole? 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)))
((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)
(defun bytes-to-string (x)
"Convert integer X into a human-readable string."
(let ((base-and-unit
(pcase (bytes/classify x)
(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")))))
('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")))))
(string-format "%d%s"
(round x (tuple/first base-and-unit))
(tuple/second base-and-unit))))
@ -93,17 +97,17 @@
(progn
(prelude-assert
(equal "1000B" (bytes/to-string 1000)))
(equal "1000B" (bytes-to-string 1000)))
(prelude-assert
(equal "2KB" (bytes/to-string (* 2 bytes/kb))))
(equal "2KB" (bytes-to-string (* 2 bytes-kb))))
(prelude-assert
(equal "17MB" (bytes/to-string (* 17 bytes/mb))))
(equal "17MB" (bytes-to-string (* 17 bytes-mb))))
(prelude-assert
(equal "419GB" (bytes/to-string (* 419 bytes/gb))))
(equal "419GB" (bytes-to-string (* 419 bytes-gb))))
(prelude-assert
(equal "999TB" (bytes/to-string (* 999 bytes/tb))))
(equal "999TB" (bytes-to-string (* 999 bytes-tb))))
(prelude-assert
(equal "2PB" (bytes/to-string (* 2 bytes/pb)))))
(equal "2PB" (bytes-to-string (* 2 bytes-pb)))))
(provide 'bytes)
;;; bytes.el ends here

34
emacs/.emacs.d/wpc/cache.el
View file

@ -1,5 +1,9 @@
;;; cache.el --- Caching things -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; An immutable cache data structure.
@ -19,6 +23,10 @@
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dependencies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'prelude)
(require 'struct)
@ -31,24 +39,24 @@
;; TODO: Prefer another KBD for yasnippet form completion than company-mode's
;; current KBD.
(defun cache/from-list (xs)
(defun cache-from-list (xs)
"Turn list, XS, into a cache."
(make-cache :xs xs))
(defun cache/contains? (x xs)
(defun cache-contains? (x xs)
"Return t if X in XS."
(->> xs
cache-xs
(list/contains? x)))
(list-contains? x)))
(defun cache/touch (x xs)
(defun cache-touch (x xs)
"Ensure value X in cache, XS, is front of the list.
If X isn't in XS (using `equal'), insert it at the front."
(struct-update
cache
xs
(>> (list/reject (lambda (y) (equal x y)))
(list/cons x))
(>> (list-reject (lambda (y) (equal x y)))
(list-cons x))
xs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -56,25 +64,25 @@ If X isn't in XS (using `equal'), insert it at the front."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn
(let ((cache (cache/from-list '("chicken" "nugget"))))
(let ((cache (cache-from-list '("chicken" "nugget"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; contains?/2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prelude-refute
(cache/contains? "turkey" cache))
(cache-contains? "turkey" cache))
(prelude-assert
(cache/contains? "chicken" cache))
(cache-contains? "chicken" cache))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; touch/2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prelude-assert
(equal
(cache/touch "nugget" cache)
(cache/from-list '("nugget" "chicken"))))
(cache-touch "nugget" cache)
(cache-from-list '("nugget" "chicken"))))
(prelude-assert
(equal
(cache/touch "spicy" cache)
(cache/from-list '("spicy" "chicken" "nugget"))))))
(cache-touch "spicy" cache)
(cache-from-list '("spicy" "chicken" "nugget"))))))
(provide 'cache)
;;; cache.el ends here

10
emacs/.emacs.d/wpc/clipboard.el
View file

@ -1,5 +1,9 @@
;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Simple functions for copying and pasting.
@ -23,17 +27,17 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cl-defun clipboard/copy (x &key (message "[clipboard.el] Copied!"))
(cl-defun clipboard-copy (x &key (message "[clipboard.el] Copied!"))
"Copy string, X, to X11's clipboard."
(kill-new x)
(message message))
(cl-defun clipboard/paste (&key (message "[clipboard.el] Pasted!"))
(cl-defun clipboard-paste (&key (message "[clipboard.el] Pasted!"))
"Paste contents of X11 clipboard."
(yank)
(message message))
(defun clipboard/contents ()
(defun clipboard-contents ()
"Return the contents of the clipboard as a string."
(substring-no-properties (current-kill 0)))

66
emacs/.emacs.d/wpc/colorscheme.el
View file

@ -1,5 +1,9 @@
;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;;
@ -21,76 +25,76 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom colorscheme/install-kbds? t
(defcustom colorscheme-install-kbds? t
"If non-nil, enable the keybindings.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defcustom colorscheme/whitelist
(cycle/from-list
(defcustom colorscheme-whitelist
(cycle-from-list
(->> (custom-available-themes)
(list/map #'symbol-name)
(list/filter (>> (s-starts-with? "doom-")))
(list/map #'intern)))
(list-map #'symbol-name)
(list-filter (>> (s-starts-with? "doom-")))
(list-map #'intern)))
"The whitelist of colorschemes through which to cycle.")
(defun colorscheme/current ()
(defun colorscheme-current ()
"Return the currently enabled colorscheme."
(cycle/current colorscheme/whitelist))
(cycle-current colorscheme-whitelist))
(defun colorscheme/disable-all ()
(defun colorscheme-disable-all ()
"Disable all currently enabled colorschemes."
(interactive)
(->> custom-enabled-themes
(list/map #'disable-theme)))
(list-map #'disable-theme)))
(defun colorscheme/set (theme)
(defun colorscheme-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)
(prelude-set-line-number-color "#da5468"))
(defun colorscheme/whitelist-set (colorscheme)
"Focus the COLORSCHEME in the `colorscheme/whitelist' cycle."
(cycle/focus (lambda (x) (equal x colorscheme)) colorscheme/whitelist)
(colorscheme/set (colorscheme/current)))
(defun colorscheme-whitelist-set (colorscheme)
"Focus the COLORSCHEME in the `colorscheme-whitelist' cycle."
(cycle-focus (lambda (x) (equal x colorscheme)) colorscheme-whitelist)
(colorscheme-set (colorscheme-current)))
(defun colorscheme/ivy-select ()
(defun colorscheme-ivy-select ()
"Load a colorscheme using ivy."
(interactive)
(let ((theme (ivy-read "Theme: " (cycle/to-list colorscheme/whitelist))))
(colorscheme/disable-all)
(colorscheme/set (intern theme))))
(let ((theme (ivy-read "Theme: " (cycle-to-list colorscheme-whitelist))))
(colorscheme-disable-all)
(colorscheme-set (intern theme))))
(cl-defun colorscheme/cycle (&key forward?)
(cl-defun colorscheme-cycle (&key forward?)
"Cycle next if `FORWARD?' is non-nil.
Cycle prev otherwise."
(disable-theme (cycle/current colorscheme/whitelist))
(disable-theme (cycle-current colorscheme-whitelist))
(let ((theme (if forward?
(cycle/next colorscheme/whitelist)
(cycle/prev colorscheme/whitelist))))
(colorscheme/set theme)
(cycle-next colorscheme-whitelist)
(cycle-prev colorscheme-whitelist))))
(colorscheme-set theme)
(message (s-concat "Active theme: " (symbol-to-string theme)))))
(defun colorscheme/next ()
(defun colorscheme-next ()
"Disable the currently active theme and load the next theme."
(interactive)
(colorscheme/cycle :forward? t))
(colorscheme-cycle :forward? t))
(defun colorscheme/prev ()
(defun colorscheme-prev ()
"Disable the currently active theme and load the previous theme."
(interactive)
(colorscheme/cycle :forward? nil))
(colorscheme-cycle :forward? nil))
;; Keybindings
(when colorscheme/install-kbds?
(when colorscheme-install-kbds?
(general-define-key
:prefix "<SPC>"
:states '(normal)
"Ft" #'colorscheme/next
"Pt" #'colorscheme/prev))
"Ft" #'colorscheme-next
"Pt" #'colorscheme-prev))
(provide 'colorscheme)
;;; colorscheme.el ends here

18
emacs/.emacs.d/wpc/constants.el
View file

@ -1,5 +1,9 @@
;;; constants.el --- Constants for organizing my Emacs -*- lexical-binding: t -*-
;; Authpr: William Carroll <wpcarro@gmail.com>
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; This file contains constants that are shared across my configuration.
@ -20,11 +24,11 @@
;; Configuration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst constants/ci?
(defconst constants-ci?
(maybe-some? (getenv "CI"))
"True when Emacs is running in CI.")
(defconst constants/briefcase
(defconst constants-briefcase
(getenv "BRIEFCASE")
"Path to my monorepo, which various parts of my configuration rely on.")
@ -32,11 +36,11 @@
;; current consumers of these constants, and I'm unsure if the indirection that
;; globally defined constants introduces is worth it.
(defconst constants/current-project
constants/briefcase
(defconst constants-current-project
constants-briefcase
"Variable holding the directory for my currently active project.")
(defconst constants/mouse-kbds
(defconst constants-mouse-kbds
'([mouse-1] [down-mouse-1] [drag-mouse-1] [double-mouse-1] [triple-mouse-1]
[mouse-2] [down-mouse-2] [drag-mouse-2] [double-mouse-2] [triple-mouse-2]
[mouse-3] [down-mouse-3] [drag-mouse-3] [double-mouse-3] [triple-mouse-3]
@ -44,7 +48,7 @@
[mouse-5] [down-mouse-5] [drag-mouse-5] [double-mouse-5] [triple-mouse-5])
"All of the mouse-related keybindings that Emacs recognizes.")
(defconst constants/fill-column 80
(defconst constants-fill-column 80
"Variable used to set the defaults for wrapping, highlighting, etc.")
(provide 'constants)

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

@ -1,5 +1,9 @@
;;; cycle.el --- Simple module for working with cycles. -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Something like this may already exist, but I'm having trouble finding it, and
@ -21,7 +25,7 @@
;; - TODO: Provide immutable variant.
;; - TODO: Replace mutable consumption with immutable variant.
;; - TODO: Replace indexing with (math/mod current cycle).
;; - TODO: Replace indexing with (math-mod current cycle).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library
@ -31,10 +35,10 @@
;; `xs' is the original list
(cl-defstruct cycle current-index previous-index xs)
(defconst cycle/enable-tests? t
(defconst cycle-enable-tests? t
"When t, run the tests defined herein.")
(defun cycle/from-list (xs)
(defun cycle-from-list (xs)
"Create a cycle from a list of `XS'."
(if (= 0 (length xs))
(make-cycle :current-index nil
@ -44,11 +48,11 @@
:previous-index nil
:xs xs)))
(defun cycle/new (&rest xs)
(defun cycle-new (&rest xs)
"Create a cycle with XS as the values."
(cycle/from-list xs))
(cycle-from-list xs))
(defun cycle/to-list (xs)
(defun cycle-to-list (xs)
"Return the list representation of a cycle, XS."
(cycle-xs xs))
@ -70,7 +74,7 @@
lo
(+ 1 x)))
(defun cycle/previous-focus (cycle)
(defun cycle-previous-focus (cycle)
"Return the previously focused entry in CYCLE."
(let ((i (cycle-previous-index cycle)))
(if (maybe-some? i)
@ -79,81 +83,81 @@
;; TODO: Consider adding "!" to the function name herein since many of them
;; mutate the collection, and the APIs are beginning to confuse me.
(defun cycle/focus-previous! (xs)
(defun cycle-focus-previous! (xs)
"Jump to the item in XS that was most recently focused; return the cycle.
This will error when previous-index is nil. This function mutates the
underlying struct."
(let ((i (cycle-previous-index xs)))
(if (maybe-some? i)
(progn
(cycle/jump i xs)
(cycle/current xs))
(cycle-jump i xs)
(cycle-current xs))
(error "Cannot focus the previous element since cycle-previous-index is nil"))))
(defun cycle/next (xs)
(defun cycle-next (xs)
"Return the next value in `XS' and update `current-index'."
(let* ((current-index (cycle-current-index xs))
(next-index (next-index-> 0 (cycle/count xs) current-index)))
(next-index (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)
(defun cycle-prev (xs)
"Return the previous value in `XS' and update `current-index'."
(let* ((current-index (cycle-current-index xs))
(next-index (next-index<- 0 (cycle/count xs) current-index)))
(next-index (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)
(defun cycle-current (cycle)
"Return the current value in `CYCLE'."
(nth (cycle-current-index cycle) (cycle-xs cycle)))
(defun cycle/count (cycle)
(defun cycle-count (cycle)
"Return the length of `xs' in `CYCLE'."
(length (cycle-xs cycle)))
(defun cycle/jump (i xs)
(defun cycle-jump (i xs)
"Jump to the I index of XS."
(let ((current-index (cycle-current-index xs))
(next-index (math/mod i (cycle/count xs))))
(next-index (math-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)
(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)
(cycle-jump i cycle)
(error "No element in cycle matches predicate"))))
(defun cycle/focus-item (x xs)
(defun cycle-focus-item (x xs)
"Focus ITEM in cycle XS.
ITEM is the first item in XS that t for `equal'."
(cycle/focus (lambda (y) (equal x y)) xs))
(cycle-focus (lambda (y) (equal x y)) xs))
(defun cycle/contains? (x xs)
(defun cycle-contains? (x xs)
"Return t if cycle, XS, has member X."
(->> xs
cycle-xs
(list/contains? x)))
(list-contains? x)))
(defun cycle/empty? (xs)
(defun cycle-empty? (xs)
"Return t if cycle XS has no elements."
(= 0 (length (cycle-xs xs))))
(defun cycle/focused? (xs)
(defun cycle-focused? (xs)
"Return t if cycle XS has a non-nil value for current-index."
(maybe-some? (cycle-current-index xs)))
(defun cycle/append (x xs)
(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)
(if (cycle-empty? xs)
(progn
(struct-set! cycle xs (list x) xs)
(struct-set! cycle current-index 0 xs)
@ -170,7 +174,7 @@ If there is no currently focused item, add X to the beginning of XS."
(when prev-i (struct-set! cycle previous-index (1+ prev-i) xs))))
xs)))
(defun cycle/remove (x xs)
(defun cycle-remove (x xs)
"Attempt to remove X from XS.
X is found using `equal'.
@ -194,25 +198,25 @@ If X is the currently focused value, after it's deleted, current-index will be
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when cycle/enable-tests?
(let ((xs (cycle/new 1 2 3)))
(prelude-assert (maybe-nil? (cycle/previous-focus xs)))
(prelude-assert (= 1 (cycle/current xs)))
(prelude-assert (= 2 (cycle/next xs)))
(prelude-assert (= 1 (cycle/previous-focus xs)))
(prelude-assert (= 1 (->> xs (cycle/jump 0) cycle/current)))
(prelude-assert (= 2 (->> xs (cycle/jump 1) cycle/current)))
(prelude-assert (= 3 (->> xs (cycle/jump 2) cycle/current)))
(prelude-assert (= 2 (cycle/previous-focus xs)))
(prelude-assert (= 2 (cycle/focus-previous! xs)))
(prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle/append 4 xs))))
(prelude-assert (equal '(1 2 3) (cycle-xs (cycle/remove 4 xs))))
(when cycle-enable-tests?
(let ((xs (cycle-new 1 2 3)))
(prelude-assert (maybe-nil? (cycle-previous-focus xs)))
(prelude-assert (= 1 (cycle-current xs)))
(prelude-assert (= 2 (cycle-next xs)))
(prelude-assert (= 1 (cycle-previous-focus xs)))
(prelude-assert (= 1 (->> xs (cycle-jump 0) cycle-current)))
(prelude-assert (= 2 (->> xs (cycle-jump 1) cycle-current)))
(prelude-assert (= 3 (->> xs (cycle-jump 2) cycle-current)))
(prelude-assert (= 2 (cycle-previous-focus xs)))
(prelude-assert (= 2 (cycle-focus-previous! xs)))
(prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle-append 4 xs))))
(prelude-assert (equal '(1 2 3) (cycle-xs (cycle-remove 4 xs))))
(progn
(cycle/focus-item 3 xs)
(cycle/focus-item 2 xs)
(cycle/remove 1 xs)
(prelude-assert (= 2 (cycle/current xs)))
(prelude-assert (= 3 (cycle/previous-focus xs))))))
(cycle-focus-item 3 xs)
(cycle-focus-item 2 xs)
(cycle-remove 1 xs)
(prelude-assert (= 2 (cycle-current xs)))
(prelude-assert (= 3 (cycle-previous-focus xs))))))
(provide 'cycle)
;;; cycle.el ends here

22
emacs/.emacs.d/wpc/device.el
View file

@ -1,5 +1,9 @@
;;; device.el --- Physical device information -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Functions for querying device information.
@ -13,30 +17,30 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst device/hostname->device
(defconst device-hostname->device
'(("zeno.lon.corp.google.com" . work-desktop)
("seneca" . work-laptop))
"Mapping hostname to a device symbol.")
;; TODO: Should I generate these predicates?
(defun device/classify ()
(defun device-classify ()
"Return the device symbol for the current host or nil if not supported."
(alist/get system-name device/hostname->device))
(alist-get system-name device-hostname->device))
(defun device/work-laptop? ()
(defun device-work-laptop? ()
"Return t if current device is work laptop."
(equal 'work-laptop
(device/classify)))
(device-classify)))
(defun device/work-desktop? ()
(defun device-work-desktop? ()
"Return t if current device is work desktop."
(equal 'work-desktop
(device/classify)))
(device-classify)))
(defun device/corporate? ()
(defun device-corporate? ()
"Return t if the current device is owned by my company."
(or (device/work-laptop?) (device/work-desktop?)))
(or (device-work-laptop?) (device-work-desktop?)))
(provide 'device)
;;; device.el ends here

48
emacs/.emacs.d/wpc/display.el
View file

@ -1,5 +1,9 @@
;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Mostly wrappers around xrandr.
@ -24,15 +28,15 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO: Consider if this logic should be conditioned by `device/work-laptop?'.
(defconst display/laptop-monitor "eDP1"
;; TODO: Consider if this logic should be conditioned by `device-work-laptop?'.
(defconst display-laptop-monitor "eDP1"
"The xrandr identifier for my primary screen (on work laptop).")
;; TODO: Why is HDMI-1, eDP-1 sometimes and HDMI1, eDP1 other times.
(defconst display/4k-monitor "HDMI1"
(defconst display-4k-monitor "HDMI1"
"The xrandr identifer for my 4K monitor.")
(defconst display/display-states (cycle/from-list '((t . nil) (nil . t)))
(defconst display-display-states (cycle-from-list '((t . nil) (nil . t)))
"A list of cons cells modelling enabled and disabled states for my displays.
The car models the enabled state of my laptop display; the cdr models the
enabled state of my external monitor.")
@ -43,50 +47,50 @@ The car models the enabled state of my laptop display; the cdr models the
;; TODO: Debug why something this scales to 4k appropriately and other times it
;; doesn't.
(defun display/enable-4k ()
(defun display-enable-4k ()
"Attempt to connect to my 4K monitor."
(interactive)
(prelude-start-process
:name "display/enable-4k"
:name "display-enable-4k"
:command (string-format
"xrandr --output %s --above %s --primary --auto --size 3840x2160 --rate 30.00 --dpi 144"
display/4k-monitor
display/laptop-monitor)))
display-4k-monitor
display-laptop-monitor)))
(defun display/disable-4k ()
(defun display-disable-4k ()
"Disconnect from the 4K monitor."
(interactive)
(prelude-start-process
:name "display/disable-4k"
:name "display-disable-4k"
:command (string-format "xrandr --output %s --off"
display/4k-monitor)))
display-4k-monitor)))
(defun display/enable-laptop ()
(defun display-enable-laptop ()
"Turn the laptop monitor off.
Sometimes this is useful when I'm sharing my screen in a Google Hangout and I
only want to present one of my monitors."
(interactive)
(prelude-start-process
:name "display/disable-laptop"
:name "display-disable-laptop"
:command (string-format "xrandr --output %s --auto"
display/laptop-monitor)))
display-laptop-monitor)))
(defun display/disable-laptop ()
(defun display-disable-laptop ()
"Turn the laptop monitor off.
Sometimes this is useful when I'm sharing my screen in a Google Hangout and I
only want to present one of my monitors."
(interactive)
(prelude-start-process
:name "display/disable-laptop"
:name "display-disable-laptop"
:command (string-format "xrandr --output %s --off"
display/laptop-monitor)))
display-laptop-monitor)))
(defun display/cycle-display-states ()
"Cycle through `display/display-states' enabling and disabling displays."
(defun display-cycle-display-states ()
"Cycle through `display-display-states' enabling and disabling displays."
(interactive)
(let ((state (cycle/next display/display-states)))
(if (car state) (display/enable-laptop) (display/disable-laptop))
(if (cdr state) (display/enable-4k) (display/disable-4k))))
(let ((state (cycle-next display-display-states)))
(if (car state) (display-enable-laptop) (display-disable-laptop))
(if (cdr state) (display-enable-4k) (display-disable-4k))))
(provide 'display)
;;; display.el ends here

22
emacs/.emacs.d/wpc/dotted.el
View file

@ -1,5 +1,9 @@
;;; dotted.el --- Working with dotted pairs in Elisp -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Part of my primitives library extensions in Elisp. Contrast my primitives
@ -9,6 +13,10 @@
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dependencies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'prelude)
(require 'macros)
@ -16,20 +24,20 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cl-defun dotted/new (&optional a b)
(cl-defun dotted-new (&optional a b)
"Create a new dotted pair (i.e. cons cell)."
(cons a b))
(defun dotted/instance? (x)
(defun dotted-instance? (x)
"Return t if X is a dotted pair."
(let ((b (cdr x)))
(and b (atom b))))
(defun dotted/first (x)
(defun dotted-first (x)
"Return the first element of X."
(car x))
(defun dotted/second (x)
(defun dotted-second (x)
"Return the second element of X."
(cdr x))
@ -39,11 +47,11 @@
(progn
(prelude-assert
(equal '(fname . "Bob") (dotted/new 'fname "Bob")))
(equal '(fname . "Bob") (dotted-new 'fname "Bob")))
(prelude-assert
(dotted/instance? '(one . two)))
(dotted-instance? '(one . two)))
(prelude-refute
(dotted/instance? '(1 2 3))))
(dotted-instance? '(1 2 3))))
(provide 'dotted)
;;; dotted.el ends here

6
emacs/.emacs.d/wpc/email.el
View file

@ -23,7 +23,9 @@
(setq notmuch-saved-searches
'((:name "inbox" :query "tag:inbox" :key "i")
(:name "direct" :query "tag:direct and tag:unread and not tag:sent" :key "d")
(:name "direct"
:query "tag:direct and tag:unread and not tag:sent"
:key "d")
(:name "action" :query "tag:action" :key "a")
(:name "review" :query "tag:review" :key "r")
(:name "waiting" :query "tag:waiting" :key "w")
@ -69,7 +71,7 @@
;; Assert that no two saved searches share share a KBD
(prelude-assert
(list/xs-distinct-by? (lambda (x) (plist-get x :key)) notmuch-saved-searches))
(list-xs-distinct-by? (lambda (x) (plist-get x :key)) notmuch-saved-searches))
(provide 'email)
;;; email.el ends here

81
emacs/.emacs.d/wpc/fonts.el
View file

@ -1,5 +1,9 @@
;;; fonts.el --- Font preferences -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Control my font preferences with ELisp.
@ -8,7 +12,6 @@
;; TODO: `defcustom' font-size.
;; TODO: `defcustom' fonts.
;; TODO: Remove wpc/ namespace.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dependencies
@ -27,16 +30,16 @@
;; TODO: Consider having a different font size when I'm using my 4K monitor.
(defconst fonts/size
(pcase (device/classify)
(defconst fonts-size
(pcase (device-classify)
('work-laptop "10")
('work-desktop "8"))
"My preferred default font-size, which is device specific.")
(defconst fonts/size-step 10
(defconst fonts-size-step 10
"The amount (%) by which to increase or decrease a font.")
(defconst fonts/hacker-news-recommendations
(defconst fonts-hacker-news-recommendations
'("APL385 Unicode"
"Go Mono"
"Sudo"
@ -45,10 +48,10 @@
)
"List of fonts optimized for programming I found in a HN article.")
(defconst fonts/whitelist
(cycle/from-list
(list/concat
fonts/hacker-news-recommendations
(defconst fonts-whitelist
(cycle-from-list
(list-concat
fonts-hacker-news-recommendations
'("JetBrainsMono"
"Mononoki Medium"
"Monospace"
@ -63,75 +66,75 @@
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO: fonts and fonts/whitelist make it difficult to name functions like
;; fonts/set as a generic Emacs function vs choosing a font from the whitelist.
;; TODO: fonts and fonts-whitelist make it difficult to name functions like
;; fonts-set as a generic Emacs function vs choosing a font from the whitelist.
(cl-defun fonts/cycle (&key forward?)
(cl-defun fonts-cycle (&key forward?)
"Cycle forwards when `FORWARD?' non-nil."
(let ((font (if forward?
(cycle/next fonts/whitelist)
(cycle/prev fonts/whitelist))))
(cycle-next fonts-whitelist)
(cycle-prev fonts-whitelist))))
(message (s-concat "Active font: " font))
(fonts/set font)))
(fonts-set font)))
(defun fonts/next ()
(defun fonts-next ()
"Quickly cycle through preferred fonts."
(interactive)
(fonts/cycle :forward? t))
(fonts-cycle :forward? t))
(defun fonts/prev ()
(defun fonts-prev ()
"Quickly cycle through preferred fonts."
(interactive)
(fonts/cycle :forward? nil))
(fonts-cycle :forward? nil))
(defun fonts/set (font &optional size)
(defun fonts-set (font &optional size)
"Change the font to `FONT' with option integer, SIZE, in pixels."
(if (maybe-some? size)
(set-frame-font (string-format "%s %s" font size) nil t)
(set-frame-font font nil t)))
(defun fonts/whitelist-set (font)
"Focuses the FONT in the `fonts/whitelist' cycle.
The size of the font is determined by `fonts/size'."
(prelude-assert (cycle/contains? font fonts/whitelist))
(cycle/focus (lambda (x) (equal x font)) fonts/whitelist)
(fonts/set (fonts/current) fonts/size))
(defun fonts-whitelist-set (font)
"Focuses the FONT in the `fonts-whitelist' cycle.
The size of the font is determined by `fonts-size'."
(prelude-assert (cycle-contains? font fonts-whitelist))
(cycle-focus (lambda (x) (equal x font)) fonts-whitelist)
(fonts-set (fonts-current) fonts-size))
(defun fonts/ivy-select ()
(defun fonts-ivy-select ()
"Select a font from an ivy prompt."
(interactive)
(fonts/whitelist-set
(ivy-read "Font: " (cycle/to-list fonts/whitelist))))
(fonts-whitelist-set
(ivy-read "Font: " (cycle-to-list fonts-whitelist))))
(defun fonts/print-current ()
(defun fonts-print-current ()
"Message the currently enabled font."
(interactive)
(message
(string-format "[fonts] Current font: \"%s\""
(fonts/current))))
(fonts-current))))
(defun fonts/current ()
(defun fonts-current ()
"Return the currently enabled font."
(cycle/current fonts/whitelist))
(cycle-current fonts-whitelist))
(defun fonts/increase-size ()
(defun fonts-increase-size ()
"Increase font size."
(interactive)
(->> (face-attribute 'default :height)
(+ fonts/size-step)
(+ fonts-size-step)
(set-face-attribute 'default (selected-frame) :height)))
(defun fonts/decrease-size ()
(defun fonts-decrease-size ()
"Decrease font size."
(interactive)
(->> (face-attribute 'default :height)
(+ (- fonts/size-step))
(+ (- fonts-size-step))
(set-face-attribute 'default (selected-frame) :height)))
(defun fonts/reset-size ()
(defun fonts-reset-size ()
"Restore font size to its default value."
(interactive)
(fonts/whitelist-set (fonts/current)))
(fonts-whitelist-set (fonts-current)))
(provide 'fonts)
;;; fonts.el ends here

23
emacs/.emacs.d/wpc/fs.el
View file

@ -1,5 +1,9 @@
;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.1"))
;;; Commentary:
;; Ergonomic alternatives for working with the filesystem.
@ -10,31 +14,33 @@
;; Dependencies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'dash)
(require 'f)
(require 's)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun fs/ensure-file (path)
(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)
fs-ensure-dir)
(f-touch path))
(f-dirname "/tmp/a/b/file.txt")
(defun fs/ensure-dir (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?)
(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."
@ -44,20 +50,19 @@ If `FULL-PATH?' is set, return the full-path of the files."
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO: Support `refute' function / macro.
(ert-deftest fs/test/ensure-file ()
(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)
(fs-ensure-file file)
(should (and (f-exists? file)
(f-file? file)))))
(ert-deftest fs/test/ensure-dir ()
(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)
(fs-ensure-dir dir)
(should (and (f-exists? dir)
(f-dir? dir)))))

100
emacs/.emacs.d/wpc/functions.el
View file

@ -1,5 +1,9 @@
;; functions.el --- Helper functions for my Emacs development -*- lexical-binding: t -*-
;;; functions.el --- Helper functions -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; This file hopefully contains friendly APIs that making ELisp development more
@ -8,114 +12,30 @@
;; TODO: Break these out into separate modules.
;;; Code:
(defun wpc/evil-window-vsplit-right ()
(defun functions-evil-window-vsplit-right ()
(interactive)
(evil-window-vsplit)
(windmove-right))
(defun wpc/evil-window-split-down ()
(defun functions-evil-window-split-down ()
(interactive)
(evil-window-split)
(windmove-down))
(defun wpc/reindent-defun-and-align-clojure-map ()
(interactive)
(call-interactively #'paredit-reindent-defun)
(call-interactively #'clojure-align))
(defun wpc/find-file-split (filename)
"Creates a window split and then edits `filename'."
(interactive)
(evil-window-vsplit)
(find-file filename))
(defun wpc/find-or-create-js-test ()
(->> buffer-file-name
(s-chop-suffix ".js")
(s-append ".test.js")
(find-file)))
(defun wpc/find-or-create-js-module ()
(->> buffer-file-name
(s-chop-suffix ".test.js")
(s-append ".js")
(find-file)))
(defun wpc/find-or-create-js-store ()
(->> buffer-file-name
(s-replace "index.js" "store.js")
(find-file)))
(defun wpc/find-or-create-js-component ()
(->> buffer-file-name
(s-replace "store.js" "index.js")
(find-file)))
(defun wpc/toggle-between-js-test-and-module ()
"Toggle between a Javascript test or module."
(interactive)
(if (s-ends-with? ".test.js" buffer-file-name)
(wpc/find-or-create-js-module)
(if (s-ends-with? ".js" buffer-file-name)
(wpc/find-or-create-js-test)
(message "Not in a Javascript file. Exiting..."))))
(defun wpc/toggle-between-js-component-and-store ()
"Toggle between a React component and its Redux store."
(interactive)
(if (s-ends-with? "index.js" buffer-file-name)
(wpc/find-or-create-js-store)
(if (or (s-ends-with? "store.js" buffer-file-name)
(s-ends-with? "store.test.js" buffer-file-name))
(wpc/find-or-create-js-component)
(message "Not in a React/Redux file. Exiting..."))))
(defun wpc/read-file-as-string (filename)
(with-temp-buffer
(insert-file-contents filename)
(s-trim (buffer-string))))
(defun wpc/create-snippet ()
(defun functions-create-snippet ()
"Creates a window split and then opens the Yasnippet editor."
(interactive)
(evil-window-vsplit)
(call-interactively #'yas-new-snippet))
(defun wpc/jump-to-parent-file ()
"Jumps to a React store or component's parent file. Useful for store or index file."
(interactive)
(-> buffer-file-name
f-dirname
(f-join "..")
(f-join (f-filename buffer-file-name))
find-file))
(defun wpc/add-earmuffs (x)
"Returns X surrounded by asterisks."
(format "*%s*" x))
(defun wpc/put-file-name-on-clipboard ()
"Put the current file name on the clipboard"
(interactive)
(let ((filename (if (equal major-mode 'dired-mode)
default-directory
(buffer-file-name))))
(when filename
(with-temp-buffer
(insert filename)
(clipboard-kill-region (point-min) (point-max)))
(message filename))))
(s-replace "/" "x" "a/b/c")
(defun wpc/evil-replace-under-point ()
(defun functions-evil-replace-under-point ()
"Faster than typing %s//thing/g."
(interactive)
(let ((term (s-replace "/" "\\/" (symbol-to-string (symbol-at-point)))))
(save-excursion
(evil-ex (concat "%s/\\b" term "\\b/")))))
(defun buffer-dirname ()
(defun functions-buffer-dirname ()
"Return the directory name of the current buffer as a string."
(->> buffer-file-name
f-dirname

24
emacs/.emacs.d/wpc/graph.el
View file

@ -1,5 +1,9 @@
;;; graph.el --- Working with in-memory graphs -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;;
@ -42,44 +46,44 @@
(cl-defstruct graph neighbors edges)
;; TODO: How do you find the starting point for a topo sort?
(defun graph/sort (xs)
(defun graph-sort (xs)
"Return a topological sort of XS.")
(defun graph/from-edges (xs)
(defun graph-from-edges (xs)
"Create a graph struct from the Edge List, XS.
The user must pass in a valid Edge List since asserting on the shape of XS might
be expensive."
(make-graph :edges xs))
(defun graph/from-neighbors (xs)
(defun graph-from-neighbors (xs)
"Create a graph struct from a Neighbors Table, XS.
The user must pass in a valid Neighbors Table since asserting on the shape of
XS might be expensive."
(make-graph :neighbors xs))
(defun graph/instance? (xs)
(defun graph-instance? (xs)
"Return t if XS is a graph struct."
(graph-p xs))
;; TODO: Model each of the mapping functions into an isomorphism.
(defun graph/edges->neighbors (xs)
(defun graph-edges->neighbors (xs)
"Map Edge List, XS, into a Neighbors Table."
(prelude-assert (graph/instance? xs)))
(prelude-assert (graph-instance? xs)))
(defun graph/neighbors->edges (xs)
(defun graph-neighbors->edges (xs)
"Map Neighbors Table, XS, into an Edge List."
(prelude-assert (graph/instance? xs)))
(prelude-assert (graph-instance? xs)))
;; Below are three different models of the same unweighted, directed graph.
(defvar graph/edges
(defvar graph-edges
'((a . b) (a . c) (a . e)
(b . c) (b . d)
(c . e)
(d . f)
(e . d) (e . f)))
(defvar graph/neighbors
(defvar graph-neighbors
((a b c e)
(b c d)
(c e)

102
emacs/.emacs.d/wpc/irc.el
View file

@ -1,5 +1,9 @@
;;; irc.el --- Configuration for IRC chat -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Need to decide which client I will use for IRC.
@ -24,47 +28,47 @@
;; Configuration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst irc/enable-tests? t
(defconst irc-enable-tests? t
"When t, run the tests defined herein.")
(setq erc-rename-buffers t)
;; TODO: Find a way to avoid putting "freenode" and "#freenode" as channels
;; here. I'm doing it because when erc first connects, it's `(buffer-name)' is
;; "freenode", so when `irc/next-channel' is called, it 404s on the
;; `cycle/contains?' call in `irc/channel->cycle" unless "freenode" is there. To
;; "freenode", so when `irc-next-channel' is called, it 404s on the
;; `cycle-contains?' call in `irc-channel->cycle" unless "freenode" is there. To
;; make matters even uglier, when `erc-join-channel' is called with "freenode"
;; as the value, it connects to the "#freenode" channel, so unless "#freenode"
;; exists in this cycle also, `irc/next-channel' breaks again. This doesn't
;; exists in this cycle also, `irc-next-channel' breaks again. This doesn't
;; pass my smell test.
(defconst irc/server->channels
`(("irc.freenode.net" . ,(cycle/new "freenode" "#freenode" "#nixos" "#emacs" "#pass"))
("irc.corp.google.com" . ,(cycle/new "#omg" "#london" "#panic" "#prod-team")))
(defconst irc-server->channels
`(("irc.freenode.net" . ,(cycle-new "freenode" "#freenode" "#nixos" "#emacs" "#pass"))
("irc.corp.google.com" . ,(cycle-new "#omg" "#london" "#panic" "#prod-team")))
"Mapping of IRC servers to a cycle of my preferred channels.")
;; TODO: Assert that no two servers have a channel with the same name. We need
;; this because that's the assumption that underpins the `irc/channel->server'
;; this because that's the assumption that underpins the `irc-channel->server'
;; function. This will probably be an O(n^2) operation.
(prelude-assert
(set/distinct? (set/from-list
(cycle/to-list
(alist/get "irc.freenode.net"
irc/server->channels)))
(set/from-list
(cycle/to-list
(alist/get "irc.corp.google.com"
irc/server->channels)))))
(set-distinct? (set-from-list
(cycle-to-list
(alist-get "irc.freenode.net"
irc-server->channels)))
(set-from-list
(cycle-to-list
(alist-get "irc.corp.google.com"
irc-server->channels)))))
(defun irc/channel->server (server->channels channel)
(defun irc-channel->server (server->channels channel)
"Resolve an IRC server from a given CHANNEL."
(let ((result (alist/find (lambda (k v) (cycle/contains? channel v))
(let ((result (alist-find (lambda (k v) (cycle-contains? channel v))
server->channels)))
(prelude-assert (maybe-some? result))
result))
(defun irc/channel->cycle (server->channels channel)
(defun irc-channel->cycle (server->channels channel)
"Resolve an IRC's channels cycle from a given CHANNEL."
(alist/get (irc/channel->server server->channels channel)
(alist-get (irc-channel->server server->channels channel)
server->channels))
;; Setting `erc-join-buffer' to 'bury prevents erc from stealing focus of the
@ -73,19 +77,19 @@
;; TODO: Here is another horrible hack that should be revisted.
(setq erc-autojoin-channels-alist
(->> irc/server->channels
(alist/map-values #'cycle/to-list)
(alist/map-keys (>> (s-chop-prefix "irc.")
(->> irc-server->channels
(alist-map-values #'cycle-to-list)
(alist-map-keys (>> (s-chop-prefix "irc.")
(s-chop-suffix ".net")))))
(defcustom irc/install-kbds? t
(defcustom irc-install-kbds? t
"When t, install the keybindings defined herein.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun irc/message (x)
(defun irc-message (x)
"Print message X in a structured way."
(message (string-format "[irc.el] %s" x)))
@ -93,31 +97,31 @@
;; TODO: Support function or KBD for switching to an ERC buffer.
(defun irc/kill-all-erc-processes ()
(defun irc-kill-all-erc-processes ()
"Kills all ERC buffers and processes."
(interactive)
(->> (erc-buffer-list)
(-map #'kill-buffer)))
(defun irc/switch-to-erc-buffer ()
(defun irc-switch-to-erc-buffer ()
"Switch to an ERC buffer."
(interactive)
(let ((buffers (erc-buffer-list)))
(if (list/empty? buffers)
(if (list-empty? buffers)
(error "[irc.el] No ERC buffers available")
(switch-to-buffer (list/head (erc-buffer-list))))))
(switch-to-buffer (list-head (erc-buffer-list))))))
(defun irc/connect-to-freenode ()
(defun irc-connect-to-freenode ()
"Connect to Freenode IRC."
(interactive)
(erc-ssl :server "irc.freenode.net"
:port 6697
:nick "wpcarro"
:password (password-store-get "programming/irc/freenode")
:password (password-store-get "programming/irc-freenode")
:full-name "William Carroll"))
;; TODO: Handle failed connections.
(defun irc/connect-to-google ()
(defun irc-connect-to-google ()
"Connect to Google's Corp IRC using ERC."
(interactive)
(erc-ssl :server "irc.corp.google.com"
@ -127,26 +131,26 @@
;; TODO: Prefer defining these with a less homespun solution. There is a
;; function call `erc-buffer-filter' that would be more appropriate for the
;; implementation of `irc/next-channel' and `irc/prev-channel'.
(defun irc/next-channel ()
;; implementation of `irc-next-channel' and `irc-prev-channel'.
(defun irc-next-channel ()
"Join the next channel for the active server."
(interactive)
(with-current-buffer (current-buffer)
(let ((cycle (irc/channel->cycle irc/server->channels (buffer-name))))
(let ((cycle (irc-channel->cycle irc-server->channels (buffer-name))))
(erc-join-channel
(cycle/next cycle))
(irc/message
(string-format "Current IRC channel: %s" (cycle/current cycle))))))
(cycle-next cycle))
(irc-message
(string-format "Current IRC channel: %s" (cycle-current cycle))))))
(defun irc/prev-channel ()
(defun irc-prev-channel ()
"Join the previous channel for the active server."
(interactive)
(with-current-buffer (current-buffer)
(let ((cycle (irc/channel->cycle irc/server->channels (buffer-name))))
(let ((cycle (irc-channel->cycle irc-server->channels (buffer-name))))
(erc-join-channel
(cycle/prev cycle))
(irc/message
(string-format "Current IRC channel: %s" (cycle/current cycle))))))
(cycle-prev cycle))
(irc-message
(string-format "Current IRC channel: %s" (cycle-current cycle))))))
(add-hook 'erc-mode-hook (macros-disable auto-fill-mode))
(add-hook 'erc-mode-hook (macros-disable company-mode))
@ -155,21 +159,21 @@
;; Keybindings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when irc/install-kbds?
(when irc-install-kbds?
(general-define-key
:keymaps 'erc-mode-map
"<C-tab>" #'irc/next-channel
"<C-S-iso-lefttab>" #'irc/prev-channel))
"<C-tab>" #'irc-next-channel
"<C-S-iso-lefttab>" #'irc-prev-channel))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when irc/enable-tests?
(when irc-enable-tests?
(prelude-assert
(equal
(irc/channel->server `(("irc.dairy.com" . ,(cycle/new "#cheese" "#milk"))
("irc.color.com" . ,(cycle/new "#red" "#blue")))
(irc-channel->server `(("irc.dairy.com" . ,(cycle-new "#cheese" "#milk"))
("irc.color.com" . ,(cycle-new "#red" "#blue")))
"#cheese")
"irc.dairy.com")))

56
emacs/.emacs.d/wpc/ivy-clipmenu.el
View file

@ -1,5 +1,9 @@
;;; ivy-clipmenu.el --- Emacs client for clipmenu -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "25.1"))
;;; Commentary:
;; Ivy integration with the clipboard manager, clipmenu. Essentially, clipmenu
@ -11,7 +15,7 @@
;;
;; This module intentionally does not define any keybindings since I'd prefer
;; not to presume my users' preferences. Personally, I use EXWM as my window
;; manager, so I call `exwm-input-set-key' and map it to `ivy-clipmenu/copy'.
;; manager, so I call `exwm-input-set-key' and map it to `ivy-clipmenu-copy'.
;;
;; Usually clipmenu integrates with rofi or dmenu. This Emacs module integrates
;; with ivy. Launch this when you want to select a clip.
@ -44,7 +48,7 @@
"Ivy integration for clipmenu."
:group 'ivy)
(defcustom ivy-clipmenu/directory
(defcustom ivy-clipmenu-directory
(or (getenv "XDG_RUNTIME_DIR")
(getenv "TMPDIR")
"/tmp")
@ -52,52 +56,52 @@
:type 'string
:group 'ivy-clipmenu)
(defconst ivy-clipmenu/executable-version 5
(defconst ivy-clipmenu-executable-version 5
"The major version number for the clipmenu executable.")
(defconst ivy-clipmenu/cache-directory
(f-join ivy-clipmenu/directory
(defconst ivy-clipmenu-cache-directory
(f-join ivy-clipmenu-directory
(format "clipmenu.%s.%s"
ivy-clipmenu/executable-version
ivy-clipmenu-executable-version
(getenv "USER")))
"Directory where the clips are stored.")
(defconst ivy-clipmenu/cache-file-pattern
(f-join ivy-clipmenu/cache-directory "line_cache_*")
(defconst ivy-clipmenu-cache-file-pattern
(f-join ivy-clipmenu-cache-directory "line_cache_*")
"Glob pattern matching the locations on disk for clipmenu's labels.")
(defcustom ivy-clipmenu/history-length
(defcustom ivy-clipmenu-history-length
(or (getenv "CM_HISTLENGTH") 25)
"Limit the number of clips in the history.
This value defaults to 25.")
(defvar ivy-clipmenu/history nil
"History for `ivy-clipmenu/copy'.")
(defvar ivy-clipmenu-history nil
"History for `ivy-clipmenu-copy'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ivy-clipmenu/parse-content (x)
(defun ivy-clipmenu-parse-content (x)
"Parse the label from the entry in clipmenu's line-cache."
(->> (s-split " " x)
(-drop 1)
(s-join " ")))
(defun ivy-clipmenu/list-clips ()
(defun ivy-clipmenu-list-clips ()
"Return a list of the content of all of the clips."
(->> ivy-clipmenu/cache-file-pattern
(->> ivy-clipmenu-cache-file-pattern
f-glob
(-map (lambda (path)
(s-split "\n" (f-read path) t)))
-flatten
(-reject #'s-blank?)
(-sort #'string>)
(-map #'ivy-clipmenu/parse-content)
(-map #'ivy-clipmenu-parse-content)
delete-dups
(-take ivy-clipmenu/history-length)))
(-take ivy-clipmenu-history-length)))
(defun ivy-clipmenu/checksum (content)
(defun ivy-clipmenu-checksum (content)
"Return the CRC checksum of CONTENT."
(s-trim-right
(with-temp-buffer
@ -105,30 +109,30 @@ This value defaults to 25.")
(format "cksum <<<'%s'" content))
(buffer-string))))
(defun ivy-clipmenu/line-to-content (line)
(defun ivy-clipmenu-line-to-content (line)
"Map the chosen LINE from the line cache its content from disk."
(->> line
ivy-clipmenu/checksum
(f-join ivy-clipmenu/cache-directory)
ivy-clipmenu-checksum
(f-join ivy-clipmenu-cache-directory)
f-read))
(defun ivy-clipmenu/do-copy (x)
(defun ivy-clipmenu-do-copy (x)
"Copy string, X, to the system clipboard."
(kill-new x)
(message "[ivy-clipmenu.el] Copied!"))
(defun ivy-clipmenu/copy ()
(defun ivy-clipmenu-copy ()
"Use `ivy-read' to select and copy a clip.
It's recommended to bind this function to a globally available keymap."
(interactive)
(let ((ivy-sort-functions-alist nil))
(ivy-read "Clipmenu: "
(ivy-clipmenu/list-clips)
:history 'ivy-clipmenu/history
(ivy-clipmenu-list-clips)
:history 'ivy-clipmenu-history
:action (lambda (line)
(->> line
ivy-clipmenu/line-to-content
ivy-clipmenu/do-copy)))))
ivy-clipmenu-line-to-content
ivy-clipmenu-do-copy)))))
(provide 'ivy-clipmenu)
;;; ivy-clipmenu.el ends here

16
emacs/.emacs.d/wpc/ivy-helpers.el
View file

@ -1,5 +1,9 @@
;;; ivy-helpers.el --- More interfaces to ivy -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Hopefully to improve my workflows.
@ -16,7 +20,7 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cl-defun ivy-helpers/kv (prompt kv f)
(cl-defun ivy-helpers-kv (prompt kv f)
"PROMPT users with the keys in KV and return its corresponding value. Calls F
with the key and value from KV."
(ivy-read
@ -26,7 +30,7 @@ with the key and value from KV."
:action (lambda (entry)
(funcall f (car entry) (cdr entry)))))
(defun ivy-helpers/do-run-external-command (cmd)
(defun ivy-helpers-do-run-external-command (cmd)
"Execute the specified CMD and notify the user when it finishes."
(message "Starting %s..." cmd)
(set-process-sentinel
@ -35,7 +39,7 @@ with the key and value from KV."
(when (string= event "finished\n")
(message "%s process finished." process)))))
(defun ivy-helpers/list-external-commands ()
(defun ivy-helpers-list-external-commands ()
"Creates a list of all external commands available on $PATH while filtering
NixOS wrappers."
(cl-loop
@ -51,14 +55,14 @@ NixOS wrappers."
append lsdir into completions
finally return (sort completions 'string-lessp)))
(defun ivy-helpers/run-external-command ()
(defun ivy-helpers-run-external-command ()
"Prompts the user with a list of all installed applications and
lets them select one to launch."
(interactive)
(let ((external-commands-list (ivy-helpers/list-external-commands)))
(let ((external-commands-list (ivy-helpers-list-external-commands)))
(ivy-read "Command:" external-commands-list
:require-match t
:action #'ivy-helpers/do-run-external-command)))
:action #'ivy-helpers-do-run-external-command)))
;;; Code:
(provide 'ivy-helpers)

32
emacs/.emacs.d/wpc/kbd.el
View file

@ -1,5 +1,9 @@
;;; kbd.el --- Elisp keybinding -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; In order to stay organized, I'm attempting to dedicate KBD prefixes to
@ -27,52 +31,52 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst kbd/prefixes
(defconst kbd-prefixes
'((workspace . "s")
(x11 . "C-s"))
"Mapping of functions to designated keybinding prefixes to stay organized.")
;; Assert that no keybindings are colliding.
(prelude-assert
(= (alist/count kbd/prefixes)
(->> kbd/prefixes
alist/values
set/from-list
set/count)))
(= (alist-count kbd-prefixes)
(->> kbd-prefixes
alist-values
set-from-list
set-count)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun kbd/raw (f x)
(defun kbd-raw (f x)
"Return the string keybinding for function F and appendage X.
Values for F include:
- workspace
- x11"
(prelude-assert (alist/has-key? f kbd/prefixes))
(prelude-assert (alist-has-key? f kbd-prefixes))
(string-format
"%s-%s"
(alist/get f kbd/prefixes)
(alist-get f kbd-prefixes)
x))
(defun kbd/for (f x)
(defun kbd-for (f x)
"Return the `kbd' for function F and appendage X.
Values for F include:
- workspace
- x11"
(kbd (kbd/raw f x)))
(kbd (kbd-raw f x)))
;; TODO: Prefer copying human-readable versions to the clipboard. Right now
;; this isn't too useful.
(defun kbd/copy-keycode ()
(defun kbd-copy-keycode ()
"Copy the pressed key to the system clipboard."
(interactive)
(message "[kbd] Awaiting keypress...")
(let ((key (read-key)))
(clipboard/copy (string-format "%s" key))
(clipboard-copy (string-format "%s" key))
(message (string-format "[kbd] \"%s\" copied!" key))))
(defun kbd/print-keycode ()
(defun kbd-print-keycode ()
"Prints the pressed keybinding."
(interactive)
(message "[kbd] Awaiting keypress...")

54
emacs/.emacs.d/wpc/keybindings.el
View file

@ -1,5 +1,9 @@
;;; keybindings.el --- Centralizing my keybindings -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "25.1"))
;;; Commentary:
;; Attempting to centralize my keybindings to simplify my configuration.
@ -63,10 +67,10 @@
"L" #'evil-end-of-line
"_" #'ranger
"-" #'dired-jump
"sl" #'wpc/evil-window-vsplit-right
"sl" #'functions-evil-window-vsplit-right
"sh" #'evil-window-vsplit
"sk" #'evil-window-split
"sj" #'wpc/evil-window-split-down)
"sj" #'functions-evil-window-split-down)
(general-nmap
:keymaps 'override
@ -114,19 +118,19 @@
;; have to bound to the readline function that deletes the entire line.
(general-unbind "C-u")
(defmacro keybinding/exwm (c fn)
(defmacro keybindings-exwm (c fn)
"Bind C to FN using `exwm-input-set-key' with `kbd' applied to C."
`(exwm-input-set-key (kbd ,c) ,fn))
(keybinding/exwm "C-M-v" #'ivy-clipmenu/copy)
(keybinding/exwm "<XF86MonBrightnessUp>" #'screen-brightness/increase)
(keybinding/exwm "<XF86MonBrightnessDown>" #'screen-brightness/decrease)
(keybinding/exwm "<XF86AudioMute>" #'pulse-audio/toggle-mute)
(keybinding/exwm "<XF86AudioLowerVolume>" #'pulse-audio/decrease-volume)
(keybinding/exwm "<XF86AudioRaiseVolume>" #'pulse-audio/increase-volume)
(keybinding/exwm "<XF86AudioMicMute>" #'pulse-audio/toggle-microphone)
(keybinding/exwm (kbd/raw 'x11 "s") #'scrot/select)
(keybinding/exwm "<C-M-tab>" #'window-manager-switch-to-exwm-buffer)
(keybindings-exwm "C-M-v" #'ivy-clipmenu-copy)
(keybindings-exwm "<XF86MonBrightnessUp>" #'screen-brightness/increase)
(keybindings-exwm "<XF86MonBrightnessDown>" #'screen-brightness/decrease)
(keybindings-exwm "<XF86AudioMute>" #'pulse-audio/toggle-mute)
(keybindings-exwm "<XF86AudioLowerVolume>" #'pulse-audio/decrease-volume)
(keybindings-exwm "<XF86AudioRaiseVolume>" #'pulse-audio/increase-volume)
(keybindings-exwm "<XF86AudioMicMute>" #'pulse-audio/toggle-microphone)
(keybindings-exwm (kbd-raw 'x11 "s") #'scrot-select)
(keybindings-exwm "<C-M-tab>" #'window-manager-switch-to-exwm-buffer)
(general-define-key
:keymaps 'override
@ -168,11 +172,11 @@
"W" #'balance-windows
"gs" #'magit-status
"E" #'refine
"es" #'wpc/create-snippet
"es" #'functions-create-snippet
"l" #'linum-mode
"B" #'magit-blame
"w" #'save-buffer
"r" #'wpc/evil-replace-under-point
"r" #'functions-evil-replace-under-point
"R" #'deadgrep)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -180,13 +184,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Show or hide a vterm buffer. I'm intentionally not defining this in
;; vterm-mgt.el because it consumes `buffer/show-previous', and I'd like to
;; vterm-mgt.el because it consumes `buffer-show-previous', and I'd like to
;; avoid bloating vterm-mgt.el with dependencies that others may not want.
(general-define-key (kbd/raw 'x11 "t")
(general-define-key (kbd-raw 'x11 "t")
(lambda ()
(interactive)
(if (vterm-mgt--instance? (current-buffer))
(switch-to-buffer (first (buffer/source-code-buffers)))
(switch-to-buffer (first (buffer-source-code-buffers)))
(call-interactively #'vterm-mgt-find-or-create))))
(general-define-key
@ -201,15 +205,15 @@
;; Displays
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when (device/work-laptop?)
(keybinding/exwm "<XF86Display>" #'display/cycle-display-states)
(when (device-work-laptop?)
(keybindings-exwm "<XF86Display>" #'display-cycle-display-states)
(general-define-key
:prefix "<SPC>"
:states '(normal)
"d0" #'display/disable-laptop
"d1" #'display/enable-laptop
"D0" #'display/disable-4k
"D1" #'display/enable-4k))
"d0" #'display-disable-laptop
"d1" #'display-enable-laptop
"D0" #'display-disable-4k
"D1" #'display-enable-4k))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; notmuch
@ -227,7 +231,7 @@
"e" #'notmuch-show-archive-message-then-next-or-next-thread)
;; TODO(wpcarro): Consider moving this to a separate module
(defun evil-ex-define-cmd-local (cmd f)
(defun keybindings--evil-ex-define-cmd-local (cmd f)
"Define CMD to F locally to a buffer."
(unless (local-variable-p 'evil-ex-commands)
(setq-local evil-ex-commands (copy-alist evil-ex-commands)))
@ -241,7 +245,7 @@
(add-hook 'notmuch-message-mode-hook
(lambda ()
(evil-ex-define-cmd-local "x" #'notmuch-mua-send-and-exit)))
(keybindings--evil-ex-define-cmd-local "x" #'notmuch-mua-send-and-exit)))
;; For now, I'm mimmicking Gmail KBDs that I have memorized and enjoy
(general-define-key

126
emacs/.emacs.d/wpc/keyboard.el
View file

@ -1,5 +1,9 @@
;;; keyboard.el --- Managing keyboard preferences with Elisp -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; Setting key repeat and other values.
@ -21,38 +25,38 @@
;; TODO: Support clamping functions for repeat-{rate,delay} to ensure only valid
;; values are sent to xset.
(defcustom keyboard/repeat-rate 80
(defcustom keyboard-repeat-rate 80
"The number of key repeat signals sent per second.")
(defcustom keyboard/repeat-delay 170
(defcustom keyboard-repeat-delay 170
"The number of milliseconds before autorepeat starts.")
(defconst keyboard/repeat-rate-copy keyboard/repeat-rate
"Copy of `keyboard/repeat-rate' to support `keyboard/reset-key-repeat'.")
(defconst keyboard-repeat-rate-copy keyboard-repeat-rate
"Copy of `keyboard-repeat-rate' to support `keyboard-reset-key-repeat'.")
(defconst keyboard/repeat-delay-copy keyboard/repeat-delay
"Copy of `keyboard/repeat-delay' to support `keyboard/reset-key-repeat'.")
(defconst keyboard-repeat-delay-copy keyboard-repeat-delay
"Copy of `keyboard-repeat-delay' to support `keyboard-reset-key-repeat'.")
(defcustom keyboard/install-preferences? t
(defcustom keyboard-install-preferences? t
"When t, install keyboard preferences.")
(defcustom keyboard/install-kbds? nil
(defcustom keyboard-install-kbds? nil
"When t, install keybindings.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun keyboard/message (x)
(defun keyboard-message (x)
"Message X in a structured way."
(message (string-format "[keyboard.el] %s" x)))
(cl-defun keyboard/set-key-repeat (&key
(rate keyboard/repeat-rate)
(delay keyboard/repeat-delay))
(cl-defun keyboard-set-key-repeat (&key
(rate keyboard-repeat-rate)
(delay keyboard-repeat-delay))
"Use xset to set the key-repeat RATE and DELAY."
(prelude-start-process
:name "keyboard/set-key-repeat"
:name "keyboard-set-key-repeat"
:command (string-format "xset r rate %s %s" delay rate)))
;; NOTE: Settings like this are machine-dependent. For instance I only need to
@ -62,91 +66,91 @@
;; than once, xmodmap will start to error about non-existent Caps_Lock symbol.
;; For more information see here:
;; https://unix.stackexchange.com/questions/108207/how-to-map-caps-lock-as-the-compose-key-using-xmodmap-portably-and-idempotently
(defun keyboard/swap-caps-lock-and-escape ()
(defun keyboard-swap-caps-lock-and-escape ()
"Swaps the caps lock and escape keys using xmodmap."
(interactive)
;; TODO: Ensure these work once the tokenizing in prelude-start-process works
;; as expected.
(start-process "keyboard/swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e"
(start-process "keyboard-swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e"
"remove Lock = Caps_Lock")
(start-process "keyboard/swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e"
(start-process "keyboard-swap-caps-lock-and-escape" nil "/usr/bin/xmodmap" "-e"
"keysym Caps_Lock = Escape"))
(defun keyboard/inc-repeat-rate ()
"Increment `keyboard/repeat-rate'."
(defun keyboard-inc-repeat-rate ()
"Increment `keyboard-repeat-rate'."
(interactive)
(setq keyboard/repeat-rate (number/inc keyboard/repeat-rate))
(keyboard/set-key-repeat :rate keyboard/repeat-rate)
(keyboard/message
(string-format "Rate: %s" keyboard/repeat-rate)))
(setq keyboard-repeat-rate (number-inc keyboard-repeat-rate))
(keyboard-set-key-repeat :rate keyboard-repeat-rate)
(keyboard-message
(string-format "Rate: %s" keyboard-repeat-rate)))
(defun keyboard/dec-repeat-rate ()
"Decrement `keyboard/repeat-rate'."
(defun keyboard-dec-repeat-rate ()
"Decrement `keyboard-repeat-rate'."
(interactive)
(setq keyboard/repeat-rate (number/dec keyboard/repeat-rate))
(keyboard/set-key-repeat :rate keyboard/repeat-rate)
(keyboard/message
(string-format "Rate: %s" keyboard/repeat-rate)))
(setq keyboard-repeat-rate (number-dec keyboard-repeat-rate))
(keyboard-set-key-repeat :rate keyboard-repeat-rate)
(keyboard-message
(string-format "Rate: %s" keyboard-repeat-rate)))
(defun keyboard/inc-repeat-delay ()
"Increment `keyboard/repeat-delay'."
(defun keyboard-inc-repeat-delay ()
"Increment `keyboard-repeat-delay'."
(interactive)
(setq keyboard/repeat-delay (number/inc keyboard/repeat-delay))
(keyboard/set-key-repeat :delay keyboard/repeat-delay)
(keyboard/message
(string-format "Delay: %s" keyboard/repeat-delay)))
(setq keyboard-repeat-delay (number-inc keyboard-repeat-delay))
(keyboard-set-key-repeat :delay keyboard-repeat-delay)
(keyboard-message
(string-format "Delay: %s" keyboard-repeat-delay)))
(defun keyboard/dec-repeat-delay ()
"Decrement `keyboard/repeat-delay'."
(defun keyboard-dec-repeat-delay ()
"Decrement `keyboard-repeat-delay'."
(interactive)
(setq keyboard/repeat-delay (number/dec keyboard/repeat-delay))
(keyboard/set-key-repeat :delay keyboard/repeat-delay)
(keyboard/message
(string-format "Delay: %s" keyboard/repeat-delay)))
(setq keyboard-repeat-delay (number-dec keyboard-repeat-delay))
(keyboard-set-key-repeat :delay keyboard-repeat-delay)
(keyboard-message
(string-format "Delay: %s" keyboard-repeat-delay)))
(defun keyboard/print-key-repeat ()
(defun keyboard-print-key-repeat ()
"Print the currently set values for key repeat."
(interactive)
(keyboard/message
(keyboard-message
(string-format "Rate: %s. Delay: %s"
keyboard/repeat-rate
keyboard/repeat-delay)))
keyboard-repeat-rate
keyboard-repeat-delay)))
(defun keyboard/set-preferences ()
(defun keyboard-set-preferences ()
"Reset the keyboard preferences to their default values.
NOTE: This function exists because occasionally I unplug and re-plug in a
keyboard and all of the preferences that I set using xset disappear."
(interactive)
(keyboard/swap-caps-lock-and-escape)
(keyboard/set-key-repeat :rate keyboard/repeat-rate
:delay keyboard/repeat-delay)
(keyboard-swap-caps-lock-and-escape)
(keyboard-set-key-repeat :rate keyboard-repeat-rate
:delay keyboard-repeat-delay)
;; TODO: Implement this message function as a macro that pulls the current
;; file name.
(keyboard/message "Keyboard preferences set!"))
(keyboard-message "Keyboard preferences set!"))
(defun keyboard/reset-key-repeat ()
(defun keyboard-reset-key-repeat ()
"Set key repeat rate and delay to original values."
(interactive)
(keyboard/set-key-repeat :rate keyboard/repeat-rate-copy
:delay keyboard/repeat-delay-copy)
(keyboard/message "Key repeat preferences reset."))
(keyboard-set-key-repeat :rate keyboard-repeat-rate-copy
:delay keyboard-repeat-delay-copy)
(keyboard-message "Key repeat preferences reset."))
(when keyboard/install-preferences?
(keyboard/set-preferences))
(when keyboard-install-preferences?
(keyboard-set-preferences))
;; TODO: Define minor-mode for this.
(when keyboard/install-kbds?
(when keyboard-install-kbds?
(general-unbind 'motion "C-i" "C-y")
(general-define-key
;; TODO: Choose better KBDs for these that don't interfere with useful evil
;; ones.
;; Use C-y when you accidentally send the key-repeat too high or too low to
;; be meaningful.
"C-y" #'keyboard/reset-key-repeat
"C-i" #'keyboard/inc-repeat-rate
"C-u" #'keyboard/dec-repeat-rate
"C-S-i" #'keyboard/inc-repeat-delay
"C-S-u" #'keyboard/dec-repeat-delay))
"C-y" #'keyboard-reset-key-repeat
"C-i" #'keyboard-inc-repeat-rate
"C-u" #'keyboard-dec-repeat-rate
"C-S-i" #'keyboard-inc-repeat-delay
"C-S-u" #'keyboard-dec-repeat-delay))
(provide 'keyboard)
;;; keyboard.el ends here

18
emacs/.emacs.d/wpc/laptop-battery.el
View file

@ -1,5 +1,9 @@
;;; laptop-battery.el --- Display laptop battery information -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Some wrappers to obtain battery information.
@ -30,28 +34,28 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun laptop-battery/available? ()
(defun laptop-battery-available? ()
"Return t if battery information is available."
(maybe-some? battery-status-function))
(defun laptop-battery/percentage ()
(defun laptop-battery-percentage ()
"Return the current percentage of the battery."
(->> battery-status-function
funcall
(alist/get 112)))
(alist-get 112)))
(defun laptop-battery/print-percentage ()
(defun laptop-battery-print-percentage ()
"Return the current percentage of the battery."
(interactive)
(->> (laptop-battery/percentage)
(->> (laptop-battery-percentage)
message))
(defun laptop-battery/display ()
(defun laptop-battery-display ()
"Display laptop battery percentage in the modeline."
(interactive)
(display-battery-mode 1))
(defun laptop-battery/hide ()
(defun laptop-battery-hide ()
"Hide laptop battery percentage in the modeline."
(interactive)
(display-battery-mode -1))

106
emacs/.emacs.d/wpc/list.el
View file

@ -1,8 +1,12 @@
;;; list.el --- Functions for working with lists. -*- lexical-binding: t -*-
;;; list.el --- Functions for working with lists -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Since I prefer having the `list/' namespace, I wrote this module to wrap many
;; 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.
@ -58,56 +62,56 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst list/tests? t
(defconst list-tests? t
"When t, run the test suite.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun list/new ()
(defun list-new ()
"Return a new, empty list."
'())
(defun list/concat (&rest lists)
(defun list-concat (&rest lists)
"Joins `LISTS' into on list."
(apply #'-concat lists))
(defun list/join (joint xs)
(defun list-join (joint xs)
"Join a list of strings, XS, with JOINT."
(if (list/empty? xs)
(if (list-empty? xs)
""
(list/reduce (list/first xs)
(list-reduce (list-first xs)
(lambda (x acc)
(string-concat acc joint x))
(list/tail xs))))
(list-tail xs))))
(defun list/length (xs)
(defun list-length (xs)
"Return the number of elements in `XS'."
(length xs))
(defun list/get (i xs)
(defun list-get (i xs)
"Return the value in `XS' at `I', or nil."
(nth i xs))
(defun list/head (xs)
(defun list-head (xs)
"Return the head of `XS'."
(car xs))
;; TODO: Learn how to write proper function aliases.
(defun list/first (xs)
"Alias for `list/head' for `XS'."
(list/head xs))
(defun list-first (xs)
"Alias for `list-head' for `XS'."
(list-head xs))
(defun list/tail (xs)
(defun list-tail (xs)
"Return the tail of `XS'."
(cdr xs))
(defun list/reverse (xs)
(defun list-reverse (xs)
"Reverses `XS'."
(reverse xs))
(defun list/cons (x xs)
(defun list-cons (x xs)
"Add `X' to the head of `XS'."
(cons x xs))
@ -120,56 +124,56 @@
;; (funcall f b a)))
;; TODO: Make this function work.
(defun list/reduce (acc f xs)
(defun list-reduce (acc f xs)
"Return over `XS' calling `F' on an element in `XS'and `ACC'."
(-reduce-from (lambda (acc x) (funcall f x acc)) acc xs))
;; TODO: Support this. It seems like `alist/set' is not working as I expected it
;; TODO: Support this. It seems like `alist-set' is not working as I expected it
;; to. Perhaps we should add some tests to confirm the expected behavior.
;; (cl-defun list/index (f xs &key (transform (lambda (x) x)))
;; (cl-defun list-index (f xs &key (transform (lambda (x) x)))
;; "Return a mapping of F applied to each x in XS to TRANSFORM applied to x.
;; The TRANSFORM function defaults to the identity function."
;; (->> xs
;; (list/reduce (alist/new)
;; (list-reduce (alist-new)
;; (lambda (x acc)
;; (let ((k (funcall f x))
;; (v (funcall transform x)))
;; (if (alist/has-key? k acc)
;; (if (alist-has-key? k acc)
;; (setf (alist-get k acc) (list v))
;; (setf (alist-get k acc) (list v))))))))
;; (prelude-assert
;; (equal '(("John" . ("Cleese" "Malkovich"))
;; ("Thomas" . ("Aquinas")))
;; (list/index (lambda (x) (plist-get x :first-name))
;; (list-index (lambda (x) (plist-get x :first-name))
;; '((:first-name "John" :last-name "Cleese")
;; (:first-name "John" :last-name "Malkovich")
;; (:first-name "Thomas" :last-name "Aquinas"))
;; :transform (lambda (x) (plist-get x :last-name)))))
(defun list/map (f xs)
(defun list-map (f xs)
"Call `F' on each element of `XS'."
(-map f xs))
(defun list/map-indexed (f xs)
(defun list-map-indexed (f xs)
"Call `F' on each element of `XS' along with its index."
(-map-indexed (lambda (i x) (funcall f x i)) xs))
(defun list/filter (p xs)
(defun list-filter (p xs)
"Return a subset of XS where predicate P returned t."
(list/reverse
(list/reduce
(list-reverse
(list-reduce
'()
(lambda (x acc)
(if (funcall p x)
(list/cons x acc)
(list-cons x acc)
acc))
xs)))
(defun list/reject (p 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))
(list-filter (lambda (x) (not (funcall p x))) xs))
(defun list/find (p xs)
(defun list-find (p xs)
"Return the first x in XS that passes P or nil."
(-find p xs))
@ -177,64 +181,64 @@
;; Predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun list/instance? (xs)
(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)
(defun list-empty? (xs)
"Return t if XS are empty."
(= 0 (list/length xs)))
(= 0 (list-length xs)))
(defun list/all? (p xs)
(defun list-all? (p xs)
"Return t if all `XS' pass the predicate, `P'."
(-all? p xs))
(defun list/any? (p xs)
(defun list-any? (p xs)
"Return t if any `XS' pass the predicate, `P'."
(-any? p xs))
(defun list/contains? (x xs)
(defun list-contains? (x xs)
"Return t if X is in XS using `equal'."
(-contains? xs x))
(defun list/xs-distinct-by? (f xs)
(defun list-xs-distinct-by? (f xs)
"Return t if all elements in XS are distinct after applying F to each."
(= (length xs)
(->> xs (-map f) set/from-list set/count)))
(->> xs (-map f) set-from-list set-count)))
;; TODO: Support dedupe.
;; TODO: Should we call this unique? Or distinct?
;; TODO: Add tests.
(defun list/dedupe-adjacent (xs)
(defun list-dedupe-adjacent (xs)
"Return XS without adjacent duplicates."
(prelude-assert (not (list/empty? xs)))
(list/reduce (list (list/first xs))
(prelude-assert (not (list-empty? xs)))
(list-reduce (list (list-first xs))
(lambda (x acc)
(if (equal x (list/first acc))
(if (equal x (list-first acc))
acc
(list/cons x acc)))
(list-cons x acc)))
xs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (when list/tests?
;; (when list-tests?
;; (prelude-assert
;; (= 0
;; (list/length '())))
;; (list-length '())))
;; (prelude-assert
;; (= 5
;; (list/length '(1 2 3 4 5))))
;; (list-length '(1 2 3 4 5))))
;; (prelude-assert
;; (= 16
;; (list/reduce 1 (lambda (x acc) (+ x acc)) '(1 2 3 4 5))))
;; (list-reduce 1 (lambda (x acc) (+ x acc)) '(1 2 3 4 5))))
;; (prelude-assert
;; (equal '(2 4 6 8 10)
;; (list/map (lambda (x) (* x 2)) '(1 2 3 4 5)))))
;; (list-map (lambda (x) (* x 2)) '(1 2 3 4 5)))))
(provide 'list)
;;; list.el ends here

16
emacs/.emacs.d/wpc/math.el
View file

@ -1,5 +1,9 @@
;;; math.el --- Math stuffs -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; Package-Requires: ((emacs "24.3"))
;; Homepage: https://user.git.corp.google.com/wpcarro/briefcase
;;; Commentary:
;; Containing some useful mathematical functions.
@ -16,7 +20,7 @@
;; Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst math/pi pi
(defconst math-pi pi
"The number pi.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -25,7 +29,7 @@
;; TODO: Support all three arguments.
;; Int -> Int -> Int -> Boolean
(cl-defun math/triangle-of-power (&key base power result)
(cl-defun math-triangle-of-power (&key base power result)
;; TODO: Assert two of three are set.
(cond
((maybe-somes? base power result)
@ -39,19 +43,19 @@
(t
(error "Two of the three arguments must be set"))))
(defun math/mod (x y)
(defun math-mod (x y)
"Return X mod Y."
(mod x y))
(defun math/exp (x y)
(defun math-exp (x y)
"Return X raised to the Y."
(expt x y))
(defun math/round (x)
(defun math-round (x)
"Round X to nearest ones digit."
(round x))
(defun math/floor (x)
(defun math-floor (x)
"Floor value X."
(floor x))

4
emacs/.emacs.d/wpc/maybe.el
View file

@ -60,11 +60,11 @@
(defun maybe-nils? (&rest xs)
"Return t if all XS are nil."
(list/all? #'maybe-nil? xs))
(list-all? #'maybe-nil? xs))
(defun maybe-somes? (&rest xs)
"Return t if all XS are non-nil."
(list/all? #'maybe-some? xs))
(list-all? #'maybe-some? xs))
(defun maybe-default (default x)
"Return DEFAULT when X is nil."

20
emacs/.emacs.d/wpc/modeline.el
View file

@ -1,5 +1,9 @@
;;; modeline.el --- Customize my Emacs mode-line -*- lexical-binding: t -*-
;;; modeline.el --- Customize my mode-line -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; Package-Requires: ((emacs "25.1"))
;; Homepage: https://user.git.corp.google.com/wpcarro/briefcase
;;; Commentary:
;; Because I use EXWM, I treat my Emacs mode-line like my system bar: I need to
@ -13,7 +17,7 @@
(use-package telephone-line)
(defun modeline/bottom-right-window? ()
(defun modeline-bottom-right-window? ()
"Determines whether the last (i.e. bottom-right) window of the
active frame is showing the buffer in which this function is
executed."
@ -23,23 +27,23 @@
(last-window (car (seq-intersection right-windows bottom-windows))))
(eq (current-buffer) (window-buffer last-window))))
(defun modeline/maybe-render-time ()
(defun modeline-maybe-render-time ()
"Renders the mode-line-misc-info string for display in the
mode-line if the currently active window is the last one in the
frame.
The idea is to not display information like the current time,
load, battery levels on all buffers."
(when (modeline/bottom-right-window?)
(when (modeline-bottom-right-window?)
(telephone-line-raw mode-line-misc-info t)))
(defun modeline/setup ()
(defun modeline-setup ()
"Render my custom modeline."
(telephone-line-defsegment telephone-line-last-window-segment ()
(modeline/maybe-render-time))
(modeline-maybe-render-time))
;; Display the current EXWM workspace index in the mode-line
(telephone-line-defsegment telephone-line-exwm-workspace-index ()
(when (modeline/bottom-right-window?)
(when (modeline-bottom-right-window?)
(format "[%s]" exwm-workspace-current-index)))
;; Define a highlight font for ~ important ~ information in the last
;; window.
@ -61,4 +65,4 @@
(telephone-line-mode 1))
(provide 'modeline)
;; modeline.el ends here
;;; modeline.el ends here

70
emacs/.emacs.d/wpc/number.el
View file

@ -40,40 +40,40 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst number/test? t
(defconst number-test? t
"When t, run the test suite defined herein.")
;; TODO: What about int.el?
;; TODO: How do we handle a number typeclass?
(defun number/positive? (x)
(defun number-positive? (x)
"Return t if `X' is a positive number."
(> x 0))
(defun number/negative? (x)
(defun number-negative? (x)
"Return t if `X' is a positive number."
(< x 0))
;; TODO: Don't rely on this. Need to have 10.0 and 10 behave similarly.
(defun number/float? (x)
(defun number-float? (x)
"Return t if `X' is a floating point number."
(floatp x))
(defun number/natural? (x)
(defun number-natural? (x)
"Return t if `X' is a natural number."
(and (number/positive? x)
(not (number/float? x))))
(and (number-positive? x)
(not (number-float? x))))
(defun number/whole? (x)
(defun number-whole? (x)
"Return t if `X' is a whole number."
(or (= 0 x)
(number/natural? x)))
(number-natural? x)))
(defun number/integer? (x)
(defun number-integer? (x)
"Return t if `X' is an integer."
(or (number/whole? x)
(number/natural? (- x))))
(or (number-whole? x)
(number-natural? (- x))))
;; TODO: How defensive should these guards be? Should we assert that the inputs
;; are integers before checking evenness or oddness?
@ -83,28 +83,28 @@
;; TODO: How should rational numbers be handled? Lisp is supposedly famous for
;; its handling of rational numbers.
;; TODO: `calc-mode' supports rational numbers as "1:2" meaning "1/2"
;; (defun number/rational? (x))
;; (defun number-rational? (x))
;; TODO: Can or should I support real numbers?
;; (defun number/real? (x))
;; (defun number-real? (x))
(defun number/even? (x)
(defun number-even? (x)
"Return t if `X' is an even number."
(or (= 0 x)
(= 0 (mod x 2))))
(defun number/odd? (x)
(defun number-odd? (x)
"Return t if `X' is an odd number."
(not (number/even? x)))
(not (number-even? x)))
(defun number/dec (x)
(defun number-dec (x)
"Subtract one from `X'.
While this function is undeniably trivial, I have unintentionally done (- 1 x)
when in fact I meant to do (- x 1) that I figure it's better for this function
to exist, and for me to train myself to reach for it and its inc counterpart."
(- x 1))
(defun number/inc (x)
(defun number-inc (x)
"Add one to `X'."
(+ x 1))
@ -112,46 +112,46 @@ While this function is undeniably trivial, I have unintentionally done (- 1 x)
;; too vague?
;; TODO: Resolve the circular dependency that this introduces with series.el,
;; and then re-enable this function and its tests below.
;; (defun number/factorial (x)
;; (defun number-factorial (x)
;; "Return factorial of `X'."
;; (cond
;; ((number/negative? x) (error "Will not take factorial of negative numbers"))
;; ((number-negative? x) (error "Will not take factorial of negative numbers"))
;; ((= 0 x) 1)
;; ;; NOTE: Using `series/range' introduces a circular dependency because:
;; ;; series -> number -> series. Conceptually, however, this should be
;; ;; perfectly acceptable.
;; (t (->> (series/range 1 x)
;; (list/reduce 1 #'*)))))
;; (list-reduce 1 #'*)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when number/test?
(when number-test?
(prelude-assert
(number/positive? 10))
(number-positive? 10))
(prelude-assert
(number/natural? 10))
(number-natural? 10))
(prelude-assert
(number/whole? 10))
(number-whole? 10))
(prelude-assert
(number/whole? 0))
(number-whole? 0))
(prelude-assert
(number/integer? 10))
(number-integer? 10))
;; (prelude-assert
;; (= 120 (number/factorial 5)))
;; (= 120 (number-factorial 5)))
(prelude-assert
(number/even? 6))
(number-even? 6))
(prelude-refute
(number/odd? 6))
(number-odd? 6))
(prelude-refute
(number/positive? -10))
(number-positive? -10))
(prelude-refute
(number/natural? 10.0))
(number-natural? 10.0))
(prelude-refute
(number/natural? -10))
(number-natural? -10))
(prelude-refute
(number/natural? -10.0)))
(number-natural? -10.0)))
(provide 'number)
;;; number.el ends here

34
emacs/.emacs.d/wpc/random.el
View file

@ -33,8 +33,8 @@
;; TODO: Make this work with sequences instead of lists.
(defun random-choice (xs)
"Return a random element of `XS'."
(let ((ct (list/length xs)))
(list/get
(let ((ct (list-length xs)))
(list-get
(random-int ct)
xs)))
@ -45,9 +45,9 @@
;; TODO: This may not work if any of these generate numbers like 0, 1, etc.
(defun random-uuid ()
"Return a generated UUID string."
(let ((eight (number/dec (math/triangle-of-power :base 16 :power 8)))
(four (number/dec (math/triangle-of-power :base 16 :power 4)))
(twelve (number/dec (math/triangle-of-power :base 16 :power 12))))
(let ((eight (number-dec (math-triangle-of-power :base 16 :power 8)))
(four (number-dec (math-triangle-of-power :base 16 :power 4)))
(twelve (number-dec (math-triangle-of-power :base 16 :power 12))))
(format "%x-%x-%x-%x-%x"
(random-int eight)
(random-int four)
@ -57,25 +57,25 @@
(defun random-token (length)
"Return a randomly generated hexadecimal string of LENGTH."
(->> (series/range 0 (number/dec length))
(list/map (lambda (_) (format "%x" (random-int 15))))
(list/join "")))
(->> (series/range 0 (number-dec length))
(list-map (lambda (_) (format "%x" (random-int 15))))
(list-join "")))
;; TODO: Support random-sample
;; (defun random-sample (n xs)
;; "Return a randomly sample of list XS of size N."
;; (prelude-assert (and (>= n 0) (< n (list/length xs))))
;; (prelude-assert (and (>= n 0) (< n (list-length xs))))
;; (cl-labels ((do-sample
;; (n xs y ys)
;; (if (= n (set/count ys))
;; (if (= n (set-count ys))
;; (->> ys
;; set/to-list
;; (list/map (lambda (i)
;; (list/get i xs))))
;; (if (set/contains? y ys)
;; (do-sample n xs (random-int (list/length xs)) ys)
;; (do-sample n xs y (set/add y ys))))))
;; (do-sample n xs (random-int (list/length xs)) (set/new))))
;; set-to-list
;; (list-map (lambda (i)
;; (list-get i xs))))
;; (if (set-contains? y ys)
;; (do-sample n xs (random-int (list-length xs)) ys)
;; (do-sample n xs y (set-add y ys))))))
;; (do-sample n xs (random-int (list-length xs)) (set-new))))
(provide 'random)
;;; random.el ends here

58
emacs/.emacs.d/wpc/scope.el
View file

@ -1,5 +1,9 @@
;;; scope.el --- Work with a scope data structure -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Exposing an API for working with a scope data structure in a non-mutative
@ -9,89 +13,93 @@
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Dependencies
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'alist)
(require 'stack)
(require 'struct)
(require 'macros)
(cl-defstruct scope scopes)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Create
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun scope/new ()
"Return an empty scope."
(make-scope :scopes (->> (stack/new)
(stack/push (alist/new)))))
(cl-defstruct scope scopes)
(defun scope/flatten (xs)
(defun scope-new ()
"Return an empty scope."
(make-scope :scopes (->> (stack-new)
(stack-push (alist-new)))))
(defun scope-flatten (xs)
"Return a flattened representation of the scope, XS.
The newest bindings eclipse the oldest."
(->> xs
scope-scopes
stack/to-list
(list/reduce (alist/new)
stack-to-list
(list-reduce (alist-new)
(lambda (scope acc)
(alist/merge acc scope)))))
(alist-merge acc scope)))))
(defun scope/push-new (xs)
(defun scope-push-new (xs)
"Push a new, empty scope onto XS."
(struct-update scope
scopes
(>> (stack/push (alist/new)))
(>> (stack-push (alist-new)))
xs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Read
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun scope/get (k xs)
(defun scope-get (k xs)
"Return K from XS if it's in scope."
(->> xs
scope/flatten
(alist/get k)))
scope-flatten
(alist-get k)))
(defun scope/current (xs)
(defun scope-current (xs)
"Return the newest scope from XS."
(let ((xs-copy (copy-scope xs)))
(->> xs-copy
scope-scopes
stack/peek)))
stack-peek)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Update
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun scope/set (k v xs)
(defun scope-set (k v xs)
"Set value, V, at key, K, in XS for the current scope."
(struct-update scope
scopes
(>> (stack/map-top (>> (alist/set k v))))
(>> (stack-map-top (>> (alist-set k v))))
xs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Delete
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun scope/pop (xs)
(defun scope-pop (xs)
"Return a new scope without the top element from XS."
(->> xs
scope-scopes
stack/pop))
stack-pop))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun scope/defined? (k xs)
(defun scope-defined? (k xs)
"Return t if K is in scope of XS."
(->> xs
scope/flatten
(alist/has-key? k)))
scope-flatten
(alist-has-key? k)))
;; TODO: Find a faster way to write aliases like this.
(defun scope/instance? (xs)
(defun scope-instance? (xs)
"Return t if XS is a scope struct."
(scope-p xs))

1
emacs/.emacs.d/wpc/screen-brightness.el
View file

@ -1,4 +1,5 @@
;;; screen-brightness.el --- Control laptop screen brightness -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;;; Commentary:

37
emacs/.emacs.d/wpc/scrot.el
View file

@ -1,4 +1,9 @@
;;; scrot.el --- Screenshot functions -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; scrot is a Linux utility for taking screenshots.
@ -19,43 +24,43 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst scrot/screenshot-directory "~/Downloads"
(defconst scrot-screenshot-directory "~/Downloads"
"The default directory for screenshot outputs.")
(defconst scrot/path-to-executable "/usr/bin/scrot"
(defconst scrot-path-to-executable "/usr/bin/scrot"
"Path to the scrot executable.")
(defconst scrot/output-format "screenshot_%H:%M:%S_%Y-%m-%d.png"
(defconst scrot-output-format "screenshot_%H:%M:%S_%Y-%m-%d.png"
"The format string for the output screenshot file.
See scrot's man page for more information.")
(defun scrot/copy-image (path)
(defun scrot-copy-image (path)
"Use xclip to copy the image at PATH to the clipboard.
This currently only works for PNG files because that's what I'm outputting"
(call-process "xclip" nil nil nil
"-selection" "clipboard" "-t" "image/png" path)
(message (string-format "[scrot.el] Image copied to clipboard!")))
(defmacro scrot/call (&rest args)
(defmacro scrot-call (&rest args)
"Call scrot with ARGS."
`(call-process ,scrot/path-to-executable nil nil nil ,@args))
`(call-process ,scrot-path-to-executable nil nil nil ,@args))
(defun scrot/fullscreen ()
(defun scrot-fullscreen ()
"Screenshot the entire screen."
(interactive)
(let ((screenshot-path (f-join scrot/screenshot-directory
(ts-format scrot/output-format (ts-now)))))
(scrot/call screenshot-path)
(scrot/copy-image screenshot-path)))
(let ((screenshot-path (f-join scrot-screenshot-directory
(ts-format scrot-output-format (ts-now)))))
(scrot-call screenshot-path)
(scrot-copy-image screenshot-path)))
(defun scrot/select ()
(defun scrot-select ()
"Click-and-drag to screenshot a region.
The output path is copied to the user's clipboard."
(interactive)
(let ((screenshot-path (f-join scrot/screenshot-directory
(ts-format scrot/output-format (ts-now)))))
(scrot/call "--select" screenshot-path)
(scrot/copy-image screenshot-path)))
(let ((screenshot-path (f-join scrot-screenshot-directory
(ts-format scrot-output-format (ts-now)))))
(scrot-call "--select" screenshot-path)
(scrot-copy-image screenshot-path)))
(provide 'scrot)
;;; scrot.el ends here

18
emacs/.emacs.d/wpc/sequence.el
View file

@ -1,5 +1,9 @@
;;; sequence.el --- Working with the "sequence" types -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "25.1"))
;;; Commentary:
;; Elisp supports a typeclass none as "sequence" which covers the following
@ -66,22 +70,22 @@
;; (defprotocol sequence
;; :functions (reduce))
;; (definstance sequence list
;; :reduce #'list/reduce
;; :filter #'list/filter
;; :map #'list/map)
;; :reduce #'list-reduce
;; :filter #'list-filter
;; :map #'list-map)
;; (definstance sequence vector
;; :reduce #'vector/reduce)
;; (definstance sequence string
;; :reduce #'string)
(defun sequence/classify (xs)
(defun sequence-classify (xs)
"Return the type of `XS'."
(cond
((listp xs) 'list)
((vectorp xs) 'vector)
((stringp xs) 'string)))
(defun sequence/reduce (acc f xs)
(defun sequence-reduce (acc f xs)
"Reduce of `XS' calling `F' on x and `ACC'."
(seq-reduce
(lambda (acc x)
@ -91,12 +95,12 @@
;; Elixir also turned everything into a list for efficiecy reasons.
(defun sequence/filter (p xs)
(defun sequence-filter (p xs)
"Filter `XS' with predicate, `P'.
Returns a list regardless of the type of `XS'."
(seq-filter p xs))
(defun sequence/map (f xs)
(defun sequence-map (f xs)
"Maps `XS' calling `F' on each element.
Returns a list regardless of the type of `XS'."
(seq-map f xs))

52
emacs/.emacs.d/wpc/series.el
View file

@ -1,5 +1,9 @@
;;; series.el --- Hosting common series of numbers -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;;; Commentary:
;; Encoding number series as I learn about them.
@ -28,62 +32,62 @@
;; Library
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun series/range (beg end)
(defun series-range (beg end)
"Create a list of numbers from `BEG' to `END'.
This is an inclusive number range."
(if (< end beg)
(list/reverse
(list-reverse
(number-sequence end beg))
(number-sequence beg end)))
(defun series/fibonacci-number (i)
(defun series-fibonacci-number (i)
"Return the number in the fibonacci series at `I'."
(cond
((= 0 i) 0)
((= 1 i) 1)
(t (+ (series/fibonacci-number (- i 1))
(series/fibonacci-number (- i 2))))))
(t (+ (series-fibonacci-number (- i 1))
(series-fibonacci-number (- i 2))))))
(defun series/fibonacci (n)
(defun series-fibonacci (n)
"Return the first `N' numbers of the fibonaccci series starting at zero."
(if (= 0 n)
'()
(list/reverse
(list/cons (series/fibonacci-number (number/dec n))
(list/reverse
(series/fibonacci (number/dec n)))))))
(list-reverse
(list-cons (series-fibonacci-number (number-dec n))
(list-reverse
(series-fibonacci (number-dec n)))))))
;; TODO: Consider memoization.
(defun series/triangular-number (i)
(defun series-triangular-number (i)
"Return the number in the triangular series at `I'."
(if (= 0 i)
0
(+ i (series/triangular-number (number/dec i)))))
(+ i (series-triangular-number (number-dec i)))))
;; TODO: Improve performance.
;; TODO: Consider creating a stream protocol with `stream/next' and implement
;; this using that.
(defun series/triangular (n)
(defun series-triangular (n)
"Return the first `N' numbers of a triangular series starting at 0."
(if (= 0 n)
'()
(list/reverse
(list/cons (series/triangular-number (number/dec n))
(list/reverse
(series/triangular (number/dec n)))))))
(list-reverse
(list-cons (series-triangular-number (number-dec n))
(list-reverse
(series-triangular (number-dec n)))))))
(defun series/catalan-number (i)
(defun series-catalan-number (i)
"Return the catalan number in the series at `I'."
(if (= 0 i)
1
(/ (number/factorial (* 2 i))
(* (number/factorial (number/inc i))
(number/factorial i)))))
(/ (number-factorial (* 2 i))
(* (number-factorial (number-inc i))
(number-factorial i)))))
(defun series/catalan (n)
(defun series-catalan (n)
"Return the first `N' numbers in a catalan series."
(->> (series/range 0 (number/dec n))
(list/map #'series/catalan-number)))
(->> (series-range 0 (number-dec n))
(list-map #'series-catalan-number)))
(provide 'series)
;;; series.el ends here

134
emacs/.emacs.d/wpc/set.el
View file

@ -1,5 +1,9 @@
;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*-
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24.3"))
;;; Commentary:
;; The set data structure is a collection that deduplicates its elements.
@ -24,26 +28,26 @@
(cl-defstruct set xs)
(defconst set/enable-testing? t
(defconst set-enable-testing? t
"Run tests when t.")
(defun set/from-list (xs)
(defun set-from-list (xs)
"Create a new set from the list XS."
(make-set :xs (->> xs
(list/map #'dotted/new)
(list-map #'dotted-new)
ht-from-alist)))
(defun set/new (&rest args)
(defun set-new (&rest args)
"Create a new set from ARGS."
(set/from-list args))
(set-from-list args))
(defun set/to-list (xs)
(defun set-to-list (xs)
"Map set XS into a list."
(->> xs
set-xs
ht-keys))
(defun set/add (x xs)
(defun set-add (x xs)
"Add X to set XS."
(struct-update set
xs
@ -54,22 +58,22 @@
xs))
;; TODO: Ensure all `*/reduce' functions share the same API.
(defun set/reduce (acc f xs)
(defun set-reduce (acc f xs)
"Return a new set by calling F on each element of XS and ACC."
(->> xs
set/to-list
(list/reduce acc f)))
set-to-list
(list-reduce acc f)))
(defun set/intersection (a b)
(defun set-intersection (a b)
"Return the set intersection between sets A and B."
(set/reduce (set/new)
(set-reduce (set-new)
(lambda (x acc)
(if (set/contains? x b)
(set/add x acc)
(if (set-contains? x b)
(set-add x acc)
acc))
a))
(defun set/count (xs)
(defun set-count (xs)
"Return the number of elements in XS."
(->> xs
set-xs
@ -79,93 +83,93 @@
;; Predicates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun set/empty? (xs)
(defun set-empty? (xs)
"Return t if XS has no elements in it."
(= 0 (set/count xs)))
(= 0 (set-count xs)))
(defun set/contains? (x 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)
(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)
(defun set-distinct? (a b)
"Return t if sets A and B have no shared members."
(set/empty? (set/intersection a b)))
(set-empty? (set-intersection a b)))
(defun set/superset? (a b)
(defun set-superset? (a b)
"Return t if set A contains all of the members of set B."
(->> b
set/to-list
(list/all? (lambda (x) (set/contains? x a)))))
set-to-list
(list-all? (lambda (x) (set-contains? x a)))))
(defun set/subset? (a b)
(defun set-subset? (a b)
"Return t if each member of set A is present in set B."
(set/superset? b a))
(set-superset? b a))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(when set/enable-testing?
;; set/distinct?
(when set-enable-testing?
;; set-distinct?
(prelude-assert
(set/distinct? (set/new 'one 'two 'three)
(set/new 'a 'b 'c)))
(set-distinct? (set-new 'one 'two 'three)
(set-new 'a 'b 'c)))
(prelude-refute
(set/distinct? (set/new 1 2 3)
(set/new 3 4 5)))
(set-distinct? (set-new 1 2 3)
(set-new 3 4 5)))
(prelude-refute
(set/distinct? (set/new 1 2 3)
(set/new 1 2 3)))
;; set/equal?
(set-distinct? (set-new 1 2 3)
(set-new 1 2 3)))
;; set-equal?
(prelude-refute
(set/equal? (set/new 'a 'b 'c)
(set/new 'x 'y 'z)))
(set-equal? (set-new 'a 'b 'c)
(set-new 'x 'y 'z)))
(prelude-refute
(set/equal? (set/new 'a 'b 'c)
(set/new 'a 'b)))
(set-equal? (set-new 'a 'b 'c)
(set-new 'a 'b)))
(prelude-assert
(set/equal? (set/new 'a 'b 'c)
(set/new 'a 'b 'c)))
;; set/intersection
(set-equal? (set-new 'a 'b 'c)
(set-new 'a 'b 'c)))
;; set-intersection
(prelude-assert
(set/equal? (set/new 2 3)
(set/intersection (set/new 1 2 3)
(set/new 2 3 4))))
;; set/{from,to}-list
(set-equal? (set-new 2 3)
(set-intersection (set-new 1 2 3)
(set-new 2 3 4))))
;; set-{from,to}-list
(prelude-assert (equal '(1 2 3)
(->> '(1 1 2 2 3 3)
set/from-list
set/to-list)))
(let ((primary-colors (set/new "red" "green" "blue")))
;; set/subset?
set-from-list
set-to-list)))
(let ((primary-colors (set-new "red" "green" "blue")))
;; set-subset?
(prelude-refute
(set/subset? (set/new "black" "grey")
(set-subset? (set-new "black" "grey")
primary-colors))
(prelude-assert
(set/subset? (set/new "red")
(set-subset? (set-new "red")
primary-colors))
;; set/superset?
;; set-superset?
(prelude-refute
(set/superset? primary-colors
(set/new "black" "grey")))
(set-superset? primary-colors
(set-new "black" "grey")))
(prelude-assert
(set/superset? primary-colors
(set/new "red" "green" "blue")))
(set-superset? primary-colors
(set-new "red" "green" "blue")))
(prelude-assert
(set/superset? primary-colors
(set/new "red" "blue"))))
;; set/empty?
(prelude-assert (set/empty? (set/new)))
(prelude-refute (set/empty? (set/new 1 2 3)))
;; set/count
(prelude-assert (= 0 (set/count (set/new))))
(prelude-assert (= 2 (set/count (set/new 1 1 2 2)))))
(set-superset? primary-colors
(set-new "red" "blue"))))
;; set-empty?
(prelude-assert (set-empty? (set-new)))
(prelude-refute (set-empty? (set-new 1 2 3)))
;; set-count
(prelude-assert (= 0 (set-count (set-new))))
(prelude-assert (= 2 (set-count (set-new 1 1 2 2)))))
(provide 'set)
;;; set.el ends here

12
emacs/.emacs.d/wpc/ssh.el
View file

@ -37,23 +37,23 @@
;; Maximizes the tramp debugging noisiness while I'm still learning about tramp.
(setq tramp-verbose 10)
(defcustom ssh/hosts '("desktop" "socrates")
(defcustom ssh-hosts '("desktop" "socrates")
"List of hosts to which I commonly connect.
Note: It could be interesting to read these values from ~/.ssh/config, but
Note: It could be interesting to read these values from ~/.ssh-config, but
that's more than I need at the moment.")
(defun ssh/sudo-buffer ()
(defun ssh-sudo-buffer ()
"Open the current buffer with sudo rights."
(interactive)
(with-current-buffer (current-buffer)
(if (s-starts-with? "/ssh:" buffer-file-name)
(message "[ssh.el] calling ssh/sudo-buffer for remote files isn't currently supported")
(message "[ssh.el] calling ssh-sudo-buffer for remote files isn't currently supported")
(find-file (format "/sudo::%s" buffer-file-name)))))
(defun ssh/cd-home ()
(defun ssh-cd-home ()
"Prompt for an SSH host and open a dired buffer for wpcarro on that machine."
(interactive)
(let ((machine (completing-read "Machine: " ssh/hosts)))
(let ((machine (completing-read "Machine: " ssh-hosts)))
(find-file (format "/ssh:wpcarro@%s:~" machine))))
(provide 'ssh)

36
emacs/.emacs.d/wpc/stack.el
View file

@ -26,62 +26,62 @@
;; Create
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun stack/new ()
(defun stack-new ()
"Create an empty stack."
(make-stack :xs '()))
(defun stack/from-list (xs)
(defun stack-from-list (xs)
"Create a new stack from the list, `XS'."
(list/reduce (stack/new) #'stack/push xs))
(list-reduce (stack-new) #'stack-push xs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Read
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun stack/peek (xs)
(defun stack-peek (xs)
"Look at the top element of `XS' without popping it off."
(->> xs
stack-xs
list/head))
list-head))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Update
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun stack/push (x xs)
(defun stack-push (x xs)
"Push `X' on `XS'."
(struct-update stack
xs
(>> (list/cons x))
(>> (list-cons x))
xs))
;; TODO: How to return something like {(list/head xs), (list/tail xs)} in Elixir
;; TODO: How to return something like {(list-head xs), (list-tail xs)} in Elixir
;; TODO: How to handle popping from empty stacks?
(defun stack/pop (xs)
(defun stack-pop (xs)
"Return the stack, `XS', without the top element.
Since I cannot figure out a nice way of return tuples in Elisp, if you want to
look at the first element, use `stack/peek' before running `stack/pop'."
look at the first element, use `stack-peek' before running `stack-pop'."
(struct-update stack
xs
(>> list/tail)
(>> list-tail)
xs))
(defun stack/map-top (f xs)
(defun stack-map-top (f xs)
"Apply F to the top element of XS."
(->> xs
stack/pop
(stack/push (funcall f (stack/peek xs)))))
stack-pop
(stack-push (funcall f (stack-peek xs)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Miscellaneous
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun stack/to-list (xs)
(defun stack-to-list (xs)
"Return XS as a list.
The round-trip property of `stack/from-list' and `stack/to-list' should hold."
The round-trip property of `stack-from-list' and `stack-to-list' should hold."
(->> xs
stack-xs
list/reverse))
list-reverse))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Predicates
@ -89,7 +89,7 @@ The round-trip property of `stack/from-list' and `stack/to-list' should hold."
;; TODO: Create a macro that wraps `cl-defstruct' that automatically creates
;; things like `new', `instance?'.
(defun stack/instance? (xs)
(defun stack-instance? (xs)
"Return t if XS is a stack."
(stack-p xs))

18
emacs/.emacs.d/wpc/tree.el
View file

@ -72,14 +72,14 @@ Depth-first traversals have the advantage of typically consuming less memory
(if (or (maybe-nil? node)
(tree-leaf? node))
acc-new
(list/reduce
(list-reduce
acc-new
(lambda (node acc)
(tree-do-reduce-depth
acc
f
node
(number/inc depth)))
(number-inc depth)))
(node-children node))))))
(do-reduce-depth acc f node 0)))
@ -94,13 +94,13 @@ Depth-first traversals have the advantage of typically consuming less memory
;; above.
(defun tree-leaf-depths (xs)
"Return a list of all of the depths of the leaf nodes in XS."
(list/reverse
(list-reverse
(tree-reduce-depth
'()
(lambda (node acc depth)
(if (or (maybe-nil? node)
(tree-leaf? node))
(list/cons depth acc)
(list-cons depth acc)
acc))
xs)))
@ -122,8 +122,8 @@ generating test data. Warning this function can overflow the stack."
(d vf bf)
(make-node
:value (funcall vf d)
:children (->> (series/range 0 (number/dec bf))
(list/map
:children (->> (series/range 0 (number-dec bf))
(list-map
(lambda (_)
(when (random-boolean?)
(do-random d vf bf))))))))
@ -147,9 +147,9 @@ A tree is balanced if none of the differences between any two depths of two leaf
nodes in XS is greater than N."
(> n (->> xs
tree-leaf-depths
set/from-list
set/count
number/dec)))
set-from-list
set-count
number-dec)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests

30
emacs/.emacs.d/wpc/vterm-mgt.el
View file

@ -31,7 +31,7 @@
;; Configuration
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst vterm-mgt--instances (cycle/new)
(defconst vterm-mgt--instances (cycle-new)
"A cycle tracking all of my vterm instances.")
(defcustom vterm-mgt-scroll-on-focus nil
@ -50,8 +50,8 @@
This function should be called from a buffer running vterm."
(interactive)
(vterm-mgt--assert-vterm-buffer)
(cycle/focus-item (current-buffer) vterm-mgt--instances)
(switch-to-buffer (cycle/next vterm-mgt--instances))
(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 ()
@ -59,8 +59,8 @@ This function should be called from a buffer running vterm."
This function should be called from a buffer running vterm."
(interactive)
(vterm-mgt--assert-vterm-buffer)
(cycle/focus-item (current-buffer) vterm-mgt--instances)
(switch-to-buffer (cycle/prev vterm-mgt--instances))
(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 ()
@ -74,8 +74,8 @@ If however you must call `vterm', if you'd like to cycle through vterm
collect any untracked vterm instances."
(interactive)
(let ((buffer (vterm)))
(cycle/append buffer vterm-mgt--instances)
(cycle/focus-item buffer vterm-mgt--instances)))
(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'.
@ -83,23 +83,23 @@ This function should be called from a buffer running vterm."
(interactive)
(vterm-mgt--assert-vterm-buffer)
(let ((buffer (current-buffer)))
(cycle/remove buffer vterm-mgt--instances)
(cycle-remove buffer vterm-mgt--instances)
(kill-buffer buffer)))
(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
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)
(if (cycle/empty? vterm-mgt--instances)
(if (cycle-empty? vterm-mgt--instances)
(vterm-mgt-instantiate)
(if (cycle/focused? vterm-mgt--instances)
(switch-to-buffer (cycle/current vterm-mgt--instances))
(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))))))
(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*<...>.
@ -118,7 +118,7 @@ If for whatever reason, the state of `vterm-mgt--instances' is corrupted and
(setq vterm-mgt--instances
(->> (buffer-list)
(-filter #'vterm-mgt--instance?)
cycle/from-list)))
cycle-from-list)))
(provide 'vterm-mgt)
;;; vterm-mgt.el ends here

46
emacs/.emacs.d/wpc/window-manager.el
View file

@ -43,11 +43,11 @@
;; TODO: Decide between window-manager, exwm, or some other namespace.
;; TODO: Support (cycle/from-list '(current previous)) to toggle back and forth
;; TODO: Support (cycle-from-list '(current previous)) to toggle back and forth
;; between most recent workspace.
;; TODO: Support ad hoc cycle for loading a few workspaces that can be cycled
;; between. (cycle/from-list '("Project" "Workspace"))
;; between. (cycle-from-list '("Project" "Workspace"))
;; TODO: Consider supporting a workspace for Racket, Clojure, Common Lisp,
;; Haskell, Elixir, and a few other languages. These could behave very similarly
@ -80,11 +80,11 @@
"List of `window-manager--named-workspace' structs.")
;; Assert that no two workspaces share KBDs.
(prelude-assert (= (list/length window-manager--named-workspaces)
(prelude-assert (= (list-length window-manager--named-workspaces)
(->> window-manager--named-workspaces
(list/map #'window-manager--named-workspace-kbd)
set/from-list
set/count)))
(list-map #'window-manager--named-workspace-kbd)
set-from-list
set-count)))
(defun window-manager--alert (x)
"Message X with a structured format."
@ -101,12 +101,12 @@
(require 'exwm-randr)
(exwm-randr-enable)
(setq exwm-randr-workspace-monitor-plist
(list 0 display/4k-monitor
1 display/laptop-monitor))
(list 0 display-4k-monitor
1 display-laptop-monitor))
(evil-set-initial-state 'exwm-mode 'emacs)
(setq exwm-workspace-number
(list/length window-manager--named-workspaces))
(list-length window-manager--named-workspaces))
(let ((kbds `(
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Window sizing
@ -146,7 +146,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(:key "M-:" :fn eval-expression)
(:key "M-SPC" :fn ivy-helpers/run-external-command)
(:key "M-SPC" :fn ivy-helpers-run-external-command)
(:key "M-x" :fn counsel-M-x)
(:key "<M-tab>" :fn window-manager-next-workspace)
(:key "<M-S-iso-lefttab>" :fn window-manager-prev-workspace)
@ -157,7 +157,7 @@
;; Workspaces
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(:key ,(kbd/raw 'workspace "l") :fn window-manager-logout))))
(:key ,(kbd-raw 'workspace "l") :fn window-manager-logout))))
(setq exwm-input-global-keys
(->> kbds
(-map (lambda (plist)
@ -184,22 +184,22 @@
;; Here is the code required to allow EXWM to cycle workspaces.
(defconst window-manager--workspaces
(->> window-manager--named-workspaces
cycle/from-list)
cycle-from-list)
"Cycle of the my EXWM workspaces.")
(prelude-assert
(= exwm-workspace-number
(list/length window-manager--named-workspaces)))
(list-length window-manager--named-workspaces)))
(defun window-manager-next-workspace ()
"Cycle forwards to the next workspace."
(interactive)
(window-manager--change-workspace (cycle/next window-manager--workspaces)))
(window-manager--change-workspace (cycle-next window-manager--workspaces)))
(defun window-manager-prev-workspace ()
"Cycle backwards to the previous workspace."
(interactive)
(window-manager--change-workspace (cycle/prev window-manager--workspaces)))
(window-manager--change-workspace (cycle-prev window-manager--workspaces)))
;; TODO: Create friendlier API for working with EXWM.
@ -215,7 +215,7 @@
(window-manager--alert "Switched to char-mode"))
(defconst window-manager--modes
(cycle/from-list (list #'window-manager--char-mode
(cycle-from-list (list #'window-manager--char-mode
#'window-manager--line-mode))
"Functions to switch exwm modes.")
@ -224,7 +224,7 @@
(interactive)
(with-current-buffer (window-buffer)
(when (eq major-mode 'exwm-mode)
(funcall (cycle/next window-manager--modes)))))
(funcall (cycle-next window-manager--modes)))))
;; Ensure exwm apps open in char-mode.
(add-hook 'exwm-manage-finish-hook #'window-manager--char-mode)
@ -285,7 +285,7 @@ Ivy is used to capture the user's input."
(funcall
(lambda ()
(shell-command
(alist/get (ivy-read "System: " (alist/keys name->cmd))
(alist-get (ivy-read "System: " (alist-keys name->cmd))
name->cmd))))))
(defun window-manager--label->index (label workspaces)
@ -303,7 +303,7 @@ Currently using super- as the prefix for switching workspaces."
(window-manager--named-workspace-label workspace))))
(key (window-manager--named-workspace-kbd workspace)))
(exwm-input-set-key
(kbd/for 'workspace key)
(kbd-for 'workspace key)
handler)))
(defun window-manager--change-workspace (workspace)
@ -318,11 +318,11 @@ Currently using super- as the prefix for switching workspaces."
(defun window-manager--switch (label)
"Switch to a named workspaces using LABEL."
(cycle/focus (lambda (x)
(cycle-focus (lambda (x)
(equal label
(window-manager--named-workspace-label x)))
window-manager--workspaces)
(window-manager--change-workspace (cycle/current window-manager--workspaces)))
(window-manager--change-workspace (cycle-current window-manager--workspaces)))
(exwm-input-set-key (kbd "C-S-f") #'window-manager-toggle-previous)
@ -330,7 +330,7 @@ Currently using super- as the prefix for switching workspaces."
"Focus the previously active EXWM workspace."
(interactive)
(window-manager--change-workspace
(cycle/focus-previous! window-manager--workspaces)))
(cycle-focus-previous! window-manager--workspaces)))
(defun window-manager--exwm-buffer? (x)
"Return t if buffer X is an EXWM buffer."
@ -361,7 +361,7 @@ predicate."
(when window-manager--install-kbds?
(progn
(->> window-manager--named-workspaces
(list/map #'window-manager--register-kbd))
(list-map #'window-manager--register-kbd))
(window-manager--alert "Registered workspace KBDs!")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

6
emacs/.emacs.d/wpc/wpc-misc.el
View file

@ -179,7 +179,7 @@
create-lockfiles nil)
;; ensure code wraps at 80 characters by default
(setq-default fill-column constants/fill-column)
(setq-default fill-column constants-fill-column)
(put 'narrow-to-region 'disabled nil)
@ -190,7 +190,7 @@
(add-hook 'after-save-hook
(lambda ()
(when (f-equal? (buffer-file-name)
(f-join constants/briefcase "secrets.json"))
(f-join constants-briefcase "secrets.json"))
(shell-command "git secret hide"))))
;; use tabs instead of spaces
@ -214,7 +214,7 @@
;; TODO: Consider moving this into a briefcase.el module.
(defun wpc-misc--briefcase-find (dir)
"Find the default.nix nearest to DIR."
(when (s-starts-with? constants/briefcase (f-expand dir))
(when (s-starts-with? constants-briefcase (f-expand dir))
(if (f-exists? (f-join dir "default.nix"))
(cons 'transient dir)
(wpc-misc--briefcase-find (f-parent dir)))))

4
emacs/.emacs.d/wpc/wpc-nix.el
View file

@ -28,12 +28,12 @@
(defun wpc-nix-rebuild-emacs ()
"Use nix-env to rebuild wpcarros-emacs."
(interactive)
(let* ((emacs (if (device/corporate?) "emacs.glinux" "emacs.nixos"))
(let* ((emacs (if (device-corporate?) "emacs.glinux" "emacs.nixos"))
(pname (format "nix-build <briefcase/%s>" emacs))
(bname (format "*%s*" pname)))
(start-process pname bname
"nix-env"
"-I" (format "briefcase=%s" constants/briefcase)
"-I" (format "briefcase=%s" constants-briefcase)
"-f" "<briefcase>" "-iA" emacs)
(display-buffer bname)))

24
emacs/.emacs.d/wpc/wpc-ui.el
View file

@ -2,8 +2,8 @@
;; Author: William Carroll <wpcarro@gmail.com>
;; Version: 0.0.1
;; URL: https://git.wpcarro.dev/wpcarro/briefcase
;; Package-Requires: ((emacs "24"))
;; Homepage: https://user.git.corp.google.com/wpcarro/briefcase
;;; Commentary:
;; Hosts font settings, scrolling, color schemes.
@ -70,7 +70,7 @@
(tool-bar-mode -1)
;; set default buffer for Emacs
(setq initial-buffer-choice constants/current-project)
(setq initial-buffer-choice constants-current-project)
;; premium Emacs themes
(use-package doom-themes
@ -91,7 +91,7 @@
:config
(counsel-mode t)
(ivy-mode t)
(alist/set! #'counsel-M-x "" ivy-initial-inputs-alist)
(alist-set! #'counsel-M-x "" ivy-initial-inputs-alist)
;; prefer using `helpful' variants
(progn
(setq counsel-describe-function-function #'helpful-callable)
@ -113,7 +113,7 @@
;; all-the-icons
(use-package all-the-icons
:config
(when (not constants/ci?)
(when (not constants-ci?)
(unless (f-exists? "~/.local/share/fonts/all-the-icons.ttf")
(all-the-icons-install-fonts t))))
@ -129,13 +129,13 @@
;; reduce noisiness of auto-revert-mode
(setq auto-revert-verbose nil)
;; highlight lines that are over `constants/fill-column' characters long
;; highlight lines that are over `constants-fill-column' characters long
(use-package whitespace
:config
;; TODO: This should change depending on the language and project. For
;; example, Google Java projects prefer 100 character width instead of 80
;; character width.
(setq whitespace-line-column constants/fill-column)
(setq whitespace-line-column constants-fill-column)
(setq whitespace-style '(face lines-tail))
(add-hook 'prog-mode-hook #'whitespace-mode))
@ -156,15 +156,15 @@
:config
(setq alert-default-style 'notifier))
;; TODO: Should `device/work-laptop?' be a function or a constant that gets set
;; TODO: Should `device-work-laptop?' be a function or a constant that gets set
;; during initialization?
(when (device/work-laptop?)
(laptop-battery/display))
(when (device-work-laptop?)
(laptop-battery-display))
(fonts/whitelist-set "JetBrainsMono")
(colorscheme/whitelist-set 'doom-solarized-light)
(fonts-whitelist-set "JetBrainsMono")
(colorscheme-whitelist-set 'doom-solarized-light)
(modeline/setup)
(modeline-setup)
(provide 'wpc-ui)
;;; wpc-ui.el ends here