subtree(users/wpcarro): docking briefcase at '24f5a642'
				
					
				
			git-subtree-dir: users/wpcarro git-subtree-mainline:464bbcb15cgit-subtree-split:24f5a642afChange-Id: I6105b3762b79126b3488359c95978cadb3efa789
This commit is contained in:
		
						commit
						019f8fd211
					
				
					 766 changed files with 175420 additions and 0 deletions
				
			
		
							
								
								
									
										21
									
								
								users/wpcarro/emacs/.emacs.d/init.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										21
									
								
								users/wpcarro/emacs/.emacs.d/init.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,21 @@ | |||
| ;; load order is intentional | ||||
| (require 'wpc-package) | ||||
| (require 'wpc-misc) | ||||
| (require 'ssh) | ||||
| (require 'keyboard) | ||||
| (require 'irc) | ||||
| (require 'email) | ||||
| (require 'keybindings) | ||||
| (require 'window-manager) | ||||
| (require 'wpc-ui) | ||||
| (require 'wpc-dired) | ||||
| (require 'wpc-org) | ||||
| (require 'wpc-company) | ||||
| (require 'wpc-shell) | ||||
| (require 'wpc-lisp) | ||||
| (require 'wpc-haskell) | ||||
| (require 'wpc-elixir) | ||||
| (require 'wpc-nix) | ||||
| (require 'wpc-rust) | ||||
| (require 'wpc-clojure) | ||||
| (require 'wpc-prolog) | ||||
							
								
								
									
										145
									
								
								users/wpcarro/emacs/.emacs.d/opam-user-setup.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										145
									
								
								users/wpcarro/emacs/.emacs.d/opam-user-setup.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,145 @@ | |||
| ;; ## added by OPAM user-setup for emacs / base ## cfd3c9b7837c85cffd0c59de521990f0 ## you can edit, but keep this line | ||||
| (provide 'opam-user-setup) | ||||
| 
 | ||||
| ;; Base configuration for OPAM | ||||
| 
 | ||||
| (defun opam-shell-command-to-string (command) | ||||
|   "Similar to shell-command-to-string, but returns nil unless the process | ||||
|   returned 0, and ignores stderr (shell-command-to-string ignores return value)" | ||||
|   (let* ((return-value 0) | ||||
|          (return-string | ||||
|           (with-output-to-string | ||||
|             (setq return-value | ||||
|                   (with-current-buffer standard-output | ||||
|                     (process-file shell-file-name nil '(t nil) nil | ||||
|                                   shell-command-switch command)))))) | ||||
|     (if (= return-value 0) return-string nil))) | ||||
| 
 | ||||
| (defun opam-update-env (switch) | ||||
|   "Update the environment to follow current OPAM switch configuration" | ||||
|   (interactive | ||||
|    (list | ||||
|     (let ((default | ||||
|             (car (split-string (opam-shell-command-to-string "opam switch show --safe"))))) | ||||
|       (completing-read | ||||
|        (concat "opam switch (" default "): ") | ||||
|        (split-string (opam-shell-command-to-string "opam switch list -s --safe") "\n") | ||||
|        nil t nil nil default)))) | ||||
|   (let* ((switch-arg (if (= 0 (length switch)) "" (concat "--switch " switch))) | ||||
|          (command (concat "opam config env --safe --sexp " switch-arg)) | ||||
|          (env (opam-shell-command-to-string command))) | ||||
|     (when (and env (not (string= env ""))) | ||||
|       (dolist (var (car (read-from-string env))) | ||||
|         (setenv (car var) (cadr var)) | ||||
|         (when (string= (car var) "PATH") | ||||
|           (setq exec-path (split-string (cadr var) path-separator))))))) | ||||
| 
 | ||||
| (opam-update-env nil) | ||||
| 
 | ||||
| (defvar opam-share | ||||
|   (let ((reply (opam-shell-command-to-string "opam config var share --safe"))) | ||||
|     (when reply (substring reply 0 -1)))) | ||||
| 
 | ||||
| (add-to-list 'load-path (concat opam-share "/emacs/site-lisp")) | ||||
| ;; OPAM-installed tools automated detection and initialisation | ||||
| 
 | ||||
| (defun opam-setup-tuareg () | ||||
|   (add-to-list 'load-path (concat opam-share "/tuareg") t) | ||||
|   (load "tuareg-site-file")) | ||||
| 
 | ||||
| (defun opam-setup-add-ocaml-hook (h) | ||||
|   (add-hook 'tuareg-mode-hook h t) | ||||
|   (add-hook 'caml-mode-hook h t)) | ||||
| 
 | ||||
| (defun opam-setup-complete () | ||||
|   (if (require 'company nil t) | ||||
|     (opam-setup-add-ocaml-hook | ||||
|       (lambda () | ||||
|          (company-mode) | ||||
|          (defalias 'auto-complete 'company-complete))) | ||||
|     (require 'auto-complete nil t))) | ||||
| 
 | ||||
| (defun opam-setup-ocp-indent () | ||||
|   (opam-setup-complete) | ||||
|   (autoload 'ocp-setup-indent "ocp-indent" "Improved indentation for Tuareg mode") | ||||
|   (autoload 'ocp-indent-caml-mode-setup "ocp-indent" "Improved indentation for Caml mode") | ||||
|   (add-hook 'tuareg-mode-hook 'ocp-setup-indent t) | ||||
|   (add-hook 'caml-mode-hook 'ocp-indent-caml-mode-setup  t)) | ||||
| 
 | ||||
| (defun opam-setup-ocp-index () | ||||
|   (autoload 'ocp-index-mode "ocp-index" "OCaml code browsing, documentation and completion based on build artefacts") | ||||
|   (opam-setup-add-ocaml-hook 'ocp-index-mode)) | ||||
| 
 | ||||
| (defun opam-setup-merlin () | ||||
|   (opam-setup-complete) | ||||
|   (require 'merlin) | ||||
|   (opam-setup-add-ocaml-hook 'merlin-mode) | ||||
| 
 | ||||
|   (defcustom ocp-index-use-auto-complete nil | ||||
|     "Use auto-complete with ocp-index (disabled by default by opam-user-setup because merlin is in use)" | ||||
|     :group 'ocp_index) | ||||
|   (defcustom merlin-ac-setup 'easy | ||||
|     "Use auto-complete with merlin (enabled by default by opam-user-setup)" | ||||
|     :group 'merlin-ac) | ||||
| 
 | ||||
|   ;; So you can do it on a mac, where `C-<up>` and `C-<down>` are used | ||||
|   ;; by spaces. | ||||
|   (define-key merlin-mode-map | ||||
|     (kbd "C-c <up>") 'merlin-type-enclosing-go-up) | ||||
|   (define-key merlin-mode-map | ||||
|     (kbd "C-c <down>") 'merlin-type-enclosing-go-down) | ||||
|   (set-face-background 'merlin-type-face "skyblue")) | ||||
| 
 | ||||
| (defun opam-setup-utop () | ||||
|   (autoload 'utop "utop" "Toplevel for OCaml" t) | ||||
|   (autoload 'utop-minor-mode "utop" "Minor mode for utop" t) | ||||
|   (add-hook 'tuareg-mode-hook 'utop-minor-mode)) | ||||
| 
 | ||||
| (defvar opam-tools | ||||
|   '(("tuareg" . opam-setup-tuareg) | ||||
|     ("ocp-indent" . opam-setup-ocp-indent) | ||||
|     ("ocp-index" . opam-setup-ocp-index) | ||||
|     ("merlin" . opam-setup-merlin) | ||||
|     ("utop" . opam-setup-utop))) | ||||
| 
 | ||||
| (defun opam-detect-installed-tools () | ||||
|   (let* | ||||
|       ((command "opam list --installed --short --safe --color=never") | ||||
|        (names (mapcar 'car opam-tools)) | ||||
|        (command-string (mapconcat 'identity (cons command names) " ")) | ||||
|        (reply (opam-shell-command-to-string command-string))) | ||||
|     (when reply (split-string reply)))) | ||||
| 
 | ||||
| (defvar opam-tools-installed (opam-detect-installed-tools)) | ||||
| 
 | ||||
| (defun opam-auto-tools-setup () | ||||
|   (interactive) | ||||
|   (dolist (tool opam-tools) | ||||
|     (when (member (car tool) opam-tools-installed) | ||||
|      (funcall (symbol-function (cdr tool)))))) | ||||
| 
 | ||||
| (opam-auto-tools-setup) | ||||
| ;; ## end of OPAM user-setup addition for emacs / base ## keep this line | ||||
| ;; ## added by OPAM user-setup for emacs / tuareg ## b10f42abebd2259b784b70d1a7f7e426 ## you can edit, but keep this line | ||||
| ;; Set to autoload tuareg from its original switch when not found in current | ||||
| ;; switch (don't load tuareg-site-file as it adds unwanted load-paths) | ||||
| (defun opam-tuareg-autoload (fct file doc args) | ||||
|   (let ((load-path (cons "/home/wpcarro/.opam/default/share/emacs/site-lisp" load-path))) | ||||
|     (load file)) | ||||
|   (apply fct args)) | ||||
| (when (not (member "tuareg" opam-tools-installed)) | ||||
|   (defun tuareg-mode (&rest args) | ||||
|     (opam-tuareg-autoload 'tuareg-mode "tuareg" "Major mode for editing OCaml code" args)) | ||||
|   (defun tuareg-run-ocaml (&rest args) | ||||
|     (opam-tuareg-autoload 'tuareg-run-ocaml "tuareg" "Run an OCaml toplevel process" args)) | ||||
|   (defun ocamldebug (&rest args) | ||||
|     (opam-tuareg-autoload 'ocamldebug "ocamldebug" "Run the OCaml debugger" args)) | ||||
|   (defalias 'run-ocaml 'tuareg-run-ocaml) | ||||
|   (defalias 'camldebug 'ocamldebug) | ||||
|   (add-to-list 'auto-mode-alist '("\\.ml[iylp]?\\'" . tuareg-mode)) | ||||
|   (add-to-list 'auto-mode-alist '("\\.eliomi?\\'" . tuareg-mode)) | ||||
|   (add-to-list 'interpreter-mode-alist '("ocamlrun" . tuareg-mode)) | ||||
|   (add-to-list 'interpreter-mode-alist '("ocaml" . tuareg-mode)) | ||||
|   (dolist (ext '(".cmo" ".cmx" ".cma" ".cmxa" ".cmxs" ".cmt" ".cmti" ".cmi" ".annot")) | ||||
|     (add-to-list 'completion-ignored-extensions ext))) | ||||
| ;; ## end of OPAM user-setup addition for emacs / tuareg ## keep this line | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/c-mode/stdio
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/c-mode/stdio
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: <stdio.h> | ||||
| # key: sio | ||||
| # -- | ||||
| #include <stdio.h> | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/c-mode/stdlib
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/c-mode/stdlib
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: <stdlib.h> | ||||
| # key: slb | ||||
| # -- | ||||
| #include <stdlib.h> | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/c-mode/struct
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/c-mode/struct
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: struct | ||||
| # key: struct | ||||
| # -- | ||||
| typedef struct $1 { | ||||
|   $2 | ||||
| } $1_t; | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,11 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Elisp module docs | ||||
| # key: emd | ||||
| # -- | ||||
| ;;; `(-> (buffer-file-name) f-filename)` --- $2 -*- lexical-binding: t -*- | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; $3 | ||||
| 
 | ||||
| ;;; Code: | ||||
|  | @ -0,0 +1,8 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Function | ||||
| # key: fn | ||||
| # expand-env: ((yas-indent-line 'fixed)) | ||||
| # -- | ||||
| (defun $1 ($2) | ||||
|   "$3" | ||||
|   $4) | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Header | ||||
| # key: hdr | ||||
| # -- | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; $1 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Library header | ||||
| # key: lib | ||||
| # -- | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|  | @ -0,0 +1,6 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Provide footer | ||||
| # key: elf | ||||
| # -- | ||||
| (provide '`(-> (buffer-file-name) f-filename f-no-ext)`) | ||||
| ;;; `(-> (buffer-file-name) f-filename)` ends here | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Derive Safe Copy | ||||
| # key: dsc | ||||
| # -- | ||||
| deriveSafeCopy 0 'base ''$1 | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Import qualified | ||||
| # key: iq | ||||
| # -- | ||||
| import qualified $1 as $2 | ||||
|  | @ -0,0 +1,6 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Instance | ||||
| # key: inst | ||||
| # -- | ||||
| instance $1 where | ||||
|   $2 = $3 | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: language extension | ||||
| # key: lang | ||||
| # -- | ||||
| {-# LANGUAGE $1 #-} | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Separator | ||||
| # key: - | ||||
| # -- | ||||
| -------------------------------------------------------------------------------- | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Undefiend | ||||
| # key: nd | ||||
| # -- | ||||
| undefined | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,18 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: HTML index.html starter | ||||
| # key: html | ||||
| # -- | ||||
| <!doctype html> | ||||
| 
 | ||||
| <html lang="en"> | ||||
| <head> | ||||
|   <meta charset="utf-8"> | ||||
|   <title>$1</title> | ||||
|   <meta name="description" content="$2"> | ||||
|   <meta name="author" content="William Carroll"> | ||||
|   <link rel="stylesheet" href="index.css"> | ||||
| </head> | ||||
| <body> | ||||
|   <script src="index.js"></script> | ||||
| </body> | ||||
| </html> | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: public static void main | ||||
| # key: psvm | ||||
| # -- | ||||
| public static void main(String[] args) { | ||||
|     $1 | ||||
| } | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,9 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Define package | ||||
| # key: defp | ||||
| # -- | ||||
| (in-package #:cl-user) | ||||
| (defpackage #:$1 | ||||
|   (:documentation "$2") | ||||
|   (:use #:cl)) | ||||
| (in-package #:$1) | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/lisp-mode/function
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/lisp-mode/function
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Function | ||||
| # key: fn | ||||
| # -- | ||||
| (defun $1 ($2) | ||||
|   "$3" | ||||
|   $4) | ||||
|  | @ -0,0 +1,8 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Typed function | ||||
| # key: tfn | ||||
| # -- | ||||
| (type $1 ($3) $4) | ||||
| (defun $1 ($2) | ||||
|   "$5" | ||||
|   $6) | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
							
								
								
									
										13
									
								
								users/wpcarro/emacs/.emacs.d/snippets/nix-mode/shell-nix
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										13
									
								
								users/wpcarro/emacs/.emacs.d/snippets/nix-mode/shell-nix
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,13 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: shell.nix boilerplate | ||||
| # key: import | ||||
| # -- | ||||
| let | ||||
|   briefcase = with import <briefcase> {}; | ||||
|   pkgs = briefcase.third_party.pkgs; | ||||
| in stdenv.mkDerivation { | ||||
|   name = "$1"; | ||||
|   buildInputs = [ | ||||
|     $2 | ||||
|   ]; | ||||
| } | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Code Snippet | ||||
| # key: src | ||||
| # -- | ||||
| #+BEGIN_SRC $1 | ||||
| $2 | ||||
| #+END_SRC | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/org-mode/href
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/org-mode/href
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Org mode URL | ||||
| # key: href | ||||
| # -- | ||||
| [[$1][$2]] | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,6 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Dunder main (__main__) | ||||
| # key: mn | ||||
| # -- | ||||
| if __name__ == "__main__": | ||||
|     main() | ||||
|  | @ -0,0 +1,6 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Function | ||||
| # key: fn | ||||
| # -- | ||||
| def $1($2): | ||||
|     $3 | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/python-mode/header
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/python-mode/header
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Header | ||||
| # key: hdr | ||||
| # -- | ||||
| ################################################################################ | ||||
| # $1 | ||||
| ################################################################################ | ||||
							
								
								
									
										6
									
								
								users/wpcarro/emacs/.emacs.d/snippets/python-mode/init
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										6
									
								
								users/wpcarro/emacs/.emacs.d/snippets/python-mode/init
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,6 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: dunder init | ||||
| # key: ctor | ||||
| # -- | ||||
| def __init__(self$1): | ||||
|     $2 | ||||
|  | @ -0,0 +1,6 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: shebang | ||||
| # key: shb | ||||
| # -- | ||||
| #!/usr/bin/env python | ||||
| # -*- coding: utf-8 -*- | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/python-mode/utf-8
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/python-mode/utf-8
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: utf-8 | ||||
| # key: utf | ||||
| # -- | ||||
| # -*- coding: utf-8 -*- | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Function | ||||
| # key: fn | ||||
| # -- | ||||
| (define ($1) $2) | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/racket-mode/lambda
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/racket-mode/lambda
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Lambda function | ||||
| # key: ld | ||||
| # -- | ||||
| (λ ($1) $2) | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Lambda symbol | ||||
| # key: l | ||||
| # -- | ||||
| λ | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Function | ||||
| # key: fn | ||||
| # -- | ||||
| let $1 = (~$2:$3) => { | ||||
|   $4 | ||||
| }; | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/reason-mode/switch
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/reason-mode/switch
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Switch statement | ||||
| # key: sw | ||||
| # -- | ||||
| switch ($1) { | ||||
| | $2 => | ||||
| } | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: exactness | ||||
| # key: $x | ||||
| # -- | ||||
| $Exact<$Call<typeof $1>> | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Console.log helper | ||||
| # key: clg | ||||
| # -- | ||||
| console.log($1) | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: const definition | ||||
| # key: cn | ||||
| # -- | ||||
| const $1 = '$2' | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: const function | ||||
| # key: cfn | ||||
| # -- | ||||
| const $1 = ($2) => { | ||||
|   $3 | ||||
| } | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Destructuring a const | ||||
| # key: cds | ||||
| # -- | ||||
| const { $1 } = $2 | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Fat arrow function | ||||
| # key: fa | ||||
| # -- | ||||
| => | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Fat arrow function | ||||
| # key: faf | ||||
| # -- | ||||
| () => { | ||||
|   $1 | ||||
| } | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Import destructured | ||||
| # key: ids | ||||
| # -- | ||||
| import { $1 } from '$2' | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Import React dependency (ES6) | ||||
| # key: ir | ||||
| # -- | ||||
| import React from 'react' | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: import type | ||||
| # key: ixt | ||||
| # -- | ||||
| import type { $1 } from '$2' | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: import x from y | ||||
| # key: ix | ||||
| # -- | ||||
| import $1 from '$2' | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/rjsx-mode/import-y
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/rjsx-mode/import-y
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: import y | ||||
| # key: iy | ||||
| # -- | ||||
| import '$1' | ||||
|  | @ -0,0 +1,10 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Jest describe/test block | ||||
| # key: dsc | ||||
| # -- | ||||
| describe('$1', () => { | ||||
|   test('$2', () => { | ||||
| 
 | ||||
|     expect($3).toEqual($4) | ||||
|   }) | ||||
| }) | ||||
|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Jest / Jasmine test | ||||
| # key: tst | ||||
| # -- | ||||
| test('$1', () => { | ||||
|   expect($2).toBe($3) | ||||
| }) | ||||
|  | @ -0,0 +1,11 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: React class extends | ||||
| # key: clz | ||||
| # -- | ||||
| class $1 extends React.Component { | ||||
|   render() { | ||||
|     $2 | ||||
|   } | ||||
| } | ||||
| 
 | ||||
| export default $1 | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: redux-action | ||||
| # key: rax | ||||
| # -- | ||||
| export const ${1:$$(string-lower->caps yas-text)} = '`(downcase (functions-buffer-dirname))`/${1:$(string-caps->kebab yas-text)}' | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: typed-redux-action | ||||
| # key: trax | ||||
| # -- | ||||
| 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)}' | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/rust-mode/for-loop
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/rust-mode/for-loop
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: for-loop | ||||
| # key: for | ||||
| # -- | ||||
| for $1 in $2 { | ||||
|     $3 | ||||
| } | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/rust-mode/match
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/rust-mode/match
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: match | ||||
| # key: match | ||||
| # -- | ||||
| match $1 { | ||||
|     $2 => $3, | ||||
| } | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/sh-mode/function
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/sh-mode/function
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Create function | ||||
| # key: fn | ||||
| # -- | ||||
| $1() { | ||||
|   $2 | ||||
| } | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Unicode checkmark | ||||
| # key: uck | ||||
| # -- | ||||
| ✓ | ||||
							
								
								
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/text-mode/x-mark
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								users/wpcarro/emacs/.emacs.d/snippets/text-mode/x-mark
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,5 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Unicode ex-mark | ||||
| # key: ux | ||||
| # -- | ||||
| ✗ | ||||
|  | @ -0,0 +1 @@ | |||
| text-mode | ||||
							
								
								
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/web-mode/header
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								users/wpcarro/emacs/.emacs.d/snippets/web-mode/header
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,7 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: Header | ||||
| # key: hdr | ||||
| # -- | ||||
| /******************************************************************************* | ||||
|  * $1 | ||||
|  ******************************************************************************/ | ||||
|  | @ -0,0 +1,18 @@ | |||
| # -*- mode: snippet -*- | ||||
| # name: HTML index.html starter | ||||
| # key: html | ||||
| # -- | ||||
| <!doctype html> | ||||
| 
 | ||||
| <html lang="en"> | ||||
| <head> | ||||
|   <meta charset="utf-8"> | ||||
|   <title>$1</title> | ||||
|   <meta name="description" content="$2"> | ||||
|   <meta name="author" content="William Carroll"> | ||||
|   <link rel="stylesheet" href="index.css"> | ||||
| </head> | ||||
| <body> | ||||
|   <script src="index.js"></script> | ||||
| </body> | ||||
| </html> | ||||
							
								
								
									
										13696
									
								
								users/wpcarro/emacs/.emacs.d/vendor/dired+.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										13696
									
								
								users/wpcarro/emacs/.emacs.d/vendor/dired+.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load diff
											
										
									
								
							
							
								
								
									
										304
									
								
								users/wpcarro/emacs/.emacs.d/vendor/reason-indent.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										304
									
								
								users/wpcarro/emacs/.emacs.d/vendor/reason-indent.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							|  | @ -0,0 +1,304 @@ | |||
| ;;; reason-indent.el --- Indentation functions for ReasonML -*-lexical-binding: t-*- | ||||
| 
 | ||||
| ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| 
 | ||||
| ;; Indentation functions for Reason. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| (defconst reason-re-ident "[[:word:][:multibyte:]_][[:word:][:multibyte:]_[:digit:]]*") | ||||
| 
 | ||||
| (defcustom reason-indent-offset 2 | ||||
|   "Indent Reason code by this number of spaces." | ||||
|   :type 'integer | ||||
|   :group 'reason-mode | ||||
|   :safe #'integerp) | ||||
| 
 | ||||
| (defun reason-looking-back-str (str) | ||||
|   "Like `looking-back' but for fixed strings rather than regexps. | ||||
| Works around some regexp slowness. | ||||
| Argument STR string to search for." | ||||
|   (let ((len (length str))) | ||||
|     (and (> (point) len) | ||||
|          (equal str (buffer-substring-no-properties (- (point) len) (point)))))) | ||||
| 
 | ||||
| (defun reason-paren-level () | ||||
|   "Get the level of nesting inside parentheses." | ||||
|   (nth 0 (syntax-ppss))) | ||||
| 
 | ||||
| (defun reason-in-str-or-cmnt () | ||||
|   "Return whether point is currently inside a string or a comment." | ||||
|   (nth 8 (syntax-ppss))) | ||||
| 
 | ||||
| (defun reason-rewind-past-str-cmnt () | ||||
|   "Rewind past string or comment." | ||||
|   (goto-char (nth 8 (syntax-ppss)))) | ||||
| 
 | ||||
| (defun reason-rewind-irrelevant () | ||||
|   "Rewind past irrelevant characters (whitespace of inside comments)." | ||||
|   (interactive) | ||||
|   (let ((starting (point))) | ||||
|     (skip-chars-backward "[:space:]\n") | ||||
|     (if (reason-looking-back-str "*/") (backward-char)) | ||||
|     (if (reason-in-str-or-cmnt) | ||||
|         (reason-rewind-past-str-cmnt)) | ||||
|     (if (/= starting (point)) | ||||
|         (reason-rewind-irrelevant)))) | ||||
| 
 | ||||
| (defun reason-align-to-expr-after-brace () | ||||
|   "Align the expression at point to the expression after the previous brace." | ||||
|   (save-excursion | ||||
|     (forward-char) | ||||
|     ;; We don't want to indent out to the open bracket if the | ||||
|     ;; open bracket ends the line | ||||
|     (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) | ||||
|       (when (looking-at "[[:space:]]") | ||||
|         (forward-word 1) | ||||
|         (backward-word 1)) | ||||
|       (current-column)))) | ||||
| 
 | ||||
| (defun reason-align-to-prev-expr () | ||||
|   "Align the expression at point to the previous expression." | ||||
|   (let ((alignment (save-excursion | ||||
|                      (forward-char) | ||||
|                      ;; We don't want to indent out to the open bracket if the | ||||
|                      ;; open bracket ends the line | ||||
|                      (when (not (looking-at "[[:blank:]]*\\(?://.*\\)?$")) | ||||
|                        (if (looking-at "[[:space:]]") | ||||
|                            (progn | ||||
|                              (forward-word 1) | ||||
|                              (backward-word 1)) | ||||
|                          (backward-char)) | ||||
|                        (current-column))))) | ||||
|     (if (not alignment) | ||||
|         (save-excursion | ||||
|           (forward-char) | ||||
|           (forward-line) | ||||
|           (back-to-indentation) | ||||
|           (current-column)) | ||||
|       alignment))) | ||||
| 
 | ||||
| ;;; Start of a reason binding | ||||
| (defvar reason-binding | ||||
|   (regexp-opt '("let" "type" "module" "fun"))) | ||||
| 
 | ||||
| (defun reason-beginning-of-defun (&optional arg) | ||||
|   "Move backward to the beginning of the current defun. | ||||
| 
 | ||||
| With ARG, move backward multiple defuns.  Negative ARG means | ||||
| move forward. | ||||
| 
 | ||||
| This is written mainly to be used as `beginning-of-defun-function'. | ||||
| Don't move to the beginning of the line.  `beginning-of-defun', | ||||
| which calls this, does that afterwards." | ||||
|   (interactive "p") | ||||
|   (re-search-backward (concat "^\\(" reason-binding "\\)\\_>") | ||||
|                       nil 'move (or arg 1))) | ||||
| 
 | ||||
| (defun reason-end-of-defun () | ||||
|   "Move forward to the next end of defun. | ||||
| 
 | ||||
| With argument, do it that many times. | ||||
| Negative argument -N means move back to Nth preceding end of defun. | ||||
| 
 | ||||
| Assume that this is called after ‘beginning-of-defun’.  So point is | ||||
| at the beginning of the defun body. | ||||
| 
 | ||||
| This is written mainly to be used as `end-of-defun-function' for Reason." | ||||
|   (interactive) | ||||
|   ;; Find the opening brace | ||||
|   (if (re-search-forward "[{]" nil t) | ||||
|       (progn | ||||
|         (goto-char (match-beginning 0)) | ||||
|         ;; Go to the closing brace | ||||
|         (condition-case nil | ||||
|             (forward-sexp) | ||||
|           (scan-error | ||||
|            ;; The parentheses are unbalanced; instead of being unable to fontify, just jump to the end of the buffer | ||||
|            (goto-char (point-max))))) | ||||
|     ;; There is no opening brace, so consider the whole buffer to be one "defun" | ||||
|     (goto-char (point-max)))) | ||||
| 
 | ||||
| (defun reason-rewind-to-beginning-of-current-level-expr () | ||||
|   "Rewind to the beginning of the expression on the current level of nesting." | ||||
|   (interactive) | ||||
|   (let ((current-level (reason-paren-level))) | ||||
|     (back-to-indentation) | ||||
|     (when (looking-at "=>") | ||||
|       (reason-rewind-irrelevant) | ||||
|       (back-to-indentation)) | ||||
|     (while (> (reason-paren-level) current-level) | ||||
|       (backward-up-list) | ||||
|       (back-to-indentation)))) | ||||
| 
 | ||||
| (defun reason-mode-indent-line () | ||||
|   "Indent current line." | ||||
|   (interactive) | ||||
|   (let ((indent | ||||
|          (save-excursion | ||||
|            (back-to-indentation) | ||||
|            ;; Point is now at beginning of current line | ||||
|            (let* ((level (reason-paren-level)) | ||||
|                   (baseline | ||||
|                    ;; Our "baseline" is one level out from the indentation of the expression | ||||
|                    ;; containing the innermost enclosing opening bracket. That | ||||
|                    ;; way if we are within a block that has a different | ||||
|                    ;; indentation than this mode would give it, we still indent | ||||
|                    ;; the inside of it correctly relative to the outside. | ||||
|                    (if (= 0 level) | ||||
|                        0 | ||||
|                      (save-excursion | ||||
|                        (reason-rewind-irrelevant) | ||||
|                        (if (save-excursion | ||||
|                              (reason-rewind-to-beginning-of-current-level-expr) | ||||
|                              (looking-at "<")) | ||||
|                            (progn | ||||
|                              (reason-rewind-to-beginning-of-current-level-expr) | ||||
|                              (current-column)) | ||||
|                            (progn | ||||
|                              (backward-up-list) | ||||
|                              (reason-rewind-to-beginning-of-current-level-expr) | ||||
| 
 | ||||
|                              (cond | ||||
|                               ((looking-at "switch") | ||||
|                                (current-column)) | ||||
| 
 | ||||
|                               ((looking-at "|") | ||||
|                                (+ (current-column) (* reason-indent-offset 2))) | ||||
| 
 | ||||
|                               (t | ||||
|                                (let ((current-level (reason-paren-level))) | ||||
|                                  (save-excursion | ||||
|                                    (while (and (= current-level (reason-paren-level)) | ||||
|                                                (not (looking-at reason-binding))) | ||||
|                                      (reason-rewind-irrelevant) | ||||
|                                      (reason-rewind-to-beginning-of-current-level-expr)) | ||||
|                                    (+ (current-column) reason-indent-offset))))))))))) | ||||
|              (cond | ||||
|               ;; A function return type is indented to the corresponding function arguments | ||||
|               ((looking-at "=>") | ||||
|                (+ baseline reason-indent-offset)) | ||||
| 
 | ||||
|               ((reason-in-str-or-cmnt) | ||||
|                (cond | ||||
|                 ;; In the end of the block -- align with star | ||||
|                 ((looking-at "*/") (+ baseline 1)) | ||||
|                 ;; Indent to the following shape: | ||||
|                 ;; /* abcd | ||||
|                 ;;  * asdf | ||||
|                 ;;  */ | ||||
|                 ;; | ||||
|                 ((looking-at "*") (+ baseline 1)) | ||||
|                 ;; Indent to the following shape: | ||||
|                 ;; /* abcd | ||||
|                 ;;    asdf | ||||
|                 ;;  */ | ||||
|                 ;; | ||||
|                 (t (+ baseline (+ reason-indent-offset 1))))) | ||||
| 
 | ||||
|               ((looking-at "</") (- baseline reason-indent-offset)) | ||||
| 
 | ||||
|               ;; A closing brace is 1 level unindented | ||||
|               ((looking-at "}\\|)\\|\\]") | ||||
|                (save-excursion | ||||
|                  (reason-rewind-irrelevant) | ||||
|                  (let ((jsx? (reason-looking-back-str ">"))) | ||||
|                    (backward-up-list) | ||||
|                    (reason-rewind-to-beginning-of-current-level-expr) | ||||
|                    (cond | ||||
|                     ((looking-at "switch") baseline) | ||||
| 
 | ||||
|                     (jsx? (current-column)) | ||||
| 
 | ||||
|                     (t (- baseline reason-indent-offset)))))) | ||||
| 
 | ||||
|               ;; Doc comments in /** style with leading * indent to line up the *s | ||||
|               ((and (nth 4 (syntax-ppss)) (looking-at "*")) | ||||
|                (+ 1 baseline)) | ||||
| 
 | ||||
|               ;; If we're in any other token-tree / sexp, then: | ||||
|               (t | ||||
|                (or | ||||
|                 ;; If we are inside a pair of braces, with something after the | ||||
|                 ;; open brace on the same line and ending with a comma, treat | ||||
|                 ;; it as fields and align them. | ||||
|                 (when (> level 0) | ||||
|                   (save-excursion | ||||
|                     (reason-rewind-irrelevant) | ||||
|                     (backward-up-list) | ||||
|                     ;; Point is now at the beginning of the containing set of braces | ||||
|                     (reason-align-to-expr-after-brace))) | ||||
| 
 | ||||
|                 (progn | ||||
|                   (back-to-indentation) | ||||
|                   (cond ((looking-at (regexp-opt '("and" "type"))) | ||||
|                          baseline) | ||||
|                         ((save-excursion | ||||
|                            (reason-rewind-irrelevant) | ||||
|                            (= (point) 1)) | ||||
|                          baseline) | ||||
|                         ((save-excursion | ||||
|                            (while (looking-at "|") | ||||
|                              (reason-rewind-irrelevant) | ||||
|                              (back-to-indentation)) | ||||
|                            (looking-at (regexp-opt '("type")))) | ||||
|                          (+ baseline reason-indent-offset)) | ||||
|                         ((looking-at "|\\|/[/*]") | ||||
|                          baseline) | ||||
|                         ((and (> level 0) | ||||
|                               (save-excursion | ||||
|                                 (reason-rewind-irrelevant) | ||||
|                                 (backward-up-list) | ||||
|                                 (reason-rewind-to-beginning-of-current-level-expr) | ||||
|                                 (looking-at "switch"))) | ||||
|                          (+ baseline reason-indent-offset)) | ||||
|                         ((save-excursion | ||||
|                            (reason-rewind-irrelevant) | ||||
|                            (looking-back "[{;,\\[(]" (- (point) 2))) | ||||
|                          baseline) | ||||
|                         ((and | ||||
|                           (save-excursion | ||||
|                             (reason-rewind-irrelevant) | ||||
|                             (reason-rewind-to-beginning-of-current-level-expr) | ||||
|                             (and (looking-at reason-binding) | ||||
|                                  (not (progn | ||||
|                                         (forward-sexp) | ||||
|                                         (forward-sexp) | ||||
|                                         (skip-chars-forward "[:space:]\n") | ||||
|                                         (looking-at "="))))) | ||||
|                           (not (save-excursion | ||||
|                                  (skip-chars-backward "[:space:]\n") | ||||
|                                  (reason-looking-back-str "=>")))) | ||||
|                          (save-excursion | ||||
|                            (reason-rewind-irrelevant) | ||||
|                            (backward-sexp) | ||||
|                            (reason-align-to-prev-expr))) | ||||
|                         ((save-excursion | ||||
|                            (reason-rewind-irrelevant) | ||||
|                            (looking-back "<\/.*?>" (- (point) 30))) | ||||
|                          baseline) | ||||
|                         (t | ||||
|                          (save-excursion | ||||
|                            (reason-rewind-irrelevant) | ||||
|                            (reason-rewind-to-beginning-of-current-level-expr) | ||||
| 
 | ||||
|                            (if (looking-at "|") | ||||
|                                baseline | ||||
|                              (+ baseline reason-indent-offset))))) | ||||
|                   ;; Point is now at the beginning of the current line | ||||
|                   )))))))) | ||||
| 
 | ||||
|     (when indent | ||||
|       ;; If we're at the beginning of the line (before or at the current | ||||
|       ;; indentation), jump with the indentation change.  Otherwise, save the | ||||
|       ;; excursion so that adding the indentations will leave us at the | ||||
|       ;; equivalent position within the line to where we were before. | ||||
|       (if (<= (current-column) (current-indentation)) | ||||
|           (indent-line-to indent) | ||||
|         (save-excursion (indent-line-to indent)))))) | ||||
| 
 | ||||
| (provide 'reason-indent) | ||||
| 
 | ||||
| ;;; reason-indent.el ends here | ||||
							
								
								
									
										216
									
								
								users/wpcarro/emacs/.emacs.d/vendor/reason-interaction.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										216
									
								
								users/wpcarro/emacs/.emacs.d/vendor/reason-interaction.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							|  | @ -0,0 +1,216 @@ | |||
| ;;; reason-interaction.el --- Phrase navitagion for rtop -*-lexical-binding: t-*- | ||||
| 
 | ||||
| ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| 
 | ||||
| ;; Phrase navigation for utop and maybe other REPLs. | ||||
| 
 | ||||
| ;; The utop compatibility layer for Reason was mainly taken from: | ||||
| ;; https://github.com/ocaml/tuareg/blob/master/tuareg-light.el (big thanks!) | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| (defun reason-backward-char (&optional step) | ||||
|   "Go back one char. | ||||
| Similar to `backward-char` but it does not signal errors | ||||
| `beginning-of-buffer` and `end-of-buffer`.  It optionally takes a | ||||
| STEP parameter for jumping back more than one character." | ||||
|   (when step (goto-char (- (point) step)) | ||||
|         (goto-char (1- (point))))) | ||||
| 
 | ||||
| (defun reason-forward-char (&optional step) | ||||
|   "Go forward one char. | ||||
| Similar to `forward-char` but it does not signal errors | ||||
| `beginning-of-buffer` and `end-of-buffer`.  It optionally takes a | ||||
| STEP parameter for jumping back more than one character." | ||||
|   (when step (goto-char (+ (point) step)) | ||||
|     (goto-char (1+ (point))))) | ||||
| 
 | ||||
| (defun reason-in-literal-p () | ||||
|   "Return non-nil if point is inside an Reason literal." | ||||
|   (nth 3 (syntax-ppss))) | ||||
| 
 | ||||
| (defconst reason-comment-delimiter-regexp "\\*/\\|/\\*" | ||||
|   "Regex for identify either open or close comment delimiters.") | ||||
| 
 | ||||
| (defun reason-in-between-comment-chars-p () | ||||
|   "Return non-nil iff point is in between the comment delimiter chars. | ||||
| It returns non-nil if point is between the chars only (*|/ or /|* | ||||
| where | is point)." | ||||
|   (and (not (bobp)) (not (eobp)) | ||||
|        (or (and (char-equal ?/ (char-before)) (char-equal ?* (char-after))) | ||||
|            (and (char-equal ?* (char-before)) (char-equal ?/ (char-after)))))) | ||||
| 
 | ||||
| (defun reason-looking-at-comment-delimiters-p () | ||||
|   "Return non-nil iff point in between comment delimiters." | ||||
|   (looking-at-p reason-comment-delimiter-regexp)) | ||||
| 
 | ||||
| (defun reason-in-between-comment-delimiters-p () | ||||
|   "Return non-nil if inside /* and */." | ||||
|   (nth 4 (syntax-ppss))) | ||||
| 
 | ||||
| (defun reason-in-comment-p () | ||||
|   "Return non-nil iff point is inside or right before a comment." | ||||
|   (or (reason-in-between-comment-delimiters-p) | ||||
|       (reason-in-between-comment-chars-p) | ||||
|       (reason-looking-at-comment-delimiters-p))) | ||||
| 
 | ||||
| (defun reason-beginning-of-literal-or-comment () | ||||
|   "Skip to the beginning of the current literal or comment (or buffer)." | ||||
|   (interactive) | ||||
|   (goto-char (or (nth 8 (syntax-ppss)) (point)))) | ||||
| 
 | ||||
| (defun reason-inside-block-scope-p () | ||||
|   "Skip to the beginning of the current literal or comment (or buffer)." | ||||
|   (and (> (nth 0 (syntax-ppss)) 0) | ||||
|        (let ((delim-start (nth 1 (syntax-ppss)))) | ||||
|          (save-excursion | ||||
|            (goto-char delim-start) | ||||
|            (char-equal ?{ (following-char)))))) | ||||
| 
 | ||||
| (defun reason-at-phrase-break-p () | ||||
|   "Is the underlying `;' a phrase break?" | ||||
|   ;; Difference from OCaml, the phrase separator is a single semi-colon | ||||
|   (and (not (eobp)) | ||||
|        (char-equal ?\; (following-char)))) | ||||
| 
 | ||||
| (defun reason-skip-to-close-delimiter (&optional limit) | ||||
|   "Skip to the end of a Reason block. | ||||
| It basically calls `re-search-forward` in order to go to any | ||||
| closing delimiter, not concerning itself with balancing of any | ||||
| sort.  Client code needs to check that. | ||||
| LIMIT is passed to `re-search-forward` directly." | ||||
|   (re-search-forward "\\s)" limit 'move)) | ||||
| 
 | ||||
| (defun reason-skip-back-to-open-delimiter (&optional limit) | ||||
|   "Skip to the beginning of a Reason block backwards. | ||||
| It basically calls `re-search-backward` in order to go to any | ||||
| opening delimiter, not concerning itself with balancing of any | ||||
| sort.  Client code needs to check that. | ||||
| LIMIT is passed to `re-search-backward` directly." | ||||
|   (re-search-backward "\\s(" limit 'move)) | ||||
| 
 | ||||
| (defun reason-find-phrase-end () | ||||
|   "Skip to the end of a phrase." | ||||
|   (while (and (not (eobp)) | ||||
|               (not (reason-at-phrase-break-p))) | ||||
|     (if (re-search-forward ";" nil 'move) | ||||
|         (progn (when (reason-inside-block-scope-p) | ||||
|                  (reason-skip-to-close-delimiter)) | ||||
|                (goto-char (1- (point)))) | ||||
|       ;; avoid infinite loop at the end of the buffer | ||||
|       (re-search-forward "[[:space:]\\|\n]+" nil 'move))) | ||||
|   (min (goto-char (1+ (point))) (point-max))) | ||||
| 
 | ||||
| (defun reason-skip-blank-and-comments () | ||||
|   "Skip blank spaces and comments." | ||||
|   (cond | ||||
|    ((eobp) (point)) | ||||
|    ((or (reason-in-between-comment-chars-p) | ||||
|         (reason-looking-at-comment-delimiters-p)) (progn | ||||
|                                                     (reason-forward-char 1) | ||||
|                                                     (reason-skip-blank-and-comments))) | ||||
|    ((reason-in-between-comment-delimiters-p) (progn | ||||
|                                                (search-forward "*/" nil t) | ||||
|                                                (reason-skip-blank-and-comments))) | ||||
|    ((eolp) (progn | ||||
|              (reason-forward-char 1) | ||||
|              (reason-skip-blank-and-comments))) | ||||
|    (t (progn (skip-syntax-forward " ") | ||||
|              (point))))) | ||||
| 
 | ||||
| (defun reason-skip-back-blank-and-comments () | ||||
|   "Skip blank spaces and comments backwards." | ||||
|   (cond | ||||
|    ((bobp) (point)) | ||||
|    ((looking-back reason-comment-delimiter-regexp) (progn | ||||
|                                                      (reason-backward-char 1) | ||||
|                                                      (reason-skip-back-blank-and-comments))) | ||||
|    ((reason-in-between-comment-delimiters-p) (progn | ||||
|                                                (search-backward "/*" nil t) | ||||
|                                                (reason-backward-char 1) | ||||
|                                                (reason-skip-back-blank-and-comments))) | ||||
|    ((or (reason-in-between-comment-chars-p) | ||||
|         (reason-looking-at-comment-delimiters-p)) (progn | ||||
|                                                     (reason-backward-char 1) | ||||
|                                                     (reason-skip-back-blank-and-comments))) | ||||
|    ((bolp) (progn | ||||
|              (reason-backward-char 1) | ||||
|              (reason-skip-back-blank-and-comments))) | ||||
|    (t (progn (skip-syntax-backward " ") | ||||
|              (point))))) | ||||
| 
 | ||||
| (defun reason-ro (&rest words) | ||||
|   "Build a regex matching iff at least a word in WORDS is present." | ||||
|   (concat "\\<" (regexp-opt words t) "\\>")) | ||||
| 
 | ||||
| (defconst reason-find-phrase-beginning-regexp | ||||
|   (concat (reason-ro "end" "type" "module" "sig" "struct" "class" | ||||
|                      "exception" "open" "let") | ||||
|           "\\|^#[ \t]*[a-z][_a-z]*\\>\\|;")) | ||||
| 
 | ||||
| (defun reason-at-phrase-start-p () | ||||
|   "Return t if is looking at the beginning of a phrase. | ||||
| A phrase starts when a toplevel keyword is at the beginning of a line." | ||||
|   (or (looking-at "#") | ||||
|       (looking-at reason-find-phrase-beginning-regexp))) | ||||
| 
 | ||||
| (defun reason-find-phrase-beginning-backward () | ||||
|   "Find the beginning of a phrase and return point. | ||||
| It scans code backwards, therefore the caller can assume that the | ||||
| beginning of the phrase (if found) is always before the starting | ||||
| point.  No error is signalled and (point-min) is returned when a | ||||
| phrease cannot be found." | ||||
|   (beginning-of-line) | ||||
|   (while (and (not (bobp)) (not (reason-at-phrase-start-p))) | ||||
|     (if (reason-inside-block-scope-p) | ||||
|         (reason-skip-back-to-open-delimiter) | ||||
|       (re-search-backward reason-find-phrase-beginning-regexp nil 'move))) | ||||
|   (point)) | ||||
| 
 | ||||
| (defun reason-discover-phrase () | ||||
|   "Discover a Reason phrase in the buffer." | ||||
|   ;; TODO reason-with-internal-syntax ;; tuareg2 modifies the syntax table (removed for now) | ||||
|   ;; TODO stop-at-and feature for phrase detection (do we need it?) | ||||
|   ;; TODO tuareg2 has some custom logic for module and class (do we need it?) | ||||
|   (save-excursion | ||||
|     (let ((case-fold-search nil)) | ||||
|       (reason-skip-blank-and-comments) | ||||
|       (list (reason-find-phrase-beginning-backward) ;; beginning | ||||
|             (reason-find-phrase-end)                ;; end | ||||
|             (save-excursion                         ;; end-with-comment | ||||
|               (reason-skip-blank-and-comments) | ||||
|               (point)))))) | ||||
| 
 | ||||
| (defun reason-discover-phrase-debug () | ||||
|   "Discover a Reason phrase in the buffer (debug mode)." | ||||
|   (let ((triple (reason-discover-phrase))) | ||||
|     (message (concat "Evaluating: \"" (reason-fetch-phrase triple) "\"")) | ||||
|     triple)) | ||||
| 
 | ||||
| (defun reason-fetch-phrase (triple) | ||||
|   "Fetch the phrase text given a TRIPLE." | ||||
|   (let* ((start (nth 0 triple)) | ||||
|          (end (nth 1 triple))) ;; we don't need end-with-comment | ||||
|     (buffer-substring-no-properties start end))) | ||||
| 
 | ||||
| (defun reason-next-phrase () | ||||
|   "Skip to the beginning of the next phrase." | ||||
|   (cond | ||||
|    ((reason-at-phrase-start-p) (point)) | ||||
|    ((eolp) (progn | ||||
|              (forward-char 1) | ||||
|              (reason-skip-blank-and-comments) | ||||
|              (reason-next-phrase))) | ||||
|    ((reason-inside-block-scope-p) (progn (reason-skip-to-close-delimiter) | ||||
|                                          (reason-next-phrase))) | ||||
|    ((looking-at ";") (progn | ||||
|                        (forward-char 1) | ||||
|                        (reason-next-phrase))) | ||||
|    (t (progn (end-of-line) | ||||
|              (reason-next-phrase))))) | ||||
| 
 | ||||
| (provide 'reason-interaction) | ||||
| 
 | ||||
| ;;; reason-interaction.el ends here | ||||
							
								
								
									
										242
									
								
								users/wpcarro/emacs/.emacs.d/vendor/reason-mode.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										242
									
								
								users/wpcarro/emacs/.emacs.d/vendor/reason-mode.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							|  | @ -0,0 +1,242 @@ | |||
| ;;; reason-mode.el --- A major mode for editing ReasonML -*-lexical-binding: t-*- | ||||
| ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. | ||||
| 
 | ||||
| ;; Version: 0.4.0 | ||||
| ;; Author: Mozilla | ||||
| ;; Url: https://github.com/reasonml-editor/reason-mode | ||||
| ;; Keywords: languages, ocaml | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;; This file is NOT part of GNU Emacs. | ||||
| 
 | ||||
| ;; This file is distributed under the terms of both the MIT license and the | ||||
| ;; Apache License (version 2.0). | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; This project provides useful functions and helpers for developing code | ||||
| ;; using the Reason programming language (https://facebook.github.io/reason). | ||||
| ;; | ||||
| ;; Reason is an umbrella project that provides a curated layer for OCaml. | ||||
| ;; | ||||
| ;; It offers: | ||||
| ;;  - A new, familiar syntax for the battle-tested language that is OCaml. | ||||
| ;;  - A workflow for compiling to JavaScript and native code. | ||||
| ;;  - A set of friendly documentations, libraries and utilities. | ||||
| ;; | ||||
| ;; See the README.md for more details. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| (require 'reason-indent) | ||||
| (require 'refmt) | ||||
| (require 'reason-interaction) | ||||
| 
 | ||||
| (eval-when-compile (require 'rx) | ||||
|                    (require 'compile) | ||||
|                    (require 'url-vars)) | ||||
| 
 | ||||
| ;; Syntax definitions and helpers | ||||
| (defvar reason-mode-syntax-table | ||||
|   (let ((table (make-syntax-table))) | ||||
| 
 | ||||
|     ;; Operators | ||||
|     (dolist (i '(?+ ?- ?* ?/ ?& ?| ?^ ?! ?< ?> ?~ ?@)) | ||||
|       (modify-syntax-entry i "." table)) | ||||
| 
 | ||||
|     ;; Strings | ||||
|     (modify-syntax-entry ?\" "\"" table) | ||||
|     (modify-syntax-entry ?\\ "\\" table) | ||||
|     (modify-syntax-entry ?\' "_"  table) | ||||
| 
 | ||||
|     ;; Comments | ||||
|     (modify-syntax-entry ?/  ". 124b" table) | ||||
|     (modify-syntax-entry ?*  ". 23n"  table) | ||||
|     (modify-syntax-entry ?\n "> b"    table) | ||||
|     (modify-syntax-entry ?\^m "> b"   table) | ||||
| 
 | ||||
|     table)) | ||||
| 
 | ||||
| (defgroup reason nil | ||||
|   "Support for Reason code." | ||||
|   :link '(url-link "http://facebook.github.io/reason/") | ||||
|   :group 'languages) | ||||
| 
 | ||||
| (defcustom reason-mode-hook nil | ||||
|   "Hook called by `reason-mode'." | ||||
|   :type 'hook | ||||
|   :group 'reason) | ||||
| 
 | ||||
| ;; Font-locking definitions and helpers | ||||
| (defconst reason-mode-keywords | ||||
|   '("and" "as" | ||||
|     "else" "external" | ||||
|     "fun" "for" | ||||
|     "if" "impl" "in" "include" | ||||
|     "let" | ||||
|     "module" "match" "mod" "move" "mutable" | ||||
|     "open" | ||||
|     "priv" "pub" | ||||
|     "rec" "ref" "return" | ||||
|     "self" "static" "switch" "struct" "super" | ||||
|     "trait" "type" | ||||
|     "use" | ||||
|     "virtual" | ||||
|     "where" "when" "while")) | ||||
| 
 | ||||
| (defconst reason-mode-consts | ||||
|   '("true" "false")) | ||||
| 
 | ||||
| (defconst reason-special-types | ||||
|   '("int" "float" "string" "char" | ||||
|     "bool" "unit" "list" "array" "exn" | ||||
|     "option" "ref")) | ||||
| 
 | ||||
| (defconst reason-camel-case | ||||
|   (rx symbol-start | ||||
|       (group upper (0+ (any word nonascii digit "_"))) | ||||
|       symbol-end)) | ||||
| 
 | ||||
| (eval-and-compile | ||||
|   (defconst reason--char-literal-rx | ||||
|     (rx (seq (group "'") | ||||
|              (or (seq "\\" anything) | ||||
|                  (not (any "'\\"))) | ||||
|              (group "'"))))) | ||||
| 
 | ||||
| (defun reason-re-word (inner) | ||||
|   "Build a word regexp given INNER." | ||||
|   (concat "\\<" inner "\\>")) | ||||
| 
 | ||||
| (defun reason-re-grab (inner) | ||||
|   "Build a grab regexp given INNER." | ||||
|   (concat "\\(" inner "\\)")) | ||||
| 
 | ||||
| (defun reason-regexp-opt-symbols (words) | ||||
|   "Like `(regexp-opt words 'symbols)`, but will work on Emacs 23. | ||||
| See rust-mode PR #42. | ||||
| Argument WORDS argument to pass to `regexp-opt`." | ||||
|   (concat "\\_<" (regexp-opt words t) "\\_>")) | ||||
| 
 | ||||
| ;;; Syntax highlighting for Reason | ||||
| (defvar reason-font-lock-keywords | ||||
|   `((,(reason-regexp-opt-symbols reason-mode-keywords) . font-lock-keyword-face) | ||||
|     (,(reason-regexp-opt-symbols reason-special-types) . font-lock-builtin-face) | ||||
|     (,(reason-regexp-opt-symbols reason-mode-consts) . font-lock-constant-face) | ||||
| 
 | ||||
|     (,reason-camel-case 1 font-lock-type-face) | ||||
| 
 | ||||
|     ;; Field names like `foo:`, highlight excluding the : | ||||
|     (,(concat (reason-re-grab reason-re-ident) ":[^:]") 1 font-lock-variable-name-face) | ||||
|     ;; Module names like `foo::`, highlight including the :: | ||||
|     (,(reason-re-grab (concat reason-re-ident "::")) 1 font-lock-type-face) | ||||
|     ;; Name punned labeled args like ::foo | ||||
|     (,(concat "[[:space:]]+" (reason-re-grab (concat "::" reason-re-ident))) 1 font-lock-type-face) | ||||
| 
 | ||||
|     ;; TODO jsx attribs? | ||||
|     (, | ||||
|      (concat "<[/]?" (reason-re-grab reason-re-ident) "[^>]*" ">") | ||||
|      1 font-lock-type-face))) | ||||
| 
 | ||||
| (defun reason-mode-try-find-alternate-file (mod-name extension) | ||||
|   "Switch to the file given by MOD-NAME and EXTENSION." | ||||
|   (let* ((filename (concat mod-name extension)) | ||||
|          (buffer (get-file-buffer filename))) | ||||
|     (if buffer (switch-to-buffer buffer) | ||||
|       (find-file filename)))) | ||||
| 
 | ||||
| (defun reason-mode-find-alternate-file () | ||||
|   "Switch to implementation/interface file." | ||||
|   (interactive) | ||||
|   (let ((name buffer-file-name)) | ||||
|     (when (string-match "\\`\\(.*\\)\\.re\\([il]\\)?\\'" name) | ||||
|       (let ((mod-name (match-string 1 name)) | ||||
|             (e (match-string 2 name))) | ||||
|         (cond | ||||
|          ((string= e "i") | ||||
|           (reason-mode-try-find-alternate-file mod-name ".re")) | ||||
|          (t | ||||
|           (reason-mode-try-find-alternate-file mod-name ".rei"))))))) | ||||
| 
 | ||||
| (defun reason--syntax-propertize-multiline-string (end) | ||||
|   "Propertize Reason multiline string. | ||||
| Argument END marks the end of the string." | ||||
|   (let ((ppss (syntax-ppss))) | ||||
|     (when (eq t (nth 3 ppss)) | ||||
|       (let ((key (save-excursion | ||||
|                    (goto-char (nth 8 ppss)) | ||||
|                    (and (looking-at "{\\([a-z]*\\)|") | ||||
|                         (match-string 1))))) | ||||
|         (when (search-forward (format "|%s}" key) end 'move) | ||||
|           (put-text-property (1- (match-end 0)) (match-end 0) | ||||
|                              'syntax-table (string-to-syntax "|"))))))) | ||||
| 
 | ||||
| (defun reason-syntax-propertize-function (start end) | ||||
|   "Propertize Reason function. | ||||
| Argument START marks the beginning of the function. | ||||
| Argument END marks the end of the function." | ||||
|   (goto-char start) | ||||
|   (reason--syntax-propertize-multiline-string end) | ||||
|   (funcall | ||||
|    (syntax-propertize-rules | ||||
|     (reason--char-literal-rx (1 "\"") (2 "\"")) | ||||
|     ;; multi line strings | ||||
|     ("\\({\\)[a-z]*|" | ||||
|      (1 (prog1 "|" | ||||
|           (goto-char (match-end 0)) | ||||
|           (reason--syntax-propertize-multiline-string end))))) | ||||
|    (point) end)) | ||||
| 
 | ||||
| (defvar reason-mode-map | ||||
|   (let ((map (make-sparse-keymap))) | ||||
|     (define-key map "\C-c\C-a" #'reason-mode-find-alternate-file) | ||||
|     (define-key map "\C-c\C-r" #'refmt-region-ocaml-to-reason) | ||||
|     (define-key map "\C-c\C-o" #'refmt-region-reason-to-ocaml) | ||||
|     map)) | ||||
| 
 | ||||
| ;;;###autoload | ||||
| (define-derived-mode reason-mode prog-mode "Reason" | ||||
|   "Major mode for Reason code. | ||||
| 
 | ||||
| \\{reason-mode-map}" | ||||
|   :group 'reason | ||||
|   :syntax-table reason-mode-syntax-table | ||||
|   :keymap reason-mode-map | ||||
| 
 | ||||
|   ;; Syntax | ||||
|   (setq-local syntax-propertize-function #'reason-syntax-propertize-function) | ||||
|   ;; Indentation | ||||
|   (setq-local indent-line-function 'reason-mode-indent-line) | ||||
|   ;; Fonts | ||||
|   (setq-local font-lock-defaults '(reason-font-lock-keywords)) | ||||
|   ;; Misc | ||||
|   (setq-local comment-start "/*") | ||||
|   (setq-local comment-end   "*/") | ||||
|   (setq-local indent-tabs-mode nil) | ||||
|   ;; Allow paragraph fills for comments | ||||
|   (setq-local comment-start-skip "/\\*+[ \t]*") | ||||
|   (setq-local paragraph-start | ||||
|               (concat "^[ \t]*$\\|\\*)$\\|" page-delimiter)) | ||||
|   (setq-local paragraph-separate paragraph-start) | ||||
|   (setq-local require-final-newline t) | ||||
|   (setq-local normal-auto-fill-function nil) | ||||
|   (setq-local comment-multi-line t) | ||||
| 
 | ||||
|   (setq-local beginning-of-defun-function 'reason-beginning-of-defun) | ||||
|   (setq-local end-of-defun-function 'reason-end-of-defun) | ||||
|   (setq-local parse-sexp-lookup-properties t)) | ||||
| 
 | ||||
| ;;;###autoload | ||||
| (add-to-list 'auto-mode-alist '("\\.rei?\\'" . reason-mode)) | ||||
| 
 | ||||
| (defun reason-mode-reload () | ||||
|   "Reload Reason mode." | ||||
|   (interactive) | ||||
|   (unload-feature 'reason-mode) | ||||
|   (unload-feature 'reason-indent) | ||||
|   (unload-feature 'reason-interaction) | ||||
|   (require 'reason-mode) | ||||
|   (reason-mode)) | ||||
| 
 | ||||
| (provide 'reason-mode) | ||||
| 
 | ||||
| ;;; reason-mode.el ends here | ||||
							
								
								
									
										231
									
								
								users/wpcarro/emacs/.emacs.d/vendor/refmt.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										231
									
								
								users/wpcarro/emacs/.emacs.d/vendor/refmt.el
									
										
									
									
										vendored
									
									
										Normal file
									
								
							|  | @ -0,0 +1,231 @@ | |||
| ;;; refmt.el --- utility functions to format reason code | ||||
| 
 | ||||
| ;; Copyright (c) 2014 The go-mode Authors. All rights reserved. | ||||
| ;; Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. | ||||
| 
 | ||||
| ;; Redistribution and use in source and binary forms, with or without | ||||
| ;; modification, are permitted provided that the following conditions are | ||||
| ;; met: | ||||
| 
 | ||||
| ;; * Redistributions of source code must retain the above copyright | ||||
| ;; notice, this list of conditions and the following disclaimer. | ||||
| ;; * Redistributions in binary form must reproduce the above | ||||
| ;; copyright notice, this list of conditions and the following disclaimer | ||||
| ;; in the documentation and/or other materials provided with the | ||||
| ;; distribution. | ||||
| ;; * Neither the name of the copyright holder nor the names of its | ||||
| ;; contributors may be used to endorse or promote products derived from | ||||
| ;; this software without specific prior written permission. | ||||
| 
 | ||||
| ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | ||||
| ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | ||||
| ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | ||||
| ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | ||||
| ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | ||||
| ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | ||||
| ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | ||||
| ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | ||||
| ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | ||||
| ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | ||||
| ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| (require 'cl-lib) | ||||
| 
 | ||||
| (defcustom refmt-command "refmt" | ||||
|   "The 'refmt' command." | ||||
|   :type 'string | ||||
|   :group 're-fmt) | ||||
| 
 | ||||
| (defcustom refmt-show-errors 'buffer | ||||
|     "Where to display refmt error output. | ||||
| It can either be displayed in its own buffer, in the echo area, or not at all. | ||||
| Please note that Emacs outputs to the echo area when writing | ||||
| files and will overwrite refmt's echo output if used from inside | ||||
| a `before-save-hook'." | ||||
|     :type '(choice | ||||
|             (const :tag "Own buffer" buffer) | ||||
|             (const :tag "Echo area" echo) | ||||
|             (const :tag "None" nil)) | ||||
|       :group 're-fmt) | ||||
| 
 | ||||
| (defcustom refmt-width-mode nil | ||||
|   "Specify width when formatting buffer contents." | ||||
|   :type '(choice | ||||
|           (const :tag "Window width" window) | ||||
|           (const :tag "Fill column" fill) | ||||
|           (const :tag "None" nil)) | ||||
|   :group 're-fmt) | ||||
| 
 | ||||
| ;;;###autoload | ||||
| (defun refmt-before-save () | ||||
|   "Add this to .emacs to run refmt on the current buffer when saving: | ||||
|  (add-hook 'before-save-hook 'refmt-before-save)." | ||||
|     (interactive) | ||||
|       (when (eq major-mode 'reason-mode) (refmt))) | ||||
| 
 | ||||
| (defun reason--goto-line (line) | ||||
|   (goto-char (point-min)) | ||||
|     (forward-line (1- line))) | ||||
| 
 | ||||
| (defun reason--delete-whole-line (&optional arg) | ||||
|     "Delete the current line without putting it in the `kill-ring'. | ||||
| Derived from function `kill-whole-line'.  ARG is defined as for that | ||||
| function." | ||||
|     (setq arg (or arg 1)) | ||||
|     (if (and (> arg 0) | ||||
|              (eobp) | ||||
|              (save-excursion (forward-visible-line 0) (eobp))) | ||||
|         (signal 'end-of-buffer nil)) | ||||
|     (if (and (< arg 0) | ||||
|              (bobp) | ||||
|              (save-excursion (end-of-visible-line) (bobp))) | ||||
|         (signal 'beginning-of-buffer nil)) | ||||
|     (cond ((zerop arg) | ||||
|            (delete-region (progn (forward-visible-line 0) (point)) | ||||
|                           (progn (end-of-visible-line) (point)))) | ||||
|           ((< arg 0) | ||||
|            (delete-region (progn (end-of-visible-line) (point)) | ||||
|                           (progn (forward-visible-line (1+ arg)) | ||||
|                                  (unless (bobp) | ||||
|                                    (backward-char)) | ||||
|                                  (point)))) | ||||
|           (t | ||||
|            (delete-region (progn (forward-visible-line 0) (point)) | ||||
|                                                   (progn (forward-visible-line arg) (point)))))) | ||||
| 
 | ||||
| (defun reason--apply-rcs-patch (patch-buffer &optional start-pos) | ||||
|   "Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer." | ||||
|   (setq start-pos (or start-pos (point-min))) | ||||
|   (let ((first-line (line-number-at-pos start-pos)) | ||||
|         (target-buffer (current-buffer)) | ||||
|         ;; Relative offset between buffer line numbers and line numbers | ||||
|         ;; in patch. | ||||
|         ;; | ||||
|         ;; Line numbers in the patch are based on the source file, so | ||||
|         ;; we have to keep an offset when making changes to the | ||||
|         ;; buffer. | ||||
|         ;; | ||||
|         ;; Appending lines decrements the offset (possibly making it | ||||
|         ;; negative), deleting lines increments it. This order | ||||
|         ;; simplifies the forward-line invocations. | ||||
|         (line-offset 0)) | ||||
|     (save-excursion | ||||
|       (with-current-buffer patch-buffer | ||||
|         (goto-char (point-min)) | ||||
|         (while (not (eobp)) | ||||
|           (unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)") | ||||
|             (error "invalid rcs patch or internal error in reason--apply-rcs-patch")) | ||||
|           (forward-line) | ||||
|           (let ((action (match-string 1)) | ||||
|                 (from (string-to-number (match-string 2))) | ||||
|                 (len  (string-to-number (match-string 3)))) | ||||
|             (cond | ||||
|              ((equal action "a") | ||||
|               (let ((start (point))) | ||||
|                 (forward-line len) | ||||
|                 (let ((text (buffer-substring start (point)))) | ||||
|                   (with-current-buffer target-buffer | ||||
|                     (cl-decf line-offset len) | ||||
|                     (goto-char start-pos) | ||||
|                     (forward-line (- from len line-offset)) | ||||
|                     (insert text))))) | ||||
|              ((equal action "d") | ||||
|               (with-current-buffer target-buffer | ||||
|                 (reason--goto-line (- (1- (+ first-line from)) line-offset)) | ||||
|                 (cl-incf line-offset len) | ||||
|                 (reason--delete-whole-line len))) | ||||
|              (t | ||||
|               (error "invalid rcs patch or internal error in reason--apply-rcs-patch"))))))))) | ||||
| 
 | ||||
| (defun refmt--process-errors (filename tmpfile errorfile errbuf) | ||||
|   (with-current-buffer errbuf | ||||
|     (if (eq refmt-show-errors 'echo) | ||||
|         (progn | ||||
|           (message "%s" (buffer-string)) | ||||
|           (refmt--kill-error-buffer errbuf)) | ||||
|       (insert-file-contents errorfile nil nil nil) | ||||
|       ;; Convert the refmt stderr to something understood by the compilation mode. | ||||
|       (goto-char (point-min)) | ||||
|       (insert "refmt errors:\n") | ||||
|       (while (search-forward-regexp (regexp-quote tmpfile) nil t) | ||||
|         (replace-match (file-name-nondirectory filename))) | ||||
|       (compilation-mode) | ||||
|       (display-buffer errbuf)))) | ||||
| 
 | ||||
| (defun refmt--kill-error-buffer (errbuf) | ||||
|   (let ((win (get-buffer-window errbuf))) | ||||
|     (if win | ||||
|         (quit-window t win) | ||||
|       (with-current-buffer errbuf | ||||
|         (erase-buffer)) | ||||
|       (kill-buffer errbuf)))) | ||||
| 
 | ||||
| (defun apply-refmt (&optional start end from to) | ||||
|   (setq start (or start (point-min)) | ||||
|         end (or end (point-max)) | ||||
|         from (or from "re") | ||||
|         to (or to "re")) | ||||
|    (let* ((ext (file-name-extension buffer-file-name t)) | ||||
|           (bufferfile (make-temp-file "refmt" nil ext)) | ||||
|           (outputfile (make-temp-file "refmt" nil ext)) | ||||
|           (errorfile (make-temp-file "refmt" nil ext)) | ||||
|           (errbuf (if refmt-show-errors (get-buffer-create "*Refmt Errors*"))) | ||||
|           (patchbuf (get-buffer-create "*Refmt patch*")) | ||||
|           (coding-system-for-read 'utf-8) | ||||
|           (coding-system-for-write 'utf-8) | ||||
|           (width-args | ||||
|            (cond | ||||
|             ((equal refmt-width-mode 'window) | ||||
|              (list "--print-width" (number-to-string (window-body-width)))) | ||||
|             ((equal refmt-width-mode 'fill) | ||||
|              (list "--print-width" (number-to-string fill-column))) | ||||
|             (t | ||||
|              '())))) | ||||
|      (unwind-protect | ||||
|          (save-restriction | ||||
|            (widen) | ||||
|            (write-region start end bufferfile) | ||||
|            (if errbuf | ||||
|                (with-current-buffer errbuf | ||||
|                  (setq buffer-read-only nil) | ||||
|                  (erase-buffer))) | ||||
|            (with-current-buffer patchbuf | ||||
|              (erase-buffer)) | ||||
|            (if (zerop (apply 'call-process | ||||
|                              refmt-command nil (list (list :file outputfile) errorfile) | ||||
|                              nil (append width-args (list "--parse" from "--print" to bufferfile)))) | ||||
|                (progn | ||||
|                  (call-process-region start end "diff" nil patchbuf nil "-n" "-" | ||||
|                                       outputfile) | ||||
|                  (reason--apply-rcs-patch patchbuf start) | ||||
|                  (message "Applied refmt") | ||||
|                  (if errbuf (refmt--kill-error-buffer errbuf))) | ||||
|              (message "Could not apply refmt") | ||||
|              (if errbuf | ||||
|                  (refmt--process-errors (buffer-file-name) bufferfile errorfile errbuf))))) | ||||
|      (kill-buffer patchbuf) | ||||
|      (delete-file errorfile) | ||||
|      (delete-file bufferfile) | ||||
|      (delete-file outputfile))) | ||||
| 
 | ||||
| (defun refmt () | ||||
|   "Format the current buffer according to the refmt tool." | ||||
|   (interactive) | ||||
|   (apply-refmt)) | ||||
| 
 | ||||
| (defun refmt-region-ocaml-to-reason (start end) | ||||
|   (interactive "r") | ||||
|   (apply-refmt start end "ml")) | ||||
| 
 | ||||
| (defun refmt-region-reason-to-ocaml (start end) | ||||
|   (interactive "r") | ||||
|   (apply-refmt start end "re" "ml")) | ||||
| 
 | ||||
| (provide 'refmt) | ||||
| 
 | ||||
| ;;; refmt.el ends here | ||||
							
								
								
									
										29
									
								
								users/wpcarro/emacs/.emacs.d/wpc/>.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										29
									
								
								users/wpcarro/emacs/.emacs.d/wpc/>.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,29 @@ | |||
| ;;; >.el --- Small utility functions -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Originally I stored the `>>` macro in macros.el, but after setting up linting | ||||
| ;; for my Elisp in CI, `>>` failed because it didn't have the `macros-` | ||||
| ;; namespace.  I created this module to establish a `>-` namespace under which I | ||||
| ;; can store some utilities that would be best kept without a cumbersome | ||||
| ;; namespace. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defmacro >-> (&rest forms) | ||||
|   "Compose a new, point-free function by composing FORMS together." | ||||
|   (let ((sym (gensym))) | ||||
|     `(lambda (,sym) | ||||
|        (->> ,sym ,@forms)))) | ||||
| 
 | ||||
| 
 | ||||
| (provide '>) | ||||
| ;;; >.el ends here | ||||
							
								
								
									
										255
									
								
								users/wpcarro/emacs/.emacs.d/wpc/al.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										255
									
								
								users/wpcarro/emacs/.emacs.d/wpc/al.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,255 @@ | |||
| ;;; al.el --- Interface for working with associative lists -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "25.1")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Firstly, a rant: | ||||
| ;; In most cases, I find Elisp's APIs to be confusing.  There's a mixture of | ||||
| ;; overloaded functions that leak the implementation details (TODO: provide an | ||||
| ;; example of this.) of the abstract data type, which I find privileges those | ||||
| ;; "insiders" who spend disproportionately large amounts of time in Elisp land, | ||||
| ;; and other functions with little-to-no pattern about the order in which | ||||
| ;; arguments should be applied.  In theory, however, most of these APIs could | ||||
| ;; and should be much simpler.  This module represents a step in that direction. | ||||
| ;; | ||||
| ;; I'm modelling these APIs after Elixir's APIs. | ||||
| ;; | ||||
| ;; On my wishlist is to create protocols that will allow generic interfaces like | ||||
| ;; Enum protocols, etc.  Would be nice to abstract over... | ||||
| ;; - associative lists (i.e. alists) | ||||
| ;; - property lists (i.e. plists) | ||||
| ;; - hash tables | ||||
| ;; ...with some dictionary or map-like interface.  This will probably end up | ||||
| ;; being quite similar to the kv.el project but with differences at the API | ||||
| ;; layer. | ||||
| ;; | ||||
| ;; Similar libraries: | ||||
| ;; - map.el: Comes bundled with recent versions of Emacs. | ||||
| ;; - asoc.el: Helpers for working with alists.  asoc.el is similar to alist.el | ||||
| ;;   because it uses the "!" convention for signalling that a function mutates | ||||
| ;;   the underlying data structure. | ||||
| ;; - ht.el: Hash table library. | ||||
| ;; - kv.el: Library for dealing with key-value collections.  Note that map.el | ||||
| ;;   has a similar typeclass because it works with lists, hash-tables, or | ||||
| ;;   arrays. | ||||
| ;; - a.el: Clojure-inspired way of working with key-value data structures in | ||||
| ;; Elisp.  Works with alists, hash-tables, and sometimes vectors. | ||||
| ;; | ||||
| ;; Some API design principles: | ||||
| ;; - The "noun" (i.e. alist) of the "verb" (i.e. function) comes last to improve | ||||
| ;; composability with the threading macro (i.e. `->>') and to improve consumers' | ||||
| ;; intuition with the APIs.  Learn this once, know it always. | ||||
| ;; | ||||
| ;; - Every function avoids mutating the alist unless it ends with !. | ||||
| ;; | ||||
| ;; - CRUD operations will be named according to the following table: | ||||
| ;;   - "create" *and* "set" | ||||
| ;;   - "read"   *and* "get" | ||||
| ;;   - "update" | ||||
| ;;   - "delete" *and* "remove" | ||||
| ;; | ||||
| ;; For better or worse, all of this code expects alists in the form of: | ||||
| ;; ((first-name . "William") (last-name . "Carroll")) | ||||
| ;; | ||||
| ;; Special thanks to github.com/alphapapa/emacs-package-dev-handbook for some of | ||||
| ;; the idiomatic ways to update alists. | ||||
| ;; | ||||
| ;; TODO: Include a section that compares alist.el to a.el from | ||||
| ;; github.com/plexus/a.el. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies: | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'macros) | ||||
| (require 'dash) | ||||
| (require 'tuple) | ||||
| (require 'maybe) | ||||
| 
 | ||||
| ;; TODO: Support function aliases for: | ||||
| ;; - create/set | ||||
| ;; - read/get | ||||
| ;; - update | ||||
| ;; - delete/remove | ||||
| 
 | ||||
| ;; Support mutative variants of functions with an ! appendage to their name. | ||||
| 
 | ||||
| ;; Ensure that the same message about only updating the first occurrence of a | ||||
| ;; key is consistent throughout documentation using string interpolation or some | ||||
| ;; other mechanism. | ||||
| 
 | ||||
| ;; TODO: Consider wrapping all of this with `(cl-defstruct alist xs)'. | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Constants | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defconst al-enable-tests? t | ||||
|   "When t, run the test suite.") | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| ;; TODO: Support a variadic version of this to easily construct alists. | ||||
| (defun al-new () | ||||
|   "Return a new, empty alist." | ||||
|   '()) | ||||
| 
 | ||||
| ;; Create | ||||
| ;; TODO: See if this mutates. | ||||
| (defun al-set (k v xs) | ||||
|   "Set K to V in XS." | ||||
|   (if (al-has-key? k xs) | ||||
|       (progn | ||||
|         ;; Note: this is intentional `alist-get' and not `al-get'. | ||||
|         (setf (alist-get k xs) v) | ||||
|         xs) | ||||
|     (list-cons `(,k . ,v) xs))) | ||||
| 
 | ||||
| (defun al-set! (k v xs) | ||||
|   "Set K to V in XS mutatively. | ||||
| Note that this doesn't append to the alist in the way that most alists handle | ||||
|   writing.  If the k already exists in XS, it is overwritten." | ||||
|   (map-delete xs k) | ||||
|   (map-put! xs k v)) | ||||
| 
 | ||||
| ;; Read | ||||
| (defun al-get (k xs) | ||||
|   "Return the value at K in XS; otherwise, return nil. | ||||
| Returns the first occurrence of K in XS since alists support multiple entries." | ||||
|   (cdr (assoc k xs))) | ||||
| 
 | ||||
| (defun al-get-entry (k xs) | ||||
|   "Return the first key-value pair at K in XS." | ||||
|   (assoc k xs)) | ||||
| 
 | ||||
| ;; Update | ||||
| ;; TODO: Add warning about only the first occurrence being updated in the | ||||
| ;; documentation. | ||||
| (defun al-update (k f xs) | ||||
|   "Apply F to the value stored at K in XS. | ||||
| If `K' is not in `XS', this function errors.  Use `al-upsert' if you're | ||||
| interested in inserting a value when a key doesn't already exist." | ||||
|   (if (not (al-has-key? k xs)) | ||||
|       (error "Refusing to update: key does not exist in alist") | ||||
|     (al-set k (funcall f (al-get k xs)) xs))) | ||||
| 
 | ||||
| (defun al-update! (k f xs) | ||||
|   "Call F on the entry at K in XS. | ||||
| Mutative variant of `al-update'." | ||||
|   (al-set! k (funcall f (al-get k xs))xs)) | ||||
| 
 | ||||
| ;; TODO: Support this. | ||||
| (defun al-upsert (k v f xs) | ||||
|   "If K exists in `XS' call `F' on the value otherwise insert `V'." | ||||
|   (if (al-has-key? k xs) | ||||
|       (al-update k f xs) | ||||
|     (al-set k v xs))) | ||||
| 
 | ||||
| ;; Delete | ||||
| ;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs. | ||||
| (defun al-delete (k xs) | ||||
|   "Deletes the entry of K from XS. | ||||
| This only removes the first occurrence of K, since alists support multiple | ||||
|   key-value entries.  See `al-delete-all' and `al-dedupe'." | ||||
|   (remove (assoc k xs) xs)) | ||||
| 
 | ||||
| (defun al-delete! (k xs) | ||||
|   "Delete the entry of K from XS. | ||||
| Mutative variant of `al-delete'." | ||||
|   (delete (assoc k xs) xs)) | ||||
| 
 | ||||
| ;; Additions to the CRUD API | ||||
| ;; TODO: Implement this function. | ||||
| (defun al-dedupe-keys (xs) | ||||
|   "Remove the entries in XS where the keys are `equal'.") | ||||
| 
 | ||||
| (defun al-dedupe-entries (xs) | ||||
|   "Remove the entries in XS where the key-value pair are `equal'." | ||||
|   (delete-dups xs)) | ||||
| 
 | ||||
| (defun al-keys (xs) | ||||
|   "Return a list of the keys in XS." | ||||
|   (mapcar 'car xs)) | ||||
| 
 | ||||
| (defun al-values (xs) | ||||
|   "Return a list of the values in XS." | ||||
|   (mapcar 'cdr xs)) | ||||
| 
 | ||||
| (defun al-has-key? (k xs) | ||||
|   "Return t if XS has a key `equal' to K." | ||||
|   (maybe-some? (assoc k xs))) | ||||
| 
 | ||||
| (defun al-has-value? (v xs) | ||||
|   "Return t if XS has a value of V." | ||||
|   (maybe-some? (rassoc v xs))) | ||||
| 
 | ||||
| (defun al-count (xs) | ||||
|   "Return the number of entries in XS." | ||||
|   (length xs)) | ||||
| 
 | ||||
| ;; TODO: Should I support `al-find-key' and `al-find-value' variants? | ||||
| (defun al-find (p xs) | ||||
|   "Find an element in XS. | ||||
| 
 | ||||
| Apply a predicate fn, P, to each key and value in XS and return the key of the | ||||
| first element that returns t." | ||||
|   (let ((result (list-find (lambda (x) (funcall p (car x) (cdr x))) xs))) | ||||
|     (if result | ||||
|         (car result) | ||||
|       nil))) | ||||
| 
 | ||||
| (defun al-map-keys (f xs) | ||||
|   "Call F on the values in XS, returning a new alist." | ||||
|   (list-map (lambda (x) | ||||
|               `(,(funcall f (car x)) . ,(cdr x))) | ||||
|             xs)) | ||||
| 
 | ||||
| (defun al-map-values (f xs) | ||||
|   "Call F on the values in XS, returning a new alist." | ||||
|   (list-map (lambda (x) | ||||
|               `(,(car x) . ,(funcall f (cdr x)))) | ||||
|             xs)) | ||||
| 
 | ||||
| (defun al-reduce (acc f xs) | ||||
|   "Return a new alist by calling F on k v and ACC from XS. | ||||
| F should return a tuple.  See tuple.el for more information." | ||||
|   (->> (al-keys xs) | ||||
|        (list-reduce acc | ||||
|                     (lambda (k acc) | ||||
|                       (funcall f k (al-get k xs) acc))))) | ||||
| 
 | ||||
| (defun al-merge (a b) | ||||
|   "Return a new alist with a merge of alists, A and B. | ||||
| In this case, the last writer wins, which is B." | ||||
|   (al-reduce a #'al-set b)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (when al-enable-tests? | ||||
|   (prelude-assert | ||||
|    (equal '((2 . one) | ||||
|             (3 . two)) | ||||
|           (al-map-keys #'1+ | ||||
|                           '((1 . one) | ||||
|                             (2 . two))))) | ||||
|   (prelude-assert | ||||
|    (equal '((one . 2) | ||||
|             (two . 3)) | ||||
|           (al-map-values #'1+ | ||||
|                             '((one . 1) | ||||
|                               (two . 2)))))) | ||||
| 
 | ||||
| 
 | ||||
| ;; TODO: Support test cases for the entire API. | ||||
| 
 | ||||
| (provide 'al) | ||||
| ;;; al.el ends here | ||||
							
								
								
									
										71
									
								
								users/wpcarro/emacs/.emacs.d/wpc/bag.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										71
									
								
								users/wpcarro/emacs/.emacs.d/wpc/bag.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,71 @@ | |||
| ;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; What is a bag?  A bag should be thought of as a frequency table.  It's a way | ||||
| ;; to convert a list of something into a set that allows duplicates.  Isn't | ||||
| ;; allowing duplicates the whole thing with Sets?  Kind of.  But the interface | ||||
| ;; of Sets is something that bags resemble, so multi-set isn't as bag of a name | ||||
| ;; as it may first seem. | ||||
| ;; | ||||
| ;; If you've used Python's collections.Counter, the concept of a bag should be | ||||
| ;; familiar already. | ||||
| ;; | ||||
| ;; Interface: | ||||
| ;; - add        :: x -> Bag(x) -> Bag(x) | ||||
| ;; - remove     :: x -> Bag(x) -> Bag(x) | ||||
| ;; - union      :: Bag(x) -> Bag(x) -> Bag(x) | ||||
| ;; - difference :: Bag(x) -> Bag(x) -> Bag(x) | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'al) | ||||
| (require 'number) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (cl-defstruct bag xs) | ||||
| 
 | ||||
| (defun bag-update (f xs) | ||||
|   "Call F on alist in XS." | ||||
|   (let ((ys (bag-xs xs))) | ||||
|     (setf (bag-xs xs) (funcall f ys)))) | ||||
| 
 | ||||
| (defun bag-new () | ||||
|   "Create an empty bag." | ||||
|   (make-bag :xs (al-new))) | ||||
| 
 | ||||
| (defun bag-contains? (x xs) | ||||
|   "Return t if XS has X." | ||||
|   (al-has-key? x (bag-xs xs))) | ||||
| 
 | ||||
| ;; TODO: Tabling this for now since working with structs seems to be | ||||
| ;; disappointingly difficult.  Where is `struct-update'? | ||||
| ;; (defun bag-add (x xs) | ||||
| ;;   "Add X to XS.") | ||||
| 
 | ||||
| ;; TODO: What do we name delete vs. remove? | ||||
| ;; (defun bag-remove (x xs) | ||||
| ;;   "Remove X from XS. | ||||
| ;; This is a no-op is X doesn't exist in XS.") | ||||
| 
 | ||||
| (defun bag-from-list (xs) | ||||
|   "Map a list of `XS' into a bag." | ||||
|   (->> xs | ||||
|        (list-reduce | ||||
|         (bag-new) | ||||
|         (lambda (x acc) | ||||
|           (bag-add x 1 #'number-inc acc))))) | ||||
| 
 | ||||
| (provide 'bag) | ||||
| ;;; bag.el ends here | ||||
							
								
								
									
										100
									
								
								users/wpcarro/emacs/.emacs.d/wpc/bookmark.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										100
									
								
								users/wpcarro/emacs/.emacs.d/wpc/bookmark.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,100 @@ | |||
| ;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; After enjoying and relying on Emacs's builtin `jump-to-register' command, I'd | ||||
| ;; like to recreate this functionality with a few extensions. | ||||
| ;; | ||||
| ;; Everything herein will mimmick my previous KBDs for `jump-to-register', which | ||||
| ;; were <leader>-j-<register-kbd>.  If the `bookmark-path' is a file, Emacs will | ||||
| ;; open a buffer with that file.  If the `bookmark-path' is a directory, Emacs | ||||
| ;; will open an ivy window searching that directory. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'f) | ||||
| (require 'buffer) | ||||
| (require 'list) | ||||
| (require 'string) | ||||
| (require 'set) | ||||
| (require 'constants) | ||||
| (require 'general) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Constants | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (cl-defstruct bookmark label path kbd) | ||||
| 
 | ||||
| ;; TODO: Consider hosting this function somewhere other than here, since it | ||||
| ;; feels useful above of the context of bookmarks. | ||||
| ;; TODO: Assess whether it'd be better to use the existing function: | ||||
| ;; `counsel-projectile-switch-project-action'.  See the noise I made on GH for | ||||
| ;; more context: https://github.com/ericdanan/counsel-projectile/issues/137 | ||||
| 
 | ||||
| (defun bookmark-handle-directory-dwim (path) | ||||
|   "Open PATH as either a project directory or a regular directory. | ||||
| If PATH is `projectile-project-p', open with `counsel-projectile-find-file'. | ||||
| Otherwise, open with `counsel-find-file'." | ||||
|   (if (projectile-project-p path) | ||||
|       (with-temp-buffer | ||||
|         (cd (projectile-project-p path)) | ||||
|         (call-interactively #'counsel-projectile-find-file)) | ||||
|     (let ((ivy-extra-directories nil)) | ||||
|       (counsel-find-file path)))) | ||||
| 
 | ||||
| (defconst bookmark-handle-directory #'bookmark-handle-directory-dwim | ||||
|   "Function to call when a bookmark points to a directory.") | ||||
| 
 | ||||
| (defconst bookmark-handle-file #'counsel-find-file-action | ||||
|   "Function to call when a bookmark points to a file.") | ||||
| 
 | ||||
| (defconst bookmark-whitelist | ||||
|   (list | ||||
|    (make-bookmark :label "briefcase" | ||||
|                   :path constants-briefcase | ||||
|                   :kbd "b") | ||||
|    (make-bookmark :label "current project" | ||||
|                   :path constants-current-project | ||||
|                   :kbd "p")) | ||||
|   "List of registered bookmarks.") | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; API | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defun bookmark-open (b) | ||||
|   "Open bookmark, B, in a new buffer or an ivy minibuffer." | ||||
|   (let ((path (bookmark-path b))) | ||||
|     (cond | ||||
|      ((f-directory? path) | ||||
|       (funcall bookmark-handle-directory path)) | ||||
|      ((f-file? path) | ||||
|       (funcall bookmark-handle-file path))))) | ||||
| 
 | ||||
| 
 | ||||
| (defun bookmark-install-kbds () | ||||
|   "Install the keybindings defined herein." | ||||
|   (->> bookmark-whitelist | ||||
|        (list-map | ||||
|         (lambda (b) | ||||
|           (general-define-key | ||||
|            :prefix "<SPC>" | ||||
|            :states '(normal) | ||||
|            (format "J%s" (bookmark-kbd b)) | ||||
|            (lambda () (interactive) (find-file (bookmark-path b))) | ||||
|            (format "j%s" (bookmark-kbd b)) | ||||
|            ;; TODO: Consider `cl-labels' so `which-key' minibuffer is more | ||||
|            ;; helpful. | ||||
|            (lambda () (interactive) (bookmark-open b))))))) | ||||
| 
 | ||||
| (provide 'bookmark) | ||||
| ;;; bookmark.el ends here | ||||
							
								
								
									
										206
									
								
								users/wpcarro/emacs/.emacs.d/wpc/buffer.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										206
									
								
								users/wpcarro/emacs/.emacs.d/wpc/buffer.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,206 @@ | |||
| ;;; buffer.el --- Working with buffers -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Utilities for CRUDing buffers in Emacs. | ||||
| ;; | ||||
| ;; Many of these functions may seem unnecessary especially when you consider | ||||
| ;; there implementations.  In general I believe that Elisp suffers from a | ||||
| ;; library disorganization problem.  Providing simple wrapper functions that | ||||
| ;; rename functions or reorder parameters is worth the effort in my opinion if | ||||
| ;; it improves discoverability (via intuition) and improve composability. | ||||
| ;; | ||||
| ;; I support three ways for switching between what I'm calling "source code | ||||
| ;; buffers": | ||||
| ;; 1. Toggling previous: <SPC><SPC> | ||||
| ;; 2. Using `ivy-read': <SPC>b | ||||
| ;; TODO: These obscure evil KBDs.  Maybe a hydra definition would be best? | ||||
| ;; 3. Cycling (forwards/backwards): C-f, C-b | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'maybe) | ||||
| (require 'set) | ||||
| (require 'cycle) | ||||
| (require 'struct) | ||||
| (require 'ts) | ||||
| (require 'general) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defconst buffer-enable-tests? t | ||||
|   "When t, run the test suite.") | ||||
| 
 | ||||
| (defconst buffer-install-kbds? t | ||||
|   "When t, install the keybindings defined herein.") | ||||
| 
 | ||||
| (defconst buffer-source-code-blacklist | ||||
|   (set-new 'dired-mode | ||||
|            'erc-mode | ||||
|            'vterm-mode | ||||
|            'magit-status-mode | ||||
|            'magit-process-mode | ||||
|            'magit-log-mode | ||||
|            'magit-diff-mode | ||||
|            'org-mode | ||||
|            'fundamental-mode) | ||||
|   "A blacklist of major-modes to ignore for listing source code buffers.") | ||||
| 
 | ||||
| (defconst buffer-source-code-timeout 2 | ||||
|   "Number of seconds to wait before invalidating the cycle.") | ||||
| 
 | ||||
| (cl-defstruct source-code-cycle cycle last-called) | ||||
| 
 | ||||
| (defun buffer-emacs-generated? (name) | ||||
|   "Return t if buffer, NAME, is an Emacs-generated buffer. | ||||
| Some buffers are Emacs-generated but are surrounded by whitespace." | ||||
|   (let ((trimmed (s-trim name))) | ||||
|     (and (s-starts-with? "*" trimmed)))) | ||||
| 
 | ||||
| (defun buffer-find (buffer-or-name) | ||||
|   "Find a buffer by its BUFFER-OR-NAME." | ||||
|   (get-buffer buffer-or-name)) | ||||
| 
 | ||||
| (defun buffer-major-mode (name) | ||||
|   "Return the active `major-mode' in buffer, NAME." | ||||
|   (with-current-buffer (buffer-find name) | ||||
|     major-mode)) | ||||
| 
 | ||||
| (defun buffer-source-code-buffers () | ||||
|   "Return a list of source code buffers. | ||||
| This will ignore Emacs-generated buffers, like *Messages*.  It will also ignore | ||||
|   any buffer whose major mode is defined in `buffer-source-code-blacklist'." | ||||
|   (->> (buffer-list) | ||||
|        (list-map #'buffer-name) | ||||
|        (list-reject #'buffer-emacs-generated?) | ||||
|        (list-reject (lambda (name) | ||||
|                       (set-contains? (buffer-major-mode name) | ||||
|                                      buffer-source-code-blacklist))))) | ||||
| 
 | ||||
| (defvar buffer-source-code-cycle-state | ||||
|   (make-source-code-cycle | ||||
|    :cycle (cycle-from-list (buffer-source-code-buffers)) | ||||
|    :last-called (ts-now)) | ||||
|   "State used to manage cycling between source code buffers.") | ||||
| 
 | ||||
| (defun buffer-exists? (name) | ||||
|   "Return t if buffer, NAME, exists." | ||||
|   (maybe-some? (buffer-find name))) | ||||
| 
 | ||||
| (defun buffer-new (name) | ||||
|   "Return a newly created buffer NAME." | ||||
|   (generate-new-buffer name)) | ||||
| 
 | ||||
| (defun buffer-find-or-create (name) | ||||
|   "Find or create buffer, NAME. | ||||
| Return a reference to that buffer." | ||||
|   (let ((x (buffer-find name))) | ||||
|     (if (maybe-some? x) | ||||
|         x | ||||
|       (buffer-new name)))) | ||||
| 
 | ||||
| ;; TODO: Should this consume: `display-buffer' or `switch-to-buffer'? | ||||
| (defun buffer-show (buffer-or-name) | ||||
|   "Display the BUFFER-OR-NAME, which is either a buffer reference or its name." | ||||
|   (display-buffer buffer-or-name)) | ||||
| 
 | ||||
| ;; TODO: Move this and `buffer-cycle-prev' into a separate module that | ||||
| ;; encapsulates all of this behavior. | ||||
| 
 | ||||
| (defun buffer-cycle (cycle-fn) | ||||
|   "Using CYCLE-FN, move through `buffer-source-code-buffers'." | ||||
|   (let ((last-called (source-code-cycle-last-called | ||||
|                       buffer-source-code-cycle-state)) | ||||
|         (cycle (source-code-cycle-cycle | ||||
|                 buffer-source-code-cycle-state))) | ||||
|     (if (> (ts-diff (ts-now) last-called) | ||||
|            buffer-source-code-timeout) | ||||
|         (progn | ||||
|           (struct-set! source-code-cycle | ||||
|                        cycle | ||||
|                        (cycle-from-list (buffer-source-code-buffers)) | ||||
|                        buffer-source-code-cycle-state) | ||||
|           (let ((cycle (source-code-cycle-cycle | ||||
|                         buffer-source-code-cycle-state))) | ||||
|             (funcall cycle-fn cycle) | ||||
|             (switch-to-buffer (cycle-current cycle))) | ||||
|           (struct-set! source-code-cycle | ||||
|                        last-called | ||||
|                        (ts-now) | ||||
|                        buffer-source-code-cycle-state)) | ||||
|       (progn | ||||
|         (funcall cycle-fn cycle) | ||||
|         (switch-to-buffer (cycle-current cycle)))))) | ||||
| 
 | ||||
| (defun buffer-cycle-next () | ||||
|   "Cycle forward through the `buffer-source-code-buffers'." | ||||
|   (interactive) | ||||
|   (buffer-cycle #'cycle-next)) | ||||
| 
 | ||||
| (defun buffer-cycle-prev () | ||||
|   "Cycle backward through the `buffer-source-code-buffers'." | ||||
|   (interactive) | ||||
|   (buffer-cycle #'cycle-prev)) | ||||
| 
 | ||||
| (defun buffer-ivy-source-code () | ||||
|   "Use `ivy-read' to choose among all open source code buffers." | ||||
|   (interactive) | ||||
|   (ivy-read "Source code buffer: " | ||||
|             (-drop 1 (buffer-source-code-buffers)) | ||||
|             :sort nil | ||||
|             :action #'switch-to-buffer)) | ||||
| 
 | ||||
| (defun buffer-show-previous () | ||||
|   "Call `switch-to-buffer' on the previously visited buffer. | ||||
| This function ignores Emacs-generated buffers, i.e. the ones that look like | ||||
|   this: *Buffer*.  It also ignores buffers that are `dired-mode' or `erc-mode'. | ||||
|   This blacklist can easily be changed." | ||||
|   (interactive) | ||||
|   (let* ((xs (buffer-source-code-buffers)) | ||||
|          (candidate (list-get 1 xs))) | ||||
|     (prelude-assert (maybe-some? candidate)) | ||||
|     (switch-to-buffer candidate))) | ||||
| 
 | ||||
| (when buffer-install-kbds? | ||||
|   (general-define-key | ||||
|    :states '(normal) | ||||
|    "C-f" #'buffer-cycle-next | ||||
|    "C-b" #'buffer-cycle-prev) | ||||
|   (general-define-key | ||||
|    :prefix "<SPC>" | ||||
|    :states '(normal) | ||||
|    "b" #'buffer-ivy-source-code | ||||
|    "<SPC>" #'buffer-show-previous | ||||
|    "k" #'kill-buffer)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (when buffer-enable-tests? | ||||
|   (prelude-assert | ||||
|    (list-all? #'buffer-emacs-generated? | ||||
|               '("*scratch*" | ||||
|                 "*Messages*" | ||||
|                 "*shell*" | ||||
|                 "*Shell Command Output*" | ||||
|                 "*Occur*" | ||||
|                 "*Warnings*" | ||||
|                 "*Help*" | ||||
|                 "*Completions*" | ||||
|                 "*Apropos*" | ||||
|                 "*info*")))) | ||||
| 
 | ||||
| (provide 'buffer) | ||||
| ;;; buffer.el ends here | ||||
							
								
								
									
										113
									
								
								users/wpcarro/emacs/.emacs.d/wpc/bytes.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										113
									
								
								users/wpcarro/emacs/.emacs.d/wpc/bytes.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,113 @@ | |||
| ;;; bytes.el --- Working with byte values -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Functions to help with human-readable representations of byte values. | ||||
| ;; | ||||
| ;; Usage: | ||||
| ;; See the test cases for example usage.  Or better yet, I should use a type of | ||||
| ;; structured documentation that would allow me to expose a view into the test | ||||
| ;; suite here.  Is this currently possible in Elisp? | ||||
| ;; | ||||
| ;; API: | ||||
| ;; - serialize :: Integer -> String | ||||
| ;; | ||||
| ;; Wish list: | ||||
| ;; - Rounding: e.g. (bytes (* 1024 1.7)) => "2KB" | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;; TODO: Support -ibabyte variants like Gibibyte (GiB). | ||||
| 
 | ||||
| ;; Ranges: | ||||
| ;;  B: [   0,  1e3) | ||||
| ;; KB: [ 1e3,  1e6) | ||||
| ;; MB: [ 1e6,  1e6) | ||||
| ;; GB: [ 1e9, 1e12) | ||||
| ;; TB: [1e12, 1e15) | ||||
| ;; PB: [1e15, 1e18) | ||||
| ;; | ||||
| ;; Note: I'm currently not support exabytes because that causes the integer to | ||||
| ;;  overflow.  I imagine a larger integer type may exist, but for now, I'll | ||||
| ;;  treat this as a YAGNI. | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'tuple) | ||||
| (require 'math) | ||||
| (require 'number) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Constants | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defconst bytes-kb (math-exp 2 10) | ||||
|   "Number of bytes in a kilobyte.") | ||||
| 
 | ||||
| (defconst bytes-mb (math-exp 2 20) | ||||
|   "Number of bytes in a megabytes.") | ||||
| 
 | ||||
| (defconst bytes-gb (math-exp 2 30) | ||||
|   "Number of bytes in a gigabyte.") | ||||
| 
 | ||||
| (defconst bytes-tb (math-exp 2 40) | ||||
|   "Number of bytes in a terabyte.") | ||||
| 
 | ||||
| (defconst bytes-pb (math-exp 2 50) | ||||
|   "Number of bytes in a petabyte.") | ||||
| 
 | ||||
| (defconst bytes-eb (math-exp 2 60) | ||||
|   "Number of bytes in an exabyte.") | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Functions | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defun bytes-classify (x) | ||||
|   "Return unit that closest fits byte count, X." | ||||
|   (prelude-assert (number-whole? x)) | ||||
|   (cond | ||||
|    ((and (>= x 0)        (< x bytes-kb))     'byte) | ||||
|    ((and (>= x bytes-kb) (< x bytes-mb)) 'kilobyte) | ||||
|    ((and (>= x bytes-mb) (< x bytes-gb)) 'megabyte) | ||||
|    ((and (>= x bytes-gb) (< x bytes-tb)) 'gigabyte) | ||||
|    ((and (>= x bytes-tb) (< x bytes-pb)) 'terabyte) | ||||
|    ((and (>= x bytes-pb) (< x bytes-eb)) 'petabyte))) | ||||
| 
 | ||||
| (defun bytes-to-string (x) | ||||
|   "Convert integer X into a human-readable string." | ||||
|   (let ((base-and-unit | ||||
|          (pcase (bytes-classify x) | ||||
|            ('byte     (tuple/from        1 "B")) | ||||
|            ('kilobyte (tuple/from bytes-kb "KB")) | ||||
|            ('megabyte (tuple/from bytes-mb "MB")) | ||||
|            ('gigabyte (tuple/from bytes-gb "GB")) | ||||
|            ('terabyte (tuple/from bytes-tb "TB")) | ||||
|            ('petabyte (tuple/from bytes-pb "PB"))))) | ||||
|     (string-format "%d%s" | ||||
|                    (round x (tuple/first base-and-unit)) | ||||
|                    (tuple/second base-and-unit)))) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (progn | ||||
|   (prelude-assert | ||||
|    (equal "1000B" (bytes-to-string 1000))) | ||||
|   (prelude-assert | ||||
|    (equal "2KB" (bytes-to-string (* 2 bytes-kb)))) | ||||
|   (prelude-assert | ||||
|    (equal "17MB" (bytes-to-string (* 17 bytes-mb)))) | ||||
|   (prelude-assert | ||||
|    (equal "419GB" (bytes-to-string (* 419 bytes-gb)))) | ||||
|   (prelude-assert | ||||
|    (equal "999TB" (bytes-to-string (* 999 bytes-tb)))) | ||||
|   (prelude-assert | ||||
|    (equal "2PB" (bytes-to-string (* 2 bytes-pb))))) | ||||
| 
 | ||||
| (provide 'bytes) | ||||
| ;;; bytes.el ends here | ||||
							
								
								
									
										89
									
								
								users/wpcarro/emacs/.emacs.d/wpc/cache.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										89
									
								
								users/wpcarro/emacs/.emacs.d/wpc/cache.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,89 @@ | |||
| ;;; cache.el --- Caching things -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; An immutable cache data structure. | ||||
| ;; | ||||
| ;; This is like a sideways stack, that you can pull values out from and re-push | ||||
| ;; to the top.  It'd be like a stack supporting push, pop, pull. | ||||
| ;; | ||||
| ;; This isn't a key-value data-structure like you might expect from a | ||||
| ;; traditional cache.  The name is subject to change, but the underlying idea of | ||||
| ;; a cache remains the same. | ||||
| ;; | ||||
| ;; Think about prescient.el, which uses essentially an LRU cache integrated into | ||||
| ;; counsel to help create a "clairovoyant", self-organizing list. | ||||
| ;; | ||||
| ;; Use-cases: | ||||
| ;; - Keeps an cache of workspaces sorted as MRU with an LRU eviction strategy. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'struct) | ||||
| (require '>) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (cl-defstruct cache xs) | ||||
| 
 | ||||
| ;; TODO: Prefer another KBD for yasnippet form completion than company-mode's | ||||
| ;; current KBD. | ||||
| 
 | ||||
| (defun cache-from-list (xs) | ||||
|   "Turn list, XS, into a cache." | ||||
|   (make-cache :xs xs)) | ||||
| 
 | ||||
| (defun cache-contains? (x xs) | ||||
|   "Return t if X in XS." | ||||
|   (->> xs | ||||
|        cache-xs | ||||
|        (list-contains? x))) | ||||
| 
 | ||||
| (defun cache-touch (x xs) | ||||
|   "Ensure value X in cache, XS, is front of the list. | ||||
| If X isn't in XS (using `equal'), insert it at the front." | ||||
|   (struct-update | ||||
|    cache | ||||
|    xs | ||||
|    (>-> (list-reject (lambda (y) (equal x y))) | ||||
|        (list-cons x)) | ||||
|    xs)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (progn | ||||
|   (let ((cache (cache-from-list '("chicken" "nugget")))) | ||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|     ;; contains?/2 | ||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|     (prelude-refute | ||||
|      (cache-contains? "turkey" cache)) | ||||
|     (prelude-assert | ||||
|      (cache-contains? "chicken" cache)) | ||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|     ;; touch/2 | ||||
|     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
|     (prelude-assert | ||||
|      (equal | ||||
|       (cache-touch "nugget" cache) | ||||
|       (cache-from-list '("nugget" "chicken")))) | ||||
|     (prelude-assert | ||||
|      (equal | ||||
|       (cache-touch "spicy" cache) | ||||
|       (cache-from-list '("spicy" "chicken" "nugget")))))) | ||||
| 
 | ||||
| (provide 'cache) | ||||
| ;;; cache.el ends here | ||||
							
								
								
									
										44
									
								
								users/wpcarro/emacs/.emacs.d/wpc/clipboard.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										44
									
								
								users/wpcarro/emacs/.emacs.d/wpc/clipboard.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,44 @@ | |||
| ;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Simple functions for copying and pasting. | ||||
| ;; | ||||
| ;; Integrate with bburns/clipmon so that System Clipboard can integrate with | ||||
| ;; Emacs's kill-ring. | ||||
| ;; | ||||
| ;; Wish list: | ||||
| ;; - Create an Emacs integration with github.com/cdown/clipmenud. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'cl-lib) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (cl-defun clipboard-copy (x &key (message "[clipboard.el] Copied!")) | ||||
|   "Copy string, X, to X11's clipboard and `message' MESSAGE." | ||||
|   (kill-new x) | ||||
|   (message message)) | ||||
| 
 | ||||
| (cl-defun clipboard-paste (&key (message "[clipboard.el] Pasted!")) | ||||
|   "Paste contents of X11 clipboard and `message' MESSAGE." | ||||
|   (yank) | ||||
|   (message message)) | ||||
| 
 | ||||
| (defun clipboard-contents () | ||||
|   "Return the contents of the clipboard as a string." | ||||
|   (substring-no-properties (current-kill 0))) | ||||
| 
 | ||||
| (provide 'clipboard) | ||||
| ;;; clipboard.el ends here | ||||
							
								
								
									
										86
									
								
								users/wpcarro/emacs/.emacs.d/wpc/colorscheme.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										86
									
								
								users/wpcarro/emacs/.emacs.d/wpc/colorscheme.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,86 @@ | |||
| ;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; | ||||
| ;; TODO: Clarify this. | ||||
| ;; Since I have my own definition of "theme", which couples wallpaper, font, | ||||
| ;; with Emacs's traditional notion of the word "theme", I'm choosing to use | ||||
| ;; "colorscheme" to refer to *just* the notion of syntax highlight etc. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'cycle) | ||||
| (require '>) | ||||
| (require 'cl-lib) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defcustom colorscheme-whitelist | ||||
|   (cycle-from-list | ||||
|    (->> (custom-available-themes) | ||||
|         (list-map #'symbol-name) | ||||
|         (list-filter (>-> (s-starts-with? "doom-"))) | ||||
|         (list-map #'intern))) | ||||
|   "The whitelist of colorschemes through which to cycle.") | ||||
| 
 | ||||
| (defun colorscheme-current () | ||||
|   "Return the currently enabled colorscheme." | ||||
|   (cycle-current colorscheme-whitelist)) | ||||
| 
 | ||||
| (defun colorscheme-disable-all () | ||||
|   "Disable all currently enabled colorschemes." | ||||
|   (interactive) | ||||
|   (->> custom-enabled-themes | ||||
|        (list-map #'disable-theme))) | ||||
| 
 | ||||
| (defun colorscheme-set (theme) | ||||
|     "Call `load-theme' with `THEME', ensuring that the line numbers are bright. | ||||
| There is no hook that I'm aware of to handle this more elegantly." | ||||
|     (load-theme theme t) | ||||
|     (prelude-set-line-number-color "#da5468")) | ||||
| 
 | ||||
| (defun colorscheme-whitelist-set (colorscheme) | ||||
|   "Focus the COLORSCHEME in the `colorscheme-whitelist' cycle." | ||||
|   (cycle-focus (lambda (x) (equal x colorscheme)) colorscheme-whitelist) | ||||
|   (colorscheme-set (colorscheme-current))) | ||||
| 
 | ||||
| (defun colorscheme-ivy-select () | ||||
|   "Load a colorscheme using ivy." | ||||
|   (interactive) | ||||
|   (let ((theme (ivy-read "Theme: " (cycle-to-list colorscheme-whitelist)))) | ||||
|     (colorscheme-disable-all) | ||||
|     (colorscheme-set (intern theme)))) | ||||
| 
 | ||||
| (cl-defun colorscheme-cycle (&key forward?) | ||||
|   "Cycle next if `FORWARD?' is non-nil. | ||||
| Cycle prev otherwise." | ||||
|   (disable-theme (cycle-current colorscheme-whitelist)) | ||||
|   (let ((theme (if forward? | ||||
|                    (cycle-next colorscheme-whitelist) | ||||
|                  (cycle-prev colorscheme-whitelist)))) | ||||
|     (colorscheme-set theme) | ||||
|     (message (s-concat "Active theme: " (symbol-to-string theme))))) | ||||
| 
 | ||||
| (defun colorscheme-next () | ||||
|   "Disable the currently active theme and load the next theme." | ||||
|   (interactive) | ||||
|   (colorscheme-cycle :forward? t)) | ||||
| 
 | ||||
| (defun colorscheme-prev () | ||||
|   "Disable the currently active theme and load the previous theme." | ||||
|   (interactive) | ||||
|   (colorscheme-cycle :forward? nil)) | ||||
| 
 | ||||
| (provide 'colorscheme) | ||||
| ;;; colorscheme.el ends here | ||||
							
								
								
									
										55
									
								
								users/wpcarro/emacs/.emacs.d/wpc/constants.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										55
									
								
								users/wpcarro/emacs/.emacs.d/wpc/constants.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,55 @@ | |||
| ;;; constants.el --- Constants for organizing my Elisp -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; This file contains constants that are shared across my configuration. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'f) | ||||
| (require 'maybe) | ||||
| 
 | ||||
| (prelude-assert (f-exists? (getenv "BRIEFCASE"))) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Configuration | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defconst constants-ci? | ||||
|   (maybe-some? (getenv "CI")) | ||||
|   "Encoded as t when Emacs is running in CI.") | ||||
| 
 | ||||
| (defconst constants-briefcase | ||||
|   (getenv "BRIEFCASE") | ||||
|   "Path to my monorepo, which various parts of my configuration rely on.") | ||||
| 
 | ||||
| ;; TODO: Consider merging `ui.el' and `misc.el' because those are the only | ||||
| ;; current consumers of these constants, and I'm unsure if the indirection that | ||||
| ;; globally defined constants introduces is worth it. | ||||
| 
 | ||||
| (defconst constants-current-project | ||||
|   constants-briefcase | ||||
|   "Variable holding the directory for my currently active project.") | ||||
| 
 | ||||
| (defconst constants-mouse-kbds | ||||
|   '([mouse-1] [down-mouse-1] [drag-mouse-1] [double-mouse-1] [triple-mouse-1] | ||||
|     [mouse-2] [down-mouse-2] [drag-mouse-2] [double-mouse-2] [triple-mouse-2] | ||||
|     [mouse-3] [down-mouse-3] [drag-mouse-3] [double-mouse-3] [triple-mouse-3] | ||||
|     [mouse-4] [down-mouse-4] [drag-mouse-4] [double-mouse-4] [triple-mouse-4] | ||||
|     [mouse-5] [down-mouse-5] [drag-mouse-5] [double-mouse-5] [triple-mouse-5]) | ||||
|   "All of the mouse-related keybindings that Emacs recognizes.") | ||||
| 
 | ||||
| (defconst constants-fill-column 80 | ||||
|   "Variable used to set the defaults for wrapping, highlighting, etc.") | ||||
| 
 | ||||
| (provide 'constants) | ||||
| ;;; constants.el ends here | ||||
							
								
								
									
										224
									
								
								users/wpcarro/emacs/.emacs.d/wpc/cycle.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										224
									
								
								users/wpcarro/emacs/.emacs.d/wpc/cycle.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,224 @@ | |||
| ;;; cycle.el --- Simple module for working with cycles -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Something like this may already exist, but I'm having trouble finding it, and | ||||
| ;; I think writing my own is a nice exercise for learning more Elisp. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'math) | ||||
| (require 'maybe) | ||||
| (require 'struct) | ||||
| (require 'cl-lib) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Wish list | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| ;; - TODO: Provide immutable variant. | ||||
| ;; - TODO: Replace mutable consumption with immutable variant. | ||||
| ;; - TODO: Replace indexing with (math-mod current cycle). | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| ;; `current-index' tracks the current index | ||||
| ;; `xs' is the original list | ||||
| (cl-defstruct cycle current-index previous-index xs) | ||||
| 
 | ||||
| (defconst cycle-enable-tests? t | ||||
|   "When t, run the tests defined herein.") | ||||
| 
 | ||||
| (defun cycle-from-list (xs) | ||||
|   "Create a cycle from a list of `XS'." | ||||
|   (if (= 0 (length xs)) | ||||
|       (make-cycle :current-index nil | ||||
|                   :previous-index nil | ||||
|                   :xs xs) | ||||
|     (make-cycle :current-index 0 | ||||
|                 :previous-index nil | ||||
|                 :xs xs))) | ||||
| 
 | ||||
| (defun cycle-new (&rest xs) | ||||
|   "Create a cycle with XS as the values." | ||||
|   (cycle-from-list xs)) | ||||
| 
 | ||||
| (defun cycle-to-list (xs) | ||||
|   "Return the list representation of a cycle, XS." | ||||
|   (cycle-xs xs)) | ||||
| 
 | ||||
| (defun cycle--next-index<- (lo hi x) | ||||
|   "Return the next index in a cycle when moving downwards. | ||||
| - `LO' is the lower bound. | ||||
| - `HI' is the upper bound. | ||||
| - `X' is the current index." | ||||
|   (if (< (- x 1) lo) | ||||
|       (- hi 1) | ||||
|     (- x 1))) | ||||
| 
 | ||||
| (defun cycle--next-index-> (lo hi x) | ||||
|   "Return the next index in a cycle when moving upwards. | ||||
| - `LO' is the lower bound. | ||||
| - `HI' is the upper bound. | ||||
| - `X' is the current index." | ||||
|   (if (>= (+ 1 x) hi) | ||||
|       lo | ||||
|     (+ 1 x))) | ||||
| 
 | ||||
| (defun cycle-previous-focus (cycle) | ||||
|   "Return the previously focused entry in CYCLE." | ||||
|   (let ((i (cycle-previous-index cycle))) | ||||
|     (if (maybe-some? i) | ||||
|         (nth i (cycle-xs cycle)) | ||||
|       nil))) | ||||
| 
 | ||||
| ;; TODO: Consider adding "!" to the function name herein since many of them | ||||
| ;; mutate the collection, and the APIs are beginning to confuse me. | ||||
| (defun cycle-focus-previous! (xs) | ||||
|   "Jump to the item in XS that was most recently focused; return the cycle. | ||||
| This will error when previous-index is nil.  This function mutates the | ||||
| underlying struct." | ||||
|   (let ((i (cycle-previous-index xs))) | ||||
|     (if (maybe-some? i) | ||||
|         (progn | ||||
|           (cycle-jump i xs) | ||||
|           (cycle-current xs)) | ||||
|       (error "Cannot focus the previous element since cycle-previous-index is nil")))) | ||||
| 
 | ||||
| (defun cycle-next (xs) | ||||
|   "Return the next value in `XS' and update `current-index'." | ||||
|   (let* ((current-index (cycle-current-index xs)) | ||||
|          (next-index (cycle--next-index-> 0 (cycle-count xs) current-index))) | ||||
|     (struct-set! cycle previous-index current-index xs) | ||||
|     (struct-set! cycle current-index next-index xs) | ||||
|     (nth next-index (cycle-xs xs)))) | ||||
| 
 | ||||
| (defun cycle-prev (xs) | ||||
|   "Return the previous value in `XS' and update `current-index'." | ||||
|   (let* ((current-index (cycle-current-index xs)) | ||||
|          (next-index (cycle--next-index<- 0 (cycle-count xs) current-index))) | ||||
|     (struct-set! cycle previous-index current-index xs) | ||||
|     (struct-set! cycle current-index next-index xs) | ||||
|     (nth next-index (cycle-xs xs)))) | ||||
| 
 | ||||
| (defun cycle-current (cycle) | ||||
|   "Return the current value in `CYCLE'." | ||||
|   (nth (cycle-current-index cycle) (cycle-xs cycle))) | ||||
| 
 | ||||
| (defun cycle-count (cycle) | ||||
|   "Return the length of `xs' in `CYCLE'." | ||||
|   (length (cycle-xs cycle))) | ||||
| 
 | ||||
| (defun cycle-jump (i xs) | ||||
|   "Jump to the I index of XS." | ||||
|   (let ((current-index (cycle-current-index xs)) | ||||
|         (next-index (math-mod i (cycle-count xs)))) | ||||
|     (struct-set! cycle previous-index current-index xs) | ||||
|     (struct-set! cycle current-index next-index xs)) | ||||
|   xs) | ||||
| 
 | ||||
| (defun cycle-focus (p cycle) | ||||
|   "Focus the element in CYCLE for which predicate, P, is t." | ||||
|   (let ((i (->> cycle | ||||
|                 cycle-xs | ||||
|                 (-find-index p)))) | ||||
|     (if i | ||||
|         (cycle-jump i cycle) | ||||
|       (error "No element in cycle matches predicate")))) | ||||
| 
 | ||||
| (defun cycle-focus-item (x xs) | ||||
|   "Focus item, X, in cycle XS. | ||||
| ITEM is the first item in XS that t for `equal'." | ||||
|   (cycle-focus (lambda (y) (equal x y)) xs)) | ||||
| 
 | ||||
| (defun cycle-contains? (x xs) | ||||
|   "Return t if cycle, XS, has member X." | ||||
|   (->> xs | ||||
|        cycle-xs | ||||
|        (list-contains? x))) | ||||
| 
 | ||||
| (defun cycle-empty? (xs) | ||||
|   "Return t if cycle XS has no elements." | ||||
|   (= 0 (length (cycle-xs xs)))) | ||||
| 
 | ||||
| (defun cycle-focused? (xs) | ||||
|   "Return t if cycle XS has a non-nil value for current-index." | ||||
|   (maybe-some? (cycle-current-index xs))) | ||||
| 
 | ||||
| (defun cycle-append (x xs) | ||||
|   "Add X to the left of the focused element in XS. | ||||
| If there is no currently focused item, add X to the beginning of XS." | ||||
|   (if (cycle-empty? xs) | ||||
|       (progn | ||||
|         (struct-set! cycle xs (list x) xs) | ||||
|         (struct-set! cycle current-index 0 xs) | ||||
|         (struct-set! cycle previous-index nil xs)) | ||||
|     (let ((curr-i (cycle-current-index xs)) | ||||
|           (prev-i (cycle-previous-index xs))) | ||||
|       (if curr-i | ||||
|           (progn | ||||
|             (struct-set! cycle xs (-insert-at curr-i x (cycle-xs xs)) xs) | ||||
|             (when (>= prev-i curr-i) (struct-set! cycle previous-index (1+ prev-i) xs)) | ||||
|             (when curr-i (struct-set! cycle current-index (1+ curr-i) xs))) | ||||
|         (progn | ||||
|           (struct-set! cycle xs (cons x (cycle-xs xs)) xs) | ||||
|           (when prev-i (struct-set! cycle previous-index (1+ prev-i) xs)))) | ||||
|       xs))) | ||||
| 
 | ||||
| (defun cycle-remove (x xs) | ||||
|   "Attempt to remove X from XS. | ||||
| 
 | ||||
| X is found using `equal'. | ||||
| 
 | ||||
| If X is the currently focused value, after it's deleted, current-index will be | ||||
|   nil.  If X is the previously value, after it's deleted, previous-index will be | ||||
|   nil." | ||||
|   (let ((curr-i (cycle-current-index xs)) | ||||
|         (prev-i (cycle-previous-index xs)) | ||||
|         (rm-i (-elem-index x (cycle-xs xs)))) | ||||
|     (struct-set! cycle xs (-remove-at rm-i (cycle-xs xs)) xs) | ||||
|     (when prev-i | ||||
|       (when (> prev-i rm-i) (struct-set! cycle previous-index (1- prev-i) xs)) | ||||
|       (when (= prev-i rm-i) (struct-set! cycle previous-index nil xs))) | ||||
|     (when curr-i | ||||
|       (when (> curr-i rm-i) (struct-set! cycle current-index (1- curr-i) xs)) | ||||
|       (when (= curr-i rm-i) (struct-set! cycle current-index nil xs))) | ||||
|     xs)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (when cycle-enable-tests? | ||||
|   (let ((xs (cycle-new 1 2 3))) | ||||
|     (prelude-assert (maybe-nil? (cycle-previous-focus xs))) | ||||
|     (prelude-assert (= 1 (cycle-current xs))) | ||||
|     (prelude-assert (= 2 (cycle-next xs))) | ||||
|     (prelude-assert (= 1 (cycle-previous-focus xs))) | ||||
|     (prelude-assert (= 1 (->> xs (cycle-jump 0) cycle-current))) | ||||
|     (prelude-assert (= 2 (->> xs (cycle-jump 1) cycle-current))) | ||||
|     (prelude-assert (= 3 (->> xs (cycle-jump 2) cycle-current))) | ||||
|     (prelude-assert (= 2 (cycle-previous-focus xs))) | ||||
|     (prelude-assert (= 2 (cycle-focus-previous! xs))) | ||||
|     (prelude-assert (equal '(1 4 2 3) (cycle-xs (cycle-append 4 xs)))) | ||||
|     (prelude-assert (equal '(1 2 3) (cycle-xs (cycle-remove 4 xs)))) | ||||
|     (progn | ||||
|       (cycle-focus-item 3 xs) | ||||
|       (cycle-focus-item 2 xs) | ||||
|       (cycle-remove 1 xs) | ||||
|       (prelude-assert (= 2 (cycle-current xs))) | ||||
|       (prelude-assert (= 3 (cycle-previous-focus xs)))))) | ||||
| 
 | ||||
| (provide 'cycle) | ||||
| ;;; cycle.el ends here | ||||
							
								
								
									
										50
									
								
								users/wpcarro/emacs/.emacs.d/wpc/device.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										50
									
								
								users/wpcarro/emacs/.emacs.d/wpc/device.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,50 @@ | |||
| ;;; device.el --- Physical device information -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "25.1")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Functions for querying device information. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'dash) | ||||
| (require 'al) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defconst device-hostname->device | ||||
|   '(("zeno.lon.corp.google.com" . work-desktop) | ||||
|     ("seneca" . work-laptop)) | ||||
|   "Mapping hostname to a device symbol.") | ||||
| 
 | ||||
| ;; TODO: Should I generate these predicates? | ||||
| 
 | ||||
| (defun device-classify () | ||||
|   "Return the device symbol for the current host or nil if not supported." | ||||
|   (al-get system-name device-hostname->device)) | ||||
| 
 | ||||
| (defun device-work-laptop? () | ||||
|   "Return t if current device is work laptop." | ||||
|   (equal 'work-laptop | ||||
|          (device-classify))) | ||||
| 
 | ||||
| (defun device-work-desktop? () | ||||
|   "Return t if current device is work desktop." | ||||
|   (equal 'work-desktop | ||||
|          (device-classify))) | ||||
| 
 | ||||
| (defun device-corporate? () | ||||
|   "Return t if the current device is owned by my company." | ||||
|   (or (device-work-laptop?) (device-work-desktop?))) | ||||
| 
 | ||||
| (provide 'device) | ||||
| ;;; device.el ends here | ||||
							
								
								
									
										138
									
								
								users/wpcarro/emacs/.emacs.d/wpc/display.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										138
									
								
								users/wpcarro/emacs/.emacs.d/wpc/display.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,138 @@ | |||
| ;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Mostly wrappers around xrandr. | ||||
| ;; | ||||
| ;; Troubleshooting: | ||||
| ;; The following commands help me when I (infrequently) interact with xrandr. | ||||
| ;; - xrandr --listmonitors | ||||
| ;; - xrandr --query | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'dash) | ||||
| (require 's) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (cl-defmacro display-register (name &key | ||||
|                                     output | ||||
|                                     primary | ||||
|                                     coords | ||||
|                                     size | ||||
|                                     rate | ||||
|                                     dpi | ||||
|                                     rotate) | ||||
|   "Macro to define constants and two functions for {en,dis}abling a display. | ||||
| 
 | ||||
| NAME    - the human-readable identifier for the display | ||||
| OUTPUT  - the xrandr identifier for the display | ||||
| PRIMARY - if true, send --primary flag to xrandr | ||||
| COORDS  - X and Y offsets | ||||
| SIZE    - the pixel resolution of the display (width height) | ||||
| RATE    - the refresh rate | ||||
| DPI     - the pixel density in dots per square inch | ||||
| rotate  - one of {normal,left,right,inverted} | ||||
| 
 | ||||
| See the man-page for xrandr for more details." | ||||
|   `(progn | ||||
|      (defconst ,(intern (format "display-%s" name)) ,output | ||||
|        ,(format "The xrandr identifier for %s" name)) | ||||
|      (defconst ,(intern (format "display-%s-args" name)) | ||||
|        ,(replace-regexp-in-string | ||||
|          "\s+" " " | ||||
|          (s-format "--output ${output} ${primary-flag} --auto \ | ||||
|                     --size ${size-x}x${size-y} --rate ${rate} --dpi ${dpi} \ | ||||
|                     --rotate ${rotate} ${pos-flag}" | ||||
|                    #'aget | ||||
|                    `(("output" . ,output) | ||||
|                      ("primary-flag" . ,(if primary "--primary" "--noprimary")) | ||||
|                      ("pos-flag" . ,(if coords | ||||
|                                         (format "--pos %dx%d" | ||||
|                                                 (car coords) | ||||
|                                                 (cadr coords)) | ||||
|                                       "")) | ||||
|                      ("size-x" . ,(car size)) | ||||
|                      ("size-y" . ,(cadr size)) | ||||
|                      ("rate" . ,rate) | ||||
|                      ("dpi" . ,dpi) | ||||
|                      ("rotate" . ,rotate)))) | ||||
|        ,(format "The arguments we pass to xrandr for display-%s." name)) | ||||
|      (defconst ,(intern (format "display-%s-command" name)) | ||||
|        (format "xrandr %s" ,(intern (format "display-%s-args" name))) | ||||
|        ,(format "The command we run to configure %s" name)) | ||||
|      (defun ,(intern (format "display-enable-%s" name)) () | ||||
|        ,(format "Attempt to enable my %s monitor" name) | ||||
|        (interactive) | ||||
|        (prelude-start-process | ||||
|         :name ,(format "display-enable-%s" name) | ||||
|         :command ,(intern (format "display-%s-command" name)))) | ||||
|      (defun ,(intern (format "display-disable-%s" name)) () | ||||
|        ,(format "Attempt to disable my %s monitor." name) | ||||
|        (interactive) | ||||
|        (prelude-start-process | ||||
|         :name ,(format "display-disable-%s" name) | ||||
|         :command ,(format | ||||
|                    "xrandr --output %s --off" | ||||
|                    output))))) | ||||
| 
 | ||||
| (defmacro display-arrangement (name &key displays) | ||||
|   "Create a function, display-arrange-<NAME>, to enable all your DISPLAYS." | ||||
|   `(defun ,(intern (format "display-arrange-%s" name)) () | ||||
|      (interactive) | ||||
|      (prelude-start-process | ||||
|       :name ,(format "display-configure-%s" name) | ||||
|       :command ,(format "xrandr %s" | ||||
|                         (->> displays | ||||
|                              (-map (lambda (x) | ||||
|                                      (eval (intern (format "display-%s-args" x))))) | ||||
|                              (s-join " ")))))) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Configuration | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (display-register laptop | ||||
|                   :output "eDP1" | ||||
|                   :primary nil | ||||
|                   :coords (2560 1440) | ||||
|                   :size (1920 1080) | ||||
|                   :rate 30.0 | ||||
|                   :dpi 144 | ||||
|                   :rotate normal) | ||||
| 
 | ||||
| (display-register 4k-horizontal | ||||
|                   :output "DP2" | ||||
|                   :primary t | ||||
|                   :coords (0 0) | ||||
|                   :size (2560 1440) | ||||
|                   :rate 30.0 | ||||
|                   :dpi 144 | ||||
|                   :rotate normal) | ||||
| 
 | ||||
| (display-register 4k-vertical | ||||
|                   :output "HDMI1" | ||||
|                   :primary nil | ||||
|                   :coords (-1440 -560) | ||||
|                   :size (2560 1440) | ||||
|                   :rate 30.0 | ||||
|                   :dpi 144 | ||||
|                   :rotate left) | ||||
| 
 | ||||
| (display-arrangement primary | ||||
|                      :displays (laptop 4k-horizontal 4k-vertical)) | ||||
| 
 | ||||
| (provide 'display) | ||||
| ;;; display.el ends here | ||||
							
								
								
									
										58
									
								
								users/wpcarro/emacs/.emacs.d/wpc/dotted.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										58
									
								
								users/wpcarro/emacs/.emacs.d/wpc/dotted.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,58 @@ | |||
| ;;; dotted.el --- Working with dotted pairs in Elisp -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Part of my primitives library extensions in Elisp.  Contrast my primitives | ||||
| ;; with the wrapper extensions that I provide, which expose immutable variants | ||||
| ;; of data structures like an list, alist, tuple, as well as quasi-typeclasses | ||||
| ;; like sequence, etc. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'macros) | ||||
| (require 'cl-lib) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (cl-defun dotted-new (&optional a b) | ||||
|   "Create a new dotted pair of A and B." | ||||
|   (cons a b)) | ||||
| 
 | ||||
| (defun dotted-instance? (x) | ||||
|   "Return t if X is a dotted pair." | ||||
|   (let ((b (cdr x))) | ||||
|     (and b (atom b)))) | ||||
| 
 | ||||
| (defun dotted-first (x) | ||||
|   "Return the first element of X." | ||||
|   (car x)) | ||||
| 
 | ||||
| (defun dotted-second (x) | ||||
|   "Return the second element of X." | ||||
|   (cdr x)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (progn | ||||
|   (prelude-assert | ||||
|    (equal '(fname . "Bob") (dotted-new 'fname "Bob"))) | ||||
|   (prelude-assert | ||||
|    (dotted-instance? '(one . two))) | ||||
|   (prelude-refute | ||||
|    (dotted-instance? '(1 2 3)))) | ||||
| 
 | ||||
| (provide 'dotted) | ||||
| ;;; dotted.el ends here | ||||
							
								
								
									
										77
									
								
								users/wpcarro/emacs/.emacs.d/wpc/email.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										77
									
								
								users/wpcarro/emacs/.emacs.d/wpc/email.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,77 @@ | |||
| ;;; email.el --- My email settings -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Attempting to configure to `notmuch' for my personal use. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'notmuch) | ||||
| (require 'list) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Configuration | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (setq notmuch-saved-searches | ||||
|       '((:name "inbox" :query "tag:inbox" :key "i") | ||||
|         (:name "direct" | ||||
|          :query "tag:direct and tag:unread and not tag:sent" | ||||
|          :key "d") | ||||
|         (:name "action" :query "tag:action" :key "a") | ||||
|         (:name "review" :query "tag:review" :key "r") | ||||
|         (:name "waiting" :query "tag:waiting" :key "w") | ||||
|         (:name "broadcast" :query "tag:/broadcast\/.+/ and tag:unread" :key "b") | ||||
|         (:name "systems" :query "tag:/systems\/.+/ and tag:unread" :key "s") | ||||
|         (:name "sent" :query "tag:sent" :key "t") | ||||
|         (:name "drafts" :query "tag:draft" :key "D"))) | ||||
| 
 | ||||
| ;; Sort results from newest-to-oldest. | ||||
| (setq notmuch-search-oldest-first nil) | ||||
| 
 | ||||
| ;; Discard noisy email signatures. | ||||
| (setq notmuch-mua-cite-function #'message-cite-original-without-signature) | ||||
| 
 | ||||
| ;; By default, this is just '("-inbox") | ||||
| (setq notmuch-archive-tags '("-inbox" "-unread" "+archive")) | ||||
| 
 | ||||
| ;; Show saved searches even when they're empty. | ||||
| (setq notmuch-show-empty-saved-searches t) | ||||
| 
 | ||||
| ;; Currently the sendmail executable on my system is symlinked to msmtp. | ||||
| (setq send-mail-function #'sendmail-send-it) | ||||
| 
 | ||||
| ;; I'm not sure if I need this or not. Copying it from tazjin@'s monorepo. | ||||
| (setq notmuch-always-prompt-for-sender nil) | ||||
| 
 | ||||
| ;; Add the "User-Agent" header to my emails and ensure that it includes Emacs | ||||
| ;; and notmuch information. | ||||
| (setq notmuch-mua-user-agent-function | ||||
|       (lambda () | ||||
|         (format "Emacs %s; notmuch.el %s" emacs-version notmuch-emacs-version))) | ||||
| 
 | ||||
| ;; I was informed that Gmail does this server-side | ||||
| (setq notmuch-fcc-dirs nil) | ||||
| 
 | ||||
| ;; Ensure buffers are closed after sending mail. | ||||
| (setq message-kill-buffer-on-exit t) | ||||
| 
 | ||||
| ;; Ensure sender is correctly passed to msmtp. | ||||
| (setq mail-specify-envelope-from t | ||||
|       message-sendmail-envelope-from 'header | ||||
|       mail-envelope-from 'header) | ||||
| 
 | ||||
| ;; Assert that no two saved searches share share a KBD | ||||
| (prelude-assert | ||||
|  (list-xs-distinct-by? (lambda (x) (plist-get x :key)) notmuch-saved-searches)) | ||||
| 
 | ||||
| (provide 'email) | ||||
| ;;; email.el ends here | ||||
							
								
								
									
										172
									
								
								users/wpcarro/emacs/.emacs.d/wpc/fonts.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										172
									
								
								users/wpcarro/emacs/.emacs.d/wpc/fonts.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,172 @@ | |||
| ;;; fonts.el --- Font preferences -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Control my font preferences with ELisp. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;; TODO: `defcustom' font-size. | ||||
| ;; TODO: `defcustom' fonts. | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| (require 'cycle) | ||||
| (require 'device) | ||||
| (require 'maybe) | ||||
| (require 'cl-lib) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Constants | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| ;; TODO: Troubleshoot why "8" appears so large on my desktop. | ||||
| 
 | ||||
| ;; TODO: Consider having a different font size when I'm using my 4K monitor. | ||||
| 
 | ||||
| (defconst fonts-size | ||||
|   (pcase (device-classify) | ||||
|     ('work-laptop "10") | ||||
|     ('work-desktop "10")) | ||||
|   "My preferred default font-size, which is device specific.") | ||||
| 
 | ||||
| (defconst fonts-size-step 10 | ||||
|   "The amount (%) by which to increase or decrease a font.") | ||||
| 
 | ||||
| (defconst fonts-hacker-news-recommendations | ||||
|   '("APL385 Unicode" | ||||
|     "Go Mono" | ||||
|     "Sudo" | ||||
|     "Monoid" | ||||
|     "Input Mono Medium" ;; NOTE: Also "Input Mono Thin" is nice. | ||||
|     ) | ||||
|   "List of fonts optimized for programming I found in a HN article.") | ||||
| 
 | ||||
| (defconst fonts-whitelist | ||||
|   (cycle-from-list | ||||
|    (list-concat | ||||
|     fonts-hacker-news-recommendations | ||||
|     '("JetBrainsMono" | ||||
|       "Mononoki Medium" | ||||
|       "Monospace" | ||||
|       "Operator Mono Light" | ||||
|       "Courier" | ||||
|       "Andale Mono" | ||||
|       "Source Code Pro" | ||||
|       "Terminus"))) | ||||
|   "This is a list of my preferred fonts.") | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Functions | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| ;; TODO: fonts and fonts-whitelist make it difficult to name functions like | ||||
| ;; fonts-set as a generic Emacs function vs choosing a font from the whitelist. | ||||
| 
 | ||||
| (cl-defun fonts-cycle (&key forward?) | ||||
|   "Cycle forwards when `FORWARD?' non-nil." | ||||
|   (let ((font (if forward? | ||||
|                   (cycle-next fonts-whitelist) | ||||
|                 (cycle-prev fonts-whitelist)))) | ||||
|     (message (s-concat "Active font: " font)) | ||||
|     (fonts-set font))) | ||||
| 
 | ||||
| (defun fonts-next () | ||||
|   "Quickly cycle through preferred fonts." | ||||
|   (interactive) | ||||
|   (fonts-cycle :forward? t)) | ||||
| 
 | ||||
| (defun fonts-prev () | ||||
|   "Quickly cycle through preferred fonts." | ||||
|   (interactive) | ||||
|   (fonts-cycle :forward? nil)) | ||||
| 
 | ||||
| (defun fonts-set (font &optional size) | ||||
|   "Change the font to `FONT' with option integer, SIZE, in pixels." | ||||
|   (if (maybe-some? size) | ||||
|       (set-frame-font (string-format "%s %s" font size) nil t) | ||||
|     (set-frame-font font nil t))) | ||||
| 
 | ||||
| (defun fonts-whitelist-set (font) | ||||
|   "Focuses the FONT in the `fonts-whitelist' cycle. | ||||
| The size of the font is determined by `fonts-size'." | ||||
|   (prelude-assert (cycle-contains? font fonts-whitelist)) | ||||
|   (cycle-focus (lambda (x) (equal x font)) fonts-whitelist) | ||||
|   (fonts-set (fonts-current) fonts-size)) | ||||
| 
 | ||||
| (defun fonts-ivy-select () | ||||
|   "Select a font from an ivy prompt." | ||||
|   (interactive) | ||||
|   (fonts-whitelist-set | ||||
|    (ivy-read "Font: " (cycle-to-list fonts-whitelist)))) | ||||
| 
 | ||||
| (defun fonts-print-current () | ||||
|   "Message the currently enabled font." | ||||
|   (interactive) | ||||
|   (message | ||||
|    (string-format "[fonts] Current font: \"%s\"" | ||||
|                   (fonts-current)))) | ||||
| 
 | ||||
| (defun fonts-current () | ||||
|   "Return the currently enabled font." | ||||
|   (cycle-current fonts-whitelist)) | ||||
| 
 | ||||
| (defun fonts-increase-size () | ||||
|   "Increase font size." | ||||
|   (interactive) | ||||
|   (->> (face-attribute 'default :height) | ||||
|        (+ fonts-size-step) | ||||
|        (set-face-attribute 'default (selected-frame) :height))) | ||||
| 
 | ||||
| (defun fonts-decrease-size () | ||||
|   "Decrease font size." | ||||
|   (interactive) | ||||
|   (->> (face-attribute 'default :height) | ||||
|        (+ (- fonts-size-step)) | ||||
|        (set-face-attribute 'default (selected-frame) :height))) | ||||
| 
 | ||||
| (defun fonts-reset-size () | ||||
|   "Restore font size to its default value." | ||||
|   (interactive) | ||||
|   (fonts-whitelist-set (fonts-current))) | ||||
| 
 | ||||
| (defun fonts-enable-ligatures () | ||||
|   "Call this function to enable ligatures." | ||||
|   (interactive) | ||||
|   (let ((alist '((33 . ".\\(?:\\(?:==\\|!!\\)\\|[!=]\\)") | ||||
|                  (35 . ".\\(?:###\\|##\\|_(\\|[#(?[_{]\\)") ;; | ||||
|                  (36 . ".\\(?:>\\)") | ||||
|                  (37 . ".\\(?:\\(?:%%\\)\\|%\\)") | ||||
|                  (38 . ".\\(?:\\(?:&&\\)\\|&\\)") | ||||
|                  (42 . ".\\(?:\\(?:\\*\\*/\\)\\|\\(?:\\*[*/]\\)\\|[*/>]\\)") ;; | ||||
|                  (43 . ".\\(?:\\(?:\\+\\+\\)\\|[+>]\\)") | ||||
|                  (45 . ".\\(?:\\(?:-[>-]\\|<<\\|>>\\)\\|[<>}~-]\\)") | ||||
|                  (46 . ".\\(?:\\(?:\\.[.<]\\)\\|[.=-]\\)") ;; | ||||
|                  (47 . ".\\(?:\\(?:\\*\\*\\|//\\|==\\)\\|[*/=>]\\)") | ||||
|                  (48 . ".\\(?:x[a-zA-Z]\\)") | ||||
|                  (58 . ".\\(?:::\\|[:=]\\)") | ||||
|                  (59 . ".\\(?:;;\\|;\\)") | ||||
|                  (60 . ".\\(?:\\(?:!--\\)\\|\\(?:~~\\|->\\|\\$>\\|\\*>\\|\\+>\\|--\\|<[<=-]\\|=[<=>]\\||>\\)\\|[*$+~/<=>|-]\\)") | ||||
|                  (61 . ".\\(?:\\(?:/=\\|:=\\|<<\\|=[=>]\\|>>\\)\\|[<=>~]\\)") | ||||
|                  (62 . ".\\(?:\\(?:=>\\|>[=>-]\\)\\|[=>-]\\)") | ||||
|                  (63 . ".\\(?:\\(\\?\\?\\)\\|[:=?]\\)") | ||||
|                  (91 . ".\\(?:]\\)") | ||||
|                  (92 . ".\\(?:\\(?:\\\\\\\\\\)\\|\\\\\\)") | ||||
|                  (94 . ".\\(?:=\\)") | ||||
|                  (119 . ".\\(?:ww\\)") | ||||
|                  (123 . ".\\(?:-\\)") | ||||
|                  (124 . ".\\(?:\\(?:|[=|]\\)\\|[=>|]\\)") | ||||
|                  (126 . ".\\(?:~>\\|~~\\|[>=@~-]\\)")))) | ||||
|     (dolist (char-regexp alist) | ||||
|       (set-char-table-range composition-function-table (car char-regexp) | ||||
|                             `([,(cdr char-regexp) 0 font-shape-gstring]))))) | ||||
| 
 | ||||
| (provide 'fonts) | ||||
| ;;; fonts.el ends here | ||||
							
								
								
									
										70
									
								
								users/wpcarro/emacs/.emacs.d/wpc/fs.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										70
									
								
								users/wpcarro/emacs/.emacs.d/wpc/fs.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,70 @@ | |||
| ;;; fs.el --- Make working with the filesystem easier -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.1")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Ergonomic alternatives for working with the filesystem. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'dash) | ||||
| (require 'f) | ||||
| (require 's) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defun fs-ensure-file (path) | ||||
|   "Ensure that a file and its directories in `PATH' exist. | ||||
| Will error for inputs with a trailing slash." | ||||
|   (when (s-ends-with? "/" path) | ||||
|     (error (format "Input path has trailing slash: %s" path))) | ||||
|   (->> path | ||||
|        f-dirname | ||||
|        fs-ensure-dir) | ||||
|   (f-touch path)) | ||||
| 
 | ||||
| (f-dirname "/tmp/a/b/file.txt") | ||||
| 
 | ||||
| (defun fs-ensure-dir (path) | ||||
|   "Ensure that a directory and its ancestor directories in `PATH' exist." | ||||
|   (->> path | ||||
|        f-split | ||||
|        (apply #'f-mkdir))) | ||||
| 
 | ||||
| (defun fs-ls (dir &optional full-path?) | ||||
|   "List the files in `DIR' one-level deep. | ||||
| Should behave similarly in spirit to the Unix command, ls. | ||||
| If `FULL-PATH?' is set, return the full-path of the files." | ||||
|   (-drop 2 (directory-files dir full-path?))) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (ert-deftest fs-test-ensure-file () | ||||
|   (let ((file "/tmp/file/a/b/c/file.txt")) | ||||
|     ;; Ensure this file doesn't exist first to prevent false-positives. | ||||
|     (f-delete file t) | ||||
|     (fs-ensure-file file) | ||||
|     (should (and (f-exists? file) | ||||
|                  (f-file? file))))) | ||||
| 
 | ||||
| (ert-deftest fs-test-ensure-dir () | ||||
|   (let ((dir "/tmp/dir/a/b/c")) | ||||
|     ;; Ensure the directory doesn't exist. | ||||
|     (f-delete dir t) | ||||
|     (fs-ensure-dir dir) | ||||
|     (should (and (f-exists? dir) | ||||
|                  (f-dir? dir))))) | ||||
| 
 | ||||
| (provide 'fs) | ||||
| ;;; fs.el ends here | ||||
							
								
								
									
										47
									
								
								users/wpcarro/emacs/.emacs.d/wpc/functions.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										47
									
								
								users/wpcarro/emacs/.emacs.d/wpc/functions.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,47 @@ | |||
| ;;; functions.el --- Helper functions -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; This file hopefully contains friendly APIs that making ELisp development more | ||||
| ;; enjoyable. | ||||
| 
 | ||||
| ;; TODO: Break these out into separate modules. | ||||
| 
 | ||||
| ;;; Code: | ||||
| (defun functions-evil-window-vsplit-right () | ||||
|   "Split the window vertically and focus the right half." | ||||
|   (interactive) | ||||
|   (evil-window-vsplit) | ||||
|   (windmove-right)) | ||||
| 
 | ||||
| (defun functions-evil-window-split-down () | ||||
|   "Split the window horizontal and focus the bottom half." | ||||
|   (interactive) | ||||
|   (evil-window-split) | ||||
|   (windmove-down)) | ||||
| 
 | ||||
| (defun functions-create-snippet () | ||||
|   "Create a window split and then opens the Yasnippet editor." | ||||
|   (interactive) | ||||
|   (evil-window-vsplit) | ||||
|   (call-interactively #'yas-new-snippet)) | ||||
| 
 | ||||
| (defun functions-evil-replace-under-point () | ||||
|   "Faster than typing %s//thing/g." | ||||
|   (interactive) | ||||
|   (let ((term (s-replace "/" "\\/" (symbol-to-string (symbol-at-point))))) | ||||
|     (save-excursion | ||||
|       (evil-ex (concat "%s/\\b" term "\\b/"))))) | ||||
| 
 | ||||
| (defun functions-buffer-dirname () | ||||
|   "Return the directory name of the current buffer as a string." | ||||
|   (->> buffer-file-name | ||||
|        f-dirname | ||||
|        f-filename)) | ||||
| 
 | ||||
| (provide 'functions) | ||||
| ;;; functions.el ends here | ||||
							
								
								
									
										95
									
								
								users/wpcarro/emacs/.emacs.d/wpc/graph.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										95
									
								
								users/wpcarro/emacs/.emacs.d/wpc/graph.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,95 @@ | |||
| ;;; graph.el --- Working with in-memory graphs -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "24.3")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; | ||||
| ;; Remember that there are optimal three ways to model a graph: | ||||
| ;; 1. Edge List | ||||
| ;; 2. Vertex Table (a.k.a. Neighbors Table) | ||||
| ;; 3. Adjacency Matrix | ||||
| ;; | ||||
| ;; I may call these "Edges", "Neighbors", "Adjacencies" to avoid verbose naming. | ||||
| ;; For now, I'm avoiding dealing with Adjacency Matrices as I don't have an | ||||
| ;; immediate use-case for them.  This is subject to change. | ||||
| ;; | ||||
| ;; There are also hybrid representations of graphs that combine the three | ||||
| ;; aforementioned models.  I believe Erlang's digraph module models graphs in | ||||
| ;; Erlang Term Storage (i.e. ETS) this way. | ||||
| ;; TODO: Verify this claim. | ||||
| ;; | ||||
| ;; Graphs can be weighted or unweighted.  They can also be directed or | ||||
| ;; undirected. | ||||
| ;; TODO: Create a table explaining all graph variants. | ||||
| ;; | ||||
| ;; TODO: Figure out the relationship of this module and tree.el, which should in | ||||
| ;; principle overlap. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'prelude) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| ;; For now, I'll support storing *either* neighbors or edges in the graph struct | ||||
| ;; as long as both aren't set, since that introduces consistency issues.  I may | ||||
| ;; want to handle that use-case in the future, but not now. | ||||
| (cl-defstruct graph neighbors edges) | ||||
| 
 | ||||
| ;; TODO: How do you find the starting point for a topo sort? | ||||
| (defun graph-sort (xs) | ||||
|   "Return a topological sort of XS.") | ||||
| 
 | ||||
| (defun graph-from-edges (xs) | ||||
|   "Create a graph struct from the Edge List, XS. | ||||
| The user must pass in a valid Edge List since asserting on the shape of XS might | ||||
|   be expensive." | ||||
|   (make-graph :edges xs)) | ||||
| 
 | ||||
| (defun graph-from-neighbors (xs) | ||||
|   "Create a graph struct from a Neighbors Table, XS. | ||||
| The user must pass in a valid Neighbors Table since asserting on the shape of | ||||
|   XS might be expensive." | ||||
|   (make-graph :neighbors xs)) | ||||
| 
 | ||||
| (defun graph-instance? (xs) | ||||
|   "Return t if XS is a graph struct." | ||||
|   (graph-p xs)) | ||||
| 
 | ||||
| ;; TODO: Model each of the mapping functions into an isomorphism. | ||||
| (defun graph-edges->neighbors (xs) | ||||
|   "Map Edge List, XS, into a Neighbors Table." | ||||
|   (prelude-assert (graph-instance? xs))) | ||||
| 
 | ||||
| (defun graph-neighbors->edges (xs) | ||||
|   "Map Neighbors Table, XS, into an Edge List." | ||||
|   (prelude-assert (graph-instance? xs))) | ||||
| 
 | ||||
| ;; Below are three different models of the same unweighted, directed graph. | ||||
| 
 | ||||
| (defvar graph-edges | ||||
|   '((a . b) (a . c) (a . e) | ||||
|     (b . c) (b . d) | ||||
|     (c . e) | ||||
|     (d . f) | ||||
|     (e . d) (e . f))) | ||||
| 
 | ||||
| (defvar graph-neighbors | ||||
|   ((a b c e) | ||||
|    (b c d) | ||||
|    (c e) | ||||
|    (d f) | ||||
|    (e d g) | ||||
|    (f))) | ||||
| 
 | ||||
| (provide 'graph) | ||||
| ;;; graph.el ends here | ||||
							
								
								
									
										171
									
								
								users/wpcarro/emacs/.emacs.d/wpc/irc.el
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										171
									
								
								users/wpcarro/emacs/.emacs.d/wpc/irc.el
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,171 @@ | |||
| ;;; irc.el --- Configuration for IRC chat -*- lexical-binding: t -*- | ||||
| 
 | ||||
| ;; Author: William Carroll <wpcarro@gmail.com> | ||||
| ;; Version: 0.0.1 | ||||
| ;; URL: https://git.wpcarro.dev/wpcarro/briefcase | ||||
| ;; Package-Requires: ((emacs "25.1")) | ||||
| 
 | ||||
| ;;; Commentary: | ||||
| ;; Need to decide which client I will use for IRC. | ||||
| 
 | ||||
| ;;; Code: | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Dependencies | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (require 'erc) | ||||
| (require 'cycle) | ||||
| (require 'string) | ||||
| (require 'prelude) | ||||
| (require 'al) | ||||
| (require 'set) | ||||
| (require 'maybe) | ||||
| (require 'macros) | ||||
| (require '>) | ||||
| (require 'password-store) | ||||
| (require 'general) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Configuration | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defcustom irc-install-kbds? t | ||||
|   "When t, install the keybindings defined herein.") | ||||
| 
 | ||||
| (setq erc-rename-buffers t) | ||||
| 
 | ||||
| ;; Setting `erc-join-buffer' to 'bury prevents erc from stealing focus of the | ||||
| ;; current buffer when it connects to IRC servers. | ||||
| (setq erc-join-buffer 'bury) | ||||
| 
 | ||||
| ;; TODO: Find a way to avoid putting "freenode" and "#freenode" as channels | ||||
| ;; here.  I'm doing it because when erc first connects, it's `(buffer-name)' is | ||||
| ;; "freenode", so when `irc-next-channel' is called, it 404s on the | ||||
| ;; `cycle-contains?' call in `irc-channel->cycle" unless "freenode" is there. To | ||||
| ;; make matters even uglier, when `erc-join-channel' is called with "freenode" | ||||
| ;; as the value, it connects to the "#freenode" channel, so unless "#freenode" | ||||
| ;; exists in this cycle also, `irc-next-channel' breaks again. | ||||
| (defconst irc-server->channels | ||||
|   `(("irc.freenode.net"    . ,(cycle-new "freenode" "#freenode" "#nixos" "#emacs" "#pass")) | ||||
|     ("irc.corp.google.com" . ,(cycle-new "#drive-prod"))) | ||||
|   "Mapping of IRC servers to a cycle of my preferred channels.") | ||||
| 
 | ||||
| ;; TODO: Here is another horrible hack that should be revisted. | ||||
| (setq erc-autojoin-channels-alist | ||||
|       (->> irc-server->channels | ||||
|            (al-map-values #'cycle-to-list) | ||||
|            (al-map-keys (>-> (s-chop-prefix "irc.") | ||||
|                              (s-chop-suffix ".net"))))) | ||||
| 
 | ||||
| ;; 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' | ||||
| ;; function. This will probably be an O(n^2) operation. | ||||
| (prelude-assert | ||||
|  (set-distinct? (set-from-list | ||||
|                  (cycle-to-list | ||||
|                   (al-get "irc.freenode.net" | ||||
|                           irc-server->channels))) | ||||
|                 (set-from-list | ||||
|                  (cycle-to-list | ||||
|                   (al-get "irc.corp.google.com" | ||||
|                           irc-server->channels))))) | ||||
| 
 | ||||
| (defun irc-channel->server (server->channels channel) | ||||
|   "Using SERVER->CHANNELS, resolve an IRC server from a given CHANNEL." | ||||
|   (let ((result (al-find (lambda (k v) (cycle-contains? channel v)) | ||||
|                          server->channels))) | ||||
|     (prelude-assert (maybe-some? result)) | ||||
|     result)) | ||||
| 
 | ||||
| (defun irc-channel->cycle (server->channels channel) | ||||
|   "Using SERVER->CHANNELS, resolve an IRC's channels cycle from CHANNEL." | ||||
|   (al-get (irc-channel->server server->channels channel) | ||||
|           server->channels)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Library | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (defun irc-message (x) | ||||
|   "Print message X in a structured way." | ||||
|   (message (string-format "[irc.el] %s" x))) | ||||
| 
 | ||||
| ;; TODO: Integrate Google setup with Freenode setup. | ||||
| 
 | ||||
| ;; TODO: Support function or KBD for switching to an ERC buffer. | ||||
| 
 | ||||
| (defun irc-kill-all-erc-processes () | ||||
|   "Kill all ERC buffers and processes." | ||||
|   (interactive) | ||||
|   (->> (erc-buffer-list) | ||||
|        (-map #'kill-buffer))) | ||||
| 
 | ||||
| (defun irc-switch-to-erc-buffer () | ||||
|   "Switch to an ERC buffer." | ||||
|   (interactive) | ||||
|   (let ((buffers (erc-buffer-list))) | ||||
|     (if (list-empty? buffers) | ||||
|         (error "[irc.el] No ERC buffers available") | ||||
|       (switch-to-buffer (list-head (erc-buffer-list)))))) | ||||
| 
 | ||||
| (defun irc-connect-to-freenode () | ||||
|   "Connect to Freenode IRC." | ||||
|   (interactive) | ||||
|   (erc-ssl :server "irc.freenode.net" | ||||
|            :port 6697 | ||||
|            :nick "wpcarro" | ||||
|            :password (password-store-get "programming/irc/freenode") | ||||
|            :full-name "William Carroll")) | ||||
| 
 | ||||
| ;; TODO: Handle failed connections. | ||||
| (defun irc-connect-to-google () | ||||
|   "Connect to Google's Corp IRC using ERC." | ||||
|   (interactive) | ||||
|   (erc-ssl :server "irc.corp.google.com" | ||||
|            :port 6697 | ||||
|            :nick "wpcarro" | ||||
|            :full-name "William Carroll")) | ||||
| 
 | ||||
| ;; TODO: Prefer defining these with a less homespun solution. There is a | ||||
| ;; function call `erc-buffer-filter' that would be more appropriate for the | ||||
| ;; implementation of `irc-next-channel' and `irc-prev-channel'. | ||||
| (defun irc-next-channel () | ||||
|   "Join the next channel for the active server." | ||||
|   (interactive) | ||||
|   (with-current-buffer (current-buffer) | ||||
|     (let ((cycle (irc-channel->cycle irc-server->channels (buffer-name)))) | ||||
|       (erc-join-channel | ||||
|        (cycle-next cycle)) | ||||
|       (irc-message | ||||
|        (string-format "Current IRC channel: %s" (cycle-current cycle)))))) | ||||
| 
 | ||||
| (defun irc-prev-channel () | ||||
|   "Join the previous channel for the active server." | ||||
|   (interactive) | ||||
|   (with-current-buffer (current-buffer) | ||||
|     (let ((cycle (irc-channel->cycle irc-server->channels (buffer-name)))) | ||||
|       (erc-join-channel | ||||
|        (cycle-prev cycle)) | ||||
|       (irc-message | ||||
|        (string-format "Current IRC channel: %s" (cycle-current cycle)))))) | ||||
| 
 | ||||
| (add-hook 'erc-mode-hook (macros-disable auto-fill-mode)) | ||||
| (add-hook 'erc-mode-hook (macros-disable company-mode)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Keybindings | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (when irc-install-kbds? | ||||
|   (general-define-key | ||||
|    :keymaps 'erc-mode-map | ||||
|    "<C-tab>" #'irc-next-channel | ||||
|    "<C-S-iso-lefttab>" #'irc-prev-channel)) | ||||
| 
 | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| ;; Tests | ||||
| ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||||
| 
 | ||||
| (provide 'irc) | ||||
| ;;; irc.el ends here | ||||
Some files were not shown because too many files have changed in this diff Show more
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue