More Elisp linting
This should cover most of the remaining linting errors. After this, I expect fewer than ten linting errors.
This commit is contained in:
		
							parent
							
								
									a638e15c0d
								
							
						
					
					
						commit
						fb5ec068dd
					
				
					 47 changed files with 1049 additions and 989 deletions
				
			
		|  | @ -2,4 +2,4 @@ | ||||||
| # name: redux-action | # name: redux-action | ||||||
| # key: rax | # 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,4 +2,4 @@ | ||||||
| # name: typed-redux-action | # name: typed-redux-action | ||||||
| # key: trax | # 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)}' | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*- | ;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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 "25.1")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Firstly, a rant: | ;; Firstly, a rant: | ||||||
|  | @ -89,7 +93,7 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst alist/enable-tests? t | (defconst alist-enable-tests? t | ||||||
|   "When t, run the test suite.") |   "When t, run the test suite.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | @ -97,21 +101,21 @@ | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support a variadic version of this to easily construct alists. | ;; TODO: Support a variadic version of this to easily construct alists. | ||||||
| (defun alist/new () | (defun alist-new () | ||||||
|   "Return a new, empty alist." |   "Return a new, empty alist." | ||||||
|   '()) |   '()) | ||||||
| 
 | 
 | ||||||
| ;; Create | ;; Create | ||||||
| ;; TODO: See if this mutates. | ;; TODO: See if this mutates. | ||||||
| (defun alist/set (k v xs) | (defun alist-set (k v xs) | ||||||
|   "Set K to V in XS." |   "Set K to V in XS." | ||||||
|   (if (alist/has-key? k xs) |   (if (alist-has-key? k xs) | ||||||
|       (progn |       (progn | ||||||
|         (setf (alist-get k xs) v) |         (setf (alist-get k xs) v) | ||||||
|         xs) |         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. |   "Set K to V in XS mutatively. | ||||||
| Note that this doesn't append to the alist in the way that most alists handle | 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." |   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)) |   (map-put xs k v)) | ||||||
| 
 | 
 | ||||||
| ;; Read | ;; Read | ||||||
| (defun alist/get (k xs) | (defun alist-get (k xs) | ||||||
|   "Return the value at K in XS; otherwise, return nil. |   "Return the value at K in XS; otherwise, return nil. | ||||||
| Returns the first occurrence of K in XS since alists support multiple entries." | Returns the first occurrence of K in XS since alists support multiple entries." | ||||||
|   (cdr (assoc k xs))) |   (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." |   "Return the first key-value pair at K in XS." | ||||||
|   (assoc k xs)) |   (assoc k xs)) | ||||||
| 
 | 
 | ||||||
| ;; Update | ;; Update | ||||||
| ;; TODO: Add warning about only the first occurrence being updated in the | ;; TODO: Add warning about only the first occurrence being updated in the | ||||||
| ;; documentation. | ;; documentation. | ||||||
| (defun alist/update (k f xs) | (defun alist-update (k f xs) | ||||||
|   "Apply F to the value stored at K in 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." | 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") |       (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. |   "Call F on the entry at K in XS. | ||||||
| Mutative variant of `alist/update'." | Mutative variant of `alist-update'." | ||||||
|   (alist/set! k (funcall f (alist/get k xs))xs)) |   (alist-set! k (funcall f (alist-get k xs))xs)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support this. | ;; 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 K exists in `XS' call `F' on the value otherwise insert `V'." | ||||||
|   (if (alist/get k xs) |   (if (alist-get k xs) | ||||||
|       (alist/update k f xs) |       (alist-update k f xs) | ||||||
|     (alist/set k v xs))) |     (alist-set k v xs))) | ||||||
| 
 | 
 | ||||||
| ;; Delete | ;; Delete | ||||||
| ;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs. | ;; 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. |   "Deletes the entry of K from XS. | ||||||
| This only removes the first occurrence of K, since alists support multiple | 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)) |   (remove (assoc k xs) xs)) | ||||||
| 
 | 
 | ||||||
| (defun alist/delete! (k xs) | (defun alist-delete! (k xs) | ||||||
|   "Delete the entry of K from XS. |   "Delete the entry of K from XS. | ||||||
| Mutative variant of `alist/delete'." | Mutative variant of `alist-delete'." | ||||||
|   (delete (assoc k xs) xs)) |   (delete (assoc k xs) xs)) | ||||||
| 
 | 
 | ||||||
| ;; Additions to the CRUD API | ;; Additions to the CRUD API | ||||||
| ;; TODO: Implement this function. | ;; TODO: Implement this function. | ||||||
| (defun alist/dedupe-keys (xs) | (defun alist-dedupe-keys (xs) | ||||||
|   "Remove the entries in XS where the keys are `equal'.") |   "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'." |   "Remove the entries in XS where the key-value pair are `equal'." | ||||||
|   (delete-dups xs)) |   (delete-dups xs)) | ||||||
| 
 | 
 | ||||||
| (defun alist/keys (xs) | (defun alist-keys (xs) | ||||||
|   "Return a list of the keys in XS." |   "Return a list of the keys in XS." | ||||||
|   (mapcar 'car xs)) |   (mapcar 'car xs)) | ||||||
| 
 | 
 | ||||||
| (defun alist/values (xs) | (defun alist-values (xs) | ||||||
|   "Return a list of the values in XS." |   "Return a list of the values in XS." | ||||||
|   (mapcar 'cdr 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." |   "Return t if XS has a key `equal' to K." | ||||||
|   (maybe-some? (assoc k xs))) |   (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." |   "Return t if XS has a value of V." | ||||||
|   (maybe-some? (rassoc v xs))) |   (maybe-some? (rassoc v xs))) | ||||||
| 
 | 
 | ||||||
| (defun alist/count (xs) | (defun alist-count (xs) | ||||||
|   "Return the number of entries in XS." |   "Return the number of entries in XS." | ||||||
|   (length xs)) |   (length xs)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Should I support `alist/find-key' and `alist/find-value' variants? | ;; TODO: Should I support `alist-find-key' and `alist-find-value' variants? | ||||||
| (defun alist/find (p xs) | (defun alist-find (p xs) | ||||||
|   "Apply a predicate fn, P, to each key and value in XS and return the key of |   "Apply a predicate fn, P, to each key and value in XS and return the key of | ||||||
|   the first element that returns t." |   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 |     (if result | ||||||
|         (car result) |         (car result) | ||||||
|       nil))) |       nil))) | ||||||
| 
 | 
 | ||||||
| (defun alist/map-keys (f xs) | (defun alist-map-keys (f xs) | ||||||
|   "Call F on the values in XS, returning a new alist." |   "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))) |               `(,(funcall f (car x)) . ,(cdr x))) | ||||||
|             xs)) |             xs)) | ||||||
| 
 | 
 | ||||||
| (defun alist/map-values (f xs) | (defun alist-map-values (f xs) | ||||||
|   "Call F on the values in XS, returning a new alist." |   "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)))) |               `(,(car x) . ,(funcall f (cdr x)))) | ||||||
|             xs)) |             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. |   "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." | F should return a tuple.  See tuple.el for more information." | ||||||
|   (->> (alist/keys xs) |   (->> (alist-keys xs) | ||||||
|        (list/reduce acc |        (list-reduce acc | ||||||
|                     (lambda (k 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. |   "Return a new alist with a merge of alists, A and B. | ||||||
| In this case, the last writer wins, which is 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: | ;; TODO: Support `-all' variants like: | ||||||
| ;; - get-all | ;; - get-all | ||||||
|  | @ -239,34 +243,34 @@ In this case, the last writer wins, which is B." | ||||||
|                   (first-name . "William") |                   (first-name . "William") | ||||||
|                   (last-name  . "Carroll") |                   (last-name  . "Carroll") | ||||||
|                   (last-name  . "Another"))) |                   (last-name  . "Another"))) | ||||||
|    (alist/set 'last-name "Van Gogh" person) |    (alist-set 'last-name "Van Gogh" person) | ||||||
|    (alist/get 'last-name person) |    (alist-get 'last-name person) | ||||||
|    (alist/update 'last-name (lambda (x) "whoops") person) |    (alist-update 'last-name (lambda (x) "whoops") person) | ||||||
|    (alist/delete 'first-name person) |    (alist-delete 'first-name person) | ||||||
|    (alist/keys person) |    (alist-keys person) | ||||||
|    (alist/values person) |    (alist-values person) | ||||||
|    (alist/count person) |    (alist-count person) | ||||||
|    (alist/has-key? 'first-name person) |    (alist-has-key? 'first-name person) | ||||||
|    (alist/has-value? "William" person) |    (alist-has-value? "William" person) | ||||||
|    ;; (alist/dedupe-keys person) |    ;; (alist-dedupe-keys person) | ||||||
|    (alist/dedupe-entries person) |    (alist-dedupe-entries person) | ||||||
|    (alist/count person))) |    (alist-count person))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when alist/enable-tests? | (when alist-enable-tests? | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal '((2 . one) |    (equal '((2 . one) | ||||||
|             (3 . two)) |             (3 . two)) | ||||||
|           (alist/map-keys #'1+ |           (alist-map-keys #'1+ | ||||||
|                           '((1 . one) |                           '((1 . one) | ||||||
|                             (2 . two))))) |                             (2 . two))))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal '((one . 2) |    (equal '((one . 2) | ||||||
|             (two . 3)) |             (two . 3)) | ||||||
|           (alist/map-values #'1+ |           (alist-map-values #'1+ | ||||||
|                             '((one . 1) |                             '((one . 1) | ||||||
|                               (two . 2)))))) |                               (two . 2)))))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*- | ;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; What is a bag?  A bag should be thought of as a frequency table.  It's a way | ;; 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) | (cl-defstruct bag xs) | ||||||
| 
 | 
 | ||||||
| (defun bag/update (f xs) | (defun bag-update (f xs) | ||||||
|   "Call F on alist in XS." |   "Call F on alist in XS." | ||||||
|   (let ((ys (bag-xs xs))) |   (let ((ys (bag-xs xs))) | ||||||
|     (setf (bag-xs xs) (funcall f ys)))) |     (setf (bag-xs xs) (funcall f ys)))) | ||||||
| 
 | 
 | ||||||
| (defun bag/new () | (defun bag-new () | ||||||
|   "Create an empty bag." |   "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." |   "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 | ;; TODO: Tabling this for now since working with structs seems to be | ||||||
| ;; disappointingly difficult.  Where is `struct-update'? | ;; disappointingly difficult.  Where is `struct-update'? | ||||||
| ;; (defun bag/add (x xs) | ;; (defun bag-add (x xs) | ||||||
| ;;   "Add X to XS.") | ;;   "Add X to XS.") | ||||||
| 
 | 
 | ||||||
| ;; TODO: What do we name delete vs. remove? | ;; TODO: What do we name delete vs. remove? | ||||||
| ;; (defun bag/remove (x xs) | ;; (defun bag-remove (x xs) | ||||||
| ;;   "Remove X from XS. | ;;   "Remove X from XS. | ||||||
| ;; This is a no-op is X doesn't exist in 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." |   "Map a list of `XS' into a bag." | ||||||
|   (->> xs |   (->> xs | ||||||
|        (list/reduce |        (list-reduce | ||||||
|         (bag/new) |         (bag-new) | ||||||
|         (lambda (x acc) |         (lambda (x acc) | ||||||
|           (bag/add x 1 #'number/inc acc))))) |           (bag-add x 1 #'number-inc acc))))) | ||||||
| 
 | 
 | ||||||
| (provide 'bag) | (provide 'bag) | ||||||
| ;;; bag.el ends here | ;;; bag.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*- | ;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; After enjoying and relying on Emacs's builtin `jump-to-register' command, I'd | ;; After enjoying and relying on Emacs's builtin `jump-to-register' command, I'd | ||||||
|  | @ -29,7 +33,7 @@ | ||||||
| 
 | 
 | ||||||
| (cl-defstruct bookmark label path kbd) | (cl-defstruct bookmark label path kbd) | ||||||
| 
 | 
 | ||||||
| (defconst bookmark/install-kbds? t | (defconst bookmark-install-kbds? t | ||||||
|   "When t, install keybindings.") |   "When t, install keybindings.") | ||||||
| 
 | 
 | ||||||
| ;; TODO: Consider hosting this function somewhere other than here, since it | ;; 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 | ;; `counsel-projectile-switch-project-action'.  See the noise I made on GH for | ||||||
| ;; more context: https://github.com/ericdanan/counsel-projectile/issues/137 | ;; 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. |   "Open PATH as either a project directory or a regular directory. | ||||||
| If PATH is `projectile-project-p', open with `counsel-projectile-find-file'. | If PATH is `projectile-project-p', open with `counsel-projectile-find-file'. | ||||||
| Otherwise, open with `counsel-find-file'." | Otherwise, open with `counsel-find-file'." | ||||||
|  | @ -49,19 +53,19 @@ Otherwise, open with `counsel-find-file'." | ||||||
|     (let ((ivy-extra-directories nil)) |     (let ((ivy-extra-directories nil)) | ||||||
|       (counsel-find-file path)))) |       (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.") |   "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.") |   "Function to call when a bookmark points to a file.") | ||||||
| 
 | 
 | ||||||
| (defconst bookmark/whitelist | (defconst bookmark-whitelist | ||||||
|   (list |   (list | ||||||
|    (make-bookmark :label "briefcase" |    (make-bookmark :label "briefcase" | ||||||
|                   :path constants/briefcase |                   :path constants-briefcase | ||||||
|                   :kbd "b") |                   :kbd "b") | ||||||
|    (make-bookmark :label "current project" |    (make-bookmark :label "current project" | ||||||
|                   :path constants/current-project |                   :path constants-current-project | ||||||
|                   :kbd "p")) |                   :kbd "p")) | ||||||
|   "List of registered bookmarks.") |   "List of registered bookmarks.") | ||||||
| 
 | 
 | ||||||
|  | @ -69,18 +73,18 @@ Otherwise, open with `counsel-find-file'." | ||||||
| ;; API | ;; API | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun bookmark/open (b) | (defun bookmark-open (b) | ||||||
|   "Open bookmark, B, in a new buffer or an ivy minibuffer." |   "Open bookmark, B, in a new buffer or an ivy minibuffer." | ||||||
|   (let ((path (bookmark-path b))) |   (let ((path (bookmark-path b))) | ||||||
|     (cond |     (cond | ||||||
|      ((f-directory? path) |      ((f-directory? path) | ||||||
|       (funcall bookmark/handle-directory path)) |       (funcall bookmark-handle-directory path)) | ||||||
|      ((f-file? path) |      ((f-file? path) | ||||||
|       (funcall bookmark/handle-file path))))) |       (funcall bookmark-handle-file path))))) | ||||||
| 
 | 
 | ||||||
| (when bookmark/install-kbds? | (when bookmark-install-kbds? | ||||||
|   (->> bookmark/whitelist |   (->> bookmark-whitelist | ||||||
|        (list/map |        (list-map | ||||||
|         (lambda (b) |         (lambda (b) | ||||||
|           (general-define-key |           (general-define-key | ||||||
|            :prefix "<SPC>" |            :prefix "<SPC>" | ||||||
|  | @ -88,7 +92,7 @@ Otherwise, open with `counsel-find-file'." | ||||||
|            (string-concat "j" (bookmark-kbd b)) |            (string-concat "j" (bookmark-kbd b)) | ||||||
|            ;; TODO: Consider `cl-labels' so `which-key' minibuffer is more |            ;; TODO: Consider `cl-labels' so `which-key' minibuffer is more | ||||||
|            ;; helpful. |            ;; helpful. | ||||||
|            (lambda () (interactive) (bookmark/open b))))))) |            (lambda () (interactive) (bookmark-open b))))))) | ||||||
| 
 | 
 | ||||||
| (provide 'bookmark) | (provide 'bookmark) | ||||||
| ;;; bookmark.el ends here | ;;; bookmark.el ends here | ||||||
|  |  | ||||||
|  | @ -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> | ;; Author: William Carroll <wpcarro@gmail.com> | ||||||
|  | ;; Version: 0.0.1 | ||||||
|  | ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||||
|  | ;; Package-Requires: ((emacs "24.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Utilities for CRUDing buffers in Emacs. | ;; Utilities for CRUDing buffers in Emacs. | ||||||
|  | @ -33,14 +37,14 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst buffer/enable-tests? t | (defconst buffer-enable-tests? t | ||||||
|   "When t, run the test suite.") |   "When t, run the test suite.") | ||||||
| 
 | 
 | ||||||
| (defconst buffer/install-kbds? t | (defconst buffer-install-kbds? t | ||||||
|   "When t, install the keybindings defined herein.") |   "When t, install the keybindings defined herein.") | ||||||
| 
 | 
 | ||||||
| (defconst buffer/source-code-blacklist | (defconst buffer-source-code-blacklist | ||||||
|   (set/new 'dired-mode |   (set-new 'dired-mode | ||||||
|            'erc-mode |            'erc-mode | ||||||
|            'vterm-mode |            'vterm-mode | ||||||
|            'magit-status-mode |            'magit-status-mode | ||||||
|  | @ -51,140 +55,140 @@ | ||||||
|            'fundamental-mode) |            'fundamental-mode) | ||||||
|   "A blacklist of major-modes to ignore for listing source code buffers.") |   "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.") |   "Number of seconds to wait before invalidating the cycle.") | ||||||
| 
 | 
 | ||||||
| (cl-defstruct source-code-cycle cycle last-called) | (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. |   "Return t if buffer, NAME, is an Emacs-generated buffer. | ||||||
| Some buffers are Emacs-generated but are surrounded by whitespace." | Some buffers are Emacs-generated but are surrounded by whitespace." | ||||||
|   (let ((trimmed (s-trim name))) |   (let ((trimmed (s-trim name))) | ||||||
|     (and (s-starts-with? "*" trimmed)))) |     (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." |   "Find a buffer by its BUFFER-OR-NAME." | ||||||
|   (get-buffer 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." |   "Return the active `major-mode' in buffer, NAME." | ||||||
|   (with-current-buffer (buffer/find name) |   (with-current-buffer (buffer-find name) | ||||||
|     major-mode)) |     major-mode)) | ||||||
| 
 | 
 | ||||||
| (defun buffer/source-code-buffers () | (defun buffer-source-code-buffers () | ||||||
|   "Return a list of source code buffers. |   "Return a list of source code buffers. | ||||||
| This will ignore Emacs-generated buffers, like *Messages*.  It will also ignore | 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) |   (->> (buffer-list) | ||||||
|        (list/map #'buffer-name) |        (list-map #'buffer-name) | ||||||
|        (list/reject #'buffer/emacs-generated?) |        (list-reject #'buffer-emacs-generated?) | ||||||
|        (list/reject (lambda (name) |        (list-reject (lambda (name) | ||||||
|                       (set/contains? (buffer/major-mode name) |                       (set-contains? (buffer-major-mode name) | ||||||
|                                      buffer/source-code-blacklist))))) |                                      buffer-source-code-blacklist))))) | ||||||
| 
 | 
 | ||||||
| (defvar buffer/source-code-cycle-state | (defvar buffer-source-code-cycle-state | ||||||
|   (make-source-code-cycle |   (make-source-code-cycle | ||||||
|    :cycle (cycle/from-list (buffer/source-code-buffers)) |    :cycle (cycle-from-list (buffer-source-code-buffers)) | ||||||
|    :last-called (ts-now)) |    :last-called (ts-now)) | ||||||
|   "State used to manage cycling between source code buffers.") |   "State used to manage cycling between source code buffers.") | ||||||
| 
 | 
 | ||||||
| (defun buffer/exists? (name) | (defun buffer-exists? (name) | ||||||
|   "Return t if buffer, NAME, exists." |   "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." |   "Return a newly created buffer NAME." | ||||||
|   (generate-new-buffer name)) |   (generate-new-buffer name)) | ||||||
| 
 | 
 | ||||||
| (defun buffer/find-or-create (name) | (defun buffer-find-or-create (name) | ||||||
|   "Find or create buffer, NAME. |   "Find or create buffer, NAME. | ||||||
| Return a reference to that buffer." | Return a reference to that buffer." | ||||||
|   (let ((x (buffer/find name))) |   (let ((x (buffer-find name))) | ||||||
|     (if (maybe-some? x) |     (if (maybe-some? x) | ||||||
|         x |         x | ||||||
|       (buffer/new name)))) |       (buffer-new name)))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Should this consume: `display-buffer' or `switch-to-buffer'? | ;; 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 the BUFFER-OR-NAME, which is either a buffer reference or its name." | ||||||
|   (display-buffer buffer-or-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. | ;; encapsulates all of this behavior. | ||||||
| 
 | 
 | ||||||
| (defun buffer/cycle (cycle-fn) | (defun buffer-cycle (cycle-fn) | ||||||
|   "Cycle forwards or backwards through `buffer/source-code-buffers'." |   "Cycle forwards or backwards through `buffer-source-code-buffers'." | ||||||
|   (let ((last-called (source-code-cycle-last-called |   (let ((last-called (source-code-cycle-last-called | ||||||
|                       buffer/source-code-cycle-state)) |                       buffer-source-code-cycle-state)) | ||||||
|         (cycle (source-code-cycle-cycle |         (cycle (source-code-cycle-cycle | ||||||
|                 buffer/source-code-cycle-state))) |                 buffer-source-code-cycle-state))) | ||||||
|     (if (> (ts-diff (ts-now) last-called) |     (if (> (ts-diff (ts-now) last-called) | ||||||
|            buffer/source-code-timeout) |            buffer-source-code-timeout) | ||||||
|         (progn |         (progn | ||||||
|           (struct-set! source-code-cycle |           (struct-set! source-code-cycle | ||||||
|                        cycle |                        cycle | ||||||
|                        (cycle/from-list (buffer/source-code-buffers)) |                        (cycle-from-list (buffer-source-code-buffers)) | ||||||
|                        buffer/source-code-cycle-state) |                        buffer-source-code-cycle-state) | ||||||
|           (let ((cycle (source-code-cycle-cycle |           (let ((cycle (source-code-cycle-cycle | ||||||
|                         buffer/source-code-cycle-state))) |                         buffer-source-code-cycle-state))) | ||||||
|             (funcall cycle-fn cycle) |             (funcall cycle-fn cycle) | ||||||
|             (switch-to-buffer (cycle/current cycle))) |             (switch-to-buffer (cycle-current cycle))) | ||||||
|           (struct-set! source-code-cycle |           (struct-set! source-code-cycle | ||||||
|                        last-called |                        last-called | ||||||
|                        (ts-now) |                        (ts-now) | ||||||
|                        buffer/source-code-cycle-state)) |                        buffer-source-code-cycle-state)) | ||||||
|       (progn |       (progn | ||||||
|         (funcall cycle-fn cycle) |         (funcall cycle-fn cycle) | ||||||
|         (switch-to-buffer (cycle/current cycle)))))) |         (switch-to-buffer (cycle-current cycle)))))) | ||||||
| 
 | 
 | ||||||
| (defun buffer/cycle-next () | (defun buffer-cycle-next () | ||||||
|   "Cycle forward through the `buffer/source-code-buffers'." |   "Cycle forward through the `buffer-source-code-buffers'." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (buffer/cycle #'cycle/next)) |   (buffer-cycle #'cycle-next)) | ||||||
| 
 | 
 | ||||||
| (defun buffer/cycle-prev () | (defun buffer-cycle-prev () | ||||||
|   "Cycle backward through the `buffer/source-code-buffers'." |   "Cycle backward through the `buffer-source-code-buffers'." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (buffer/cycle #'cycle/prev)) |   (buffer-cycle #'cycle-prev)) | ||||||
| 
 | 
 | ||||||
| (defun buffer/ivy-source-code () | (defun buffer-ivy-source-code () | ||||||
|   "Use `ivy-read' to choose among all open source code buffers." |   "Use `ivy-read' to choose among all open source code buffers." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (ivy-read "Source code buffer: " |   (ivy-read "Source code buffer: " | ||||||
|             (-drop 1 (buffer/source-code-buffers)) |             (-drop 1 (buffer-source-code-buffers)) | ||||||
|             :sort nil |             :sort nil | ||||||
|             :action #'switch-to-buffer)) |             :action #'switch-to-buffer)) | ||||||
| 
 | 
 | ||||||
| (defun buffer/show-previous () | (defun buffer-show-previous () | ||||||
|   "Call `switch-to-buffer' on the previously visited buffer. |   "Call `switch-to-buffer' on the previously visited buffer. | ||||||
| This function ignores Emacs-generated buffers, i.e. the ones that look like | 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: *Buffer*.  It also ignores buffers that are `dired-mode' or `erc-mode'. | ||||||
|   This blacklist can easily be changed." |   This blacklist can easily be changed." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let* ((xs (buffer/source-code-buffers)) |   (let* ((xs (buffer-source-code-buffers)) | ||||||
|          (candidate (list/get 1 xs))) |          (candidate (list-get 1 xs))) | ||||||
|     (prelude-assert (maybe-some? candidate)) |     (prelude-assert (maybe-some? candidate)) | ||||||
|     (switch-to-buffer candidate))) |     (switch-to-buffer candidate))) | ||||||
| 
 | 
 | ||||||
| (when buffer/install-kbds? | (when buffer-install-kbds? | ||||||
|   (general-define-key |   (general-define-key | ||||||
|    :states '(normal) |    :states '(normal) | ||||||
|    "C-f" #'buffer/cycle-next |    "C-f" #'buffer-cycle-next | ||||||
|    "C-b" #'buffer/cycle-prev) |    "C-b" #'buffer-cycle-prev) | ||||||
|   (general-define-key |   (general-define-key | ||||||
|    :prefix "<SPC>" |    :prefix "<SPC>" | ||||||
|    :states '(normal) |    :states '(normal) | ||||||
|    "b" #'buffer/ivy-source-code |    "b" #'buffer-ivy-source-code | ||||||
|    "<SPC>" #'buffer/show-previous |    "<SPC>" #'buffer-show-previous | ||||||
|    "k" #'kill-buffer)) |    "k" #'kill-buffer)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when buffer/enable-tests? | (when buffer-enable-tests? | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (list/all? #'buffer/emacs-generated? |    (list-all? #'buffer-emacs-generated? | ||||||
|               '("*scratch*" |               '("*scratch*" | ||||||
|                 "*Messages*" |                 "*Messages*" | ||||||
|                 "*shell*" |                 "*shell*" | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; bytes.el --- Working with byte values -*- lexical-binding: t -*- | ;;; bytes.el --- Working with byte values -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Functions to help with human-readable representations of byte values. | ;; Functions to help with human-readable representations of byte values. | ||||||
|  | @ -40,49 +44,49 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst bytes/kb (math/exp 2 10) | (defconst bytes-kb (math-exp 2 10) | ||||||
|   "Number of bytes in a kilobyte.") |   "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.") |   "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.") |   "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.") |   "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.") |   "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.") |   "Number of bytes in an exabyte.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Functions | ;; Functions | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun bytes/classify (x) | (defun bytes-classify (x) | ||||||
|   "Return unit that closest fits byte count, X." |   "Return unit that closest fits byte count, X." | ||||||
|   (prelude-assert (number/whole? x)) |   (prelude-assert (number-whole? x)) | ||||||
|   (cond |   (cond | ||||||
|    ((and (>= x 0)        (< x bytes/kb))     'byte) |    ((and (>= x 0)        (< x bytes-kb))     'byte) | ||||||
|    ((and (>= x bytes/kb) (< x bytes/mb)) 'kilobyte) |    ((and (>= x bytes-kb) (< x bytes-mb)) 'kilobyte) | ||||||
|    ((and (>= x bytes/mb) (< x bytes/gb)) 'megabyte) |    ((and (>= x bytes-mb) (< x bytes-gb)) 'megabyte) | ||||||
|    ((and (>= x bytes/gb) (< x bytes/tb)) 'gigabyte) |    ((and (>= x bytes-gb) (< x bytes-tb)) 'gigabyte) | ||||||
|    ((and (>= x bytes/tb) (< x bytes/pb)) 'terabyte) |    ((and (>= x bytes-tb) (< x bytes-pb)) 'terabyte) | ||||||
|    ((and (>= x bytes/pb) (< x bytes/eb)) 'petabyte))) |    ((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." |   "Convert integer X into a human-readable string." | ||||||
|   (let ((base-and-unit |   (let ((base-and-unit | ||||||
|          (pcase (bytes/classify x) |          (pcase (bytes-classify x) | ||||||
|            ('byte     (tuple/from        1 "B")) |            ('byte     (tuple/from        1 "B")) | ||||||
|            ('kilobyte (tuple/from bytes/kb "KB")) |            ('kilobyte (tuple/from bytes-kb "KB")) | ||||||
|            ('megabyte (tuple/from bytes/mb "MB")) |            ('megabyte (tuple/from bytes-mb "MB")) | ||||||
|            ('gigabyte (tuple/from bytes/gb "GB")) |            ('gigabyte (tuple/from bytes-gb "GB")) | ||||||
|            ('terabyte (tuple/from bytes/tb "TB")) |            ('terabyte (tuple/from bytes-tb "TB")) | ||||||
|            ('petabyte (tuple/from bytes/pb "PB"))))) |            ('petabyte (tuple/from bytes-pb "PB"))))) | ||||||
|     (string-format "%d%s" |     (string-format "%d%s" | ||||||
|                    (round x (tuple/first base-and-unit)) |                    (round x (tuple/first base-and-unit)) | ||||||
|                    (tuple/second base-and-unit)))) |                    (tuple/second base-and-unit)))) | ||||||
|  | @ -93,17 +97,17 @@ | ||||||
| 
 | 
 | ||||||
| (progn | (progn | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal "1000B" (bytes/to-string 1000))) |    (equal "1000B" (bytes-to-string 1000))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal "2KB" (bytes/to-string (* 2 bytes/kb)))) |    (equal "2KB" (bytes-to-string (* 2 bytes-kb)))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal "17MB" (bytes/to-string (* 17 bytes/mb)))) |    (equal "17MB" (bytes-to-string (* 17 bytes-mb)))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal "419GB" (bytes/to-string (* 419 bytes/gb)))) |    (equal "419GB" (bytes-to-string (* 419 bytes-gb)))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal "999TB" (bytes/to-string (* 999 bytes/tb)))) |    (equal "999TB" (bytes-to-string (* 999 bytes-tb)))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal "2PB" (bytes/to-string (* 2 bytes/pb))))) |    (equal "2PB" (bytes-to-string (* 2 bytes-pb))))) | ||||||
| 
 | 
 | ||||||
| (provide 'bytes) | (provide 'bytes) | ||||||
| ;;; bytes.el ends here | ;;; bytes.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; cache.el --- Caching things -*- lexical-binding: t -*- | ;;; cache.el --- Caching things -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; An immutable cache data structure. | ;; An immutable cache data structure. | ||||||
|  | @ -19,6 +23,10 @@ | ||||||
| 
 | 
 | ||||||
| ;;; Code: | ;;; Code: | ||||||
| 
 | 
 | ||||||
|  | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | ;; Dependencies | ||||||
|  | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | 
 | ||||||
| (require 'prelude) | (require 'prelude) | ||||||
| (require 'struct) | (require 'struct) | ||||||
| 
 | 
 | ||||||
|  | @ -31,24 +39,24 @@ | ||||||
| ;; TODO: Prefer another KBD for yasnippet form completion than company-mode's | ;; TODO: Prefer another KBD for yasnippet form completion than company-mode's | ||||||
| ;; current KBD. | ;; current KBD. | ||||||
| 
 | 
 | ||||||
| (defun cache/from-list (xs) | (defun cache-from-list (xs) | ||||||
|   "Turn list, XS, into a cache." |   "Turn list, XS, into a cache." | ||||||
|   (make-cache :xs xs)) |   (make-cache :xs xs)) | ||||||
| 
 | 
 | ||||||
| (defun cache/contains? (x xs) | (defun cache-contains? (x xs) | ||||||
|   "Return t if X in XS." |   "Return t if X in XS." | ||||||
|   (->> xs |   (->> xs | ||||||
|        cache-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. |   "Ensure value X in cache, XS, is front of the list. | ||||||
| If X isn't in XS (using `equal'), insert it at the front." | If X isn't in XS (using `equal'), insert it at the front." | ||||||
|   (struct-update |   (struct-update | ||||||
|    cache |    cache | ||||||
|    xs |    xs | ||||||
|    (>> (list/reject (lambda (y) (equal x y))) |    (>> (list-reject (lambda (y) (equal x y))) | ||||||
|        (list/cons x)) |        (list-cons x)) | ||||||
|    xs)) |    xs)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | @ -56,25 +64,25 @@ If X isn't in XS (using `equal'), insert it at the front." | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (progn | (progn | ||||||
|   (let ((cache (cache/from-list '("chicken" "nugget")))) |   (let ((cache (cache-from-list '("chicken" "nugget")))) | ||||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|     ;; contains?/2 |     ;; contains?/2 | ||||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|     (prelude-refute |     (prelude-refute | ||||||
|      (cache/contains? "turkey" cache)) |      (cache-contains? "turkey" cache)) | ||||||
|     (prelude-assert |     (prelude-assert | ||||||
|      (cache/contains? "chicken" cache)) |      (cache-contains? "chicken" cache)) | ||||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|     ;; touch/2 |     ;; touch/2 | ||||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|     (prelude-assert |     (prelude-assert | ||||||
|      (equal |      (equal | ||||||
|       (cache/touch "nugget" cache) |       (cache-touch "nugget" cache) | ||||||
|       (cache/from-list '("nugget" "chicken")))) |       (cache-from-list '("nugget" "chicken")))) | ||||||
|     (prelude-assert |     (prelude-assert | ||||||
|      (equal |      (equal | ||||||
|       (cache/touch "spicy" cache) |       (cache-touch "spicy" cache) | ||||||
|       (cache/from-list '("spicy" "chicken" "nugget")))))) |       (cache-from-list '("spicy" "chicken" "nugget")))))) | ||||||
| 
 | 
 | ||||||
| (provide 'cache) | (provide 'cache) | ||||||
| ;;; cache.el ends here | ;;; cache.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*- | ;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Simple functions for copying and pasting. | ;; Simple functions for copying and pasting. | ||||||
|  | @ -23,17 +27,17 @@ | ||||||
| ;; Library | ;; 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." |   "Copy string, X, to X11's clipboard." | ||||||
|   (kill-new x) |   (kill-new x) | ||||||
|   (message message)) |   (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." |   "Paste contents of X11 clipboard." | ||||||
|   (yank) |   (yank) | ||||||
|   (message message)) |   (message message)) | ||||||
| 
 | 
 | ||||||
| (defun clipboard/contents () | (defun clipboard-contents () | ||||||
|   "Return the contents of the clipboard as a string." |   "Return the contents of the clipboard as a string." | ||||||
|   (substring-no-properties (current-kill 0))) |   (substring-no-properties (current-kill 0))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*- | ;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; | ;; | ||||||
|  | @ -21,76 +25,76 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defcustom colorscheme/install-kbds? t | (defcustom colorscheme-install-kbds? t | ||||||
|   "If non-nil, enable the keybindings.") |   "If non-nil, enable the keybindings.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defcustom colorscheme/whitelist | (defcustom colorscheme-whitelist | ||||||
|   (cycle/from-list |   (cycle-from-list | ||||||
|    (->> (custom-available-themes) |    (->> (custom-available-themes) | ||||||
|         (list/map #'symbol-name) |         (list-map #'symbol-name) | ||||||
|         (list/filter (>> (s-starts-with? "doom-"))) |         (list-filter (>> (s-starts-with? "doom-"))) | ||||||
|         (list/map #'intern))) |         (list-map #'intern))) | ||||||
|   "The whitelist of colorschemes through which to cycle.") |   "The whitelist of colorschemes through which to cycle.") | ||||||
| 
 | 
 | ||||||
| (defun colorscheme/current () | (defun colorscheme-current () | ||||||
|   "Return the currently enabled colorscheme." |   "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." |   "Disable all currently enabled colorschemes." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (->> custom-enabled-themes |   (->> 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. |     "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." | There is no hook that I'm aware of to handle this more elegantly." | ||||||
|     (load-theme theme t) |     (load-theme theme t) | ||||||
|     (prelude-set-line-number-color "#da5468")) |     (prelude-set-line-number-color "#da5468")) | ||||||
| 
 | 
 | ||||||
| (defun colorscheme/whitelist-set (colorscheme) | (defun colorscheme-whitelist-set (colorscheme) | ||||||
|   "Focus the COLORSCHEME in the `colorscheme/whitelist' cycle." |   "Focus the COLORSCHEME in the `colorscheme-whitelist' cycle." | ||||||
|   (cycle/focus (lambda (x) (equal x colorscheme)) colorscheme/whitelist) |   (cycle-focus (lambda (x) (equal x colorscheme)) colorscheme-whitelist) | ||||||
|   (colorscheme/set (colorscheme/current))) |   (colorscheme-set (colorscheme-current))) | ||||||
| 
 | 
 | ||||||
| (defun colorscheme/ivy-select () | (defun colorscheme-ivy-select () | ||||||
|   "Load a colorscheme using ivy." |   "Load a colorscheme using ivy." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((theme (ivy-read "Theme: " (cycle/to-list colorscheme/whitelist)))) |   (let ((theme (ivy-read "Theme: " (cycle-to-list colorscheme-whitelist)))) | ||||||
|     (colorscheme/disable-all) |     (colorscheme-disable-all) | ||||||
|     (colorscheme/set (intern theme)))) |     (colorscheme-set (intern theme)))) | ||||||
| 
 | 
 | ||||||
| (cl-defun colorscheme/cycle (&key forward?) | (cl-defun colorscheme-cycle (&key forward?) | ||||||
|   "Cycle next if `FORWARD?' is non-nil. |   "Cycle next if `FORWARD?' is non-nil. | ||||||
| Cycle prev otherwise." | Cycle prev otherwise." | ||||||
|   (disable-theme (cycle/current colorscheme/whitelist)) |   (disable-theme (cycle-current colorscheme-whitelist)) | ||||||
|   (let ((theme (if forward? |   (let ((theme (if forward? | ||||||
|                    (cycle/next colorscheme/whitelist) |                    (cycle-next colorscheme-whitelist) | ||||||
|                  (cycle/prev colorscheme/whitelist)))) |                  (cycle-prev colorscheme-whitelist)))) | ||||||
|     (colorscheme/set theme) |     (colorscheme-set theme) | ||||||
|     (message (s-concat "Active theme: " (symbol-to-string theme))))) |     (message (s-concat "Active theme: " (symbol-to-string theme))))) | ||||||
| 
 | 
 | ||||||
| (defun colorscheme/next () | (defun colorscheme-next () | ||||||
|   "Disable the currently active theme and load the next theme." |   "Disable the currently active theme and load the next theme." | ||||||
|   (interactive) |   (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." |   "Disable the currently active theme and load the previous theme." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (colorscheme/cycle :forward? nil)) |   (colorscheme-cycle :forward? nil)) | ||||||
| 
 | 
 | ||||||
| ;; Keybindings | ;; Keybindings | ||||||
| (when colorscheme/install-kbds? | (when colorscheme-install-kbds? | ||||||
|   (general-define-key |   (general-define-key | ||||||
|    :prefix "<SPC>" |    :prefix "<SPC>" | ||||||
|    :states '(normal) |    :states '(normal) | ||||||
|    "Ft" #'colorscheme/next |    "Ft" #'colorscheme-next | ||||||
|    "Pt" #'colorscheme/prev)) |    "Pt" #'colorscheme-prev)) | ||||||
| 
 | 
 | ||||||
| (provide 'colorscheme) | (provide 'colorscheme) | ||||||
| ;;; colorscheme.el ends here | ;;; colorscheme.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; constants.el --- Constants for organizing my Emacs -*- lexical-binding: t -*- | ;;; 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: | ;;; Commentary: | ||||||
| ;; This file contains constants that are shared across my configuration. | ;; This file contains constants that are shared across my configuration. | ||||||
|  | @ -20,11 +24,11 @@ | ||||||
| ;; Configuration | ;; Configuration | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst constants/ci? | (defconst constants-ci? | ||||||
|   (maybe-some? (getenv "CI")) |   (maybe-some? (getenv "CI")) | ||||||
|   "True when Emacs is running in CI.") |   "True when Emacs is running in CI.") | ||||||
| 
 | 
 | ||||||
| (defconst constants/briefcase | (defconst constants-briefcase | ||||||
|   (getenv "BRIEFCASE") |   (getenv "BRIEFCASE") | ||||||
|   "Path to my monorepo, which various parts of my configuration rely on.") |   "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 | ;; current consumers of these constants, and I'm unsure if the indirection that | ||||||
| ;; globally defined constants introduces is worth it. | ;; globally defined constants introduces is worth it. | ||||||
| 
 | 
 | ||||||
| (defconst constants/current-project | (defconst constants-current-project | ||||||
|   constants/briefcase |   constants-briefcase | ||||||
|   "Variable holding the directory for my currently active project.") |   "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-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-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] |     [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]) |     [mouse-5] [down-mouse-5] [drag-mouse-5] [double-mouse-5] [triple-mouse-5]) | ||||||
|   "All of the mouse-related keybindings that Emacs recognizes.") |   "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.") |   "Variable used to set the defaults for wrapping, highlighting, etc.") | ||||||
| 
 | 
 | ||||||
| (provide 'constants) | (provide 'constants) | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; cycle.el --- Simple module for working with cycles. -*- lexical-binding: t -*- | ;;; cycle.el --- Simple module for working with cycles. -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Something like this may already exist, but I'm having trouble finding it, and | ;; Something like this may already exist, but I'm having trouble finding it, and | ||||||
|  | @ -21,7 +25,7 @@ | ||||||
| 
 | 
 | ||||||
| ;; - TODO: Provide immutable variant. | ;; - TODO: Provide immutable variant. | ||||||
| ;; - TODO: Replace mutable consumption with immutable variant. | ;; - TODO: Replace mutable consumption with immutable variant. | ||||||
| ;; - TODO: Replace indexing with (math/mod current cycle). | ;; - TODO: Replace indexing with (math-mod current cycle). | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Library | ;; Library | ||||||
|  | @ -31,10 +35,10 @@ | ||||||
| ;; `xs' is the original list | ;; `xs' is the original list | ||||||
| (cl-defstruct cycle current-index previous-index xs) | (cl-defstruct cycle current-index previous-index xs) | ||||||
| 
 | 
 | ||||||
| (defconst cycle/enable-tests? t | (defconst cycle-enable-tests? t | ||||||
|   "When t, run the tests defined herein.") |   "When t, run the tests defined herein.") | ||||||
| 
 | 
 | ||||||
| (defun cycle/from-list (xs) | (defun cycle-from-list (xs) | ||||||
|   "Create a cycle from a list of `XS'." |   "Create a cycle from a list of `XS'." | ||||||
|   (if (= 0 (length xs)) |   (if (= 0 (length xs)) | ||||||
|       (make-cycle :current-index nil |       (make-cycle :current-index nil | ||||||
|  | @ -44,11 +48,11 @@ | ||||||
|                 :previous-index nil |                 :previous-index nil | ||||||
|                 :xs xs))) |                 :xs xs))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/new (&rest xs) | (defun cycle-new (&rest xs) | ||||||
|   "Create a cycle with XS as the values." |   "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." |   "Return the list representation of a cycle, XS." | ||||||
|   (cycle-xs xs)) |   (cycle-xs xs)) | ||||||
| 
 | 
 | ||||||
|  | @ -70,7 +74,7 @@ | ||||||
|       lo |       lo | ||||||
|     (+ 1 x))) |     (+ 1 x))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/previous-focus (cycle) | (defun cycle-previous-focus (cycle) | ||||||
|   "Return the previously focused entry in CYCLE." |   "Return the previously focused entry in CYCLE." | ||||||
|   (let ((i (cycle-previous-index cycle))) |   (let ((i (cycle-previous-index cycle))) | ||||||
|     (if (maybe-some? i) |     (if (maybe-some? i) | ||||||
|  | @ -79,81 +83,81 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Consider adding "!" to the function name herein since many of them | ;; TODO: Consider adding "!" to the function name herein since many of them | ||||||
| ;; mutate the collection, and the APIs are beginning to confuse me. | ;; mutate the collection, and the APIs are beginning to confuse me. | ||||||
| (defun cycle/focus-previous! (xs) | (defun cycle-focus-previous! (xs) | ||||||
|   "Jump to the item in XS that was most recently focused; return the cycle. |   "Jump to the item in XS that was most recently focused; return the cycle. | ||||||
| This will error when previous-index is nil.  This function mutates the | This will error when previous-index is nil.  This function mutates the | ||||||
| underlying struct." | underlying struct." | ||||||
|   (let ((i (cycle-previous-index xs))) |   (let ((i (cycle-previous-index xs))) | ||||||
|     (if (maybe-some? i) |     (if (maybe-some? i) | ||||||
|         (progn |         (progn | ||||||
|           (cycle/jump i xs) |           (cycle-jump i xs) | ||||||
|           (cycle/current xs)) |           (cycle-current xs)) | ||||||
|       (error "Cannot focus the previous element since cycle-previous-index is nil")))) |       (error "Cannot focus the previous element since cycle-previous-index is nil")))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/next (xs) | (defun cycle-next (xs) | ||||||
|   "Return the next value in `XS' and update `current-index'." |   "Return the next value in `XS' and update `current-index'." | ||||||
|   (let* ((current-index (cycle-current-index xs)) |   (let* ((current-index (cycle-current-index xs)) | ||||||
|          (next-index (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 previous-index current-index xs) | ||||||
|     (struct-set! cycle current-index next-index xs) |     (struct-set! cycle current-index next-index xs) | ||||||
|     (nth next-index (cycle-xs xs)))) |     (nth next-index (cycle-xs xs)))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/prev (xs) | (defun cycle-prev (xs) | ||||||
|   "Return the previous value in `XS' and update `current-index'." |   "Return the previous value in `XS' and update `current-index'." | ||||||
|   (let* ((current-index (cycle-current-index xs)) |   (let* ((current-index (cycle-current-index xs)) | ||||||
|          (next-index (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 previous-index current-index xs) | ||||||
|     (struct-set! cycle current-index next-index xs) |     (struct-set! cycle current-index next-index xs) | ||||||
|     (nth next-index (cycle-xs xs)))) |     (nth next-index (cycle-xs xs)))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/current (cycle) | (defun cycle-current (cycle) | ||||||
|   "Return the current value in `CYCLE'." |   "Return the current value in `CYCLE'." | ||||||
|   (nth (cycle-current-index cycle) (cycle-xs cycle))) |   (nth (cycle-current-index cycle) (cycle-xs cycle))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/count (cycle) | (defun cycle-count (cycle) | ||||||
|   "Return the length of `xs' in `CYCLE'." |   "Return the length of `xs' in `CYCLE'." | ||||||
|   (length (cycle-xs cycle))) |   (length (cycle-xs cycle))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/jump (i xs) | (defun cycle-jump (i xs) | ||||||
|   "Jump to the I index of XS." |   "Jump to the I index of XS." | ||||||
|   (let ((current-index (cycle-current-index xs)) |   (let ((current-index (cycle-current-index xs)) | ||||||
|         (next-index (math/mod i (cycle/count xs)))) |         (next-index (math-mod i (cycle-count xs)))) | ||||||
|     (struct-set! cycle previous-index current-index xs) |     (struct-set! cycle previous-index current-index xs) | ||||||
|     (struct-set! cycle current-index next-index xs)) |     (struct-set! cycle current-index next-index xs)) | ||||||
|   xs) |   xs) | ||||||
| 
 | 
 | ||||||
| (defun cycle/focus (p cycle) | (defun cycle-focus (p cycle) | ||||||
|   "Focus the element in CYCLE for which predicate, P, is t." |   "Focus the element in CYCLE for which predicate, P, is t." | ||||||
|   (let ((i (->> cycle |   (let ((i (->> cycle | ||||||
|                 cycle-xs |                 cycle-xs | ||||||
|                 (-find-index p)))) |                 (-find-index p)))) | ||||||
|     (if i |     (if i | ||||||
|         (cycle/jump i cycle) |         (cycle-jump i cycle) | ||||||
|       (error "No element in cycle matches predicate")))) |       (error "No element in cycle matches predicate")))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/focus-item (x xs) | (defun cycle-focus-item (x xs) | ||||||
|   "Focus ITEM in cycle XS. |   "Focus ITEM in cycle XS. | ||||||
| ITEM is the first item in XS that t for `equal'." | ITEM is the first item in XS that t for `equal'." | ||||||
|   (cycle/focus (lambda (y) (equal x y)) xs)) |   (cycle-focus (lambda (y) (equal x y)) xs)) | ||||||
| 
 | 
 | ||||||
| (defun cycle/contains? (x xs) | (defun cycle-contains? (x xs) | ||||||
|   "Return t if cycle, XS, has member X." |   "Return t if cycle, XS, has member X." | ||||||
|   (->> xs |   (->> xs | ||||||
|        cycle-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." |   "Return t if cycle XS has no elements." | ||||||
|   (= 0 (length (cycle-xs xs)))) |   (= 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." |   "Return t if cycle XS has a non-nil value for current-index." | ||||||
|   (maybe-some? (cycle-current-index xs))) |   (maybe-some? (cycle-current-index xs))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/append (x xs) | (defun cycle-append (x xs) | ||||||
|   "Add X to the left of the focused element in XS. |   "Add X to the left of the focused element in XS. | ||||||
| If there is no currently focused item, add X to the beginning of XS." | If there is no currently focused item, add X to the beginning of XS." | ||||||
|   (if (cycle/empty? xs) |   (if (cycle-empty? xs) | ||||||
|       (progn |       (progn | ||||||
|         (struct-set! cycle xs (list x) xs) |         (struct-set! cycle xs (list x) xs) | ||||||
|         (struct-set! cycle current-index 0 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)))) |           (when prev-i (struct-set! cycle previous-index (1+ prev-i) xs)))) | ||||||
|       xs))) |       xs))) | ||||||
| 
 | 
 | ||||||
| (defun cycle/remove (x xs) | (defun cycle-remove (x xs) | ||||||
|   "Attempt to remove X from XS. |   "Attempt to remove X from XS. | ||||||
| 
 | 
 | ||||||
| X is found using `equal'. | X is found using `equal'. | ||||||
|  | @ -194,25 +198,25 @@ If X is the currently focused value, after it's deleted, current-index will be | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when cycle/enable-tests? | (when cycle-enable-tests? | ||||||
|   (let ((xs (cycle/new 1 2 3))) |   (let ((xs (cycle-new 1 2 3))) | ||||||
|     (prelude-assert (maybe-nil? (cycle/previous-focus xs))) |     (prelude-assert (maybe-nil? (cycle-previous-focus xs))) | ||||||
|     (prelude-assert (= 1 (cycle/current xs))) |     (prelude-assert (= 1 (cycle-current xs))) | ||||||
|     (prelude-assert (= 2 (cycle/next xs))) |     (prelude-assert (= 2 (cycle-next xs))) | ||||||
|     (prelude-assert (= 1 (cycle/previous-focus xs))) |     (prelude-assert (= 1 (cycle-previous-focus xs))) | ||||||
|     (prelude-assert (= 1 (->> xs (cycle/jump 0) cycle/current))) |     (prelude-assert (= 1 (->> xs (cycle-jump 0) cycle-current))) | ||||||
|     (prelude-assert (= 2 (->> xs (cycle/jump 1) cycle/current))) |     (prelude-assert (= 2 (->> xs (cycle-jump 1) cycle-current))) | ||||||
|     (prelude-assert (= 3 (->> xs (cycle/jump 2) cycle/current))) |     (prelude-assert (= 3 (->> xs (cycle-jump 2) cycle-current))) | ||||||
|     (prelude-assert (= 2 (cycle/previous-focus xs))) |     (prelude-assert (= 2 (cycle-previous-focus xs))) | ||||||
|     (prelude-assert (= 2 (cycle/focus-previous! xs))) |     (prelude-assert (= 2 (cycle-focus-previous! xs))) | ||||||
|     (prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle/append 4 xs)))) |     (prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle-append 4 xs)))) | ||||||
|     (prelude-assert (equal '(1 2 3) (cycle-xs (cycle/remove 4 xs)))) |     (prelude-assert (equal '(1 2 3) (cycle-xs (cycle-remove 4 xs)))) | ||||||
|     (progn |     (progn | ||||||
|       (cycle/focus-item 3 xs) |       (cycle-focus-item 3 xs) | ||||||
|       (cycle/focus-item 2 xs) |       (cycle-focus-item 2 xs) | ||||||
|       (cycle/remove 1 xs) |       (cycle-remove 1 xs) | ||||||
|       (prelude-assert (= 2 (cycle/current xs))) |       (prelude-assert (= 2 (cycle-current xs))) | ||||||
|       (prelude-assert (= 3 (cycle/previous-focus xs)))))) |       (prelude-assert (= 3 (cycle-previous-focus xs)))))) | ||||||
| 
 | 
 | ||||||
| (provide 'cycle) | (provide 'cycle) | ||||||
| ;;; cycle.el ends here | ;;; cycle.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; device.el --- Physical device information -*- lexical-binding: t -*- | ;;; device.el --- Physical device information -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Functions for querying device information. | ;; Functions for querying device information. | ||||||
|  | @ -13,30 +17,30 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst device/hostname->device | (defconst device-hostname->device | ||||||
|   '(("zeno.lon.corp.google.com" . work-desktop) |   '(("zeno.lon.corp.google.com" . work-desktop) | ||||||
|     ("seneca" . work-laptop)) |     ("seneca" . work-laptop)) | ||||||
|   "Mapping hostname to a device symbol.") |   "Mapping hostname to a device symbol.") | ||||||
| 
 | 
 | ||||||
| ;; TODO: Should I generate these predicates? | ;; 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." |   "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." |   "Return t if current device is work laptop." | ||||||
|   (equal '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." |   "Return t if current device is work desktop." | ||||||
|   (equal '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." |   "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) | (provide 'device) | ||||||
| ;;; device.el ends here | ;;; device.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*- | ;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Mostly wrappers around xrandr. | ;; Mostly wrappers around xrandr. | ||||||
|  | @ -24,15 +28,15 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| ;; TODO: Consider if this logic should be conditioned by `device/work-laptop?'. | ;; TODO: Consider if this logic should be conditioned by `device-work-laptop?'. | ||||||
| (defconst display/laptop-monitor "eDP1" | (defconst display-laptop-monitor "eDP1" | ||||||
|   "The xrandr identifier for my primary screen (on work laptop).") |   "The xrandr identifier for my primary screen (on work laptop).") | ||||||
| 
 | 
 | ||||||
| ;; TODO: Why is HDMI-1, eDP-1 sometimes and HDMI1, eDP1 other times. | ;; 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.") |   "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. |   "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 | The car models the enabled state of my laptop display; the cdr models the | ||||||
|   enabled state of my external monitor.") |   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 | ;; TODO: Debug why something this scales to 4k appropriately and other times it | ||||||
| ;; doesn't. | ;; doesn't. | ||||||
| (defun display/enable-4k () | (defun display-enable-4k () | ||||||
|   "Attempt to connect to my 4K monitor." |   "Attempt to connect to my 4K monitor." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (prelude-start-process |   (prelude-start-process | ||||||
|    :name "display/enable-4k" |    :name "display-enable-4k" | ||||||
|    :command (string-format |    :command (string-format | ||||||
|              "xrandr --output %s --above %s --primary --auto --size 3840x2160 --rate 30.00 --dpi 144" |              "xrandr --output %s --above %s --primary --auto --size 3840x2160 --rate 30.00 --dpi 144" | ||||||
|              display/4k-monitor |              display-4k-monitor | ||||||
|              display/laptop-monitor))) |              display-laptop-monitor))) | ||||||
| 
 | 
 | ||||||
| (defun display/disable-4k () | (defun display-disable-4k () | ||||||
|   "Disconnect from the 4K monitor." |   "Disconnect from the 4K monitor." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (prelude-start-process |   (prelude-start-process | ||||||
|    :name "display/disable-4k" |    :name "display-disable-4k" | ||||||
|    :command (string-format "xrandr --output %s --off" |    :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. |   "Turn the laptop monitor off. | ||||||
| Sometimes this is useful when I'm sharing my screen in a Google Hangout and I | Sometimes this is useful when I'm sharing my screen in a Google Hangout and I | ||||||
|   only want to present one of my monitors." |   only want to present one of my monitors." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (prelude-start-process |   (prelude-start-process | ||||||
|    :name "display/disable-laptop" |    :name "display-disable-laptop" | ||||||
|    :command (string-format "xrandr --output %s --auto" |    :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. |   "Turn the laptop monitor off. | ||||||
| Sometimes this is useful when I'm sharing my screen in a Google Hangout and I | Sometimes this is useful when I'm sharing my screen in a Google Hangout and I | ||||||
|   only want to present one of my monitors." |   only want to present one of my monitors." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (prelude-start-process |   (prelude-start-process | ||||||
|    :name "display/disable-laptop" |    :name "display-disable-laptop" | ||||||
|    :command (string-format "xrandr --output %s --off" |    :command (string-format "xrandr --output %s --off" | ||||||
|                            display/laptop-monitor))) |                            display-laptop-monitor))) | ||||||
| 
 | 
 | ||||||
| (defun display/cycle-display-states () | (defun display-cycle-display-states () | ||||||
|   "Cycle through `display/display-states' enabling and disabling displays." |   "Cycle through `display-display-states' enabling and disabling displays." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((state (cycle/next display/display-states))) |   (let ((state (cycle-next display-display-states))) | ||||||
|     (if (car state) (display/enable-laptop) (display/disable-laptop)) |     (if (car state) (display-enable-laptop) (display-disable-laptop)) | ||||||
|     (if (cdr state) (display/enable-4k) (display/disable-4k)))) |     (if (cdr state) (display-enable-4k) (display-disable-4k)))) | ||||||
| 
 | 
 | ||||||
| (provide 'display) | (provide 'display) | ||||||
| ;;; display.el ends here | ;;; display.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; dotted.el --- Working with dotted pairs in Elisp -*- lexical-binding: t -*- | ;;; dotted.el --- Working with dotted pairs in Elisp -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Part of my primitives library extensions in Elisp.  Contrast my primitives | ;; Part of my primitives library extensions in Elisp.  Contrast my primitives | ||||||
|  | @ -9,6 +13,10 @@ | ||||||
| 
 | 
 | ||||||
| ;;; Code: | ;;; Code: | ||||||
| 
 | 
 | ||||||
|  | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | ;; Dependencies | ||||||
|  | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | 
 | ||||||
| (require 'prelude) | (require 'prelude) | ||||||
| (require 'macros) | (require 'macros) | ||||||
| 
 | 
 | ||||||
|  | @ -16,20 +24,20 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (cl-defun dotted/new (&optional a b) | (cl-defun dotted-new (&optional a b) | ||||||
|   "Create a new dotted pair (i.e. cons cell)." |   "Create a new dotted pair (i.e. cons cell)." | ||||||
|   (cons a b)) |   (cons a b)) | ||||||
| 
 | 
 | ||||||
| (defun dotted/instance? (x) | (defun dotted-instance? (x) | ||||||
|   "Return t if X is a dotted pair." |   "Return t if X is a dotted pair." | ||||||
|   (let ((b (cdr x))) |   (let ((b (cdr x))) | ||||||
|     (and b (atom b)))) |     (and b (atom b)))) | ||||||
| 
 | 
 | ||||||
| (defun dotted/first (x) | (defun dotted-first (x) | ||||||
|   "Return the first element of X." |   "Return the first element of X." | ||||||
|   (car x)) |   (car x)) | ||||||
| 
 | 
 | ||||||
| (defun dotted/second (x) | (defun dotted-second (x) | ||||||
|   "Return the second element of X." |   "Return the second element of X." | ||||||
|   (cdr x)) |   (cdr x)) | ||||||
| 
 | 
 | ||||||
|  | @ -39,11 +47,11 @@ | ||||||
| 
 | 
 | ||||||
| (progn | (progn | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal '(fname . "Bob") (dotted/new 'fname "Bob"))) |    (equal '(fname . "Bob") (dotted-new 'fname "Bob"))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (dotted/instance? '(one . two))) |    (dotted-instance? '(one . two))) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (dotted/instance? '(1 2 3)))) |    (dotted-instance? '(1 2 3)))) | ||||||
| 
 | 
 | ||||||
| (provide 'dotted) | (provide 'dotted) | ||||||
| ;;; dotted.el ends here | ;;; dotted.el ends here | ||||||
|  |  | ||||||
|  | @ -23,7 +23,9 @@ | ||||||
| 
 | 
 | ||||||
| (setq notmuch-saved-searches | (setq notmuch-saved-searches | ||||||
|       '((:name "inbox" :query "tag:inbox" :key "i") |       '((: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 "action" :query "tag:action" :key "a") | ||||||
|         (:name "review" :query "tag:review" :key "r") |         (:name "review" :query "tag:review" :key "r") | ||||||
|         (:name "waiting" :query "tag:waiting" :key "w") |         (:name "waiting" :query "tag:waiting" :key "w") | ||||||
|  | @ -69,7 +71,7 @@ | ||||||
| 
 | 
 | ||||||
| ;; Assert that no two saved searches share share a KBD | ;; Assert that no two saved searches share share a KBD | ||||||
| (prelude-assert | (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) | (provide 'email) | ||||||
| ;;; email.el ends here | ;;; email.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; fonts.el --- Font preferences -*- lexical-binding: t -*- | ;;; fonts.el --- Font preferences -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Control my font preferences with ELisp. | ;; Control my font preferences with ELisp. | ||||||
|  | @ -8,7 +12,6 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: `defcustom' font-size. | ;; TODO: `defcustom' font-size. | ||||||
| ;; TODO: `defcustom' fonts. | ;; TODO: `defcustom' fonts. | ||||||
| ;; TODO: Remove wpc/ namespace. |  | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Dependencies | ;; Dependencies | ||||||
|  | @ -27,16 +30,16 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Consider having a different font size when I'm using my 4K monitor. | ;; TODO: Consider having a different font size when I'm using my 4K monitor. | ||||||
| 
 | 
 | ||||||
| (defconst fonts/size | (defconst fonts-size | ||||||
|   (pcase (device/classify) |   (pcase (device-classify) | ||||||
|     ('work-laptop "10") |     ('work-laptop "10") | ||||||
|     ('work-desktop "8")) |     ('work-desktop "8")) | ||||||
|   "My preferred default font-size, which is device specific.") |   "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.") |   "The amount (%) by which to increase or decrease a font.") | ||||||
| 
 | 
 | ||||||
| (defconst fonts/hacker-news-recommendations | (defconst fonts-hacker-news-recommendations | ||||||
|   '("APL385 Unicode" |   '("APL385 Unicode" | ||||||
|     "Go Mono" |     "Go Mono" | ||||||
|     "Sudo" |     "Sudo" | ||||||
|  | @ -45,10 +48,10 @@ | ||||||
|     ) |     ) | ||||||
|   "List of fonts optimized for programming I found in a HN article.") |   "List of fonts optimized for programming I found in a HN article.") | ||||||
| 
 | 
 | ||||||
| (defconst fonts/whitelist | (defconst fonts-whitelist | ||||||
|   (cycle/from-list |   (cycle-from-list | ||||||
|    (list/concat |    (list-concat | ||||||
|     fonts/hacker-news-recommendations |     fonts-hacker-news-recommendations | ||||||
|     '("JetBrainsMono" |     '("JetBrainsMono" | ||||||
|       "Mononoki Medium" |       "Mononoki Medium" | ||||||
|       "Monospace" |       "Monospace" | ||||||
|  | @ -63,75 +66,75 @@ | ||||||
| ;; Functions | ;; Functions | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| ;; TODO: fonts and fonts/whitelist make it difficult to name functions like | ;; 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. | ;; 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." |   "Cycle forwards when `FORWARD?' non-nil." | ||||||
|   (let ((font (if forward? |   (let ((font (if forward? | ||||||
|                   (cycle/next fonts/whitelist) |                   (cycle-next fonts-whitelist) | ||||||
|                 (cycle/prev fonts/whitelist)))) |                 (cycle-prev fonts-whitelist)))) | ||||||
|     (message (s-concat "Active font: " font)) |     (message (s-concat "Active font: " font)) | ||||||
|     (fonts/set font))) |     (fonts-set font))) | ||||||
| 
 | 
 | ||||||
| (defun fonts/next () | (defun fonts-next () | ||||||
|   "Quickly cycle through preferred fonts." |   "Quickly cycle through preferred fonts." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (fonts/cycle :forward? t)) |   (fonts-cycle :forward? t)) | ||||||
| 
 | 
 | ||||||
| (defun fonts/prev () | (defun fonts-prev () | ||||||
|   "Quickly cycle through preferred fonts." |   "Quickly cycle through preferred fonts." | ||||||
|   (interactive) |   (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." |   "Change the font to `FONT' with option integer, SIZE, in pixels." | ||||||
|   (if (maybe-some? size) |   (if (maybe-some? size) | ||||||
|       (set-frame-font (string-format "%s %s" font size) nil t) |       (set-frame-font (string-format "%s %s" font size) nil t) | ||||||
|     (set-frame-font font nil t))) |     (set-frame-font font nil t))) | ||||||
| 
 | 
 | ||||||
| (defun fonts/whitelist-set (font) | (defun fonts-whitelist-set (font) | ||||||
|   "Focuses the FONT in the `fonts/whitelist' cycle. |   "Focuses the FONT in the `fonts-whitelist' cycle. | ||||||
| The size of the font is determined by `fonts/size'." | The size of the font is determined by `fonts-size'." | ||||||
|   (prelude-assert (cycle/contains? font fonts/whitelist)) |   (prelude-assert (cycle-contains? font fonts-whitelist)) | ||||||
|   (cycle/focus (lambda (x) (equal x font)) fonts/whitelist) |   (cycle-focus (lambda (x) (equal x font)) fonts-whitelist) | ||||||
|   (fonts/set (fonts/current) fonts/size)) |   (fonts-set (fonts-current) fonts-size)) | ||||||
| 
 | 
 | ||||||
| (defun fonts/ivy-select () | (defun fonts-ivy-select () | ||||||
|   "Select a font from an ivy prompt." |   "Select a font from an ivy prompt." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (fonts/whitelist-set |   (fonts-whitelist-set | ||||||
|    (ivy-read "Font: " (cycle/to-list fonts/whitelist)))) |    (ivy-read "Font: " (cycle-to-list fonts-whitelist)))) | ||||||
| 
 | 
 | ||||||
| (defun fonts/print-current () | (defun fonts-print-current () | ||||||
|   "Message the currently enabled font." |   "Message the currently enabled font." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (message |   (message | ||||||
|    (string-format "[fonts] Current font: \"%s\"" |    (string-format "[fonts] Current font: \"%s\"" | ||||||
|                   (fonts/current)))) |                   (fonts-current)))) | ||||||
| 
 | 
 | ||||||
| (defun fonts/current () | (defun fonts-current () | ||||||
|   "Return the currently enabled font." |   "Return the currently enabled font." | ||||||
|   (cycle/current fonts/whitelist)) |   (cycle-current fonts-whitelist)) | ||||||
| 
 | 
 | ||||||
| (defun fonts/increase-size () | (defun fonts-increase-size () | ||||||
|   "Increase font size." |   "Increase font size." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (->> (face-attribute 'default :height) |   (->> (face-attribute 'default :height) | ||||||
|        (+ fonts/size-step) |        (+ fonts-size-step) | ||||||
|        (set-face-attribute 'default (selected-frame) :height))) |        (set-face-attribute 'default (selected-frame) :height))) | ||||||
| 
 | 
 | ||||||
| (defun fonts/decrease-size () | (defun fonts-decrease-size () | ||||||
|   "Decrease font size." |   "Decrease font size." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (->> (face-attribute 'default :height) |   (->> (face-attribute 'default :height) | ||||||
|        (+ (- fonts/size-step)) |        (+ (- fonts-size-step)) | ||||||
|        (set-face-attribute 'default (selected-frame) :height))) |        (set-face-attribute 'default (selected-frame) :height))) | ||||||
| 
 | 
 | ||||||
| (defun fonts/reset-size () | (defun fonts-reset-size () | ||||||
|   "Restore font size to its default value." |   "Restore font size to its default value." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (fonts/whitelist-set (fonts/current))) |   (fonts-whitelist-set (fonts-current))) | ||||||
| 
 | 
 | ||||||
| (provide 'fonts) | (provide 'fonts) | ||||||
| ;;; fonts.el ends here | ;;; fonts.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*- | ;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.1")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Ergonomic alternatives for working with the filesystem. | ;; Ergonomic alternatives for working with the filesystem. | ||||||
|  | @ -10,31 +14,33 @@ | ||||||
| ;; Dependencies | ;; Dependencies | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
|  | (require 'dash) | ||||||
| (require 'f) | (require 'f) | ||||||
|  | (require 's) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun fs/ensure-file (path) | (defun fs-ensure-file (path) | ||||||
|   "Ensure that a file and its directories in `PATH' exist. |   "Ensure that a file and its directories in `PATH' exist. | ||||||
| Will error for inputs with a trailing slash." | Will error for inputs with a trailing slash." | ||||||
|   (when (s-ends-with? "/" path) |   (when (s-ends-with? "/" path) | ||||||
|     (error (format "Input path has trailing slash: %s" path))) |     (error (format "Input path has trailing slash: %s" path))) | ||||||
|   (->> path |   (->> path | ||||||
|        f-dirname |        f-dirname | ||||||
|        fs/ensure-dir) |        fs-ensure-dir) | ||||||
|   (f-touch path)) |   (f-touch path)) | ||||||
| 
 | 
 | ||||||
| (f-dirname "/tmp/a/b/file.txt") | (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." |   "Ensure that a directory and its ancestor directories in `PATH' exist." | ||||||
|   (->> path |   (->> path | ||||||
|        f-split |        f-split | ||||||
|        (apply #'f-mkdir))) |        (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. |   "List the files in `DIR' one-level deep. | ||||||
| Should behave similarly in spirit to the Unix command, ls. | Should behave similarly in spirit to the Unix command, ls. | ||||||
| If `FULL-PATH?' is set, return the full-path of the files." | 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 | ;; 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")) |   (let ((file "/tmp/file/a/b/c/file.txt")) | ||||||
|     ;; Ensure this file doesn't exist first to prevent false-positives. |     ;; Ensure this file doesn't exist first to prevent false-positives. | ||||||
|     (f-delete file t) |     (f-delete file t) | ||||||
|     (fs/ensure-file file) |     (fs-ensure-file file) | ||||||
|     (should (and (f-exists? file) |     (should (and (f-exists? file) | ||||||
|                  (f-file? file))))) |                  (f-file? file))))) | ||||||
| 
 | 
 | ||||||
| (ert-deftest fs/test/ensure-dir () | (ert-deftest fs-test-ensure-dir () | ||||||
|   (let ((dir "/tmp/dir/a/b/c")) |   (let ((dir "/tmp/dir/a/b/c")) | ||||||
|     ;; Ensure the directory doesn't exist. |     ;; Ensure the directory doesn't exist. | ||||||
|     (f-delete dir t) |     (f-delete dir t) | ||||||
|     (fs/ensure-dir dir) |     (fs-ensure-dir dir) | ||||||
|     (should (and (f-exists? dir) |     (should (and (f-exists? dir) | ||||||
|                  (f-dir? dir))))) |                  (f-dir? dir))))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -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> | ;; Author: William Carroll <wpcarro@gmail.com> | ||||||
|  | ;; Version: 0.0.1 | ||||||
|  | ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||||
|  | ;; Package-Requires: ((emacs "24")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; This file hopefully contains friendly APIs that making ELisp development more | ;; This file hopefully contains friendly APIs that making ELisp development more | ||||||
|  | @ -8,114 +12,30 @@ | ||||||
| ;; TODO: Break these out into separate modules. | ;; TODO: Break these out into separate modules. | ||||||
| 
 | 
 | ||||||
| ;;; Code: | ;;; Code: | ||||||
| (defun wpc/evil-window-vsplit-right () | (defun functions-evil-window-vsplit-right () | ||||||
|   (interactive) |   (interactive) | ||||||
|   (evil-window-vsplit) |   (evil-window-vsplit) | ||||||
|   (windmove-right)) |   (windmove-right)) | ||||||
| 
 | 
 | ||||||
| (defun wpc/evil-window-split-down () | (defun functions-evil-window-split-down () | ||||||
|   (interactive) |   (interactive) | ||||||
|   (evil-window-split) |   (evil-window-split) | ||||||
|   (windmove-down)) |   (windmove-down)) | ||||||
| 
 | 
 | ||||||
| (defun wpc/reindent-defun-and-align-clojure-map () | (defun functions-create-snippet () | ||||||
|   (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 () |  | ||||||
|   "Creates a window split and then opens the Yasnippet editor." |   "Creates a window split and then opens the Yasnippet editor." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (evil-window-vsplit) |   (evil-window-vsplit) | ||||||
|   (call-interactively #'yas-new-snippet)) |   (call-interactively #'yas-new-snippet)) | ||||||
| 
 | 
 | ||||||
| (defun wpc/jump-to-parent-file () | (defun functions-evil-replace-under-point () | ||||||
|   "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 () |  | ||||||
|   "Faster than typing %s//thing/g." |   "Faster than typing %s//thing/g." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((term (s-replace "/" "\\/" (symbol-to-string (symbol-at-point))))) |   (let ((term (s-replace "/" "\\/" (symbol-to-string (symbol-at-point))))) | ||||||
|     (save-excursion |     (save-excursion | ||||||
|       (evil-ex (concat "%s/\\b" term "\\b/"))))) |       (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." |   "Return the directory name of the current buffer as a string." | ||||||
|   (->> buffer-file-name |   (->> buffer-file-name | ||||||
|        f-dirname |        f-dirname | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; graph.el --- Working with in-memory graphs -*- lexical-binding: t -*- | ;;; graph.el --- Working with in-memory graphs -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; | ;; | ||||||
|  | @ -42,44 +46,44 @@ | ||||||
| (cl-defstruct graph neighbors edges) | (cl-defstruct graph neighbors edges) | ||||||
| 
 | 
 | ||||||
| ;; TODO: How do you find the starting point for a topo sort? | ;; 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.") |   "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. |   "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 | The user must pass in a valid Edge List since asserting on the shape of XS might | ||||||
|   be expensive." |   be expensive." | ||||||
|   (make-graph :edges xs)) |   (make-graph :edges xs)) | ||||||
| 
 | 
 | ||||||
| (defun graph/from-neighbors (xs) | (defun graph-from-neighbors (xs) | ||||||
|   "Create a graph struct from a Neighbors Table, 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 | The user must pass in a valid Neighbors Table since asserting on the shape of | ||||||
|   XS might be expensive." |   XS might be expensive." | ||||||
|   (make-graph :neighbors xs)) |   (make-graph :neighbors xs)) | ||||||
| 
 | 
 | ||||||
| (defun graph/instance? (xs) | (defun graph-instance? (xs) | ||||||
|   "Return t if XS is a graph struct." |   "Return t if XS is a graph struct." | ||||||
|   (graph-p xs)) |   (graph-p xs)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Model each of the mapping functions into an isomorphism. | ;; 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." |   "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." |   "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. | ;; Below are three different models of the same unweighted, directed graph. | ||||||
| 
 | 
 | ||||||
| (defvar graph/edges | (defvar graph-edges | ||||||
|   '((a . b) (a . c) (a . e) |   '((a . b) (a . c) (a . e) | ||||||
|     (b . c) (b . d) |     (b . c) (b . d) | ||||||
|     (c . e) |     (c . e) | ||||||
|     (d . f) |     (d . f) | ||||||
|     (e . d) (e . f))) |     (e . d) (e . f))) | ||||||
| 
 | 
 | ||||||
| (defvar graph/neighbors | (defvar graph-neighbors | ||||||
|   ((a b c e) |   ((a b c e) | ||||||
|    (b c d) |    (b c d) | ||||||
|    (c e) |    (c e) | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; irc.el --- Configuration for IRC chat -*- lexical-binding: t -*- | ;;; irc.el --- Configuration for IRC chat -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Need to decide which client I will use for IRC. | ;; Need to decide which client I will use for IRC. | ||||||
|  | @ -24,47 +28,47 @@ | ||||||
| ;; Configuration | ;; Configuration | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst irc/enable-tests? t | (defconst irc-enable-tests? t | ||||||
|   "When t, run the tests defined herein.") |   "When t, run the tests defined herein.") | ||||||
| 
 | 
 | ||||||
| (setq erc-rename-buffers t) | (setq erc-rename-buffers t) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Find a way to avoid putting "freenode" and "#freenode" as channels | ;; 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 | ;; 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 | ;; "freenode", so when `irc-next-channel' is called, it 404s on the | ||||||
| ;; `cycle/contains?' call in `irc/channel->cycle" unless "freenode" is there. To | ;; `cycle-contains?' call in `irc-channel->cycle" unless "freenode" is there. To | ||||||
| ;; make matters even uglier, when `erc-join-channel' is called with "freenode" | ;; make matters even uglier, when `erc-join-channel' is called with "freenode" | ||||||
| ;; as the value, it connects to the "#freenode" channel, so unless "#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. | ;; pass my smell test. | ||||||
| (defconst irc/server->channels | (defconst irc-server->channels | ||||||
|   `(("irc.freenode.net"    . ,(cycle/new "freenode" "#freenode" "#nixos" "#emacs" "#pass")) |   `(("irc.freenode.net"    . ,(cycle-new "freenode" "#freenode" "#nixos" "#emacs" "#pass")) | ||||||
|     ("irc.corp.google.com" . ,(cycle/new "#omg" "#london" "#panic" "#prod-team"))) |     ("irc.corp.google.com" . ,(cycle-new "#omg" "#london" "#panic" "#prod-team"))) | ||||||
|   "Mapping of IRC servers to a cycle of my preferred channels.") |   "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 | ;; 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. | ;; function. This will probably be an O(n^2) operation. | ||||||
| (prelude-assert | (prelude-assert | ||||||
|  (set/distinct? (set/from-list |  (set-distinct? (set-from-list | ||||||
|                  (cycle/to-list |                  (cycle-to-list | ||||||
|                   (alist/get "irc.freenode.net" |                   (alist-get "irc.freenode.net" | ||||||
|                              irc/server->channels))) |                              irc-server->channels))) | ||||||
|                 (set/from-list |                 (set-from-list | ||||||
|                  (cycle/to-list |                  (cycle-to-list | ||||||
|                   (alist/get "irc.corp.google.com" |                   (alist-get "irc.corp.google.com" | ||||||
|                              irc/server->channels))))) |                              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." |   "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))) |                             server->channels))) | ||||||
|     (prelude-assert (maybe-some? result)) |     (prelude-assert (maybe-some? result)) | ||||||
|     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." |   "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)) |              server->channels)) | ||||||
| 
 | 
 | ||||||
| ;; Setting `erc-join-buffer' to 'bury prevents erc from stealing focus of the | ;; 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. | ;; TODO: Here is another horrible hack that should be revisted. | ||||||
| (setq erc-autojoin-channels-alist | (setq erc-autojoin-channels-alist | ||||||
|       (->> irc/server->channels |       (->> irc-server->channels | ||||||
|            (alist/map-values #'cycle/to-list) |            (alist-map-values #'cycle-to-list) | ||||||
|            (alist/map-keys (>> (s-chop-prefix "irc.") |            (alist-map-keys (>> (s-chop-prefix "irc.") | ||||||
|                                (s-chop-suffix ".net"))))) |                                (s-chop-suffix ".net"))))) | ||||||
| 
 | 
 | ||||||
| (defcustom irc/install-kbds? t | (defcustom irc-install-kbds? t | ||||||
|   "When t, install the keybindings defined herein.") |   "When t, install the keybindings defined herein.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun irc/message (x) | (defun irc-message (x) | ||||||
|   "Print message X in a structured way." |   "Print message X in a structured way." | ||||||
|   (message (string-format "[irc.el] %s" x))) |   (message (string-format "[irc.el] %s" x))) | ||||||
| 
 | 
 | ||||||
|  | @ -93,31 +97,31 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support function or KBD for switching to an ERC buffer. | ;; 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." |   "Kills all ERC buffers and processes." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (->> (erc-buffer-list) |   (->> (erc-buffer-list) | ||||||
|        (-map #'kill-buffer))) |        (-map #'kill-buffer))) | ||||||
| 
 | 
 | ||||||
| (defun irc/switch-to-erc-buffer () | (defun irc-switch-to-erc-buffer () | ||||||
|   "Switch to an ERC buffer." |   "Switch to an ERC buffer." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((buffers (erc-buffer-list))) |   (let ((buffers (erc-buffer-list))) | ||||||
|     (if (list/empty? buffers) |     (if (list-empty? buffers) | ||||||
|         (error "[irc.el] No ERC buffers available") |         (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." |   "Connect to Freenode IRC." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (erc-ssl :server "irc.freenode.net" |   (erc-ssl :server "irc.freenode.net" | ||||||
|            :port 6697 |            :port 6697 | ||||||
|            :nick "wpcarro" |            :nick "wpcarro" | ||||||
|            :password (password-store-get "programming/irc/freenode") |            :password (password-store-get "programming/irc-freenode") | ||||||
|            :full-name "William Carroll")) |            :full-name "William Carroll")) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Handle failed connections. | ;; TODO: Handle failed connections. | ||||||
| (defun irc/connect-to-google () | (defun irc-connect-to-google () | ||||||
|   "Connect to Google's Corp IRC using ERC." |   "Connect to Google's Corp IRC using ERC." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (erc-ssl :server "irc.corp.google.com" |   (erc-ssl :server "irc.corp.google.com" | ||||||
|  | @ -127,26 +131,26 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Prefer defining these with a less homespun solution. There is a | ;; TODO: Prefer defining these with a less homespun solution. There is a | ||||||
| ;; function call `erc-buffer-filter' that would be more appropriate for the | ;; function call `erc-buffer-filter' that would be more appropriate for the | ||||||
| ;; implementation of `irc/next-channel' and `irc/prev-channel'. | ;; implementation of `irc-next-channel' and `irc-prev-channel'. | ||||||
| (defun irc/next-channel () | (defun irc-next-channel () | ||||||
|   "Join the next channel for the active server." |   "Join the next channel for the active server." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (with-current-buffer (current-buffer) |   (with-current-buffer (current-buffer) | ||||||
|     (let ((cycle (irc/channel->cycle irc/server->channels (buffer-name)))) |     (let ((cycle (irc-channel->cycle irc-server->channels (buffer-name)))) | ||||||
|       (erc-join-channel |       (erc-join-channel | ||||||
|        (cycle/next cycle)) |        (cycle-next cycle)) | ||||||
|       (irc/message |       (irc-message | ||||||
|        (string-format "Current IRC channel: %s" (cycle/current cycle)))))) |        (string-format "Current IRC channel: %s" (cycle-current cycle)))))) | ||||||
| 
 | 
 | ||||||
| (defun irc/prev-channel () | (defun irc-prev-channel () | ||||||
|   "Join the previous channel for the active server." |   "Join the previous channel for the active server." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (with-current-buffer (current-buffer) |   (with-current-buffer (current-buffer) | ||||||
|     (let ((cycle (irc/channel->cycle irc/server->channels (buffer-name)))) |     (let ((cycle (irc-channel->cycle irc-server->channels (buffer-name)))) | ||||||
|       (erc-join-channel |       (erc-join-channel | ||||||
|        (cycle/prev cycle)) |        (cycle-prev cycle)) | ||||||
|       (irc/message |       (irc-message | ||||||
|        (string-format "Current IRC channel: %s" (cycle/current cycle)))))) |        (string-format "Current IRC channel: %s" (cycle-current cycle)))))) | ||||||
| 
 | 
 | ||||||
| (add-hook 'erc-mode-hook (macros-disable auto-fill-mode)) | (add-hook 'erc-mode-hook (macros-disable auto-fill-mode)) | ||||||
| (add-hook 'erc-mode-hook (macros-disable company-mode)) | (add-hook 'erc-mode-hook (macros-disable company-mode)) | ||||||
|  | @ -155,21 +159,21 @@ | ||||||
| ;; Keybindings | ;; Keybindings | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when irc/install-kbds? | (when irc-install-kbds? | ||||||
|   (general-define-key |   (general-define-key | ||||||
|    :keymaps 'erc-mode-map |    :keymaps 'erc-mode-map | ||||||
|    "<C-tab>" #'irc/next-channel |    "<C-tab>" #'irc-next-channel | ||||||
|    "<C-S-iso-lefttab>" #'irc/prev-channel)) |    "<C-S-iso-lefttab>" #'irc-prev-channel)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when irc/enable-tests? | (when irc-enable-tests? | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (equal |    (equal | ||||||
|     (irc/channel->server `(("irc.dairy.com" . ,(cycle/new "#cheese" "#milk")) |     (irc-channel->server `(("irc.dairy.com" . ,(cycle-new "#cheese" "#milk")) | ||||||
|                            ("irc.color.com" . ,(cycle/new "#red" "#blue"))) |                            ("irc.color.com" . ,(cycle-new "#red" "#blue"))) | ||||||
|                          "#cheese") |                          "#cheese") | ||||||
|     "irc.dairy.com"))) |     "irc.dairy.com"))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; ivy-clipmenu.el --- Emacs client for clipmenu -*- lexical-binding: t -*- | ;;; ivy-clipmenu.el --- Emacs client for clipmenu -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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 "25.1")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Ivy integration with the clipboard manager, clipmenu.  Essentially, clipmenu | ;; 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 | ;; 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 | ;; 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 | ;; Usually clipmenu integrates with rofi or dmenu.  This Emacs module integrates | ||||||
| ;; with ivy.  Launch this when you want to select a clip. | ;; with ivy.  Launch this when you want to select a clip. | ||||||
|  | @ -44,7 +48,7 @@ | ||||||
|   "Ivy integration for clipmenu." |   "Ivy integration for clipmenu." | ||||||
|   :group 'ivy) |   :group 'ivy) | ||||||
| 
 | 
 | ||||||
| (defcustom ivy-clipmenu/directory | (defcustom ivy-clipmenu-directory | ||||||
|   (or (getenv "XDG_RUNTIME_DIR") |   (or (getenv "XDG_RUNTIME_DIR") | ||||||
|       (getenv "TMPDIR") |       (getenv "TMPDIR") | ||||||
|       "/tmp") |       "/tmp") | ||||||
|  | @ -52,52 +56,52 @@ | ||||||
|   :type 'string |   :type 'string | ||||||
|   :group 'ivy-clipmenu) |   :group 'ivy-clipmenu) | ||||||
| 
 | 
 | ||||||
| (defconst ivy-clipmenu/executable-version 5 | (defconst ivy-clipmenu-executable-version 5 | ||||||
|    "The major version number for the clipmenu executable.") |    "The major version number for the clipmenu executable.") | ||||||
| 
 | 
 | ||||||
| (defconst ivy-clipmenu/cache-directory | (defconst ivy-clipmenu-cache-directory | ||||||
|   (f-join ivy-clipmenu/directory |   (f-join ivy-clipmenu-directory | ||||||
|           (format "clipmenu.%s.%s" |           (format "clipmenu.%s.%s" | ||||||
|                   ivy-clipmenu/executable-version |                   ivy-clipmenu-executable-version | ||||||
|                   (getenv "USER"))) |                   (getenv "USER"))) | ||||||
|   "Directory where the clips are stored.") |   "Directory where the clips are stored.") | ||||||
| 
 | 
 | ||||||
| (defconst ivy-clipmenu/cache-file-pattern | (defconst ivy-clipmenu-cache-file-pattern | ||||||
|   (f-join ivy-clipmenu/cache-directory "line_cache_*") |   (f-join ivy-clipmenu-cache-directory "line_cache_*") | ||||||
|   "Glob pattern matching the locations on disk for clipmenu's labels.") |   "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) |   (or (getenv "CM_HISTLENGTH") 25) | ||||||
|   "Limit the number of clips in the history. |   "Limit the number of clips in the history. | ||||||
| This value defaults to 25.") | This value defaults to 25.") | ||||||
| 
 | 
 | ||||||
| (defvar ivy-clipmenu/history nil | (defvar ivy-clipmenu-history nil | ||||||
|   "History for `ivy-clipmenu/copy'.") |   "History for `ivy-clipmenu-copy'.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Functions | ;; Functions | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun ivy-clipmenu/parse-content (x) | (defun ivy-clipmenu-parse-content (x) | ||||||
|   "Parse the label from the entry in clipmenu's line-cache." |   "Parse the label from the entry in clipmenu's line-cache." | ||||||
|   (->> (s-split " " x) |   (->> (s-split " " x) | ||||||
|        (-drop 1) |        (-drop 1) | ||||||
|        (s-join " "))) |        (s-join " "))) | ||||||
| 
 | 
 | ||||||
| (defun ivy-clipmenu/list-clips () | (defun ivy-clipmenu-list-clips () | ||||||
|   "Return a list of the content of all of the clips." |   "Return a list of the content of all of the clips." | ||||||
|   (->> ivy-clipmenu/cache-file-pattern |   (->> ivy-clipmenu-cache-file-pattern | ||||||
|        f-glob |        f-glob | ||||||
|        (-map (lambda (path) |        (-map (lambda (path) | ||||||
|                (s-split "\n" (f-read path) t))) |                (s-split "\n" (f-read path) t))) | ||||||
|        -flatten |        -flatten | ||||||
|        (-reject #'s-blank?) |        (-reject #'s-blank?) | ||||||
|        (-sort #'string>) |        (-sort #'string>) | ||||||
|        (-map #'ivy-clipmenu/parse-content) |        (-map #'ivy-clipmenu-parse-content) | ||||||
|        delete-dups |        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." |   "Return the CRC checksum of CONTENT." | ||||||
|   (s-trim-right |   (s-trim-right | ||||||
|    (with-temp-buffer |    (with-temp-buffer | ||||||
|  | @ -105,30 +109,30 @@ This value defaults to 25.") | ||||||
|                    (format "cksum <<<'%s'" content)) |                    (format "cksum <<<'%s'" content)) | ||||||
|      (buffer-string)))) |      (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." |   "Map the chosen LINE from the line cache its content from disk." | ||||||
|   (->> line |   (->> line | ||||||
|        ivy-clipmenu/checksum |        ivy-clipmenu-checksum | ||||||
|        (f-join ivy-clipmenu/cache-directory) |        (f-join ivy-clipmenu-cache-directory) | ||||||
|        f-read)) |        f-read)) | ||||||
| 
 | 
 | ||||||
| (defun ivy-clipmenu/do-copy (x) | (defun ivy-clipmenu-do-copy (x) | ||||||
|   "Copy string, X, to the system clipboard." |   "Copy string, X, to the system clipboard." | ||||||
|   (kill-new x) |   (kill-new x) | ||||||
|   (message "[ivy-clipmenu.el] Copied!")) |   (message "[ivy-clipmenu.el] Copied!")) | ||||||
| 
 | 
 | ||||||
| (defun ivy-clipmenu/copy () | (defun ivy-clipmenu-copy () | ||||||
|   "Use `ivy-read' to select and copy a clip. |   "Use `ivy-read' to select and copy a clip. | ||||||
| It's recommended to bind this function to a globally available keymap." | It's recommended to bind this function to a globally available keymap." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((ivy-sort-functions-alist nil)) |   (let ((ivy-sort-functions-alist nil)) | ||||||
|     (ivy-read "Clipmenu: " |     (ivy-read "Clipmenu: " | ||||||
|               (ivy-clipmenu/list-clips) |               (ivy-clipmenu-list-clips) | ||||||
|               :history 'ivy-clipmenu/history |               :history 'ivy-clipmenu-history | ||||||
|               :action (lambda (line) |               :action (lambda (line) | ||||||
|                         (->> line |                         (->> line | ||||||
|                              ivy-clipmenu/line-to-content |                              ivy-clipmenu-line-to-content | ||||||
|                              ivy-clipmenu/do-copy))))) |                              ivy-clipmenu-do-copy))))) | ||||||
| 
 | 
 | ||||||
| (provide 'ivy-clipmenu) | (provide 'ivy-clipmenu) | ||||||
| ;;; ivy-clipmenu.el ends here | ;;; ivy-clipmenu.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; ivy-helpers.el --- More interfaces to ivy -*- lexical-binding: t -*- | ;;; ivy-helpers.el --- More interfaces to ivy -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Hopefully to improve my workflows. | ;; Hopefully to improve my workflows. | ||||||
|  | @ -16,7 +20,7 @@ | ||||||
| ;; Library | ;; 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 |   "PROMPT users with the keys in KV and return its corresponding value.  Calls F | ||||||
| with the key and value from KV." | with the key and value from KV." | ||||||
|   (ivy-read |   (ivy-read | ||||||
|  | @ -26,7 +30,7 @@ with the key and value from KV." | ||||||
|    :action (lambda (entry) |    :action (lambda (entry) | ||||||
|              (funcall f (car entry) (cdr 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." |   "Execute the specified CMD and notify the user when it finishes." | ||||||
|   (message "Starting %s..." cmd) |   (message "Starting %s..." cmd) | ||||||
|   (set-process-sentinel |   (set-process-sentinel | ||||||
|  | @ -35,7 +39,7 @@ with the key and value from KV." | ||||||
|      (when (string= event "finished\n") |      (when (string= event "finished\n") | ||||||
|        (message "%s process finished." process))))) |        (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 |   "Creates a list of all external commands available on $PATH while filtering | ||||||
| NixOS wrappers." | NixOS wrappers." | ||||||
|   (cl-loop |   (cl-loop | ||||||
|  | @ -51,14 +55,14 @@ NixOS wrappers." | ||||||
|    append lsdir into completions |    append lsdir into completions | ||||||
|    finally return (sort completions 'string-lessp))) |    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 |   "Prompts the user with a list of all installed applications and | ||||||
| lets them select one to launch." | lets them select one to launch." | ||||||
|   (interactive) |   (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 |     (ivy-read "Command:" external-commands-list | ||||||
|               :require-match t |               :require-match t | ||||||
|               :action #'ivy-helpers/do-run-external-command))) |               :action #'ivy-helpers-do-run-external-command))) | ||||||
| 
 | 
 | ||||||
| ;;; Code: | ;;; Code: | ||||||
| (provide 'ivy-helpers) | (provide 'ivy-helpers) | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; kbd.el --- Elisp keybinding -*- lexical-binding: t -*- | ;;; kbd.el --- Elisp keybinding -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; In order to stay organized, I'm attempting to dedicate KBD prefixes to | ;; In order to stay organized, I'm attempting to dedicate KBD prefixes to | ||||||
|  | @ -27,52 +31,52 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst kbd/prefixes | (defconst kbd-prefixes | ||||||
|   '((workspace . "s") |   '((workspace . "s") | ||||||
|     (x11 . "C-s")) |     (x11 . "C-s")) | ||||||
|   "Mapping of functions to designated keybinding prefixes to stay organized.") |   "Mapping of functions to designated keybinding prefixes to stay organized.") | ||||||
| 
 | 
 | ||||||
| ;; Assert that no keybindings are colliding. | ;; Assert that no keybindings are colliding. | ||||||
| (prelude-assert | (prelude-assert | ||||||
|  (= (alist/count kbd/prefixes) |  (= (alist-count kbd-prefixes) | ||||||
|     (->> kbd/prefixes |     (->> kbd-prefixes | ||||||
|          alist/values |          alist-values | ||||||
|          set/from-list |          set-from-list | ||||||
|          set/count))) |          set-count))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun kbd/raw (f x) | (defun kbd-raw (f x) | ||||||
|   "Return the string keybinding for function F and appendage X. |   "Return the string keybinding for function F and appendage X. | ||||||
| Values for F include: | Values for F include: | ||||||
| - workspace | - workspace | ||||||
| - x11" | - x11" | ||||||
|   (prelude-assert (alist/has-key? f kbd/prefixes)) |   (prelude-assert (alist-has-key? f kbd-prefixes)) | ||||||
|   (string-format |   (string-format | ||||||
|    "%s-%s" |    "%s-%s" | ||||||
|    (alist/get f kbd/prefixes) |    (alist-get f kbd-prefixes) | ||||||
|    x)) |    x)) | ||||||
| 
 | 
 | ||||||
| (defun kbd/for (f x) | (defun kbd-for (f x) | ||||||
|   "Return the `kbd' for function F and appendage X. |   "Return the `kbd' for function F and appendage X. | ||||||
| Values for F include: | Values for F include: | ||||||
| - workspace | - workspace | ||||||
| - x11" | - x11" | ||||||
|   (kbd (kbd/raw f x))) |   (kbd (kbd-raw f x))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Prefer copying human-readable versions to the clipboard.  Right now | ;; TODO: Prefer copying human-readable versions to the clipboard.  Right now | ||||||
| ;; this isn't too useful. | ;; this isn't too useful. | ||||||
| (defun kbd/copy-keycode () | (defun kbd-copy-keycode () | ||||||
|   "Copy the pressed key to the system clipboard." |   "Copy the pressed key to the system clipboard." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (message "[kbd] Awaiting keypress...") |   (message "[kbd] Awaiting keypress...") | ||||||
|   (let ((key (read-key))) |   (let ((key (read-key))) | ||||||
|     (clipboard/copy (string-format "%s" key)) |     (clipboard-copy (string-format "%s" key)) | ||||||
|     (message (string-format "[kbd] \"%s\" copied!" key)))) |     (message (string-format "[kbd] \"%s\" copied!" key)))) | ||||||
| 
 | 
 | ||||||
| (defun kbd/print-keycode () | (defun kbd-print-keycode () | ||||||
|   "Prints the pressed keybinding." |   "Prints the pressed keybinding." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (message "[kbd] Awaiting keypress...") |   (message "[kbd] Awaiting keypress...") | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; keybindings.el --- Centralizing my keybindings -*- lexical-binding: t -*- | ;;; keybindings.el --- Centralizing my keybindings -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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 "25.1")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Attempting to centralize my keybindings to simplify my configuration. | ;; Attempting to centralize my keybindings to simplify my configuration. | ||||||
|  | @ -63,10 +67,10 @@ | ||||||
|   "L"   #'evil-end-of-line |   "L"   #'evil-end-of-line | ||||||
|   "_"   #'ranger |   "_"   #'ranger | ||||||
|   "-"   #'dired-jump |   "-"   #'dired-jump | ||||||
|   "sl"  #'wpc/evil-window-vsplit-right |   "sl"  #'functions-evil-window-vsplit-right | ||||||
|   "sh"  #'evil-window-vsplit |   "sh"  #'evil-window-vsplit | ||||||
|   "sk"  #'evil-window-split |   "sk"  #'evil-window-split | ||||||
|   "sj"  #'wpc/evil-window-split-down) |   "sj"  #'functions-evil-window-split-down) | ||||||
| 
 | 
 | ||||||
| (general-nmap | (general-nmap | ||||||
|   :keymaps 'override |   :keymaps 'override | ||||||
|  | @ -114,19 +118,19 @@ | ||||||
| ;; have to bound to the readline function that deletes the entire line. | ;; have to bound to the readline function that deletes the entire line. | ||||||
| (general-unbind "C-u") | (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." |   "Bind C to FN using `exwm-input-set-key' with `kbd' applied to C." | ||||||
|   `(exwm-input-set-key (kbd ,c) ,fn)) |   `(exwm-input-set-key (kbd ,c) ,fn)) | ||||||
| 
 | 
 | ||||||
| (keybinding/exwm "C-M-v" #'ivy-clipmenu/copy) | (keybindings-exwm "C-M-v" #'ivy-clipmenu-copy) | ||||||
| (keybinding/exwm "<XF86MonBrightnessUp>" #'screen-brightness/increase) | (keybindings-exwm "<XF86MonBrightnessUp>" #'screen-brightness/increase) | ||||||
| (keybinding/exwm "<XF86MonBrightnessDown>" #'screen-brightness/decrease) | (keybindings-exwm "<XF86MonBrightnessDown>" #'screen-brightness/decrease) | ||||||
| (keybinding/exwm "<XF86AudioMute>" #'pulse-audio/toggle-mute) | (keybindings-exwm "<XF86AudioMute>" #'pulse-audio/toggle-mute) | ||||||
| (keybinding/exwm "<XF86AudioLowerVolume>" #'pulse-audio/decrease-volume) | (keybindings-exwm "<XF86AudioLowerVolume>" #'pulse-audio/decrease-volume) | ||||||
| (keybinding/exwm "<XF86AudioRaiseVolume>" #'pulse-audio/increase-volume) | (keybindings-exwm "<XF86AudioRaiseVolume>" #'pulse-audio/increase-volume) | ||||||
| (keybinding/exwm "<XF86AudioMicMute>" #'pulse-audio/toggle-microphone) | (keybindings-exwm "<XF86AudioMicMute>" #'pulse-audio/toggle-microphone) | ||||||
| (keybinding/exwm (kbd/raw 'x11 "s") #'scrot/select) | (keybindings-exwm (kbd-raw 'x11 "s") #'scrot-select) | ||||||
| (keybinding/exwm "<C-M-tab>" #'window-manager-switch-to-exwm-buffer) | (keybindings-exwm "<C-M-tab>" #'window-manager-switch-to-exwm-buffer) | ||||||
| 
 | 
 | ||||||
| (general-define-key | (general-define-key | ||||||
|  :keymaps 'override |  :keymaps 'override | ||||||
|  | @ -168,11 +172,11 @@ | ||||||
|  "W" #'balance-windows |  "W" #'balance-windows | ||||||
|  "gs" #'magit-status |  "gs" #'magit-status | ||||||
|  "E" #'refine |  "E" #'refine | ||||||
|  "es" #'wpc/create-snippet |  "es" #'functions-create-snippet | ||||||
|  "l" #'linum-mode |  "l" #'linum-mode | ||||||
|  "B" #'magit-blame |  "B" #'magit-blame | ||||||
|  "w" #'save-buffer |  "w" #'save-buffer | ||||||
|  "r" #'wpc/evil-replace-under-point |  "r" #'functions-evil-replace-under-point | ||||||
|  "R" #'deadgrep) |  "R" #'deadgrep) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | @ -180,13 +184,13 @@ | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| ;; Show or hide a vterm buffer.  I'm intentionally not defining this in | ;; 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. | ;; 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 () |                     (lambda () | ||||||
|                       (interactive) |                       (interactive) | ||||||
|                       (if (vterm-mgt--instance? (current-buffer)) |                       (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)))) |                         (call-interactively #'vterm-mgt-find-or-create)))) | ||||||
| 
 | 
 | ||||||
| (general-define-key | (general-define-key | ||||||
|  | @ -201,15 +205,15 @@ | ||||||
| ;; Displays | ;; Displays | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when (device/work-laptop?) | (when (device-work-laptop?) | ||||||
|   (keybinding/exwm "<XF86Display>" #'display/cycle-display-states) |   (keybindings-exwm "<XF86Display>" #'display-cycle-display-states) | ||||||
|   (general-define-key |   (general-define-key | ||||||
|    :prefix "<SPC>" |    :prefix "<SPC>" | ||||||
|    :states '(normal) |    :states '(normal) | ||||||
|    "d0" #'display/disable-laptop |    "d0" #'display-disable-laptop | ||||||
|    "d1" #'display/enable-laptop |    "d1" #'display-enable-laptop | ||||||
|    "D0" #'display/disable-4k |    "D0" #'display-disable-4k | ||||||
|    "D1" #'display/enable-4k)) |    "D1" #'display-enable-4k)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; notmuch | ;; notmuch | ||||||
|  | @ -227,7 +231,7 @@ | ||||||
|  "e" #'notmuch-show-archive-message-then-next-or-next-thread) |  "e" #'notmuch-show-archive-message-then-next-or-next-thread) | ||||||
| 
 | 
 | ||||||
| ;; TODO(wpcarro): Consider moving this to a separate module | ;; 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." |   "Define CMD to F locally to a buffer." | ||||||
|   (unless (local-variable-p 'evil-ex-commands) |   (unless (local-variable-p 'evil-ex-commands) | ||||||
|     (setq-local evil-ex-commands (copy-alist evil-ex-commands))) |     (setq-local evil-ex-commands (copy-alist evil-ex-commands))) | ||||||
|  | @ -241,7 +245,7 @@ | ||||||
| 
 | 
 | ||||||
| (add-hook 'notmuch-message-mode-hook | (add-hook 'notmuch-message-mode-hook | ||||||
|           (lambda () |           (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 | ;; For now, I'm mimmicking Gmail KBDs that I have memorized and enjoy | ||||||
| (general-define-key | (general-define-key | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; keyboard.el --- Managing keyboard preferences with Elisp -*- lexical-binding: t -*- | ;;; keyboard.el --- Managing keyboard preferences with Elisp -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Setting key repeat and other values. | ;; Setting key repeat and other values. | ||||||
|  | @ -21,38 +25,38 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support clamping functions for repeat-{rate,delay} to ensure only valid | ;; TODO: Support clamping functions for repeat-{rate,delay} to ensure only valid | ||||||
| ;; values are sent to xset. | ;; values are sent to xset. | ||||||
| (defcustom keyboard/repeat-rate 80 | (defcustom keyboard-repeat-rate 80 | ||||||
|   "The number of key repeat signals sent per second.") |   "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.") |   "The number of milliseconds before autorepeat starts.") | ||||||
| 
 | 
 | ||||||
| (defconst keyboard/repeat-rate-copy keyboard/repeat-rate | (defconst keyboard-repeat-rate-copy keyboard-repeat-rate | ||||||
|   "Copy of `keyboard/repeat-rate' to support `keyboard/reset-key-repeat'.") |   "Copy of `keyboard-repeat-rate' to support `keyboard-reset-key-repeat'.") | ||||||
| 
 | 
 | ||||||
| (defconst keyboard/repeat-delay-copy keyboard/repeat-delay | (defconst keyboard-repeat-delay-copy keyboard-repeat-delay | ||||||
|   "Copy of `keyboard/repeat-delay' to support `keyboard/reset-key-repeat'.") |   "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.") |   "When t, install keyboard preferences.") | ||||||
| 
 | 
 | ||||||
| (defcustom keyboard/install-kbds? nil | (defcustom keyboard-install-kbds? nil | ||||||
|   "When t, install keybindings.") |   "When t, install keybindings.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Functions | ;; Functions | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun keyboard/message (x) | (defun keyboard-message (x) | ||||||
|   "Message X in a structured way." |   "Message X in a structured way." | ||||||
|   (message (string-format "[keyboard.el] %s" x))) |   (message (string-format "[keyboard.el] %s" x))) | ||||||
| 
 | 
 | ||||||
| (cl-defun keyboard/set-key-repeat (&key | (cl-defun keyboard-set-key-repeat (&key | ||||||
|                                    (rate keyboard/repeat-rate) |                                    (rate keyboard-repeat-rate) | ||||||
|                                    (delay keyboard/repeat-delay)) |                                    (delay keyboard-repeat-delay)) | ||||||
|   "Use xset to set the key-repeat RATE and DELAY." |   "Use xset to set the key-repeat RATE and DELAY." | ||||||
|   (prelude-start-process |   (prelude-start-process | ||||||
|    :name "keyboard/set-key-repeat" |    :name "keyboard-set-key-repeat" | ||||||
|    :command (string-format "xset r rate %s %s" delay rate))) |    :command (string-format "xset r rate %s %s" delay rate))) | ||||||
| 
 | 
 | ||||||
| ;; NOTE: Settings like this are machine-dependent. For instance I only need to | ;; 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. | ;; than once, xmodmap will start to error about non-existent Caps_Lock symbol. | ||||||
| ;; For more information see here: | ;; 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 | ;; 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." |   "Swaps the caps lock and escape keys using xmodmap." | ||||||
|   (interactive) |   (interactive) | ||||||
|   ;; TODO: Ensure these work once the tokenizing in prelude-start-process works |   ;; TODO: Ensure these work once the tokenizing in prelude-start-process works | ||||||
|   ;; as expected. |   ;; 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") |                  "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")) |                  "keysym Caps_Lock = Escape")) | ||||||
| 
 | 
 | ||||||
| (defun keyboard/inc-repeat-rate () | (defun keyboard-inc-repeat-rate () | ||||||
|   "Increment `keyboard/repeat-rate'." |   "Increment `keyboard-repeat-rate'." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (setq keyboard/repeat-rate (number/inc keyboard/repeat-rate)) |   (setq keyboard-repeat-rate (number-inc keyboard-repeat-rate)) | ||||||
|   (keyboard/set-key-repeat :rate keyboard/repeat-rate) |   (keyboard-set-key-repeat :rate keyboard-repeat-rate) | ||||||
|   (keyboard/message |   (keyboard-message | ||||||
|    (string-format "Rate: %s" keyboard/repeat-rate))) |    (string-format "Rate: %s" keyboard-repeat-rate))) | ||||||
| 
 | 
 | ||||||
| (defun keyboard/dec-repeat-rate () | (defun keyboard-dec-repeat-rate () | ||||||
|   "Decrement `keyboard/repeat-rate'." |   "Decrement `keyboard-repeat-rate'." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (setq keyboard/repeat-rate (number/dec keyboard/repeat-rate)) |   (setq keyboard-repeat-rate (number-dec keyboard-repeat-rate)) | ||||||
|   (keyboard/set-key-repeat :rate keyboard/repeat-rate) |   (keyboard-set-key-repeat :rate keyboard-repeat-rate) | ||||||
|   (keyboard/message |   (keyboard-message | ||||||
|    (string-format "Rate: %s" keyboard/repeat-rate))) |    (string-format "Rate: %s" keyboard-repeat-rate))) | ||||||
| 
 | 
 | ||||||
| (defun keyboard/inc-repeat-delay () | (defun keyboard-inc-repeat-delay () | ||||||
|   "Increment `keyboard/repeat-delay'." |   "Increment `keyboard-repeat-delay'." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (setq keyboard/repeat-delay (number/inc keyboard/repeat-delay)) |   (setq keyboard-repeat-delay (number-inc keyboard-repeat-delay)) | ||||||
|   (keyboard/set-key-repeat :delay keyboard/repeat-delay) |   (keyboard-set-key-repeat :delay keyboard-repeat-delay) | ||||||
|   (keyboard/message |   (keyboard-message | ||||||
|    (string-format "Delay: %s" keyboard/repeat-delay))) |    (string-format "Delay: %s" keyboard-repeat-delay))) | ||||||
| 
 | 
 | ||||||
| (defun keyboard/dec-repeat-delay () | (defun keyboard-dec-repeat-delay () | ||||||
|   "Decrement `keyboard/repeat-delay'." |   "Decrement `keyboard-repeat-delay'." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (setq keyboard/repeat-delay (number/dec keyboard/repeat-delay)) |   (setq keyboard-repeat-delay (number-dec keyboard-repeat-delay)) | ||||||
|   (keyboard/set-key-repeat :delay keyboard/repeat-delay) |   (keyboard-set-key-repeat :delay keyboard-repeat-delay) | ||||||
|   (keyboard/message |   (keyboard-message | ||||||
|    (string-format "Delay: %s" keyboard/repeat-delay))) |    (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." |   "Print the currently set values for key repeat." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (keyboard/message |   (keyboard-message | ||||||
|    (string-format "Rate: %s. Delay: %s" |    (string-format "Rate: %s. Delay: %s" | ||||||
|                   keyboard/repeat-rate |                   keyboard-repeat-rate | ||||||
|                   keyboard/repeat-delay))) |                   keyboard-repeat-delay))) | ||||||
| 
 | 
 | ||||||
| (defun keyboard/set-preferences () | (defun keyboard-set-preferences () | ||||||
|   "Reset the keyboard preferences to their default values. |   "Reset the keyboard preferences to their default values. | ||||||
| NOTE: This function exists because occasionally I unplug and re-plug in a | 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." |   keyboard and all of the preferences that I set using xset disappear." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (keyboard/swap-caps-lock-and-escape) |   (keyboard-swap-caps-lock-and-escape) | ||||||
|   (keyboard/set-key-repeat :rate keyboard/repeat-rate |   (keyboard-set-key-repeat :rate keyboard-repeat-rate | ||||||
|                            :delay keyboard/repeat-delay) |                            :delay keyboard-repeat-delay) | ||||||
|   ;; TODO: Implement this message function as a macro that pulls the current |   ;; TODO: Implement this message function as a macro that pulls the current | ||||||
|   ;; file name. |   ;; 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." |   "Set key repeat rate and delay to original values." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (keyboard/set-key-repeat :rate keyboard/repeat-rate-copy |   (keyboard-set-key-repeat :rate keyboard-repeat-rate-copy | ||||||
|                            :delay keyboard/repeat-delay-copy) |                            :delay keyboard-repeat-delay-copy) | ||||||
|   (keyboard/message "Key repeat preferences reset.")) |   (keyboard-message "Key repeat preferences reset.")) | ||||||
| 
 | 
 | ||||||
| (when keyboard/install-preferences? | (when keyboard-install-preferences? | ||||||
|   (keyboard/set-preferences)) |   (keyboard-set-preferences)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Define minor-mode for this. | ;; TODO: Define minor-mode for this. | ||||||
| (when keyboard/install-kbds? | (when keyboard-install-kbds? | ||||||
|   (general-unbind 'motion "C-i" "C-y") |   (general-unbind 'motion "C-i" "C-y") | ||||||
|   (general-define-key |   (general-define-key | ||||||
|    ;; TODO: Choose better KBDs for these that don't interfere with useful evil |    ;; TODO: Choose better KBDs for these that don't interfere with useful evil | ||||||
|    ;; ones. |    ;; ones. | ||||||
|    ;; Use C-y when you accidentally send the key-repeat too high or too low to |    ;; Use C-y when you accidentally send the key-repeat too high or too low to | ||||||
|    ;; be meaningful. |    ;; be meaningful. | ||||||
|    "C-y" #'keyboard/reset-key-repeat |    "C-y" #'keyboard-reset-key-repeat | ||||||
|    "C-i" #'keyboard/inc-repeat-rate |    "C-i" #'keyboard-inc-repeat-rate | ||||||
|    "C-u" #'keyboard/dec-repeat-rate |    "C-u" #'keyboard-dec-repeat-rate | ||||||
|    "C-S-i" #'keyboard/inc-repeat-delay |    "C-S-i" #'keyboard-inc-repeat-delay | ||||||
|    "C-S-u" #'keyboard/dec-repeat-delay)) |    "C-S-u" #'keyboard-dec-repeat-delay)) | ||||||
| 
 | 
 | ||||||
| (provide 'keyboard) | (provide 'keyboard) | ||||||
| ;;; keyboard.el ends here | ;;; keyboard.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; laptop-battery.el --- Display laptop battery information -*- lexical-binding: t -*- | ;;; laptop-battery.el --- Display laptop battery information -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Some wrappers to obtain battery information. | ;; Some wrappers to obtain battery information. | ||||||
|  | @ -30,28 +34,28 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun laptop-battery/available? () | (defun laptop-battery-available? () | ||||||
|   "Return t if battery information is available." |   "Return t if battery information is available." | ||||||
|   (maybe-some? battery-status-function)) |   (maybe-some? battery-status-function)) | ||||||
| 
 | 
 | ||||||
| (defun laptop-battery/percentage () | (defun laptop-battery-percentage () | ||||||
|   "Return the current percentage of the battery." |   "Return the current percentage of the battery." | ||||||
|   (->> battery-status-function |   (->> battery-status-function | ||||||
|        funcall |        funcall | ||||||
|        (alist/get 112))) |        (alist-get 112))) | ||||||
| 
 | 
 | ||||||
| (defun laptop-battery/print-percentage () | (defun laptop-battery-print-percentage () | ||||||
|   "Return the current percentage of the battery." |   "Return the current percentage of the battery." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (->> (laptop-battery/percentage) |   (->> (laptop-battery-percentage) | ||||||
|        message)) |        message)) | ||||||
| 
 | 
 | ||||||
| (defun laptop-battery/display () | (defun laptop-battery-display () | ||||||
|   "Display laptop battery percentage in the modeline." |   "Display laptop battery percentage in the modeline." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (display-battery-mode 1)) |   (display-battery-mode 1)) | ||||||
| 
 | 
 | ||||||
| (defun laptop-battery/hide () | (defun laptop-battery-hide () | ||||||
|   "Hide laptop battery percentage in the modeline." |   "Hide laptop battery percentage in the modeline." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (display-battery-mode -1)) |   (display-battery-mode -1)) | ||||||
|  |  | ||||||
|  | @ -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> | ;; Author: William Carroll <wpcarro@gmail.com> | ||||||
|  | ;; Version: 0.0.1 | ||||||
|  | ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||||
|  | ;; Package-Requires: ((emacs "24")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; 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 | ;; 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 | ;; sometimes forget the names of these functions, so it's nice for them to be | ||||||
| ;; organized like this. | ;; organized like this. | ||||||
|  | @ -58,56 +62,56 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst list/tests? t | (defconst list-tests? t | ||||||
|   "When t, run the test suite.") |   "When t, run the test suite.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun list/new () | (defun list-new () | ||||||
|   "Return a new, empty list." |   "Return a new, empty list." | ||||||
|   '()) |   '()) | ||||||
| 
 | 
 | ||||||
| (defun list/concat (&rest lists) | (defun list-concat (&rest lists) | ||||||
|   "Joins `LISTS' into on list." |   "Joins `LISTS' into on list." | ||||||
|   (apply #'-concat lists)) |   (apply #'-concat lists)) | ||||||
| 
 | 
 | ||||||
| (defun list/join (joint xs) | (defun list-join (joint xs) | ||||||
|   "Join a list of strings, XS, with JOINT." |   "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) |                  (lambda (x acc) | ||||||
|                    (string-concat acc joint x)) |                    (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'." |   "Return the number of elements in `XS'." | ||||||
|   (length xs)) |   (length xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/get (i xs) | (defun list-get (i xs) | ||||||
|   "Return the value in `XS' at `I', or nil." |   "Return the value in `XS' at `I', or nil." | ||||||
|   (nth i xs)) |   (nth i xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/head (xs) | (defun list-head (xs) | ||||||
|   "Return the head of `XS'." |   "Return the head of `XS'." | ||||||
|   (car xs)) |   (car xs)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Learn how to write proper function aliases. | ;; TODO: Learn how to write proper function aliases. | ||||||
| (defun list/first (xs) | (defun list-first (xs) | ||||||
|   "Alias for `list/head' for `XS'." |   "Alias for `list-head' for `XS'." | ||||||
|   (list/head xs)) |   (list-head xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/tail (xs) | (defun list-tail (xs) | ||||||
|   "Return the tail of `XS'." |   "Return the tail of `XS'." | ||||||
|   (cdr xs)) |   (cdr xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/reverse (xs) | (defun list-reverse (xs) | ||||||
|   "Reverses `XS'." |   "Reverses `XS'." | ||||||
|   (reverse xs)) |   (reverse xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/cons (x xs) | (defun list-cons (x xs) | ||||||
|   "Add `X' to the head of `XS'." |   "Add `X' to the head of `XS'." | ||||||
|   (cons x xs)) |   (cons x xs)) | ||||||
| 
 | 
 | ||||||
|  | @ -120,56 +124,56 @@ | ||||||
| ;;     (funcall f b a))) | ;;     (funcall f b a))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Make this function work. | ;; 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'." |   "Return over `XS' calling `F' on an element in `XS'and `ACC'." | ||||||
|   (-reduce-from (lambda (acc x) (funcall f x acc)) acc xs)) |   (-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. | ;; 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. | ;;   "Return a mapping of F applied to each x in XS to TRANSFORM applied to x. | ||||||
| ;; The TRANSFORM function defaults to the identity function." | ;; The TRANSFORM function defaults to the identity function." | ||||||
| ;;   (->> xs | ;;   (->> xs | ||||||
| ;;        (list/reduce (alist/new) | ;;        (list-reduce (alist-new) | ||||||
| ;;                     (lambda (x acc) | ;;                     (lambda (x acc) | ||||||
| ;;                       (let ((k (funcall f x)) | ;;                       (let ((k (funcall f x)) | ||||||
| ;;                             (v (funcall transform 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)) | ||||||
| ;;                           (setf (alist-get k acc) (list v)))))))) | ;;                           (setf (alist-get k acc) (list v)))))))) | ||||||
| ;; (prelude-assert | ;; (prelude-assert | ||||||
| ;;  (equal '(("John" . ("Cleese" "Malkovich")) | ;;  (equal '(("John" . ("Cleese" "Malkovich")) | ||||||
| ;;           ("Thomas" . ("Aquinas"))) | ;;           ("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 "Cleese") | ||||||
| ;;                       (:first-name "John" :last-name "Malkovich") | ;;                       (:first-name "John" :last-name "Malkovich") | ||||||
| ;;                       (:first-name "Thomas" :last-name "Aquinas")) | ;;                       (:first-name "Thomas" :last-name "Aquinas")) | ||||||
| ;;                     :transform (lambda (x) (plist-get x :last-name))))) | ;;                     :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'." |   "Call `F' on each element of `XS'." | ||||||
|   (-map f 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." |   "Call `F' on each element of `XS' along with its index." | ||||||
|   (-map-indexed (lambda (i x) (funcall f x i)) xs)) |   (-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." |   "Return a subset of XS where predicate P returned t." | ||||||
|   (list/reverse |   (list-reverse | ||||||
|    (list/reduce |    (list-reduce | ||||||
|     '() |     '() | ||||||
|     (lambda (x acc) |     (lambda (x acc) | ||||||
|       (if (funcall p x) |       (if (funcall p x) | ||||||
|           (list/cons x acc) |           (list-cons x acc) | ||||||
|         acc)) |         acc)) | ||||||
|     xs))) |     xs))) | ||||||
| 
 | 
 | ||||||
| (defun list/reject (p xs) | (defun list-reject (p xs) | ||||||
|   "Return a subset of XS where predicate of P return nil." |   "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." |   "Return the first x in XS that passes P or nil." | ||||||
|   (-find p xs)) |   (-find p xs)) | ||||||
| 
 | 
 | ||||||
|  | @ -177,64 +181,64 @@ | ||||||
| ;; Predicates | ;; Predicates | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun list/instance? (xs) | (defun list-instance? (xs) | ||||||
|   "Return t if `XS' is a list. |   "Return t if `XS' is a list. | ||||||
| Be leery of using this with things like alists.  Many data structures in Elisp | Be leery of using this with things like alists.  Many data structures in Elisp | ||||||
|   are implemented using linked lists." |   are implemented using linked lists." | ||||||
|   (listp xs)) |   (listp xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/empty? (xs) | (defun list-empty? (xs) | ||||||
|   "Return t if XS are empty." |   "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'." |   "Return t if all `XS' pass the predicate, `P'." | ||||||
|   (-all? p xs)) |   (-all? p xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/any? (p xs) | (defun list-any? (p xs) | ||||||
|   "Return t if any `XS' pass the predicate, `P'." |   "Return t if any `XS' pass the predicate, `P'." | ||||||
|   (-any? p xs)) |   (-any? p xs)) | ||||||
| 
 | 
 | ||||||
| (defun list/contains? (x xs) | (defun list-contains? (x xs) | ||||||
|   "Return t if X is in XS using `equal'." |   "Return t if X is in XS using `equal'." | ||||||
|   (-contains? xs x)) |   (-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." |   "Return t if all elements in XS are distinct after applying F to each." | ||||||
|   (= (length xs) |   (= (length xs) | ||||||
|      (->> xs (-map f) set/from-list set/count))) |      (->> xs (-map f) set-from-list set-count))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support dedupe. | ;; TODO: Support dedupe. | ||||||
| ;; TODO: Should we call this unique? Or distinct? | ;; TODO: Should we call this unique? Or distinct? | ||||||
| 
 | 
 | ||||||
| ;; TODO: Add tests. | ;; TODO: Add tests. | ||||||
| (defun list/dedupe-adjacent (xs) | (defun list-dedupe-adjacent (xs) | ||||||
|   "Return XS without adjacent duplicates." |   "Return XS without adjacent duplicates." | ||||||
|   (prelude-assert (not (list/empty? xs))) |   (prelude-assert (not (list-empty? xs))) | ||||||
|   (list/reduce (list (list/first xs)) |   (list-reduce (list (list-first xs)) | ||||||
|     (lambda (x acc) |     (lambda (x acc) | ||||||
|       (if (equal x (list/first acc)) |       (if (equal x (list-first acc)) | ||||||
|           acc |           acc | ||||||
|         (list/cons x acc))) |         (list-cons x acc))) | ||||||
|     xs)) |     xs)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| ;; (when list/tests? | ;; (when list-tests? | ||||||
| ;;   (prelude-assert | ;;   (prelude-assert | ||||||
| ;;    (= 0 | ;;    (= 0 | ||||||
| ;;       (list/length '()))) | ;;       (list-length '()))) | ||||||
| ;;   (prelude-assert | ;;   (prelude-assert | ||||||
| ;;    (= 5 | ;;    (= 5 | ||||||
| ;;       (list/length '(1 2 3 4 5)))) | ;;       (list-length '(1 2 3 4 5)))) | ||||||
| ;;   (prelude-assert | ;;   (prelude-assert | ||||||
| ;;    (= 16 | ;;    (= 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 | ;;   (prelude-assert | ||||||
| ;;    (equal '(2 4 6 8 10) | ;;    (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) | (provide 'list) | ||||||
| ;;; list.el ends here | ;;; list.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; math.el --- Math stuffs -*- lexical-binding: t -*- | ;;; math.el --- Math stuffs -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ;; 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: | ;;; Commentary: | ||||||
| ;; Containing some useful mathematical functions. | ;; Containing some useful mathematical functions. | ||||||
|  | @ -16,7 +20,7 @@ | ||||||
| ;; Constants | ;; Constants | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst math/pi pi | (defconst math-pi pi | ||||||
|   "The number pi.") |   "The number pi.") | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | @ -25,7 +29,7 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support all three arguments. | ;; TODO: Support all three arguments. | ||||||
| ;; Int -> Int -> Int -> Boolean | ;; 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. |   ;; TODO: Assert two of three are set. | ||||||
|   (cond |   (cond | ||||||
|    ((maybe-somes? base power result) |    ((maybe-somes? base power result) | ||||||
|  | @ -39,19 +43,19 @@ | ||||||
|    (t |    (t | ||||||
|     (error "Two of the three arguments must be set")))) |     (error "Two of the three arguments must be set")))) | ||||||
| 
 | 
 | ||||||
| (defun math/mod (x y) | (defun math-mod (x y) | ||||||
|   "Return X mod Y." |   "Return X mod Y." | ||||||
|   (mod x y)) |   (mod x y)) | ||||||
| 
 | 
 | ||||||
| (defun math/exp (x y) | (defun math-exp (x y) | ||||||
|   "Return X raised to the Y." |   "Return X raised to the Y." | ||||||
|   (expt x y)) |   (expt x y)) | ||||||
| 
 | 
 | ||||||
| (defun math/round (x) | (defun math-round (x) | ||||||
|   "Round X to nearest ones digit." |   "Round X to nearest ones digit." | ||||||
|   (round x)) |   (round x)) | ||||||
| 
 | 
 | ||||||
| (defun math/floor (x) | (defun math-floor (x) | ||||||
|   "Floor value X." |   "Floor value X." | ||||||
|   (floor x)) |   (floor x)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -60,11 +60,11 @@ | ||||||
| 
 | 
 | ||||||
| (defun maybe-nils? (&rest xs) | (defun maybe-nils? (&rest xs) | ||||||
|   "Return t if all XS are nil." |   "Return t if all XS are nil." | ||||||
|   (list/all? #'maybe-nil? xs)) |   (list-all? #'maybe-nil? xs)) | ||||||
| 
 | 
 | ||||||
| (defun maybe-somes? (&rest xs) | (defun maybe-somes? (&rest xs) | ||||||
|   "Return t if all XS are non-nil." |   "Return t if all XS are non-nil." | ||||||
|   (list/all? #'maybe-some? xs)) |   (list-all? #'maybe-some? xs)) | ||||||
| 
 | 
 | ||||||
| (defun maybe-default (default x) | (defun maybe-default (default x) | ||||||
|   "Return DEFAULT when X is nil." |   "Return DEFAULT when X is nil." | ||||||
|  |  | ||||||
|  | @ -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> | ;; 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: | ;;; Commentary: | ||||||
| ;; Because I use EXWM, I treat my Emacs mode-line like my system bar: I need to | ;; 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) | (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 |   "Determines whether the last (i.e. bottom-right) window of the | ||||||
|   active frame is showing the buffer in which this function is |   active frame is showing the buffer in which this function is | ||||||
|   executed." |   executed." | ||||||
|  | @ -23,23 +27,23 @@ | ||||||
|          (last-window (car (seq-intersection right-windows bottom-windows)))) |          (last-window (car (seq-intersection right-windows bottom-windows)))) | ||||||
|     (eq (current-buffer) (window-buffer last-window)))) |     (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 |   "Renders the mode-line-misc-info string for display in the | ||||||
|   mode-line if the currently active window is the last one in the |   mode-line if the currently active window is the last one in the | ||||||
|   frame. |   frame. | ||||||
| 
 | 
 | ||||||
|   The idea is to not display information like the current time, |   The idea is to not display information like the current time, | ||||||
|   load, battery levels on all buffers." |   load, battery levels on all buffers." | ||||||
|   (when (modeline/bottom-right-window?) |   (when (modeline-bottom-right-window?) | ||||||
|     (telephone-line-raw mode-line-misc-info t))) |     (telephone-line-raw mode-line-misc-info t))) | ||||||
| 
 | 
 | ||||||
| (defun modeline/setup () | (defun modeline-setup () | ||||||
|   "Render my custom modeline." |   "Render my custom modeline." | ||||||
|   (telephone-line-defsegment telephone-line-last-window-segment () |   (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 |   ;; Display the current EXWM workspace index in the mode-line | ||||||
|   (telephone-line-defsegment telephone-line-exwm-workspace-index () |   (telephone-line-defsegment telephone-line-exwm-workspace-index () | ||||||
|     (when (modeline/bottom-right-window?) |     (when (modeline-bottom-right-window?) | ||||||
|       (format "[%s]" exwm-workspace-current-index))) |       (format "[%s]" exwm-workspace-current-index))) | ||||||
|   ;; Define a highlight font for ~ important ~ information in the last |   ;; Define a highlight font for ~ important ~ information in the last | ||||||
|   ;; window. |   ;; window. | ||||||
|  | @ -61,4 +65,4 @@ | ||||||
|   (telephone-line-mode 1)) |   (telephone-line-mode 1)) | ||||||
| 
 | 
 | ||||||
| (provide 'modeline) | (provide 'modeline) | ||||||
| ;; modeline.el ends here | ;;; modeline.el ends here | ||||||
|  |  | ||||||
|  | @ -40,40 +40,40 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst number/test? t | (defconst number-test? t | ||||||
|   "When t, run the test suite defined herein.") |   "When t, run the test suite defined herein.") | ||||||
| 
 | 
 | ||||||
| ;; TODO: What about int.el? | ;; TODO: What about int.el? | ||||||
| 
 | 
 | ||||||
| ;; TODO: How do we handle a number typeclass? | ;; TODO: How do we handle a number typeclass? | ||||||
| 
 | 
 | ||||||
| (defun number/positive? (x) | (defun number-positive? (x) | ||||||
|   "Return t if `X' is a positive number." |   "Return t if `X' is a positive number." | ||||||
|   (> x 0)) |   (> x 0)) | ||||||
| 
 | 
 | ||||||
| (defun number/negative? (x) | (defun number-negative? (x) | ||||||
|   "Return t if `X' is a positive number." |   "Return t if `X' is a positive number." | ||||||
|   (< x 0)) |   (< x 0)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Don't rely on this. Need to have 10.0 and 10 behave similarly. | ;; 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." |   "Return t if `X' is a floating point number." | ||||||
|   (floatp x)) |   (floatp x)) | ||||||
| 
 | 
 | ||||||
| (defun number/natural? (x) | (defun number-natural? (x) | ||||||
|   "Return t if `X' is a natural number." |   "Return t if `X' is a natural number." | ||||||
|   (and (number/positive? x) |   (and (number-positive? x) | ||||||
|        (not (number/float? x)))) |        (not (number-float? x)))) | ||||||
| 
 | 
 | ||||||
| (defun number/whole? (x) | (defun number-whole? (x) | ||||||
|   "Return t if `X' is a whole number." |   "Return t if `X' is a whole number." | ||||||
|   (or (= 0 x) |   (or (= 0 x) | ||||||
|       (number/natural? x))) |       (number-natural? x))) | ||||||
| 
 | 
 | ||||||
| (defun number/integer? (x) | (defun number-integer? (x) | ||||||
|   "Return t if `X' is an integer." |   "Return t if `X' is an integer." | ||||||
|   (or (number/whole? x) |   (or (number-whole? x) | ||||||
|       (number/natural? (- x)))) |       (number-natural? (- x)))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: How defensive should these guards be?  Should we assert that the inputs | ;; TODO: How defensive should these guards be?  Should we assert that the inputs | ||||||
| ;; are integers before checking evenness or oddness? | ;; are integers before checking evenness or oddness? | ||||||
|  | @ -83,28 +83,28 @@ | ||||||
| ;; TODO: How should rational numbers be handled? Lisp is supposedly famous for | ;; TODO: How should rational numbers be handled? Lisp is supposedly famous for | ||||||
| ;; its handling of rational numbers. | ;; its handling of rational numbers. | ||||||
| ;; TODO: `calc-mode' supports rational numbers as "1:2" meaning "1/2" | ;; 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? | ;; 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." |   "Return t if `X' is an even number." | ||||||
|   (or (= 0 x) |   (or (= 0 x) | ||||||
|       (= 0 (mod x 2)))) |       (= 0 (mod x 2)))) | ||||||
| 
 | 
 | ||||||
| (defun number/odd? (x) | (defun number-odd? (x) | ||||||
|   "Return t if `X' is an odd number." |   "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'. |   "Subtract one from `X'. | ||||||
| While this function is undeniably trivial, I have unintentionally done (- 1 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 |   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." |   to exist, and for me to train myself to reach for it and its inc counterpart." | ||||||
|   (- x 1)) |   (- x 1)) | ||||||
| 
 | 
 | ||||||
| (defun number/inc (x) | (defun number-inc (x) | ||||||
|   "Add one to `X'." |   "Add one to `X'." | ||||||
|   (+ x 1)) |   (+ x 1)) | ||||||
| 
 | 
 | ||||||
|  | @ -112,46 +112,46 @@ While this function is undeniably trivial, I have unintentionally done (- 1 x) | ||||||
| ;; too vague? | ;; too vague? | ||||||
| ;; TODO: Resolve the circular dependency that this introduces with series.el, | ;; TODO: Resolve the circular dependency that this introduces with series.el, | ||||||
| ;; and then re-enable this function and its tests below. | ;; and then re-enable this function and its tests below. | ||||||
| ;; (defun number/factorial (x) | ;; (defun number-factorial (x) | ||||||
| ;;   "Return factorial of `X'." | ;;   "Return factorial of `X'." | ||||||
| ;;   (cond | ;;   (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) | ;;    ((= 0 x) 1) | ||||||
| ;;    ;; NOTE: Using `series/range' introduces a circular dependency because: | ;;    ;; NOTE: Using `series/range' introduces a circular dependency because: | ||||||
| ;;    ;; series -> number -> series.  Conceptually, however, this should be | ;;    ;; series -> number -> series.  Conceptually, however, this should be | ||||||
| ;;    ;; perfectly acceptable. | ;;    ;; perfectly acceptable. | ||||||
| ;;    (t (->> (series/range 1 x) | ;;    (t (->> (series/range 1 x) | ||||||
| ;;            (list/reduce 1 #'*))))) | ;;            (list-reduce 1 #'*))))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when number/test? | (when number-test? | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (number/positive? 10)) |    (number-positive? 10)) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (number/natural? 10)) |    (number-natural? 10)) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (number/whole? 10)) |    (number-whole? 10)) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (number/whole? 0)) |    (number-whole? 0)) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (number/integer? 10)) |    (number-integer? 10)) | ||||||
|   ;; (prelude-assert |   ;; (prelude-assert | ||||||
|   ;;  (= 120 (number/factorial 5))) |   ;;  (= 120 (number-factorial 5))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (number/even? 6)) |    (number-even? 6)) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (number/odd? 6)) |    (number-odd? 6)) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (number/positive? -10)) |    (number-positive? -10)) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (number/natural? 10.0)) |    (number-natural? 10.0)) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (number/natural? -10)) |    (number-natural? -10)) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (number/natural? -10.0))) |    (number-natural? -10.0))) | ||||||
| 
 | 
 | ||||||
| (provide 'number) | (provide 'number) | ||||||
| ;;; number.el ends here | ;;; number.el ends here | ||||||
|  |  | ||||||
|  | @ -33,8 +33,8 @@ | ||||||
| ;; TODO: Make this work with sequences instead of lists. | ;; TODO: Make this work with sequences instead of lists. | ||||||
| (defun random-choice (xs) | (defun random-choice (xs) | ||||||
|   "Return a random element of `XS'." |   "Return a random element of `XS'." | ||||||
|   (let ((ct (list/length xs))) |   (let ((ct (list-length xs))) | ||||||
|     (list/get |     (list-get | ||||||
|      (random-int ct) |      (random-int ct) | ||||||
|      xs))) |      xs))) | ||||||
| 
 | 
 | ||||||
|  | @ -45,9 +45,9 @@ | ||||||
| ;; TODO: This may not work if any of these generate numbers like 0, 1, etc. | ;; TODO: This may not work if any of these generate numbers like 0, 1, etc. | ||||||
| (defun random-uuid () | (defun random-uuid () | ||||||
|   "Return a generated UUID string." |   "Return a generated UUID string." | ||||||
|   (let ((eight  (number/dec (math/triangle-of-power :base 16 :power 8))) |   (let ((eight  (number-dec (math-triangle-of-power :base 16 :power 8))) | ||||||
|         (four   (number/dec (math/triangle-of-power :base 16 :power 4))) |         (four   (number-dec (math-triangle-of-power :base 16 :power 4))) | ||||||
|         (twelve (number/dec (math/triangle-of-power :base 16 :power 12)))) |         (twelve (number-dec (math-triangle-of-power :base 16 :power 12)))) | ||||||
|     (format "%x-%x-%x-%x-%x" |     (format "%x-%x-%x-%x-%x" | ||||||
|             (random-int eight) |             (random-int eight) | ||||||
|             (random-int four) |             (random-int four) | ||||||
|  | @ -57,25 +57,25 @@ | ||||||
| 
 | 
 | ||||||
| (defun random-token (length) | (defun random-token (length) | ||||||
|   "Return a randomly generated hexadecimal string of LENGTH." |   "Return a randomly generated hexadecimal string of LENGTH." | ||||||
|   (->> (series/range 0 (number/dec length)) |   (->> (series/range 0 (number-dec length)) | ||||||
|        (list/map (lambda (_) (format "%x" (random-int 15)))) |        (list-map (lambda (_) (format "%x" (random-int 15)))) | ||||||
|        (list/join ""))) |        (list-join ""))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support random-sample | ;; TODO: Support random-sample | ||||||
| ;; (defun random-sample (n xs) | ;; (defun random-sample (n xs) | ||||||
| ;;   "Return a randomly sample of list XS of size N." | ;;   "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 | ;;   (cl-labels ((do-sample | ||||||
| ;;                (n xs y ys) | ;;                (n xs y ys) | ||||||
| ;;                (if (= n (set/count ys)) | ;;                (if (= n (set-count ys)) | ||||||
| ;;                    (->> ys | ;;                    (->> ys | ||||||
| ;;                         set/to-list | ;;                         set-to-list | ||||||
| ;;                         (list/map (lambda (i) | ;;                         (list-map (lambda (i) | ||||||
| ;;                                     (list/get i xs)))) | ;;                                     (list-get i xs)))) | ||||||
| ;;                  (if (set/contains? y ys) | ;;                  (if (set-contains? y ys) | ||||||
| ;;                      (do-sample n xs (random-int (list/length xs)) ys) | ;;                      (do-sample n xs (random-int (list-length xs)) ys) | ||||||
| ;;                    (do-sample n xs y (set/add y ys)))))) | ;;                    (do-sample n xs y (set-add y ys)))))) | ||||||
| ;;     (do-sample n xs (random-int (list/length xs)) (set/new)))) | ;;     (do-sample n xs (random-int (list-length xs)) (set-new)))) | ||||||
| 
 | 
 | ||||||
| (provide 'random) | (provide 'random) | ||||||
| ;;; random.el ends here | ;;; random.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; scope.el --- Work with a scope data structure -*- lexical-binding: t -*- | ;;; scope.el --- Work with a scope data structure -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Exposing an API for working with a scope data structure in a non-mutative | ;; Exposing an API for working with a scope data structure in a non-mutative | ||||||
|  | @ -9,89 +13,93 @@ | ||||||
| 
 | 
 | ||||||
| ;;; Code: | ;;; Code: | ||||||
| 
 | 
 | ||||||
|  | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | ;; Dependencies | ||||||
|  | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  | 
 | ||||||
| (require 'alist) | (require 'alist) | ||||||
| (require 'stack) | (require 'stack) | ||||||
| (require 'struct) | (require 'struct) | ||||||
| (require 'macros) | (require 'macros) | ||||||
| 
 | 
 | ||||||
| (cl-defstruct scope scopes) |  | ||||||
| 
 |  | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Create | ;; Create | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun scope/new () | (cl-defstruct scope scopes) | ||||||
|   "Return an empty scope." |  | ||||||
|   (make-scope :scopes (->> (stack/new) |  | ||||||
|                            (stack/push (alist/new))))) |  | ||||||
| 
 | 
 | ||||||
| (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. |   "Return a flattened representation of the scope, XS. | ||||||
| The newest bindings eclipse the oldest." | The newest bindings eclipse the oldest." | ||||||
|   (->> xs |   (->> xs | ||||||
|        scope-scopes |        scope-scopes | ||||||
|        stack/to-list |        stack-to-list | ||||||
|        (list/reduce (alist/new) |        (list-reduce (alist-new) | ||||||
|                     (lambda (scope acc) |                     (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." |   "Push a new, empty scope onto XS." | ||||||
|   (struct-update scope |   (struct-update scope | ||||||
|                  scopes |                  scopes | ||||||
|                  (>> (stack/push (alist/new))) |                  (>> (stack-push (alist-new))) | ||||||
|                  xs)) |                  xs)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Read | ;; Read | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun scope/get (k xs) | (defun scope-get (k xs) | ||||||
|   "Return K from XS if it's in scope." |   "Return K from XS if it's in scope." | ||||||
|   (->> xs |   (->> xs | ||||||
|        scope/flatten |        scope-flatten | ||||||
|        (alist/get k))) |        (alist-get k))) | ||||||
| 
 | 
 | ||||||
| (defun scope/current (xs) | (defun scope-current (xs) | ||||||
|   "Return the newest scope from XS." |   "Return the newest scope from XS." | ||||||
|   (let ((xs-copy (copy-scope xs))) |   (let ((xs-copy (copy-scope xs))) | ||||||
|     (->> xs-copy |     (->> xs-copy | ||||||
|          scope-scopes |          scope-scopes | ||||||
|          stack/peek))) |          stack-peek))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Update | ;; 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." |   "Set value, V, at key, K, in XS for the current scope." | ||||||
|   (struct-update scope |   (struct-update scope | ||||||
|                  scopes |                  scopes | ||||||
|                  (>> (stack/map-top (>> (alist/set k v)))) |                  (>> (stack-map-top (>> (alist-set k v)))) | ||||||
|                  xs)) |                  xs)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Delete | ;; Delete | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun scope/pop (xs) | (defun scope-pop (xs) | ||||||
|   "Return a new scope without the top element from XS." |   "Return a new scope without the top element from XS." | ||||||
|   (->> xs |   (->> xs | ||||||
|        scope-scopes |        scope-scopes | ||||||
|        stack/pop)) |        stack-pop)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Predicates | ;; Predicates | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun scope/defined? (k xs) | (defun scope-defined? (k xs) | ||||||
|   "Return t if K is in scope of XS." |   "Return t if K is in scope of XS." | ||||||
|   (->> xs |   (->> xs | ||||||
|        scope/flatten |        scope-flatten | ||||||
|        (alist/has-key? k))) |        (alist-has-key? k))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Find a faster way to write aliases like this. | ;; 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." |   "Return t if XS is a scope struct." | ||||||
|   (scope-p xs)) |   (scope-p xs)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -1,4 +1,5 @@ | ||||||
| ;;; screen-brightness.el --- Control laptop screen brightness -*- lexical-binding: t -*- | ;;; screen-brightness.el --- Control laptop screen brightness -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ;; Author: William Carroll <wpcarro@gmail.com> | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
|  |  | ||||||
|  | @ -1,4 +1,9 @@ | ||||||
|  | ;;; scrot.el --- Screenshot functions -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; scrot is a Linux utility for taking screenshots. | ;; scrot is a Linux utility for taking screenshots. | ||||||
|  | @ -19,43 +24,43 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst scrot/screenshot-directory "~/Downloads" | (defconst scrot-screenshot-directory "~/Downloads" | ||||||
|   "The default directory for screenshot outputs.") |   "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.") |   "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. |   "The format string for the output screenshot file. | ||||||
| See scrot's man page for more information.") | 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. |   "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" | This currently only works for PNG files because that's what I'm outputting" | ||||||
|   (call-process "xclip" nil nil nil |   (call-process "xclip" nil nil nil | ||||||
|                 "-selection" "clipboard" "-t" "image/png" path) |                 "-selection" "clipboard" "-t" "image/png" path) | ||||||
|   (message (string-format "[scrot.el] Image copied to clipboard!"))) |   (message (string-format "[scrot.el] Image copied to clipboard!"))) | ||||||
| 
 | 
 | ||||||
| (defmacro scrot/call (&rest args) | (defmacro scrot-call (&rest args) | ||||||
|   "Call scrot with 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." |   "Screenshot the entire screen." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((screenshot-path (f-join scrot/screenshot-directory |   (let ((screenshot-path (f-join scrot-screenshot-directory | ||||||
|                                  (ts-format scrot/output-format (ts-now))))) |                                  (ts-format scrot-output-format (ts-now))))) | ||||||
|     (scrot/call screenshot-path) |     (scrot-call screenshot-path) | ||||||
|     (scrot/copy-image screenshot-path))) |     (scrot-copy-image screenshot-path))) | ||||||
| 
 | 
 | ||||||
| (defun scrot/select () | (defun scrot-select () | ||||||
|   "Click-and-drag to screenshot a region. |   "Click-and-drag to screenshot a region. | ||||||
| The output path is copied to the user's clipboard." | The output path is copied to the user's clipboard." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((screenshot-path (f-join scrot/screenshot-directory |   (let ((screenshot-path (f-join scrot-screenshot-directory | ||||||
|                                  (ts-format scrot/output-format (ts-now))))) |                                  (ts-format scrot-output-format (ts-now))))) | ||||||
|     (scrot/call "--select" screenshot-path) |     (scrot-call "--select" screenshot-path) | ||||||
|     (scrot/copy-image screenshot-path))) |     (scrot-copy-image screenshot-path))) | ||||||
| 
 | 
 | ||||||
| (provide 'scrot) | (provide 'scrot) | ||||||
| ;;; scrot.el ends here | ;;; scrot.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; sequence.el --- Working with the "sequence" types -*- lexical-binding: t -*- | ;;; sequence.el --- Working with the "sequence" types -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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 "25.1")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Elisp supports a typeclass none as "sequence" which covers the following | ;; Elisp supports a typeclass none as "sequence" which covers the following | ||||||
|  | @ -66,22 +70,22 @@ | ||||||
| ;; (defprotocol sequence | ;; (defprotocol sequence | ||||||
| ;;   :functions (reduce)) | ;;   :functions (reduce)) | ||||||
| ;; (definstance sequence list | ;; (definstance sequence list | ||||||
| ;;   :reduce #'list/reduce | ;;   :reduce #'list-reduce | ||||||
| ;;   :filter #'list/filter | ;;   :filter #'list-filter | ||||||
| ;;   :map    #'list/map) | ;;   :map    #'list-map) | ||||||
| ;; (definstance sequence vector | ;; (definstance sequence vector | ||||||
| ;;   :reduce #'vector/reduce) | ;;   :reduce #'vector/reduce) | ||||||
| ;; (definstance sequence string | ;; (definstance sequence string | ||||||
| ;;   :reduce #'string) | ;;   :reduce #'string) | ||||||
| 
 | 
 | ||||||
| (defun sequence/classify (xs) | (defun sequence-classify (xs) | ||||||
|   "Return the type of `XS'." |   "Return the type of `XS'." | ||||||
|   (cond |   (cond | ||||||
|    ((listp xs) 'list) |    ((listp xs) 'list) | ||||||
|    ((vectorp xs) 'vector) |    ((vectorp xs) 'vector) | ||||||
|    ((stringp xs) 'string))) |    ((stringp xs) 'string))) | ||||||
| 
 | 
 | ||||||
| (defun sequence/reduce (acc f xs) | (defun sequence-reduce (acc f xs) | ||||||
|   "Reduce of `XS' calling `F' on x and `ACC'." |   "Reduce of `XS' calling `F' on x and `ACC'." | ||||||
|   (seq-reduce |   (seq-reduce | ||||||
|    (lambda (acc x) |    (lambda (acc x) | ||||||
|  | @ -91,12 +95,12 @@ | ||||||
| 
 | 
 | ||||||
| ;; Elixir also turned everything into a list for efficiecy reasons. | ;; 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'. |   "Filter `XS' with predicate, `P'. | ||||||
| Returns a list regardless of the type of `XS'." | Returns a list regardless of the type of `XS'." | ||||||
|   (seq-filter p xs)) |   (seq-filter p xs)) | ||||||
| 
 | 
 | ||||||
| (defun sequence/map (f xs) | (defun sequence-map (f xs) | ||||||
|   "Maps `XS' calling `F' on each element. |   "Maps `XS' calling `F' on each element. | ||||||
| Returns a list regardless of the type of `XS'." | Returns a list regardless of the type of `XS'." | ||||||
|   (seq-map f xs)) |   (seq-map f xs)) | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; series.el --- Hosting common series of numbers -*- lexical-binding: t -*- | ;;; series.el --- Hosting common series of numbers -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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: | ;;; Commentary: | ||||||
| ;; Encoding number series as I learn about them. | ;; Encoding number series as I learn about them. | ||||||
|  | @ -28,62 +32,62 @@ | ||||||
| ;; Library | ;; Library | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun series/range (beg end) | (defun series-range (beg end) | ||||||
|   "Create a list of numbers from `BEG' to `END'. |   "Create a list of numbers from `BEG' to `END'. | ||||||
| This is an inclusive number range." | This is an inclusive number range." | ||||||
|   (if (< end beg) |   (if (< end beg) | ||||||
|       (list/reverse |       (list-reverse | ||||||
|        (number-sequence end beg)) |        (number-sequence end beg)) | ||||||
|     (number-sequence beg end))) |     (number-sequence beg end))) | ||||||
| 
 | 
 | ||||||
| (defun series/fibonacci-number (i) | (defun series-fibonacci-number (i) | ||||||
|   "Return the number in the fibonacci series at `I'." |   "Return the number in the fibonacci series at `I'." | ||||||
|   (cond |   (cond | ||||||
|    ((= 0 i) 0) |    ((= 0 i) 0) | ||||||
|    ((= 1 i) 1) |    ((= 1 i) 1) | ||||||
|    (t (+ (series/fibonacci-number (- i 1)) |    (t (+ (series-fibonacci-number (- i 1)) | ||||||
|          (series/fibonacci-number (- i 2)))))) |          (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." |   "Return the first `N' numbers of the fibonaccci series starting at zero." | ||||||
|   (if (= 0 n) |   (if (= 0 n) | ||||||
|       '() |       '() | ||||||
|     (list/reverse |     (list-reverse | ||||||
|      (list/cons (series/fibonacci-number (number/dec n)) |      (list-cons (series-fibonacci-number (number-dec n)) | ||||||
|                 (list/reverse |                 (list-reverse | ||||||
|                  (series/fibonacci (number/dec n))))))) |                  (series-fibonacci (number-dec n))))))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Consider memoization. | ;; TODO: Consider memoization. | ||||||
| (defun series/triangular-number (i) | (defun series-triangular-number (i) | ||||||
|   "Return the number in the triangular series at `I'." |   "Return the number in the triangular series at `I'." | ||||||
|   (if (= 0 i) |   (if (= 0 i) | ||||||
|       0 |       0 | ||||||
|     (+ i (series/triangular-number (number/dec i))))) |     (+ i (series-triangular-number (number-dec i))))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Improve performance. | ;; TODO: Improve performance. | ||||||
| ;; TODO: Consider creating a stream protocol with `stream/next' and implement | ;; TODO: Consider creating a stream protocol with `stream/next' and implement | ||||||
| ;; this using that. | ;; this using that. | ||||||
| (defun series/triangular (n) | (defun series-triangular (n) | ||||||
|   "Return the first `N' numbers of a triangular series starting at 0." |   "Return the first `N' numbers of a triangular series starting at 0." | ||||||
|   (if (= 0 n) |   (if (= 0 n) | ||||||
|       '() |       '() | ||||||
|     (list/reverse |     (list-reverse | ||||||
|      (list/cons (series/triangular-number (number/dec n)) |      (list-cons (series-triangular-number (number-dec n)) | ||||||
|                 (list/reverse |                 (list-reverse | ||||||
|                  (series/triangular (number/dec n))))))) |                  (series-triangular (number-dec n))))))) | ||||||
| 
 | 
 | ||||||
| (defun series/catalan-number (i) | (defun series-catalan-number (i) | ||||||
|   "Return the catalan number in the series at `I'." |   "Return the catalan number in the series at `I'." | ||||||
|   (if (= 0 i) |   (if (= 0 i) | ||||||
|       1 |       1 | ||||||
|     (/ (number/factorial (* 2 i)) |     (/ (number-factorial (* 2 i)) | ||||||
|        (* (number/factorial (number/inc i)) |        (* (number-factorial (number-inc i)) | ||||||
|           (number/factorial i))))) |           (number-factorial i))))) | ||||||
| 
 | 
 | ||||||
| (defun series/catalan (n) | (defun series-catalan (n) | ||||||
|   "Return the first `N' numbers in a catalan series." |   "Return the first `N' numbers in a catalan series." | ||||||
|   (->> (series/range 0 (number/dec n)) |   (->> (series-range 0 (number-dec n)) | ||||||
|        (list/map #'series/catalan-number))) |        (list-map #'series-catalan-number))) | ||||||
| 
 | 
 | ||||||
| (provide 'series) | (provide 'series) | ||||||
| ;;; series.el ends here | ;;; series.el ends here | ||||||
|  |  | ||||||
|  | @ -1,5 +1,9 @@ | ||||||
| ;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- | ;;; set.el --- Working with mathematical sets -*- lexical-binding: t -*- | ||||||
|  | 
 | ||||||
| ;; Author: 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.3")) | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; The set data structure is a collection that deduplicates its elements. | ;; The set data structure is a collection that deduplicates its elements. | ||||||
|  | @ -24,26 +28,26 @@ | ||||||
| 
 | 
 | ||||||
| (cl-defstruct set xs) | (cl-defstruct set xs) | ||||||
| 
 | 
 | ||||||
| (defconst set/enable-testing? t | (defconst set-enable-testing? t | ||||||
|   "Run tests when t.") |   "Run tests when t.") | ||||||
| 
 | 
 | ||||||
| (defun set/from-list (xs) | (defun set-from-list (xs) | ||||||
|   "Create a new set from the list XS." |   "Create a new set from the list XS." | ||||||
|   (make-set :xs (->> xs |   (make-set :xs (->> xs | ||||||
|                      (list/map #'dotted/new) |                      (list-map #'dotted-new) | ||||||
|                      ht-from-alist))) |                      ht-from-alist))) | ||||||
| 
 | 
 | ||||||
| (defun set/new (&rest args) | (defun set-new (&rest args) | ||||||
|   "Create a new set from 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." |   "Map set XS into a list." | ||||||
|   (->> xs |   (->> xs | ||||||
|        set-xs |        set-xs | ||||||
|        ht-keys)) |        ht-keys)) | ||||||
| 
 | 
 | ||||||
| (defun set/add (x xs) | (defun set-add (x xs) | ||||||
|   "Add X to set XS." |   "Add X to set XS." | ||||||
|   (struct-update set |   (struct-update set | ||||||
|                  xs |                  xs | ||||||
|  | @ -54,22 +58,22 @@ | ||||||
|                  xs)) |                  xs)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Ensure all `*/reduce' functions share the same API. | ;; 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." |   "Return a new set by calling F on each element of XS and ACC." | ||||||
|   (->> xs |   (->> xs | ||||||
|        set/to-list |        set-to-list | ||||||
|        (list/reduce acc f))) |        (list-reduce acc f))) | ||||||
| 
 | 
 | ||||||
| (defun set/intersection (a b) | (defun set-intersection (a b) | ||||||
|   "Return the set intersection between sets A and B." |   "Return the set intersection between sets A and B." | ||||||
|   (set/reduce (set/new) |   (set-reduce (set-new) | ||||||
|               (lambda (x acc) |               (lambda (x acc) | ||||||
|                 (if (set/contains? x b) |                 (if (set-contains? x b) | ||||||
|                     (set/add x acc) |                     (set-add x acc) | ||||||
|                   acc)) |                   acc)) | ||||||
|               a)) |               a)) | ||||||
| 
 | 
 | ||||||
| (defun set/count (xs) | (defun set-count (xs) | ||||||
|   "Return the number of elements in XS." |   "Return the number of elements in XS." | ||||||
|   (->> xs |   (->> xs | ||||||
|        set-xs |        set-xs | ||||||
|  | @ -79,93 +83,93 @@ | ||||||
| ;; Predicates | ;; Predicates | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun set/empty? (xs) | (defun set-empty? (xs) | ||||||
|   "Return t if XS has no elements in it." |   "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." |   "Return t if set XS has X." | ||||||
|   (ht-contains? (set-xs xs) x)) |   (ht-contains? (set-xs xs) x)) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Prefer using `ht.el' functions for this. | ;; 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." |   "Return t if A and B share the name members." | ||||||
|   (ht-equal? (set-xs a) |   (ht-equal? (set-xs a) | ||||||
|              (set-xs b))) |              (set-xs b))) | ||||||
| 
 | 
 | ||||||
| (defun set/distinct? (a b) | (defun set-distinct? (a b) | ||||||
|   "Return t if sets A and B have no shared members." |   "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." |   "Return t if set A contains all of the members of set B." | ||||||
|   (->> b |   (->> b | ||||||
|        set/to-list |        set-to-list | ||||||
|        (list/all? (lambda (x) (set/contains? x a))))) |        (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." |   "Return t if each member of set A is present in set B." | ||||||
|   (set/superset? b a)) |   (set-superset? b a)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (when set/enable-testing? | (when set-enable-testing? | ||||||
|   ;; set/distinct? |   ;; set-distinct? | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (set/distinct? (set/new 'one 'two 'three) |    (set-distinct? (set-new 'one 'two 'three) | ||||||
|                   (set/new 'a 'b 'c))) |                   (set-new 'a 'b 'c))) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (set/distinct? (set/new 1 2 3) |    (set-distinct? (set-new 1 2 3) | ||||||
|                   (set/new 3 4 5))) |                   (set-new 3 4 5))) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (set/distinct? (set/new 1 2 3) |    (set-distinct? (set-new 1 2 3) | ||||||
|                   (set/new 1 2 3))) |                   (set-new 1 2 3))) | ||||||
|   ;; set/equal? |   ;; set-equal? | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (set/equal? (set/new 'a 'b 'c) |    (set-equal? (set-new 'a 'b 'c) | ||||||
|                (set/new 'x 'y 'z))) |                (set-new 'x 'y 'z))) | ||||||
|   (prelude-refute |   (prelude-refute | ||||||
|    (set/equal? (set/new 'a 'b 'c) |    (set-equal? (set-new 'a 'b 'c) | ||||||
|                (set/new 'a 'b))) |                (set-new 'a 'b))) | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (set/equal? (set/new 'a 'b 'c) |    (set-equal? (set-new 'a 'b 'c) | ||||||
|                (set/new 'a 'b 'c))) |                (set-new 'a 'b 'c))) | ||||||
|   ;; set/intersection |   ;; set-intersection | ||||||
|   (prelude-assert |   (prelude-assert | ||||||
|    (set/equal? (set/new 2 3) |    (set-equal? (set-new 2 3) | ||||||
|                (set/intersection (set/new 1 2 3) |                (set-intersection (set-new 1 2 3) | ||||||
|                                  (set/new 2 3 4)))) |                                  (set-new 2 3 4)))) | ||||||
|   ;; set/{from,to}-list |   ;; set-{from,to}-list | ||||||
|   (prelude-assert (equal '(1 2 3) |   (prelude-assert (equal '(1 2 3) | ||||||
|                          (->> '(1 1 2 2 3 3) |                          (->> '(1 1 2 2 3 3) | ||||||
|                               set/from-list |                               set-from-list | ||||||
|                               set/to-list))) |                               set-to-list))) | ||||||
|   (let ((primary-colors (set/new "red" "green" "blue"))) |   (let ((primary-colors (set-new "red" "green" "blue"))) | ||||||
|     ;; set/subset? |     ;; set-subset? | ||||||
|     (prelude-refute |     (prelude-refute | ||||||
|      (set/subset? (set/new "black" "grey") |      (set-subset? (set-new "black" "grey") | ||||||
|                   primary-colors)) |                   primary-colors)) | ||||||
|     (prelude-assert |     (prelude-assert | ||||||
|      (set/subset? (set/new "red") |      (set-subset? (set-new "red") | ||||||
|                   primary-colors)) |                   primary-colors)) | ||||||
|     ;; set/superset? |     ;; set-superset? | ||||||
|     (prelude-refute |     (prelude-refute | ||||||
|      (set/superset? primary-colors |      (set-superset? primary-colors | ||||||
|                     (set/new "black" "grey"))) |                     (set-new "black" "grey"))) | ||||||
|     (prelude-assert |     (prelude-assert | ||||||
|      (set/superset? primary-colors |      (set-superset? primary-colors | ||||||
|                     (set/new "red" "green" "blue"))) |                     (set-new "red" "green" "blue"))) | ||||||
|     (prelude-assert |     (prelude-assert | ||||||
|      (set/superset? primary-colors |      (set-superset? primary-colors | ||||||
|                     (set/new "red" "blue")))) |                     (set-new "red" "blue")))) | ||||||
|   ;; set/empty? |   ;; set-empty? | ||||||
|   (prelude-assert (set/empty? (set/new))) |   (prelude-assert (set-empty? (set-new))) | ||||||
|   (prelude-refute (set/empty? (set/new 1 2 3))) |   (prelude-refute (set-empty? (set-new 1 2 3))) | ||||||
|   ;; set/count |   ;; set-count | ||||||
|   (prelude-assert (= 0 (set/count (set/new)))) |   (prelude-assert (= 0 (set-count (set-new)))) | ||||||
|   (prelude-assert (= 2 (set/count (set/new 1 1 2 2))))) |   (prelude-assert (= 2 (set-count (set-new 1 1 2 2))))) | ||||||
| 
 | 
 | ||||||
| (provide 'set) | (provide 'set) | ||||||
| ;;; set.el ends here | ;;; set.el ends here | ||||||
|  |  | ||||||
|  | @ -37,23 +37,23 @@ | ||||||
| ;; Maximizes the tramp debugging noisiness while I'm still learning about tramp. | ;; Maximizes the tramp debugging noisiness while I'm still learning about tramp. | ||||||
| (setq tramp-verbose 10) | (setq tramp-verbose 10) | ||||||
| 
 | 
 | ||||||
| (defcustom ssh/hosts '("desktop" "socrates") | (defcustom ssh-hosts '("desktop" "socrates") | ||||||
|   "List of hosts to which I commonly connect. |   "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.") |   that's more than I need at the moment.") | ||||||
| 
 | 
 | ||||||
| (defun ssh/sudo-buffer () | (defun ssh-sudo-buffer () | ||||||
|   "Open the current buffer with sudo rights." |   "Open the current buffer with sudo rights." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (with-current-buffer (current-buffer) |   (with-current-buffer (current-buffer) | ||||||
|     (if (s-starts-with? "/ssh:" buffer-file-name) |     (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))))) |       (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." |   "Prompt for an SSH host and open a dired buffer for wpcarro on that machine." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((machine (completing-read "Machine: " ssh/hosts))) |   (let ((machine (completing-read "Machine: " ssh-hosts))) | ||||||
|     (find-file (format "/ssh:wpcarro@%s:~" machine)))) |     (find-file (format "/ssh:wpcarro@%s:~" machine)))) | ||||||
| 
 | 
 | ||||||
| (provide 'ssh) | (provide 'ssh) | ||||||
|  |  | ||||||
|  | @ -26,62 +26,62 @@ | ||||||
| ;; Create | ;; Create | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun stack/new () | (defun stack-new () | ||||||
|   "Create an empty stack." |   "Create an empty stack." | ||||||
|   (make-stack :xs '())) |   (make-stack :xs '())) | ||||||
| 
 | 
 | ||||||
| (defun stack/from-list (xs) | (defun stack-from-list (xs) | ||||||
|   "Create a new stack from the 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 | ;; Read | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun stack/peek (xs) | (defun stack-peek (xs) | ||||||
|   "Look at the top element of `XS' without popping it off." |   "Look at the top element of `XS' without popping it off." | ||||||
|   (->> xs |   (->> xs | ||||||
|        stack-xs |        stack-xs | ||||||
|        list/head)) |        list-head)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Update | ;; Update | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun stack/push (x xs) | (defun stack-push (x xs) | ||||||
|   "Push `X' on `XS'." |   "Push `X' on `XS'." | ||||||
|   (struct-update stack |   (struct-update stack | ||||||
|                  xs |                  xs | ||||||
|                  (>> (list/cons x)) |                  (>> (list-cons x)) | ||||||
|                  xs)) |                  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? | ;; TODO: How to handle popping from empty stacks? | ||||||
| (defun stack/pop (xs) | (defun stack-pop (xs) | ||||||
|   "Return the stack, `XS', without the top element. |   "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 | 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 |   (struct-update stack | ||||||
|                  xs |                  xs | ||||||
|                  (>> list/tail) |                  (>> list-tail) | ||||||
|                  xs)) |                  xs)) | ||||||
| 
 | 
 | ||||||
| (defun stack/map-top (f xs) | (defun stack-map-top (f xs) | ||||||
|   "Apply F to the top element of XS." |   "Apply F to the top element of XS." | ||||||
|   (->> xs |   (->> xs | ||||||
|        stack/pop |        stack-pop | ||||||
|        (stack/push (funcall f (stack/peek xs))))) |        (stack-push (funcall f (stack-peek xs))))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Miscellaneous | ;; Miscellaneous | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defun stack/to-list (xs) | (defun stack-to-list (xs) | ||||||
|   "Return XS as a list. |   "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 |   (->> xs | ||||||
|        stack-xs |        stack-xs | ||||||
|        list/reverse)) |        list-reverse)) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Predicates | ;; 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 | ;; TODO: Create a macro that wraps `cl-defstruct' that automatically creates | ||||||
| ;; things like `new', `instance?'. | ;; things like `new', `instance?'. | ||||||
| (defun stack/instance? (xs) | (defun stack-instance? (xs) | ||||||
|   "Return t if XS is a stack." |   "Return t if XS is a stack." | ||||||
|   (stack-p xs)) |   (stack-p xs)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -72,14 +72,14 @@ Depth-first traversals have the advantage of typically consuming less memory | ||||||
|                  (if (or (maybe-nil? node) |                  (if (or (maybe-nil? node) | ||||||
|                          (tree-leaf? node)) |                          (tree-leaf? node)) | ||||||
|                      acc-new |                      acc-new | ||||||
|                    (list/reduce |                    (list-reduce | ||||||
|                     acc-new |                     acc-new | ||||||
|                     (lambda (node acc) |                     (lambda (node acc) | ||||||
|                       (tree-do-reduce-depth |                       (tree-do-reduce-depth | ||||||
|                        acc |                        acc | ||||||
|                        f |                        f | ||||||
|                        node |                        node | ||||||
|                        (number/inc depth))) |                        (number-inc depth))) | ||||||
|                     (node-children node)))))) |                     (node-children node)))))) | ||||||
|     (do-reduce-depth acc f node 0))) |     (do-reduce-depth acc f node 0))) | ||||||
| 
 | 
 | ||||||
|  | @ -94,13 +94,13 @@ Depth-first traversals have the advantage of typically consuming less memory | ||||||
| ;; above. | ;; above. | ||||||
| (defun tree-leaf-depths (xs) | (defun tree-leaf-depths (xs) | ||||||
|   "Return a list of all of the depths of the leaf nodes in XS." |   "Return a list of all of the depths of the leaf nodes in XS." | ||||||
|   (list/reverse |   (list-reverse | ||||||
|    (tree-reduce-depth |    (tree-reduce-depth | ||||||
|     '() |     '() | ||||||
|     (lambda (node acc depth) |     (lambda (node acc depth) | ||||||
|       (if (or (maybe-nil? node) |       (if (or (maybe-nil? node) | ||||||
|               (tree-leaf? node)) |               (tree-leaf? node)) | ||||||
|           (list/cons depth acc) |           (list-cons depth acc) | ||||||
|         acc)) |         acc)) | ||||||
|     xs))) |     xs))) | ||||||
| 
 | 
 | ||||||
|  | @ -122,8 +122,8 @@ generating test data.  Warning this function can overflow the stack." | ||||||
|                (d vf bf) |                (d vf bf) | ||||||
|                (make-node |                (make-node | ||||||
|                 :value (funcall vf d) |                 :value (funcall vf d) | ||||||
|                 :children (->> (series/range 0 (number/dec bf)) |                 :children (->> (series/range 0 (number-dec bf)) | ||||||
|                                (list/map |                                (list-map | ||||||
|                                 (lambda (_) |                                 (lambda (_) | ||||||
|                                   (when (random-boolean?) |                                   (when (random-boolean?) | ||||||
|                                     (do-random d vf bf)))))))) |                                     (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." |   nodes in XS is greater than N." | ||||||
|   (> n (->> xs |   (> n (->> xs | ||||||
|             tree-leaf-depths |             tree-leaf-depths | ||||||
|             set/from-list |             set-from-list | ||||||
|             set/count |             set-count | ||||||
|             number/dec))) |             number-dec))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| ;; Tests | ;; Tests | ||||||
|  |  | ||||||
|  | @ -31,7 +31,7 @@ | ||||||
| ;; Configuration | ;; Configuration | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
| (defconst vterm-mgt--instances (cycle/new) | (defconst vterm-mgt--instances (cycle-new) | ||||||
|   "A cycle tracking all of my vterm instances.") |   "A cycle tracking all of my vterm instances.") | ||||||
| 
 | 
 | ||||||
| (defcustom vterm-mgt-scroll-on-focus nil | (defcustom vterm-mgt-scroll-on-focus nil | ||||||
|  | @ -50,8 +50,8 @@ | ||||||
| This function should be called from a buffer running vterm." | This function should be called from a buffer running vterm." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (vterm-mgt--assert-vterm-buffer) |   (vterm-mgt--assert-vterm-buffer) | ||||||
|   (cycle/focus-item (current-buffer) vterm-mgt--instances) |   (cycle-focus-item (current-buffer) vterm-mgt--instances) | ||||||
|   (switch-to-buffer (cycle/next vterm-mgt--instances)) |   (switch-to-buffer (cycle-next vterm-mgt--instances)) | ||||||
|   (when vterm-mgt-scroll-on-focus (end-of-buffer))) |   (when vterm-mgt-scroll-on-focus (end-of-buffer))) | ||||||
| 
 | 
 | ||||||
| (defun vterm-mgt-prev () | (defun vterm-mgt-prev () | ||||||
|  | @ -59,8 +59,8 @@ This function should be called from a buffer running vterm." | ||||||
| This function should be called from a buffer running vterm." | This function should be called from a buffer running vterm." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (vterm-mgt--assert-vterm-buffer) |   (vterm-mgt--assert-vterm-buffer) | ||||||
|   (cycle/focus-item (current-buffer) vterm-mgt--instances) |   (cycle-focus-item (current-buffer) vterm-mgt--instances) | ||||||
|   (switch-to-buffer (cycle/prev vterm-mgt--instances)) |   (switch-to-buffer (cycle-prev vterm-mgt--instances)) | ||||||
|   (when vterm-mgt-scroll-on-focus (end-of-buffer))) |   (when vterm-mgt-scroll-on-focus (end-of-buffer))) | ||||||
| 
 | 
 | ||||||
| (defun vterm-mgt-instantiate () | (defun vterm-mgt-instantiate () | ||||||
|  | @ -74,8 +74,8 @@ If however you must call `vterm', if you'd like to cycle through vterm | ||||||
|   collect any untracked vterm instances." |   collect any untracked vterm instances." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (let ((buffer (vterm))) |   (let ((buffer (vterm))) | ||||||
|     (cycle/append buffer vterm-mgt--instances) |     (cycle-append buffer vterm-mgt--instances) | ||||||
|     (cycle/focus-item buffer vterm-mgt--instances))) |     (cycle-focus-item buffer vterm-mgt--instances))) | ||||||
| 
 | 
 | ||||||
| (defun vterm-mgt-kill () | (defun vterm-mgt-kill () | ||||||
|   "Kill the current buffer and remove it from `vterm-mgt--instances'. |   "Kill the current buffer and remove it from `vterm-mgt--instances'. | ||||||
|  | @ -83,23 +83,23 @@ This function should be called from a buffer running vterm." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (vterm-mgt--assert-vterm-buffer) |   (vterm-mgt--assert-vterm-buffer) | ||||||
|   (let ((buffer (current-buffer))) |   (let ((buffer (current-buffer))) | ||||||
|     (cycle/remove buffer vterm-mgt--instances) |     (cycle-remove buffer vterm-mgt--instances) | ||||||
|     (kill-buffer buffer))) |     (kill-buffer buffer))) | ||||||
| 
 | 
 | ||||||
| (defun vterm-mgt-find-or-create () | (defun vterm-mgt-find-or-create () | ||||||
|   "Call `switch-to-buffer' on a focused vterm instance if there is one. |   "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 | there are no items in the cycle, call `vterm-mgt-instantiate' to create a vterm | ||||||
| instance." | instance." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (if (cycle/empty? vterm-mgt--instances) |   (if (cycle-empty? vterm-mgt--instances) | ||||||
|       (vterm-mgt-instantiate) |       (vterm-mgt-instantiate) | ||||||
|     (if (cycle/focused? vterm-mgt--instances) |     (if (cycle-focused? vterm-mgt--instances) | ||||||
|         (switch-to-buffer (cycle/current vterm-mgt--instances)) |         (switch-to-buffer (cycle-current vterm-mgt--instances)) | ||||||
|       (progn |       (progn | ||||||
|         (cycle/jump 0 vterm-mgt--instances) |         (cycle-jump 0 vterm-mgt--instances) | ||||||
|         (switch-to-buffer (cycle/current vterm-mgt--instances)))))) |         (switch-to-buffer (cycle-current vterm-mgt--instances)))))) | ||||||
| 
 | 
 | ||||||
| (defun vterm-mgt-rename-buffer (name) | (defun vterm-mgt-rename-buffer (name) | ||||||
|   "Rename the current buffer ensuring that its NAME is wrapped in *vterm*<...>. |   "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 |   (setq vterm-mgt--instances | ||||||
|         (->> (buffer-list) |         (->> (buffer-list) | ||||||
|              (-filter #'vterm-mgt--instance?) |              (-filter #'vterm-mgt--instance?) | ||||||
|              cycle/from-list))) |              cycle-from-list))) | ||||||
| 
 | 
 | ||||||
| (provide 'vterm-mgt) | (provide 'vterm-mgt) | ||||||
| ;;; vterm-mgt.el ends here | ;;; vterm-mgt.el ends here | ||||||
|  |  | ||||||
|  | @ -43,11 +43,11 @@ | ||||||
| 
 | 
 | ||||||
| ;; TODO: Decide between window-manager, exwm, or some other namespace. | ;; 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. | ;; between most recent workspace. | ||||||
| 
 | 
 | ||||||
| ;; TODO: Support ad hoc cycle for loading a few workspaces that can be cycled | ;; 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, | ;; TODO: Consider supporting a workspace for Racket, Clojure, Common Lisp, | ||||||
| ;; Haskell, Elixir, and a few other languages. These could behave very similarly | ;; Haskell, Elixir, and a few other languages. These could behave very similarly | ||||||
|  | @ -80,11 +80,11 @@ | ||||||
|   "List of `window-manager--named-workspace' structs.") |   "List of `window-manager--named-workspace' structs.") | ||||||
| 
 | 
 | ||||||
| ;; Assert that no two workspaces share KBDs. | ;; 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 |                    (->> window-manager--named-workspaces | ||||||
|                         (list/map #'window-manager--named-workspace-kbd) |                         (list-map #'window-manager--named-workspace-kbd) | ||||||
|                         set/from-list |                         set-from-list | ||||||
|                         set/count))) |                         set-count))) | ||||||
| 
 | 
 | ||||||
| (defun window-manager--alert (x) | (defun window-manager--alert (x) | ||||||
|   "Message X with a structured format." |   "Message X with a structured format." | ||||||
|  | @ -101,12 +101,12 @@ | ||||||
|   (require 'exwm-randr) |   (require 'exwm-randr) | ||||||
|   (exwm-randr-enable) |   (exwm-randr-enable) | ||||||
|   (setq exwm-randr-workspace-monitor-plist |   (setq exwm-randr-workspace-monitor-plist | ||||||
|         (list 0 display/4k-monitor |         (list 0 display-4k-monitor | ||||||
|               1 display/laptop-monitor)) |               1 display-laptop-monitor)) | ||||||
| 
 | 
 | ||||||
|   (evil-set-initial-state 'exwm-mode 'emacs) |   (evil-set-initial-state 'exwm-mode 'emacs) | ||||||
|   (setq exwm-workspace-number |   (setq exwm-workspace-number | ||||||
|         (list/length window-manager--named-workspaces)) |         (list-length window-manager--named-workspaces)) | ||||||
|   (let ((kbds `( |   (let ((kbds `( | ||||||
|                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|                 ;; Window sizing |                 ;; Window sizing | ||||||
|  | @ -146,7 +146,7 @@ | ||||||
|                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
|                 (:key "M-:"               :fn eval-expression) |                 (: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-x"               :fn counsel-M-x) | ||||||
|                 (:key "<M-tab>"           :fn window-manager-next-workspace) |                 (:key "<M-tab>"           :fn window-manager-next-workspace) | ||||||
|                 (:key "<M-S-iso-lefttab>" :fn window-manager-prev-workspace) |                 (:key "<M-S-iso-lefttab>" :fn window-manager-prev-workspace) | ||||||
|  | @ -157,7 +157,7 @@ | ||||||
|                 ;; Workspaces |                 ;; Workspaces | ||||||
|                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
| 
 | 
 | ||||||
|                 (:key ,(kbd/raw 'workspace "l") :fn window-manager-logout)))) |                 (:key ,(kbd-raw 'workspace "l") :fn window-manager-logout)))) | ||||||
|     (setq exwm-input-global-keys |     (setq exwm-input-global-keys | ||||||
|           (->> kbds |           (->> kbds | ||||||
|                (-map (lambda (plist) |                (-map (lambda (plist) | ||||||
|  | @ -184,22 +184,22 @@ | ||||||
| ;; Here is the code required to allow EXWM to cycle workspaces. | ;; Here is the code required to allow EXWM to cycle workspaces. | ||||||
| (defconst window-manager--workspaces | (defconst window-manager--workspaces | ||||||
|   (->> window-manager--named-workspaces |   (->> window-manager--named-workspaces | ||||||
|        cycle/from-list) |        cycle-from-list) | ||||||
|   "Cycle of the my EXWM workspaces.") |   "Cycle of the my EXWM workspaces.") | ||||||
| 
 | 
 | ||||||
| (prelude-assert | (prelude-assert | ||||||
|  (= exwm-workspace-number |  (= exwm-workspace-number | ||||||
|     (list/length window-manager--named-workspaces))) |     (list-length window-manager--named-workspaces))) | ||||||
| 
 | 
 | ||||||
| (defun window-manager-next-workspace () | (defun window-manager-next-workspace () | ||||||
|   "Cycle forwards to the next workspace." |   "Cycle forwards to the next workspace." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (window-manager--change-workspace (cycle/next window-manager--workspaces))) |   (window-manager--change-workspace (cycle-next window-manager--workspaces))) | ||||||
| 
 | 
 | ||||||
| (defun window-manager-prev-workspace () | (defun window-manager-prev-workspace () | ||||||
|   "Cycle backwards to the previous workspace." |   "Cycle backwards to the previous workspace." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (window-manager--change-workspace (cycle/prev window-manager--workspaces))) |   (window-manager--change-workspace (cycle-prev window-manager--workspaces))) | ||||||
| 
 | 
 | ||||||
| ;; TODO: Create friendlier API for working with EXWM. | ;; TODO: Create friendlier API for working with EXWM. | ||||||
| 
 | 
 | ||||||
|  | @ -215,7 +215,7 @@ | ||||||
|   (window-manager--alert "Switched to char-mode")) |   (window-manager--alert "Switched to char-mode")) | ||||||
| 
 | 
 | ||||||
| (defconst window-manager--modes | (defconst window-manager--modes | ||||||
|   (cycle/from-list (list #'window-manager--char-mode |   (cycle-from-list (list #'window-manager--char-mode | ||||||
|                          #'window-manager--line-mode)) |                          #'window-manager--line-mode)) | ||||||
|   "Functions to switch exwm modes.") |   "Functions to switch exwm modes.") | ||||||
| 
 | 
 | ||||||
|  | @ -224,7 +224,7 @@ | ||||||
|   (interactive) |   (interactive) | ||||||
|   (with-current-buffer (window-buffer) |   (with-current-buffer (window-buffer) | ||||||
|     (when (eq major-mode 'exwm-mode) |     (when (eq major-mode 'exwm-mode) | ||||||
|       (funcall (cycle/next window-manager--modes))))) |       (funcall (cycle-next window-manager--modes))))) | ||||||
| 
 | 
 | ||||||
| ;; Ensure exwm apps open in char-mode. | ;; Ensure exwm apps open in char-mode. | ||||||
| (add-hook 'exwm-manage-finish-hook #'window-manager--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 |     (funcall | ||||||
|      (lambda () |      (lambda () | ||||||
|        (shell-command |        (shell-command | ||||||
|         (alist/get (ivy-read "System: " (alist/keys name->cmd)) |         (alist-get (ivy-read "System: " (alist-keys name->cmd)) | ||||||
|                    name->cmd)))))) |                    name->cmd)))))) | ||||||
| 
 | 
 | ||||||
| (defun window-manager--label->index (label workspaces) | (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)))) |                     (window-manager--named-workspace-label workspace)))) | ||||||
|         (key (window-manager--named-workspace-kbd workspace))) |         (key (window-manager--named-workspace-kbd workspace))) | ||||||
|     (exwm-input-set-key |     (exwm-input-set-key | ||||||
|      (kbd/for 'workspace key) |      (kbd-for 'workspace key) | ||||||
|      handler))) |      handler))) | ||||||
| 
 | 
 | ||||||
| (defun window-manager--change-workspace (workspace) | (defun window-manager--change-workspace (workspace) | ||||||
|  | @ -318,11 +318,11 @@ Currently using super- as the prefix for switching workspaces." | ||||||
| 
 | 
 | ||||||
| (defun window-manager--switch (label) | (defun window-manager--switch (label) | ||||||
|   "Switch to a named workspaces using LABEL." |   "Switch to a named workspaces using LABEL." | ||||||
|   (cycle/focus (lambda (x) |   (cycle-focus (lambda (x) | ||||||
|                  (equal label |                  (equal label | ||||||
|                         (window-manager--named-workspace-label x))) |                         (window-manager--named-workspace-label x))) | ||||||
|                window-manager--workspaces) |                window-manager--workspaces) | ||||||
|   (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) | (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." |   "Focus the previously active EXWM workspace." | ||||||
|   (interactive) |   (interactive) | ||||||
|   (window-manager--change-workspace |   (window-manager--change-workspace | ||||||
|    (cycle/focus-previous! window-manager--workspaces))) |    (cycle-focus-previous! window-manager--workspaces))) | ||||||
| 
 | 
 | ||||||
| (defun window-manager--exwm-buffer? (x) | (defun window-manager--exwm-buffer? (x) | ||||||
|   "Return t if buffer X is an EXWM buffer." |   "Return t if buffer X is an EXWM buffer." | ||||||
|  | @ -361,7 +361,7 @@ predicate." | ||||||
| (when window-manager--install-kbds? | (when window-manager--install-kbds? | ||||||
|   (progn |   (progn | ||||||
|     (->> window-manager--named-workspaces |     (->> window-manager--named-workspaces | ||||||
|          (list/map #'window-manager--register-kbd)) |          (list-map #'window-manager--register-kbd)) | ||||||
|     (window-manager--alert "Registered workspace KBDs!"))) |     (window-manager--alert "Registered workspace KBDs!"))) | ||||||
| 
 | 
 | ||||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||||
|  |  | ||||||
|  | @ -179,7 +179,7 @@ | ||||||
|       create-lockfiles nil) |       create-lockfiles nil) | ||||||
| 
 | 
 | ||||||
| ;; ensure code wraps at 80 characters by default | ;; 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) | (put 'narrow-to-region 'disabled nil) | ||||||
| 
 | 
 | ||||||
|  | @ -190,7 +190,7 @@ | ||||||
| (add-hook 'after-save-hook | (add-hook 'after-save-hook | ||||||
|           (lambda () |           (lambda () | ||||||
|             (when (f-equal? (buffer-file-name) |             (when (f-equal? (buffer-file-name) | ||||||
|                             (f-join constants/briefcase "secrets.json")) |                             (f-join constants-briefcase "secrets.json")) | ||||||
|               (shell-command "git secret hide")))) |               (shell-command "git secret hide")))) | ||||||
| 
 | 
 | ||||||
| ;; use tabs instead of spaces | ;; use tabs instead of spaces | ||||||
|  | @ -214,7 +214,7 @@ | ||||||
| ;; TODO: Consider moving this into a briefcase.el module. | ;; TODO: Consider moving this into a briefcase.el module. | ||||||
| (defun wpc-misc--briefcase-find (dir) | (defun wpc-misc--briefcase-find (dir) | ||||||
|   "Find the default.nix nearest to 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")) |     (if (f-exists? (f-join dir "default.nix")) | ||||||
|         (cons 'transient dir) |         (cons 'transient dir) | ||||||
|       (wpc-misc--briefcase-find (f-parent dir))))) |       (wpc-misc--briefcase-find (f-parent dir))))) | ||||||
|  |  | ||||||
|  | @ -28,12 +28,12 @@ | ||||||
| (defun wpc-nix-rebuild-emacs () | (defun wpc-nix-rebuild-emacs () | ||||||
|   "Use nix-env to rebuild wpcarros-emacs." |   "Use nix-env to rebuild wpcarros-emacs." | ||||||
|   (interactive) |   (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)) |          (pname (format "nix-build <briefcase/%s>" emacs)) | ||||||
|          (bname (format "*%s*" pname))) |          (bname (format "*%s*" pname))) | ||||||
|     (start-process pname bname |     (start-process pname bname | ||||||
|                    "nix-env" |                    "nix-env" | ||||||
|                    "-I" (format "briefcase=%s" constants/briefcase) |                    "-I" (format "briefcase=%s" constants-briefcase) | ||||||
|                    "-f" "<briefcase>" "-iA" emacs) |                    "-f" "<briefcase>" "-iA" emacs) | ||||||
|     (display-buffer bname))) |     (display-buffer bname))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -2,8 +2,8 @@ | ||||||
| 
 | 
 | ||||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ;; Author: William Carroll <wpcarro@gmail.com> | ||||||
| ;; Version: 0.0.1 | ;; Version: 0.0.1 | ||||||
|  | ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||||
| ;; Package-Requires: ((emacs "24")) | ;; Package-Requires: ((emacs "24")) | ||||||
| ;; Homepage: https://user.git.corp.google.com/wpcarro/briefcase |  | ||||||
| 
 | 
 | ||||||
| ;;; Commentary: | ;;; Commentary: | ||||||
| ;; Hosts font settings, scrolling, color schemes. | ;; Hosts font settings, scrolling, color schemes. | ||||||
|  | @ -70,7 +70,7 @@ | ||||||
| (tool-bar-mode -1) | (tool-bar-mode -1) | ||||||
| 
 | 
 | ||||||
| ;; set default buffer for Emacs | ;; set default buffer for Emacs | ||||||
| (setq initial-buffer-choice constants/current-project) | (setq initial-buffer-choice constants-current-project) | ||||||
| 
 | 
 | ||||||
| ;; premium Emacs themes | ;; premium Emacs themes | ||||||
| (use-package doom-themes | (use-package doom-themes | ||||||
|  | @ -91,7 +91,7 @@ | ||||||
|   :config |   :config | ||||||
|   (counsel-mode t) |   (counsel-mode t) | ||||||
|   (ivy-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 |   ;; prefer using `helpful' variants | ||||||
|   (progn |   (progn | ||||||
|     (setq counsel-describe-function-function #'helpful-callable) |     (setq counsel-describe-function-function #'helpful-callable) | ||||||
|  | @ -113,7 +113,7 @@ | ||||||
| ;; all-the-icons | ;; all-the-icons | ||||||
| (use-package all-the-icons | (use-package all-the-icons | ||||||
|   :config |   :config | ||||||
|   (when (not constants/ci?) |   (when (not constants-ci?) | ||||||
|     (unless (f-exists? "~/.local/share/fonts/all-the-icons.ttf") |     (unless (f-exists? "~/.local/share/fonts/all-the-icons.ttf") | ||||||
|       (all-the-icons-install-fonts t)))) |       (all-the-icons-install-fonts t)))) | ||||||
| 
 | 
 | ||||||
|  | @ -129,13 +129,13 @@ | ||||||
| ;; reduce noisiness of auto-revert-mode | ;; reduce noisiness of auto-revert-mode | ||||||
| (setq auto-revert-verbose nil) | (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 | (use-package whitespace | ||||||
|   :config |   :config | ||||||
|   ;; TODO: This should change depending on the language and project. For |   ;; TODO: This should change depending on the language and project. For | ||||||
|   ;; example, Google Java projects prefer 100 character width instead of 80 |   ;; example, Google Java projects prefer 100 character width instead of 80 | ||||||
|   ;; character width. |   ;; character width. | ||||||
|   (setq whitespace-line-column constants/fill-column) |   (setq whitespace-line-column constants-fill-column) | ||||||
|   (setq whitespace-style '(face lines-tail)) |   (setq whitespace-style '(face lines-tail)) | ||||||
|   (add-hook 'prog-mode-hook #'whitespace-mode)) |   (add-hook 'prog-mode-hook #'whitespace-mode)) | ||||||
| 
 | 
 | ||||||
|  | @ -156,15 +156,15 @@ | ||||||
|   :config |   :config | ||||||
|   (setq alert-default-style 'notifier)) |   (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? | ;; during initialization? | ||||||
| (when (device/work-laptop?) | (when (device-work-laptop?) | ||||||
|   (laptop-battery/display)) |   (laptop-battery-display)) | ||||||
| 
 | 
 | ||||||
| (fonts/whitelist-set "JetBrainsMono") | (fonts-whitelist-set "JetBrainsMono") | ||||||
| (colorscheme/whitelist-set 'doom-solarized-light) | (colorscheme-whitelist-set 'doom-solarized-light) | ||||||
| 
 | 
 | ||||||
| (modeline/setup) | (modeline-setup) | ||||||
| 
 | 
 | ||||||
| (provide 'wpc-ui) | (provide 'wpc-ui) | ||||||
| ;;; wpc-ui.el ends here | ;;; wpc-ui.el ends here | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue