Move move .emacs.d out of configs/shared
Moving all of my Emacs-related files into their own directory at the root of this repository.
This commit is contained in:
William Carroll
parent
3684adf23f
commit
578ed1ba98
190 changed files with 41 additions and 302 deletions
|
|
@ -1,59 +0,0 @@
|
|||
(require 'wpc-package "~/.emacs.d/wpc/packages/wpc-package.el")
|
||||
|
||||
;; load order is intentional
|
||||
(require 'constants)
|
||||
(require 'wpc-misc)
|
||||
|
||||
;; my libraries
|
||||
(require 'functions)
|
||||
(require 'prelude)
|
||||
(require 'macros)
|
||||
(require 'kaomoji)
|
||||
|
||||
;; Google
|
||||
;; (require 'google-stuff)
|
||||
|
||||
;; Laptop XF-functionality
|
||||
(require 'pulse-audio)
|
||||
(require 'screen-brightness)
|
||||
|
||||
;; miscellaneous
|
||||
(require 'clipboard)
|
||||
(require 'battery)
|
||||
(require 'dotfiles)
|
||||
(require 'bookmark)
|
||||
(require 'keyboard)
|
||||
(require 'irc)
|
||||
(require 'email)
|
||||
;; TODO: Consider renaming entr.el.
|
||||
(require 'entr)
|
||||
(require 'scrot)
|
||||
;; TODO: Remove path once published to MELPA.
|
||||
(require 'egg-timer "~/programming/egg-timer.el/egg-timer.el")
|
||||
|
||||
;; TODO: Reconcile kbd.el, keybindings.el, wpc-keybindings.el, keyboard.el.
|
||||
(require 'keybindings)
|
||||
(require 'wpc-keybindings)
|
||||
(require 'window-manager)
|
||||
(require 'wpc-ui)
|
||||
(require 'wpc-dired)
|
||||
(require 'wpc-terminal)
|
||||
(require 'wpc-org)
|
||||
(require 'wpc-company)
|
||||
;; TODO: Re-enable flycheck for all languages besides Elisp once I learn more
|
||||
;; about the issue with the `emacs-lisp' `flycheck-checker'.
|
||||
;; (require 'wpc-flycheck)
|
||||
(require 'wpc-shell)
|
||||
(require 'wpc-docker)
|
||||
(require 'wpc-lisp)
|
||||
(require 'wpc-haskell)
|
||||
(require 'wpc-reasonml)
|
||||
(require 'wpc-ocaml)
|
||||
(require 'wpc-elixir)
|
||||
(require 'wpc-nix)
|
||||
(require 'wpc-rust)
|
||||
(require 'wpc-clojure)
|
||||
(require 'wpc-python)
|
||||
(require 'wpc-javascript)
|
||||
(require 'wpc-java)
|
||||
(require 'wpc-prolog)
|
||||
|
|
@ -1,145 +0,0 @@
|
|||
;; ## 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
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: <stdio.h>
|
||||
# key: sio
|
||||
# --
|
||||
#include <stdio.h>
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: <stdlib.h>
|
||||
# key: slb
|
||||
# --
|
||||
#include <stdlib.h>
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: struct
|
||||
# key: struct
|
||||
# --
|
||||
typedef struct $1 {
|
||||
$2
|
||||
} $1_t;
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
# -*- 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:
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Function
|
||||
# key: fn
|
||||
# expand-env: ((yas-indent-line 'fixed))
|
||||
# --
|
||||
(defun $1 ($2)
|
||||
"$3"
|
||||
$4)
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Header
|
||||
# key: hdr
|
||||
# --
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; $1
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Library header
|
||||
# key: lib
|
||||
# --
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Library
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Provide footer
|
||||
# key: elf
|
||||
# --
|
||||
(provide '`(-> (buffer-file-name) f-filename f-no-ext)`)
|
||||
;;; `(-> (buffer-file-name) f-filename)` ends here
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Derive Safe Copy
|
||||
# key: dsc
|
||||
# --
|
||||
deriveSafeCopy 0 'base ''$1
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Import qualified
|
||||
# key: iq
|
||||
# --
|
||||
import qualified $1 as $2
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Instance
|
||||
# key: inst
|
||||
# --
|
||||
instance $1 where
|
||||
$2 = $3
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: language extension
|
||||
# key: lang
|
||||
# --
|
||||
{-# LANGUAGE $1 #-}
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Separator
|
||||
# key: -
|
||||
# --
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Undefiend
|
||||
# key: nd
|
||||
# --
|
||||
undefined
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
# -*- 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>
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: public static void main
|
||||
# key: psvm
|
||||
# --
|
||||
public static void main(String[] args) {
|
||||
$1
|
||||
}
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Define package
|
||||
# key: defp
|
||||
# --
|
||||
(in-package #:cl-user)
|
||||
(defpackage #:$1
|
||||
(:documentation "$2")
|
||||
(:use #:cl))
|
||||
(in-package #:$1)
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Function
|
||||
# key: fn
|
||||
# --
|
||||
(defun $1 ($2)
|
||||
"$3"
|
||||
$4)
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Typed function
|
||||
# key: tfn
|
||||
# --
|
||||
(type $1 ($3) $4)
|
||||
(defun $1 ($2)
|
||||
"$5"
|
||||
$6)
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: shell.nix boilerplate
|
||||
# key: import
|
||||
# --
|
||||
with import <nixpkgs> {};
|
||||
|
||||
stdenv.mkDerivation {
|
||||
name = "$1";
|
||||
buildInputs = [
|
||||
$2
|
||||
];
|
||||
}
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Code Snippet
|
||||
# key: src
|
||||
# --
|
||||
#+BEGIN_SRC $1
|
||||
$2
|
||||
#+END_SRC
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Org mode URL
|
||||
# key: href
|
||||
# --
|
||||
[[$1][$2]]
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Dunder main (__main__)
|
||||
# key: mn
|
||||
# --
|
||||
if __name__ == "__main__":
|
||||
main()
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Function
|
||||
# key: fn
|
||||
# --
|
||||
def $1($2):
|
||||
$3
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Header
|
||||
# key: hdr
|
||||
# --
|
||||
################################################################################
|
||||
# $1
|
||||
################################################################################
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: dunder init
|
||||
# key: ctor
|
||||
# --
|
||||
def __init__(self$1):
|
||||
$2
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: shebang
|
||||
# key: shb
|
||||
# --
|
||||
#!/usr/bin/env python
|
||||
# -*- coding: utf-8 -*-
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: utf-8
|
||||
# key: utf
|
||||
# --
|
||||
# -*- coding: utf-8 -*-
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Function
|
||||
# key: fn
|
||||
# --
|
||||
(define ($1) $2)
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Lambda function
|
||||
# key: ld
|
||||
# --
|
||||
(λ ($1) $2)
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Lambda symbol
|
||||
# key: l
|
||||
# --
|
||||
λ
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Function
|
||||
# key: fn
|
||||
# --
|
||||
let $1 = (~$2:$3) => {
|
||||
$4
|
||||
};
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Switch statement
|
||||
# key: sw
|
||||
# --
|
||||
switch ($1) {
|
||||
| $2 =>
|
||||
}
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: exactness
|
||||
# key: $x
|
||||
# --
|
||||
$Exact<$Call<typeof $1>>
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Console.log helper
|
||||
# key: clg
|
||||
# --
|
||||
console.log($1)
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: const definition
|
||||
# key: cn
|
||||
# --
|
||||
const $1 = '$2'
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: const function
|
||||
# key: cfn
|
||||
# --
|
||||
const $1 = ($2) => {
|
||||
$3
|
||||
}
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Destructuring a const
|
||||
# key: cds
|
||||
# --
|
||||
const { $1 } = $2
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Fat arrow function
|
||||
# key: fa
|
||||
# --
|
||||
=>
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Fat arrow function
|
||||
# key: faf
|
||||
# --
|
||||
() => {
|
||||
$1
|
||||
}
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Import destructured
|
||||
# key: ids
|
||||
# --
|
||||
import { $1 } from '$2'
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Import React dependency (ES6)
|
||||
# key: ir
|
||||
# --
|
||||
import React from 'react'
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: import type
|
||||
# key: ixt
|
||||
# --
|
||||
import type { $1 } from '$2'
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: import x from y
|
||||
# key: ix
|
||||
# --
|
||||
import $1 from '$2'
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: import y
|
||||
# key: iy
|
||||
# --
|
||||
import '$1'
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Jest describe/test block
|
||||
# key: dsc
|
||||
# --
|
||||
describe('$1', () => {
|
||||
test('$2', () => {
|
||||
|
||||
expect($3).toEqual($4)
|
||||
})
|
||||
})
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Jest / Jasmine test
|
||||
# key: tst
|
||||
# --
|
||||
test('$1', () => {
|
||||
expect($2).toBe($3)
|
||||
})
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: React class extends
|
||||
# key: clz
|
||||
# --
|
||||
class $1 extends React.Component {
|
||||
render() {
|
||||
$2
|
||||
}
|
||||
}
|
||||
|
||||
export default $1
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: redux-action
|
||||
# key: rax
|
||||
# --
|
||||
export const ${1:$$(string/lower->caps yas-text)} = '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}'
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: typed-redux-action
|
||||
# key: trax
|
||||
# --
|
||||
export const ${1:$$(string/lower->caps yas-text)}: '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}' = '`(downcase (buffer-dirname))`/${1:$(string/caps->kebab yas-text)}'
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: for-loop
|
||||
# key: for
|
||||
# --
|
||||
for $1 in $2 {
|
||||
$3
|
||||
}
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: match
|
||||
# key: match
|
||||
# --
|
||||
match $1 {
|
||||
$2 => $3,
|
||||
}
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Create function
|
||||
# key: fn
|
||||
# --
|
||||
$1() {
|
||||
$2
|
||||
}
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Unicode checkmark
|
||||
# key: uck
|
||||
# --
|
||||
✓
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Unicode ex-mark
|
||||
# key: ux
|
||||
# --
|
||||
✗
|
||||
|
|
@ -1 +0,0 @@
|
|||
text-mode
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
# -*- mode: snippet -*-
|
||||
# name: Header
|
||||
# key: hdr
|
||||
# --
|
||||
/*******************************************************************************
|
||||
* $1
|
||||
******************************************************************************/
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
# -*- 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>
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
;; -*- emacs-lisp -*- <19/12/10 12:42:49 /home/wpcarro/.emacs.d/tramp>
|
||||
;; Tramp connection history. Don't change this file.
|
||||
;; You can delete it, forcing Tramp to reapply the checks.
|
||||
|
||||
(((tramp-file-name "ssh" "wpcarro" nil "desktop" nil nil nil)
|
||||
("uname" "Linux 5.2.17-1rodete3-amd64")
|
||||
("locale" "LC_ALL=en_US.utf8")
|
||||
("test" "test")
|
||||
("remote-path"
|
||||
("/bin" "/usr/bin" "/sbin" "/usr/sbin" "/usr/local/bin" "/usr/local/sbin"))
|
||||
("remote-shell" "/bin/sh")
|
||||
("file-exists" "test -e")
|
||||
("case-insensitive" nil)
|
||||
("ls" "/bin/ls --color=never")
|
||||
("ls-quoting-style" t)
|
||||
("ls-dired" t)
|
||||
("stat" "env QUOTING_STYLE=locale \\stat")
|
||||
("id" "/bin/id")
|
||||
("gid-integer" 89939)
|
||||
("readlink" "\\readlink")
|
||||
("gid-string" "primarygroup")
|
||||
("perl-file-spec" t)
|
||||
("perl-cwd-realpath" t)
|
||||
("perl" "\\perl")
|
||||
("bzr" nil)
|
||||
("git" "\\git")
|
||||
("hg" "\\hg")))
|
||||
13696
configs/shared/.emacs.d/vendor/dired+.el
vendored
13696
configs/shared/.emacs.d/vendor/dired+.el
vendored
File diff suppressed because it is too large
Load diff
365
configs/shared/.emacs.d/vendor/org-clubhouse.el
vendored
365
configs/shared/.emacs.d/vendor/org-clubhouse.el
vendored
|
|
@ -1,365 +0,0 @@
|
|||
;;; private/grfn/org-clubhouse.el
|
||||
|
||||
(require 'dash)
|
||||
(require 'dash-functional)
|
||||
(require 's)
|
||||
(require 'org)
|
||||
(require 'org-element)
|
||||
(require 'cl)
|
||||
|
||||
;;;
|
||||
;;; Configuration
|
||||
;;;
|
||||
|
||||
(defvar org-clubhouse-auth-token nil
|
||||
"Authorization token for the Clubhouse API")
|
||||
|
||||
(defvar org-clubhouse-team-name nil
|
||||
"Team name to use in links to Clubhouse
|
||||
ie https://app.clubhouse.io/<TEAM_NAME>/stories")
|
||||
|
||||
(defvar org-clubhouse-project-ids nil
|
||||
"Specific list of project IDs to synchronize with clubhouse.
|
||||
If unset all projects will be synchronized")
|
||||
|
||||
(defvar org-clubhouse-workflow-name "Default")
|
||||
|
||||
(defvar org-clubhouse-state-alist
|
||||
'(("LATER" . "Unscheduled")
|
||||
("[ ]" . "Ready for Development")
|
||||
("TODO" . "Ready for Development")
|
||||
("OPEN" . "Ready for Development")
|
||||
("ACTIVE" . "In Development")
|
||||
("PR" . "Review")
|
||||
("DONE" . "Merged")
|
||||
("[X]" . "Merged")
|
||||
("CLOSED" . "Merged")))
|
||||
|
||||
;;;
|
||||
;;; Utilities
|
||||
;;;
|
||||
|
||||
(defun ->list (vec) (append vec nil))
|
||||
|
||||
(defun reject-archived (item-list)
|
||||
(-filter (lambda (item) (equal :json-false (alist-get 'archived item))) item-list))
|
||||
|
||||
(defun alist->plist (key-map alist)
|
||||
(->> key-map
|
||||
(-map (lambda (key-pair)
|
||||
(let ((alist-key (car key-pair))
|
||||
(plist-key (cdr key-pair)))
|
||||
(list plist-key (alist-get alist-key alist)))))
|
||||
(-flatten-n 1)))
|
||||
|
||||
(defun alist-get-equal (key alist)
|
||||
"Like `alist-get', but uses `equal' instead of `eq' for comparing keys"
|
||||
(->> alist
|
||||
(-find (lambda (pair) (equal key (car pair))))
|
||||
(cdr)))
|
||||
|
||||
;;;
|
||||
;;; Org-element interaction
|
||||
;;;
|
||||
|
||||
;; (defun org-element-find-headline ()
|
||||
;; (let ((current-elt (org-element-at-point)))
|
||||
;; (if (equal 'headline (car current-elt))
|
||||
;; current-elt
|
||||
;; (let* ((elt-attrs (cadr current-elt))
|
||||
;; (parent (plist-get elt-attrs :post-affiliated)))
|
||||
;; (goto-char parent)
|
||||
;; (org-element-find-headline)))))
|
||||
|
||||
(defun org-element-find-headline ()
|
||||
(let ((current-elt (org-element-at-point)))
|
||||
(when (equal 'headline (car current-elt))
|
||||
(cadr current-elt))))
|
||||
|
||||
(defun org-element-extract-clubhouse-id (elt)
|
||||
(when-let ((clubhouse-id-link (plist-get elt :CLUBHOUSE-ID)))
|
||||
(string-match
|
||||
(rx "[[" (one-or-more anything) "]"
|
||||
"[" (group (one-or-more digit)) "]]")
|
||||
clubhouse-id-link)
|
||||
(string-to-int (match-string 1 clubhouse-id-link))))
|
||||
|
||||
|
||||
|
||||
(defun org-element-clubhouse-id ()
|
||||
(org-element-extract-clubhouse-id
|
||||
(org-element-find-headline)))
|
||||
|
||||
;;;
|
||||
;;; API integration
|
||||
;;;
|
||||
|
||||
(defvar org-clubhouse-base-url* "https://api.clubhouse.io/api/v2")
|
||||
|
||||
(defun org-clubhouse-auth-url (url)
|
||||
(concat url
|
||||
"?"
|
||||
(url-build-query-string
|
||||
`(("token" ,org-clubhouse-auth-token)))))
|
||||
|
||||
(defun org-clubhouse-baseify-url (url)
|
||||
(if (s-starts-with? org-clubhouse-base-url* url) url
|
||||
(concat org-clubhouse-base-url*
|
||||
(if (s-starts-with? "/" url) url
|
||||
(concat "/" url)))))
|
||||
|
||||
(defun org-clubhouse-request (method url &optional data)
|
||||
(message "%s %s %s" method url (prin1-to-string data))
|
||||
(let* ((url-request-method method)
|
||||
(url-request-extra-headers
|
||||
'(("Content-Type" . "application/json")))
|
||||
(url-request-data data)
|
||||
(buf))
|
||||
|
||||
(setq url (-> url
|
||||
org-clubhouse-baseify-url
|
||||
org-clubhouse-auth-url))
|
||||
|
||||
(setq buf (url-retrieve-synchronously url))
|
||||
|
||||
(with-current-buffer buf
|
||||
(goto-char url-http-end-of-headers)
|
||||
(prog1 (json-read) (kill-buffer)))))
|
||||
|
||||
(cl-defun to-id-name-pairs
|
||||
(seq &optional (id-attr 'id) (name-attr 'name))
|
||||
(->> seq
|
||||
->list
|
||||
(-map (lambda (resource)
|
||||
(cons (alist-get id-attr resource)
|
||||
(alist-get name-attr resource))))))
|
||||
|
||||
(cl-defun org-clubhouse-fetch-as-id-name-pairs
|
||||
(resource &optional
|
||||
(id-attr 'id)
|
||||
(name-attr 'name))
|
||||
"Returns the given resource from clubhouse as (id . name) pairs"
|
||||
(let ((resp-json (org-clubhouse-request "GET" resource)))
|
||||
(-> resp-json
|
||||
->list
|
||||
reject-archived
|
||||
(to-id-name-pairs id-attr name-attr))))
|
||||
|
||||
(defun org-clubhouse-link-to-story (story-id)
|
||||
(format "https://app.clubhouse.io/%s/story/%d"
|
||||
org-clubhouse-team-name
|
||||
story-id))
|
||||
|
||||
(defun org-clubhouse-link-to-epic (epic-id)
|
||||
(format "https://app.clubhouse.io/%s/epic/%d"
|
||||
org-clubhouse-team-name
|
||||
epic-id))
|
||||
|
||||
(defun org-clubhouse-link-to-project (project-id)
|
||||
(format "https://app.clubhouse.io/%s/project/%d"
|
||||
org-clubhouse-team-name
|
||||
project-id))
|
||||
|
||||
;;;
|
||||
;;; Caching
|
||||
;;;
|
||||
|
||||
|
||||
|
||||
(defvar org-clubhouse-cache-clear-functions ())
|
||||
|
||||
(defmacro defcache (name &optional docstring &rest body)
|
||||
(let* ((doc (when docstring (list docstring)))
|
||||
(cache-var-name (intern (concat (symbol-name name)
|
||||
"-cache")))
|
||||
(clear-cache-function-name
|
||||
(intern (concat "clear-" (symbol-name cache-var-name)))))
|
||||
`(progn
|
||||
(defvar ,cache-var-name :no-cache)
|
||||
(defun ,name ()
|
||||
,@doc
|
||||
(when (equal :no-cache ,cache-var-name)
|
||||
(setq ,cache-var-name (progn ,@body)))
|
||||
,cache-var-name)
|
||||
(defun ,clear-cache-function-name ()
|
||||
(interactive)
|
||||
(setq ,cache-var-name :no-cache))
|
||||
|
||||
(push (quote ,clear-cache-function-name)
|
||||
org-clubhouse-cache-clear-functions))))
|
||||
|
||||
(defun org-clubhouse-clear-cache ()
|
||||
(interactive)
|
||||
(-map #'funcall org-clubhouse-cache-clear-functions))
|
||||
|
||||
;;;
|
||||
;;; API resource functions
|
||||
;;;
|
||||
|
||||
(defcache org-clubhouse-projects
|
||||
"Returns projects as (project-id . name)"
|
||||
(org-clubhouse-fetch-as-id-name-pairs "projects"))
|
||||
|
||||
(defcache org-clubhouse-epics
|
||||
"Returns projects as (project-id . name)"
|
||||
(org-clubhouse-fetch-as-id-name-pairs "epics"))
|
||||
|
||||
(defcache org-clubhouse-workflow-states
|
||||
"Returns worflow states as (name . id) pairs"
|
||||
(let* ((resp-json (org-clubhouse-request "GET" "workflows"))
|
||||
(workflows (->list resp-json))
|
||||
;; just assume it exists, for now
|
||||
(workflow (-find (lambda (workflow)
|
||||
(equal org-clubhouse-workflow-name
|
||||
(alist-get 'name workflow)))
|
||||
workflows))
|
||||
(states (->list (alist-get 'states workflow))))
|
||||
(to-id-name-pairs states
|
||||
'name
|
||||
'id)))
|
||||
|
||||
(defun org-clubhouse-stories-in-project (project-id)
|
||||
"Returns the stories in the given project as org bugs"
|
||||
(let ((resp-json (org-clubhouse-request "GET" (format "/projects/%d/stories" project-id))))
|
||||
(->> resp-json ->list reject-archived
|
||||
(-reject (lambda (story) (equal :json-true (alist-get 'completed story))))
|
||||
(-map (lambda (story)
|
||||
(cons
|
||||
(cons 'status
|
||||
(cond
|
||||
((equal :json-true (alist-get 'started story))
|
||||
'started)
|
||||
((equal :json-true (alist-get 'completed story))
|
||||
'completed)
|
||||
('t
|
||||
'open)))
|
||||
story)))
|
||||
(-map (-partial #'alist->plist
|
||||
'((name . :title)
|
||||
(id . :id)
|
||||
(status . :status)))))))
|
||||
|
||||
;;;
|
||||
;;; Story creation
|
||||
;;;
|
||||
|
||||
(cl-defun org-clubhouse-create-story-internal
|
||||
(title &key project-id epic-id)
|
||||
(assert (and (stringp title)
|
||||
(integerp project-id)
|
||||
(or (null epic-id) (integerp epic-id))))
|
||||
(org-clubhouse-request
|
||||
"POST"
|
||||
"stories"
|
||||
(json-encode
|
||||
`((name . ,title)
|
||||
(project_id . ,project-id)
|
||||
(epic_id . ,epic-id)))))
|
||||
|
||||
(defun org-clubhouse-prompt-for-project (cb)
|
||||
(ivy-read
|
||||
"Select a project: "
|
||||
(-map #'cdr (org-clubhouse-projects))
|
||||
:require-match t
|
||||
:history 'org-clubhouse-project-history
|
||||
:action (lambda (selected)
|
||||
(let ((project-id
|
||||
(->> (org-clubhouse-projects)
|
||||
(-find (lambda (proj)
|
||||
(string-equal (cdr proj) selected)))
|
||||
car)))
|
||||
(message "%d" project-id)
|
||||
(funcall cb project-id)))))
|
||||
|
||||
(defun org-clubhouse-prompt-for-epic (cb)
|
||||
(ivy-read
|
||||
"Select an epic: "
|
||||
(-map #'cdr (org-clubhouse-epics))
|
||||
:history 'org-clubhouse-epic-history
|
||||
:action (lambda (selected)
|
||||
(let ((epic-id
|
||||
(->> (org-clubhouse-epics)
|
||||
(-find (lambda (proj)
|
||||
(string-equal (cdr proj) selected)))
|
||||
car)))
|
||||
(message "%d" epic-id)
|
||||
(funcall cb epic-id)))))
|
||||
|
||||
(defun org-clubhouse-populate-created-story (story)
|
||||
(let ((elt (org-element-find-headline))
|
||||
(story-id (alist-get 'id story))
|
||||
(epic-id (alist-get 'epic_id story))
|
||||
(project-id (alist-get 'project_id story)))
|
||||
|
||||
(org-set-property "clubhouse-id"
|
||||
(org-make-link-string
|
||||
(org-clubhouse-link-to-story story-id)
|
||||
(number-to-string story-id)))
|
||||
|
||||
(org-set-property "clubhouse-epic"
|
||||
(org-make-link-string
|
||||
(org-clubhouse-link-to-epic epic-id)
|
||||
(alist-get epic-id (org-clubhouse-epics))))
|
||||
|
||||
(org-set-property "clubhouse-project"
|
||||
(org-make-link-string
|
||||
(org-clubhouse-link-to-project project-id)
|
||||
(alist-get project-id (org-clubhouse-projects))))
|
||||
|
||||
(org-todo "TODO")))
|
||||
|
||||
(defun org-clubhouse-create-story ()
|
||||
(interactive)
|
||||
;; (message (org-element-find-headline))
|
||||
(when-let ((elt (org-element-find-headline))
|
||||
(title (plist-get elt :title)))
|
||||
(if (plist-get elt :CLUBHOUSE-ID)
|
||||
(message "This headline is already a clubhouse story!")
|
||||
(org-clubhouse-prompt-for-project
|
||||
(lambda (project-id)
|
||||
(when project-id
|
||||
(org-clubhouse-prompt-for-epic
|
||||
(lambda (epic-id)
|
||||
(let* ((story (org-clubhouse-create-story-internal
|
||||
title
|
||||
:project-id project-id
|
||||
:epic-id epic-id)))
|
||||
(org-clubhouse-populate-created-story story))))))))))
|
||||
|
||||
;;;
|
||||
;;; Story updates
|
||||
;;;
|
||||
|
||||
(cl-defun org-clubhouse-update-story-internal
|
||||
(story-id &rest attrs)
|
||||
(assert (and (integerp story-id)
|
||||
(listp attrs)))
|
||||
(org-clubhouse-request
|
||||
"PUT"
|
||||
(format "stories/%d" story-id)
|
||||
(json-encode attrs)))
|
||||
|
||||
(defun org-clubhouse-update-status ()
|
||||
(when-let (clubhouse-id (org-element-clubhouse-id))
|
||||
(let* ((elt (org-element-find-headline))
|
||||
(todo-keyword (-> elt (plist-get :todo-keyword) (substring-no-properties))))
|
||||
(message todo-keyword)
|
||||
(when-let ((clubhouse-workflow-state
|
||||
(alist-get-equal todo-keyword org-clubhouse-state-alist))
|
||||
(workflow-state-id
|
||||
(alist-get-equal clubhouse-workflow-state (org-clubhouse-workflow-states))))
|
||||
(org-clubhouse-update-story-internal
|
||||
clubhouse-id
|
||||
:workflow_state_id workflow-state-id)
|
||||
(message "Successfully updated clubhouse status to \"%s\""
|
||||
clubhouse-workflow-state)))))
|
||||
|
||||
(define-minor-mode org-clubhouse-mode
|
||||
:init-value nil
|
||||
:group 'org
|
||||
:lighter "Org-Clubhouse"
|
||||
:keymap '()
|
||||
(add-hook 'org-after-todo-state-change-hook
|
||||
'org-clubhouse-update-status
|
||||
nil
|
||||
t))
|
||||
304
configs/shared/.emacs.d/vendor/reason-indent.el
vendored
304
configs/shared/.emacs.d/vendor/reason-indent.el
vendored
|
|
@ -1,304 +0,0 @@
|
|||
;;; 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
configs/shared/.emacs.d/vendor/reason-interaction.el
vendored
216
configs/shared/.emacs.d/vendor/reason-interaction.el
vendored
|
|
@ -1,216 +0,0 @@
|
|||
;;; 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
configs/shared/.emacs.d/vendor/reason-mode.el
vendored
242
configs/shared/.emacs.d/vendor/reason-mode.el
vendored
|
|
@ -1,242 +0,0 @@
|
|||
;;; 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
configs/shared/.emacs.d/vendor/refmt.el
vendored
231
configs/shared/.emacs.d/vendor/refmt.el
vendored
|
|
@ -1,231 +0,0 @@
|
|||
;;; 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
|
||||
228
configs/shared/.emacs.d/vendor/slack-snippets.el
vendored
228
configs/shared/.emacs.d/vendor/slack-snippets.el
vendored
|
|
@ -1,228 +0,0 @@
|
|||
;;; private/grfn/slack-snippets.el -*- lexical-binding: t; -*-
|
||||
|
||||
(require 's)
|
||||
(require 'json)
|
||||
(require 'dash)
|
||||
(require 'dash-functional)
|
||||
(require 'request)
|
||||
(require 'subr-x)
|
||||
|
||||
;;;
|
||||
;;; Configuration
|
||||
;;;
|
||||
|
||||
(defvar slack/token nil
|
||||
"Legacy (https://api.slack.com/custom-integrations/legacy-tokens) access token")
|
||||
|
||||
(defvar slack/include-public-channels 't
|
||||
"Whether or not to inclue public channels in the list of conversations")
|
||||
|
||||
(defvar slack/include-private-channels 't
|
||||
"Whether or not to inclue public channels in the list of conversations")
|
||||
|
||||
(defvar slack/include-im 't
|
||||
"Whether or not to inclue IMs (private messages) in the list of conversations")
|
||||
|
||||
(defvar slack/include-mpim nil
|
||||
"Whether or not to inclue multi-person IMs (multi-person private messages) in
|
||||
the list of conversations")
|
||||
|
||||
;;;
|
||||
;;; Utilities
|
||||
;;;
|
||||
|
||||
(defmacro comment (&rest _body)
|
||||
"Comment out one or more s-expressions"
|
||||
nil)
|
||||
|
||||
(defun ->list (vec) (append vec nil))
|
||||
|
||||
(defun json-truthy? (x) (and x (not (equal :json-false x))))
|
||||
|
||||
;;;
|
||||
;;; Generic API integration
|
||||
;;;
|
||||
|
||||
(defvar slack/base-url "https://slack.com/api")
|
||||
|
||||
(defun slack/get (path params &optional callback)
|
||||
"params is an alist of query parameters"
|
||||
(let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback)))
|
||||
(params (car params-callback)) (callback (cdr params-callback))
|
||||
(params (append `(("token" . ,slack/token)) params))
|
||||
(url (concat (file-name-as-directory slack/base-url) path)))
|
||||
(request url
|
||||
:type "GET"
|
||||
:params params
|
||||
:parser 'json-read
|
||||
:success (cl-function
|
||||
(lambda (&key data &allow-other-keys)
|
||||
(funcall callback data))))))
|
||||
|
||||
(defun slack/post (path params &optional callback)
|
||||
(let* ((params-callback (if (functionp params) `(() . ,params) (cons params callback)))
|
||||
(params (car params-callback)) (callback (cdr params-callback))
|
||||
(url (concat (file-name-as-directory slack/base-url) path)))
|
||||
(request url
|
||||
:type "POST"
|
||||
:data (json-encode params)
|
||||
:headers `(("Content-Type" . "application/json")
|
||||
("Authorization" . ,(format "Bearer %s" slack/token)))
|
||||
:success (cl-function
|
||||
(lambda (&key data &allow-other-keys)
|
||||
(funcall callback data))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Specific API endpoints
|
||||
;;;
|
||||
|
||||
;; Users
|
||||
|
||||
(defun slack/users (cb)
|
||||
"Returns users as (id . name) pairs"
|
||||
(slack/get
|
||||
"users.list"
|
||||
(lambda (data)
|
||||
(->> data
|
||||
(assoc-default 'members)
|
||||
->list
|
||||
(-map (lambda (user)
|
||||
(cons (assoc-default 'id user)
|
||||
(assoc-default 'real_name user))))
|
||||
(-filter #'cdr)
|
||||
(funcall cb)))))
|
||||
|
||||
(comment
|
||||
(slack/get
|
||||
"users.list"
|
||||
(lambda (data) (setq response-data data)))
|
||||
|
||||
(slack/users (lambda (data) (setq --users data)))
|
||||
|
||||
)
|
||||
|
||||
;; Conversations
|
||||
|
||||
(defun slack/conversation-types ()
|
||||
(->>
|
||||
(list (when slack/include-public-channels "public_channel")
|
||||
(when slack/include-private-channels "private_channel")
|
||||
(when slack/include-im "im")
|
||||
(when slack/include-mpim "mpim"))
|
||||
(-filter #'identity)
|
||||
(s-join ",")))
|
||||
|
||||
(defun channel-label (chan users-alist)
|
||||
(cond
|
||||
((json-truthy? (assoc-default 'is_channel chan))
|
||||
(format "#%s" (assoc-default 'name chan)))
|
||||
((json-truthy? (assoc-default 'is_im chan))
|
||||
(let ((user-id (assoc-default 'user chan)))
|
||||
(format "Private message with %s" (assoc-default user-id users-alist))))
|
||||
((json-truthy? (assoc-default 'is_mpim chan))
|
||||
(->> chan
|
||||
(assoc-default 'purpose)
|
||||
(assoc-default 'value)))))
|
||||
|
||||
(defun slack/conversations (cb)
|
||||
"Calls `cb' with (id . '((label . \"label\") '(topic . \"topic\") '(purpose . \"purpose\"))) pairs"
|
||||
(slack/get
|
||||
"conversations.list"
|
||||
`(("types" . ,(slack/conversation-types))
|
||||
("exclude-archived" . "true"))
|
||||
(lambda (data)
|
||||
(setq --data data)
|
||||
(slack/users
|
||||
(lambda (users)
|
||||
(->> data
|
||||
(assoc-default 'channels)
|
||||
->list
|
||||
(-filter
|
||||
(lambda (chan) (channel-label chan users)))
|
||||
(-map
|
||||
(lambda (chan)
|
||||
(cons (assoc-default 'id chan)
|
||||
`((label . ,(channel-label chan users))
|
||||
(topic . ,(->> chan
|
||||
(assoc-default 'topic)
|
||||
(assoc-default 'value)))
|
||||
(purpose . ,(->> chan
|
||||
(assoc-default 'purpose)
|
||||
(assoc-default 'value)))))))
|
||||
(funcall cb)))))))
|
||||
|
||||
(comment
|
||||
(slack/get
|
||||
"conversations.list"
|
||||
'(("types" . "public_channel,private_channel,im,mpim"))
|
||||
(lambda (data) (setq response-data data)))
|
||||
|
||||
(slack/get
|
||||
"conversations.list"
|
||||
'(("types" . "im"))
|
||||
(lambda (data) (setq response-data data)))
|
||||
|
||||
(slack/conversations
|
||||
(lambda (convos) (setq --conversations convos)))
|
||||
|
||||
)
|
||||
|
||||
;; Messages
|
||||
|
||||
(cl-defun slack/post-message
|
||||
(&key text channel-id (on-success #'identity))
|
||||
(slack/post "chat.postMessage"
|
||||
`((text . ,text)
|
||||
(channel . ,channel-id)
|
||||
(as_user . t))
|
||||
on-success))
|
||||
|
||||
(comment
|
||||
|
||||
(slack/post-message
|
||||
:text "hi slackbot"
|
||||
:channel-id slackbot-channel-id
|
||||
:on-success (lambda (data) (setq resp data)))
|
||||
|
||||
(-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan)))
|
||||
(id (car chan)))
|
||||
(propertize label 'channel-id id)))
|
||||
--conversations)
|
||||
|
||||
)
|
||||
|
||||
;;;
|
||||
;;; Posting code snippets to slack
|
||||
;;;
|
||||
|
||||
(defun prompt-for-channel (cb)
|
||||
(slack/conversations
|
||||
(lambda (conversations)
|
||||
(setq testing (-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan)))
|
||||
(id (car chan)))
|
||||
(propertize label 'channel-id id)))
|
||||
conversations))
|
||||
(ivy-read
|
||||
"Select channel: "
|
||||
;; TODO want to potentially use purpose / topic stuff here
|
||||
(-map (lambda (chan) (let ((label (assoc-default 'label (cdr chan)))
|
||||
(id (car chan)))
|
||||
(propertize label 'channel-id id)))
|
||||
conversations)
|
||||
:history 'slack/channel-history
|
||||
:action (lambda (selected)
|
||||
(let ((channel-id (get-text-property 0 'channel-id selected)))
|
||||
(funcall cb channel-id)
|
||||
(message "Sent message to %s" selected))))))
|
||||
nil)
|
||||
|
||||
(defun slack-send-code-snippet (&optional snippet-text)
|
||||
(interactive)
|
||||
(when-let ((snippet-text (or snippet-text
|
||||
(buffer-substring-no-properties (mark) (point)))))
|
||||
(prompt-for-channel
|
||||
(lambda (channel-id)
|
||||
(slack/post-message
|
||||
:text (format "```\n%s```" snippet-text)
|
||||
:channel-id channel-id)))))
|
||||
536
configs/shared/.emacs.d/vendor/wpgtk-theme.el
vendored
536
configs/shared/.emacs.d/vendor/wpgtk-theme.el
vendored
|
|
@ -1,536 +0,0 @@
|
|||
;;; wpgtk-theme.el --- Dynamic color theme, specially made for wpgtk
|
||||
|
||||
;; based on: <https://github.com/warreq/xres-theme>
|
||||
;;
|
||||
;; Version: 0.1
|
||||
;; Keywords: color, theme
|
||||
;; Package-Requires: ((emacs "24"))
|
||||
|
||||
;; Initially with the help of emacs-theme-generator, <https://github.com/mswift42/theme-creator>.
|
||||
;; Modified directly from Nasser Alshammari's spacemacs theme
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;; This file is not part of Emacs.
|
||||
|
||||
;; TODO: Is it possible to generate a *complete* Emacs theme from only 16 bit
|
||||
;; colors? If so, replace all of this nonsense with just that.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup wpgtk-theme nil
|
||||
"Xres-theme options."
|
||||
:group 'faces)
|
||||
|
||||
(defcustom wpgtk-theme-comment-bg nil
|
||||
"Use a background for comment lines."
|
||||
:type 'boolean
|
||||
:group 'wpgtk-theme)
|
||||
|
||||
(defcustom wpgtk-theme-org-height t
|
||||
"Use varying text heights for org headings."
|
||||
:type 'boolean
|
||||
:group 'wpgtk-theme)
|
||||
|
||||
(defconst wpgtk/font "Source Code Pro 10"
|
||||
"Font read from the wpg.conf template.")
|
||||
|
||||
(macros/comment
|
||||
(fonts/set wpgtk/font))
|
||||
|
||||
(defun get-hex-or-term (n)
|
||||
"Gets N hex or a term color depending on whether we're using an GUI or not."
|
||||
;; Since I start emacs with `emacs --daemon`, `(display-graphic-p)` is `nil`
|
||||
;; and therefore "black", "brightblue", etc. will be set, which is
|
||||
;; undesirable.
|
||||
(list/get n '("#01022E"
|
||||
"#434AA6"
|
||||
"#0278C6"
|
||||
"#9B6DB0"
|
||||
"#018CD5"
|
||||
"#07AAE9"
|
||||
"#3FA4E0"
|
||||
"#a7dff4"
|
||||
"#749caa"
|
||||
"#434AA6"
|
||||
"#0278C6"
|
||||
"#9B6DB0"
|
||||
"#018CD5"
|
||||
"#07AAE9"
|
||||
"#3FA4E0"
|
||||
"#a7dff4")))
|
||||
|
||||
(defun create-wpgtk-theme (variant theme-name)
|
||||
(let ((class '((class color) (min-colors 16)))
|
||||
(base (get-hex-or-term 15))
|
||||
(white (get-hex-or-term 7))
|
||||
(cursor (get-hex-or-term 7))
|
||||
(bg1 (get-hex-or-term 0))
|
||||
(bg2 (get-hex-or-term 8))
|
||||
(bg3 (get-hex-or-term 8))
|
||||
(bg4 (get-hex-or-term 8))
|
||||
(key1 (get-hex-or-term 14))
|
||||
(key2 (get-hex-or-term 14))
|
||||
(builtin (get-hex-or-term 13))
|
||||
(keyword (get-hex-or-term 12))
|
||||
(const (get-hex-or-term 11))
|
||||
(comment (get-hex-or-term 2))
|
||||
(comment-bg (get-hex-or-term 0))
|
||||
(func (get-hex-or-term 13))
|
||||
(str (get-hex-or-term 11))
|
||||
(type (get-hex-or-term 14))
|
||||
(comp (get-hex-or-term 13))
|
||||
(var (get-hex-or-term 10))
|
||||
(err (get-hex-or-term 9))
|
||||
(war (get-hex-or-term 11))
|
||||
(inf (get-hex-or-term 11))
|
||||
(suc (get-hex-or-term 10))
|
||||
(green (get-hex-or-term 10))
|
||||
(yellow (get-hex-or-term 11))
|
||||
(cyan (get-hex-or-term 14))
|
||||
(violet (get-hex-or-term 13))
|
||||
(red (get-hex-or-term 9))
|
||||
(active1 (get-hex-or-term 14))
|
||||
(active2 (get-hex-or-term 6))
|
||||
(inactive (get-hex-or-term 8))
|
||||
(m-line-brdr (get-hex-or-term 8))
|
||||
(org-block-bg (get-hex-or-term 8))
|
||||
(org-h1-bg (get-hex-or-term 8))
|
||||
(org-h2-bg (get-hex-or-term 0))
|
||||
(org-h3-bg (get-hex-or-term 0))
|
||||
(org-h4-bg (get-hex-or-term 0))
|
||||
(highlight (get-hex-or-term 14)))
|
||||
|
||||
(custom-theme-set-faces
|
||||
theme-name
|
||||
|
||||
;;;;; basics
|
||||
`(cursor ((,class (:background ,cursor))))
|
||||
`(default ((,class (:background ,bg1 :foreground ,base))))
|
||||
`(default-italic ((,class (:italic t))))
|
||||
`(error ((,class (:foreground ,err))))
|
||||
`(eval-sexp-fu-flash ((,class (:background ,suc :foreground ,bg1))))
|
||||
`(eval-sexp-fu-flash-error ((,class (:background ,err :foreground ,bg1))))
|
||||
`(font-lock-builtin-face ((,class (:foreground ,builtin))))
|
||||
`(font-lock-comment-face ((,class (:foreground ,comment :background ,(when wpgtk-theme-comment-bg comment-bg)))))
|
||||
`(font-lock-constant-face ((,class (:foreground ,const))))
|
||||
`(font-lock-doc-face ((,class (:foreground ,comment))))
|
||||
`(font-lock-function-name-face ((,class (:foreground ,func :bold t))))
|
||||
`(font-lock-keyword-face ((,class (:bold ,class :foreground ,keyword))))
|
||||
`(font-lock-negation-char-face ((,class (:foreground ,const))))
|
||||
`(font-lock-preprocessor-face ((,class (:foreground ,func))))
|
||||
`(font-lock-reference-face ((,class (:foreground ,const))))
|
||||
`(font-lock-string-face ((,class (:foreground ,str))))
|
||||
`(font-lock-type-face ((,class (:foreground ,type :bold t))))
|
||||
`(font-lock-variable-name-face ((,class (:foreground ,var))))
|
||||
`(font-lock-warning-face ((,class (:foreground ,war :background ,bg1))))
|
||||
`(fringe ((,class (:background ,bg1 :foreground ,base))))
|
||||
`(highlight ((,class (:foreground ,base :background ,bg3))))
|
||||
`(hl-line ((,class (:background ,bg2))))
|
||||
`(isearch ((,class (:bold t :foreground ,bg1 :background ,inf))))
|
||||
`(lazy-highlight ((,class (:foreground ,bg1 :background ,inf :weight normal))))
|
||||
`(link ((,class (:foreground ,comment :underline t))))
|
||||
`(link-visited ((,class (:foreground ,comp :underline t))))
|
||||
`(match ((,class (:background ,bg1 :foreground ,inf :weight bold))))
|
||||
`(minibuffer-prompt ((,class (:bold t :foreground ,keyword))))
|
||||
`(page-break-lines ((,class (:foreground ,active2))))
|
||||
`(region ((,class (:background ,highlight :foreground ,bg1))))
|
||||
`(secondary-selection ((,class (:background ,bg3))))
|
||||
`(show-paren-match-face ((,class (:background ,suc))))
|
||||
`(success ((,class (:foreground ,suc))))
|
||||
`(vertical-border ((,class (:foreground ,white :background, bg2))))
|
||||
`(warning ((,class (:foreground ,war ))))
|
||||
|
||||
;;;;; anzu-mode
|
||||
`(anzu-mode-line ((,class (:foreground ,yellow :weight bold))))
|
||||
|
||||
;;;;; company
|
||||
`(company-echo-common ((,class (:background ,base :foreground ,bg1))))
|
||||
`(company-preview ((,class (:background ,bg1 :foreground ,key1))))
|
||||
`(company-preview-common ((,class (:background ,bg2 :foreground ,keyword))))
|
||||
`(company-preview-search ((,class (:background ,bg2 :foreground ,green))))
|
||||
`(company-scrollbar-bg ((,class (:background ,bg2))))
|
||||
`(company-scrollbar-fg ((,class (:background ,comp))))
|
||||
`(company-template-field ((,class (:inherit region))))
|
||||
`(company-tooltip ((,class (:background ,bg2 :foreground ,base))))
|
||||
`(company-tooltip-annotation ((,class (:background ,bg2 :foreground ,active1))))
|
||||
`(company-tooltip-common ((,class (:background ,active2 :foreground ,bg1))))
|
||||
`(company-tooltip-common-selection ((,class (:foreground ,bg1))))
|
||||
`(company-tooltip-mouse ((,class (:inherit highlight))))
|
||||
`(company-tooltip-search ((,class (:inherit match))))
|
||||
`(company-tooltip-selection ((,class (:background ,active1 :foreground, bg1))))
|
||||
|
||||
;;;;; diff
|
||||
`(diff-added ((,class :background nil :foreground ,green)))
|
||||
`(diff-changed ((,class :background nil :foreground ,inf)))
|
||||
`(diff-indicator-added ((,class :background nil :foreground ,green)))
|
||||
`(diff-indicator-changed ((,class :background nil :foreground ,inf)))
|
||||
`(diff-indicator-removed ((,class :background nil :foreground ,red)))
|
||||
`(diff-refine-added ((,class :background ,green :foreground ,bg4)))
|
||||
`(diff-refine-changed ((,class :background ,inf :foreground ,bg4)))
|
||||
`(diff-refine-removed ((,class :background ,red :foreground ,bg4)))
|
||||
`(diff-removed ((,class :background nil :foreground ,red)))
|
||||
|
||||
;;;;; dired
|
||||
`(dired-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold))))
|
||||
`(dired-flagged ((,class (:foreground ,red))))
|
||||
`(dired-header ((,class (:foreground ,comp :weight bold))))
|
||||
`(dired-ignored ((,class (:inherit shadow))))
|
||||
`(dired-mark ((,class (:foreground ,comp :weight bold))))
|
||||
`(dired-marked ((,class (:foreground ,violet :weight bold))))
|
||||
`(dired-perm-write ((,class (:foreground ,base :underline t))))
|
||||
`(dired-symlink ((,class (:foreground ,cyan :background ,bg1 :weight bold))))
|
||||
`(dired-warning ((,class (:foreground ,war))))
|
||||
|
||||
;;;;; ediff
|
||||
`(ediff-current-diff-A ((,class(:background ,org-h1-bg :foreground ,inf))))
|
||||
`(ediff-current-diff-Ancestor ((,class(:background ,org-h2-bg :foreground ,str))))
|
||||
`(ediff-current-diff-B ((,class(:background ,org-h4-bg :foreground ,yellow))))
|
||||
`(ediff-current-diff-C ((,class(:background ,org-h3-bg :foreground ,green))))
|
||||
`(ediff-even-diff-A ((,class(:background ,bg3))))
|
||||
`(ediff-even-diff-Ancestor ((,class(:background ,bg3))))
|
||||
`(ediff-even-diff-B ((,class(:background ,bg3))))
|
||||
`(ediff-even-diff-C ((,class(:background ,bg3))))
|
||||
`(ediff-fine-diff-A ((,class(:background nil :bold t :underline t))))
|
||||
`(ediff-fine-diff-Ancestor ((,class(:background nil :bold t :underline t))))
|
||||
`(ediff-fine-diff-B ((,class(:background nil :bold t :underline t))))
|
||||
`(ediff-fine-diff-C ((,class(:background nil :bold t :underline t))))
|
||||
`(ediff-odd-diff-A ((,class(:background ,bg4))))
|
||||
`(ediff-odd-diff-Ancestor ((,class(:background ,bg4))))
|
||||
`(ediff-odd-diff-B ((,class(:background ,bg4))))
|
||||
`(ediff-odd-diff-C ((,class(:background ,bg4))))
|
||||
|
||||
;;;;; ein
|
||||
`(ein:cell-input-area((,class (:background ,bg2))))
|
||||
`(ein:cell-input-prompt ((,class (:foreground ,(if (eq variant 'dark) suc green)))))
|
||||
`(ein:cell-output-prompt ((,class (:foreground ,err))))
|
||||
`(ein:notification-tab-normal ((,class (:foreground ,builtin))))
|
||||
`(ein:notification-tab-selected ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t))))
|
||||
|
||||
;;;;; eldoc
|
||||
`(eldoc-highlight-function-argument ((,class (:foreground ,(if (eq variant 'dark) suc red) :bold t))))
|
||||
|
||||
;;;;; erc
|
||||
`(erc-input-face ((,class (:foreground ,func))))
|
||||
`(erc-my-nick-face ((,class (:foreground ,key1))))
|
||||
`(erc-nick-default-face ((,class (:foreground ,inf))))
|
||||
`(erc-nick-prefix-face ((,class (:foreground ,yellow))))
|
||||
`(erc-notice-face ((,class (:foreground ,str))))
|
||||
`(erc-prompt-face ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t))))
|
||||
`(erc-timestamp-face ((,class (:foreground ,builtin))))
|
||||
|
||||
;;;;; eshell
|
||||
`(eshell-ls-archive ((,class (:foreground ,red :weight bold))))
|
||||
`(eshell-ls-backup ((,class (:inherit font-lock-comment-face))))
|
||||
`(eshell-ls-clutter ((,class (:inherit font-lock-comment-face))))
|
||||
`(eshell-ls-directory ((,class (:foreground ,inf :weight bold))))
|
||||
`(eshell-ls-executable ((,class (:foreground ,suc :weight bold))))
|
||||
`(eshell-ls-missing ((,class (:inherit font-lock-warning-face))))
|
||||
`(eshell-ls-product ((,class (:inherit font-lock-doc-face))))
|
||||
`(eshell-ls-special ((,class (:foreground ,yellow :weight bold))))
|
||||
`(eshell-ls-symlink ((,class (:foreground ,cyan :weight bold))))
|
||||
`(eshell-ls-unreadable ((,class (:foreground ,base))))
|
||||
`(eshell-prompt ((,class (:foreground ,keyword :weight bold))))
|
||||
|
||||
;;;;; flycheck
|
||||
`(flycheck-error ((,class (:foreground ,bg1 :background ,err))))
|
||||
`(flycheck-error-list-checker-name ((,class (:foreground ,keyword))))
|
||||
`(flycheck-fringe-error ((,class (:foreground ,err :weight bold))))
|
||||
`(flycheck-fringe-info ((,class (:foreground ,inf :weight bold))))
|
||||
`(flycheck-fringe-warning ((,class (:foreground ,war :weight bold))))
|
||||
`(flycheck-info
|
||||
((,(append '((supports :underline (:style line))) class)
|
||||
(:underline (:style line :color ,inf)))
|
||||
(,class (:foreground ,base :background ,inf :weight bold :underline t))))
|
||||
`(flycheck-warning ((,class (:foreground ,bg1 :background ,violet))))
|
||||
|
||||
;;;;; git-gutter-fr
|
||||
`(git-gutter-fr:added ((,class (:foreground ,green :weight bold))))
|
||||
`(git-gutter-fr:deleted ((,class (:foreground ,war :weight bold))))
|
||||
`(git-gutter-fr:modified ((,class (:foreground ,inf :weight bold))))
|
||||
|
||||
;;;;; git-timemachine
|
||||
`(git-timemachine-minibuffer-detail-face ((,class (:foreground ,inf :bold t :background ,org-h1-bg))))
|
||||
|
||||
;;;;; gnus
|
||||
`(gnus-emphasis-highlight-words ((,class (:background ,(if (eq variant 'dark) err suc) :foreground ,(when (eq variant 'light) bg1)))))
|
||||
`(gnus-header-content ((,class (:foreground ,keyword))))
|
||||
`(gnus-header-from ((,class (:foreground ,var))))
|
||||
`(gnus-header-name ((,class (:foreground ,comp))))
|
||||
`(gnus-header-subject ((,class (:foreground ,func :bold t))))
|
||||
`(gnus-summary-cancelled ((,class (:background ,(if (eq variant 'dark) err suc) :foreground ,bg1))))
|
||||
|
||||
;;;;; guide-key
|
||||
`(guide-key/highlight-command-face ((,class (:foreground ,base))))
|
||||
`(guide-key/key-face ((,class (:foreground ,key1))))
|
||||
`(guide-key/prefix-command-face ((,class (:foreground ,key2 :weight bold))))
|
||||
|
||||
;;;;; helm
|
||||
`(helm-bookmark-directory ((,class (:inherit helm-ff-directory))))
|
||||
`(helm-bookmark-file ((,class (:foreground ,base))))
|
||||
`(helm-bookmark-gnus ((,class (:foreground ,comp))))
|
||||
`(helm-bookmark-info ((,class (:foreground ,comp))))
|
||||
`(helm-bookmark-man ((,class (:foreground ,comp))))
|
||||
`(helm-bookmark-w3m ((,class (:foreground ,comp))))
|
||||
`(helm-buffer-directory ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-buffer-file ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-buffer-not-saved ((,class (:foreground ,comp :background ,bg1))))
|
||||
`(helm-buffer-process ((,class (:foreground ,builtin :background ,bg1))))
|
||||
`(helm-buffer-saved-out ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-buffer-size ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-candidate-number ((,class (:background ,bg1 :foreground ,inf :bold t))))
|
||||
`(helm-ff-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold))))
|
||||
`(helm-ff-dotted-directory ((,class (:foreground ,key1 :background ,bg1 :weight bold))))
|
||||
`(helm-ff-executable ((,class (:foreground ,suc :background ,bg1 :weight normal))))
|
||||
`(helm-ff-file ((,class (:foreground ,base :background ,bg1 :weight normal))))
|
||||
`(helm-ff-invalid-symlink ((,class (:foreground ,red :background ,bg1 :weight bold))))
|
||||
`(helm-ff-prefix ((,class (:foreground ,bg1 :background ,keyword :weight normal))))
|
||||
`(helm-ff-symlink ((,class (:foreground ,cyan :background ,bg1 :weight bold))))
|
||||
`(helm-grep-cmd-line ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-grep-file ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-grep-finish ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-grep-lineno ((,class (:foreground ,base :background ,bg1))))
|
||||
`(helm-grep-match ((,class (:foreground nil :background nil :inherit helm-match))))
|
||||
`(helm-grep-running ((,class (:foreground ,func :background ,bg1))))
|
||||
`(helm-header ((,class (:foreground ,base :background ,bg1 :underline nil :box nil))))
|
||||
`(helm-header-line-left-margin ((,class (:foreground ,inf :background ,nil))))
|
||||
`(helm-match ((,class (:inherit match))))
|
||||
`(helm-match-item ((,class (:inherit match))))
|
||||
`(helm-moccur-buffer ((,class (:foreground ,func :background ,bg1))))
|
||||
`(helm-selection ((,class (:background ,highlight :foreground, bg1))))
|
||||
`(helm-selection-line ((,class (:background ,bg2))))
|
||||
`(helm-separator ((,class (:foreground ,comp :background ,bg1))))
|
||||
`(helm-source-header ((,class (:background ,comp :foreground ,bg1 :bold t))))
|
||||
`(helm-time-zone-current ((,class (:foreground ,builtin :background ,bg1))))
|
||||
`(helm-time-zone-home ((,class (:foreground ,comp :background ,bg1))))
|
||||
`(helm-visible-mark ((,class (:foreground ,bg1 :background ,bg3))))
|
||||
|
||||
;;;;; helm-swoop
|
||||
`(helm-swoop-target-line-block-face ((,class (:foreground ,base :background ,highlight))))
|
||||
`(helm-swoop-target-line-face ((,class (:foreground ,base :background ,highlight))))
|
||||
`(helm-swoop-target-word-face ((,class (:foreground ,bg1 :background ,suc))))
|
||||
|
||||
;;;;; ido
|
||||
`(ido-first-match ((,class (:foreground ,comp :bold t))))
|
||||
`(ido-only-match ((,class (:foreground ,(if (eq variant 'dark) suc red) :bold t))))
|
||||
`(ido-subdir ((,class (:foreground ,key1))))
|
||||
`(ido-vertical-match-face ((,class (:foreground ,comp :underline nil))))
|
||||
|
||||
;;;;; info
|
||||
`(info-header-xref ((,class (:foreground ,func :underline t))))
|
||||
`(info-menu ((,class (:foreground ,suc))))
|
||||
`(info-node ((,class (:foreground ,func :bold t))))
|
||||
`(info-quoted-name ((,class (:foreground ,builtin))))
|
||||
`(info-reference-item ((,class (:background nil :underline t :bold t))))
|
||||
`(info-string ((,class (:foreground ,str))))
|
||||
`(info-title-1 ((,class (:height 1.4 :bold t))))
|
||||
`(info-title-2 ((,class (:height 1.3 :bold t))))
|
||||
`(info-title-3 ((,class (:height 1.3))))
|
||||
`(info-title-4 ((,class (:height 1.2))))
|
||||
|
||||
;;;;; linum-mode
|
||||
`(linum ((,class (:foreground ,base :background ,bg2))))
|
||||
`(nlinum ((,class (:foreground ,base :background ,bg2))))
|
||||
`(line-number ((,class (:foreground ,base :background ,bg2))))
|
||||
|
||||
;;;;; magit
|
||||
`(magit-tag ((,class :background nil :foreground ,yellow)))
|
||||
`(magit-blame-culprit ((,class :background ,org-h4-bg :foreground ,yellow)))
|
||||
`(magit-blame-header ((,class :background ,org-h4-bg :foreground ,green)))
|
||||
`(magit-blame-sha1 ((,class :background ,org-h4-bg :foreground ,func)))
|
||||
`(magit-blame-subject ((,class :background ,org-h4-bg :foreground ,yellow)))
|
||||
`(magit-blame-time ((,class :background ,org-h4-bg :foreground ,green)))
|
||||
`(magit-blame-name ((,class :background ,org-h4-bg :foreground ,yellow)))
|
||||
`(magit-blame-heading ((,class :background ,org-h4-bg :foreground ,green)))
|
||||
`(magit-blame-hash ((,class :background ,org-h4-bg :foreground ,func)))
|
||||
`(magit-blame-summary ((,class :background ,org-h4-bg :foreground ,yellow)))
|
||||
`(magit-blame-date ((,class :background ,org-h4-bg :foreground ,green)))
|
||||
`(magit-branch-local ((,class :background nil :foreground , func)))
|
||||
`(magit-branch-remote ((,class :background nil :foreground ,green)))
|
||||
`(magit-branch ((,class (:foreground ,const :weight bold))))
|
||||
`(magit-diff-context-highlight ((,class (:background ,bg3 :foreground ,base))))
|
||||
`(magit-diff-file-header ((,class (:background nil :foreground ,str))))
|
||||
`(magit-diff-hunk-header ((,class (:background nil :foreground ,builtin))))
|
||||
`(magit-hash ((,class (:foreground ,base))))
|
||||
`(magit-hunk-heading ((,class (:background ,bg3))))
|
||||
`(magit-hunk-heading-highlight ((,class (:background ,bg3))))
|
||||
`(magit-item-highlight ((,class :background ,bg2)))
|
||||
`(magit-log-author ((,class (:foreground ,base))))
|
||||
`(magit-log-head-label-head ((,class (:background ,yellow :foreground ,bg1 :bold t))))
|
||||
`(magit-log-head-label-local ((,class (:background ,inf :foreground ,bg1 :bold t))))
|
||||
`(magit-log-head-label-remote ((,class (:background ,suc :foreground ,bg1 :bold t))))
|
||||
`(magit-log-head-label-tags ((,class (:background ,violet :foreground ,bg1 :bold t))))
|
||||
`(magit-log-head-label-wip ((,class (:background ,cyan :foreground ,bg1 :bold t))))
|
||||
`(magit-log-sha1 ((,class (:foreground ,str))))
|
||||
`(magit-process-ng ((,class (:foreground ,war :weight bold))))
|
||||
`(magit-process-ok ((,class (:foreground ,func :weight bold))))
|
||||
`(magit-section-heading ((,class (:foreground ,keyword :weight bold))))
|
||||
`(magit-section-highlight ((,class (:background ,bg2))))
|
||||
`(magit-section-title ((,class (:background ,bg1 :foreground ,builtin :weight bold))))
|
||||
|
||||
;;;;; mode-line
|
||||
`(mode-line ((,class (:foreground ,bg1 :background ,active1 :box (:color ,m-line-brdr :line-width 0)))))
|
||||
`(mode-line-inactive ((,class (:foreground ,white :background ,bg2 :box (:color ,m-line-brdr :line-width 0)))))
|
||||
`(mode-line-buffer-id ((,class (:bold f :foreground ,bg1))))
|
||||
|
||||
;;;;; mode-line
|
||||
`(sml/modified ((,class (:foreground ,bg1 :background ,red))))
|
||||
|
||||
;;;;; neotree
|
||||
`(neo-dir-link-face ((,class (:foreground ,inf :weight bold))))
|
||||
`(neo-expand-btn-face ((,class (:foreground ,base))))
|
||||
`(neo-file-link-face ((,class (:foreground ,base))))
|
||||
`(neo-root-dir-face ((,class (:foreground ,func :weight bold))))
|
||||
|
||||
;;;;; org
|
||||
`(org-agenda-clocking ((,class (:foreground ,comp))))
|
||||
`(org-agenda-date ((,class (:foreground ,var :height 1.1))))
|
||||
`(org-agenda-date-today ((,class (:weight bold :foreground ,keyword :height 1.3))))
|
||||
`(org-agenda-date-weekend ((,class (:weight normal :foreground ,base))))
|
||||
`(org-agenda-done ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t))))
|
||||
`(org-agenda-structure ((,class (:weight bold :foreground ,comp))))
|
||||
`(org-block ((,class (:foreground ,base))))
|
||||
`(org-block-background ((,class (:background ,org-block-bg))))
|
||||
`(org-clock-overlay ((,class (:foreground ,comp))))
|
||||
`(org-code ((,class (:foreground ,cyan))))
|
||||
`(org-column ((,class (:background ,highlight))))
|
||||
`(org-column-title ((,class (:background ,highlight))))
|
||||
`(org-date ((,class (:underline t :foreground ,var) )))
|
||||
`(org-date-selected ((,class (:background ,func :foreground ,bg1) )))
|
||||
`(org-document-info-keyword ((,class (:foreground ,str))))
|
||||
`(org-document-title ((,class (:foreground ,func :weight bold :height ,(if wpgtk-theme-org-height 1.4 1.0) :underline t))))
|
||||
`(org-done ((,class (:foreground ,(if (eq variant 'dark) suc green) :bold t :overline t :background ,org-h3-bg))))
|
||||
`(org-ellipsis ((,class (:foreground ,builtin))))
|
||||
`(org-footnote ((,class (:underline t :foreground ,base))))
|
||||
`(org-hide ((,class (:foreground ,base))))
|
||||
`(org-level-1 ((,class (:bold t :foreground ,inf :height ,(if wpgtk-theme-org-height 1.3 1.0) :background ,org-h1-bg))))
|
||||
`(org-level-2 ((,class (:bold t :foreground ,str :height ,(if wpgtk-theme-org-height 1.2 1.0) :background ,org-h2-bg))))
|
||||
`(org-level-3 ((,class (:bold nil :foreground ,green :height ,(if wpgtk-theme-org-height 1.1 1.0) :background ,org-h3-bg))))
|
||||
`(org-level-4 ((,class (:bold nil :foreground ,yellow :background ,org-h4-bg))))
|
||||
`(org-level-5 ((,class (:bold nil :foreground ,inf))))
|
||||
`(org-level-6 ((,class (:bold nil :foreground ,str))))
|
||||
`(org-level-7 ((,class (:bold nil :foreground ,green))))
|
||||
`(org-level-8 ((,class (:bold nil :foreground ,yellow))))
|
||||
`(org-link ((,class (:underline t :foreground ,comment))))
|
||||
`(org-mode-line-clock-overrun ((,class (:foreground ,err))))
|
||||
`(org-priority ((,class (:foreground ,war :bold t))))
|
||||
`(org-quote ((,class (:inherit org-block :slant italic))))
|
||||
`(org-scheduled ((,class (:foreground ,comp))))
|
||||
`(org-scheduled-today ((,class (:foreground ,func :weight bold :height 1.2))))
|
||||
`(org-sexp-date ((,class (:foreground ,base))))
|
||||
`(org-special-keyword ((,class (:foreground ,func))))
|
||||
`(org-table ((,class (:foreground ,yellow :background ,org-h4-bg))))
|
||||
`(org-todo ((,class (:foreground ,war :bold t :overline t :background ,org-h4-bg))))
|
||||
`(org-verbatim ((,class (:foreground ,inf))))
|
||||
`(org-verse ((,class (:inherit org-block :slant italic))))
|
||||
`(org-warning ((,class (:foreground ,err))))
|
||||
|
||||
;;;;; powerline
|
||||
`(powerline-active1 ((,class (:background ,active2 :foreground ,base))))
|
||||
`(powerline-active2 ((,class (:background ,active2 :foreground ,base))))
|
||||
`(powerline-inactive1 ((,class (:background ,bg2 :foreground ,base))))
|
||||
`(powerline-inactive2 ((,class (:background ,bg2 :foreground ,base))))
|
||||
|
||||
;;;;; rainbow-delimiters
|
||||
`(rainbow-delimiters-depth-1-face ((,class :foreground ,inf)))
|
||||
`(rainbow-delimiters-depth-2-face ((,class :foreground ,func)))
|
||||
`(rainbow-delimiters-depth-3-face ((,class :foreground ,str)))
|
||||
`(rainbow-delimiters-depth-4-face ((,class :foreground ,green)))
|
||||
`(rainbow-delimiters-depth-5-face ((,class :foreground ,yellow)))
|
||||
`(rainbow-delimiters-depth-6-face ((,class :foreground ,inf)))
|
||||
`(rainbow-delimiters-depth-7-face ((,class :foreground ,func)))
|
||||
`(rainbow-delimiters-depth-8-face ((,class :foreground ,str)))
|
||||
`(rainbow-delimiters-unmatched-face ((,class :foreground ,war)))
|
||||
|
||||
;;;;; smartparens
|
||||
`(sp-pair-overlay-face ((,class (:background ,highlight :foreground nil))))
|
||||
`(sp-show-pair-match-face ((,class (:foreground ,(if (eq variant 'dark) suc red) :weight bold :underline t))))
|
||||
|
||||
;;;;; term
|
||||
`(term ((,class (:foreground ,base :background ,bg1))))
|
||||
`(term-color-black ((,class (:foreground ,bg4))))
|
||||
`(term-color-blue ((,class (:foreground ,inf))))
|
||||
`(term-color-cyan ((,class (:foreground ,cyan))))
|
||||
`(term-color-green ((,class (:foreground ,green))))
|
||||
`(term-color-magenta ((,class (:foreground ,builtin))))
|
||||
`(term-color-red ((,class (:foreground ,red))))
|
||||
`(term-color-white ((,class (:foreground ,base))))
|
||||
`(term-color-yellow ((,class (:foreground ,yellow))))
|
||||
|
||||
;;;;; which-key
|
||||
`(which-key-command-description-face ((,class (:foreground ,base))))
|
||||
`(which-key-group-description-face ((,class (:foreground ,key2))))
|
||||
`(which-key-key-face ((,class (:foreground ,func :bold t))))
|
||||
`(which-key-separator-face ((,class (:background nil :foreground ,str))))
|
||||
`(which-key-special-key-face ((,class (:background ,func :foreground ,bg1))))
|
||||
|
||||
;;;;; other, need more work
|
||||
`(ac-completion-face ((,class (:underline t :foreground ,keyword))))
|
||||
`(elixir-atom-face ((,class (:foreground ,func))))
|
||||
`(ffap ((,class (:foreground ,base))))
|
||||
`(flx-highlight-face ((,class (:foreground ,comp :underline nil))))
|
||||
`(font-latex-bold-face ((,class (:foreground ,comp))))
|
||||
`(font-latex-italic-face ((,class (:foreground ,key2 :italic t))))
|
||||
`(font-latex-match-reference-keywords ((,class (:foreground ,const))))
|
||||
`(font-latex-match-variable-keywords ((,class (:foreground ,var))))
|
||||
`(font-latex-string-face ((,class (:foreground ,str))))
|
||||
`(icompletep-determined ((,class :foreground ,builtin)))
|
||||
`(js2-external-variable ((,class (:foreground ,comp ))))
|
||||
`(js2-function-param ((,class (:foreground ,const))))
|
||||
`(js2-function-call ((,class (:inherit ,font-lock-function-name-face))))
|
||||
`(js2-jsdoc-html-tag-delimiter ((,class (:foreground ,str))))
|
||||
`(js2-jsdoc-html-tag-name ((,class (:foreground ,key1))))
|
||||
`(js2-jsdoc-value ((,class (:foreground ,str))))
|
||||
`(js2-private-function-call ((,class (:foreground ,const))))
|
||||
`(js2-private-member ((,class (:foreground ,base))))
|
||||
`(js3-error-face ((,class (:underline ,war))))
|
||||
`(js3-external-variable-face ((,class (:foreground ,var))))
|
||||
`(js3-function-param-face ((,class (:foreground ,key2))))
|
||||
`(js3-instance-member-face ((,class (:foreground ,const))))
|
||||
`(js3-jsdoc-tag-face ((,class (:foreground ,keyword))))
|
||||
`(js3-warning-face ((,class (:underline ,keyword))))
|
||||
`(mu4e-cited-1-face ((,class (:foreground ,base))))
|
||||
`(mu4e-cited-7-face ((,class (:foreground ,base))))
|
||||
`(mu4e-header-marks-face ((,class (:foreground ,comp))))
|
||||
`(mu4e-view-url-number-face ((,class (:foreground ,comp))))
|
||||
`(py-variable-name-face ((,class (:foreground ,var))))
|
||||
`(slime-repl-inputed-output-face ((,class (:foreground ,comp))))
|
||||
`(sh-quoted-text ((,class (:foreground ,func))))
|
||||
`(trailing-whitespace ((,class :foreground nil :background ,err)))
|
||||
`(undo-tree-visualizer-current-face ((,class :foreground ,builtin)))
|
||||
`(undo-tree-visualizer-default-face ((,class :foreground ,base)))
|
||||
`(undo-tree-visualizer-register-face ((,class :foreground ,comp)))
|
||||
`(undo-tree-visualizer-unmodified-face ((,class :foreground ,var)))
|
||||
`(web-mode-builtin-face ((,class (:inherit ,font-lock-builtin-face))))
|
||||
`(web-mode-comment-face ((,class (:inherit ,font-lock-comment-face))))
|
||||
`(web-mode-constant-face ((,class (:inherit ,font-lock-constant-face))))
|
||||
`(web-mode-doctype-face ((,class (:inherit ,font-lock-comment-face))))
|
||||
`(web-mode-function-name-face ((,class (:inherit ,font-lock-function-name-face))))
|
||||
`(web-mode-html-attr-name-face ((,class (:foreground ,func))))
|
||||
`(web-mode-html-attr-value-face ((,class (:foreground ,keyword))))
|
||||
`(web-mode-html-tag-face ((,class (:foreground ,builtin))))
|
||||
`(web-mode-keyword-face ((,class (:foreground ,keyword))))
|
||||
`(web-mode-string-face ((,class (:foreground ,str))))
|
||||
`(web-mode-type-face ((,class (:inherit ,font-lock-type-face))))
|
||||
`(web-mode-warning-face ((,class (:inherit ,font-lock-warning-face)))))))
|
||||
|
||||
(deftheme wpgtk "Theme for wpgtk template system")
|
||||
(create-wpgtk-theme 'dark 'wpgtk)
|
||||
(provide-theme 'wpgtk)
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
||||
;;; wpgtk-theme.el ends here
|
||||
|
|
@ -1,277 +0,0 @@
|
|||
;;; alist.el --- Interface for working with associative lists -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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.
|
||||
|
||||
;; Dependencies:
|
||||
|
||||
;; TODO: Consider dropping explicit dependency white-listing since all of these
|
||||
;; should be available in my Emacs. The problem arises when this library needs
|
||||
;; to be published, in which case, something like Nix and a build process could
|
||||
;; possible insert the necessary require statements herein. Not sure how I feel
|
||||
;; about this though.
|
||||
(require 'maybe)
|
||||
(require 'macros)
|
||||
(require 'dash)
|
||||
(require 'tuple)
|
||||
(require 'maybe)
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; 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 alist/enable-tests? t
|
||||
"When t, run the test suite.")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Library
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; TODO: Support a variadic version of this to easily construct alists.
|
||||
(defun alist/new ()
|
||||
"Return a new, empty alist."
|
||||
'())
|
||||
|
||||
;; Create
|
||||
;; TODO: See if this mutates.
|
||||
(defun alist/set (k v xs)
|
||||
"Set K to V in XS."
|
||||
(if (alist/has-key? k xs)
|
||||
(progn
|
||||
(setf (alist-get k xs) v)
|
||||
xs)
|
||||
(list/cons `(,k . ,v) xs)))
|
||||
|
||||
(defun alist/set! (k v xs)
|
||||
"Set K to V in XS mutatively.
|
||||
Note that this doesn't append to the alist in the way that most alists handle
|
||||
writing. If the k already exists in XS, it is overwritten."
|
||||
(map-delete xs k)
|
||||
(map-put xs k v))
|
||||
|
||||
;; Read
|
||||
(defun alist/get (k xs)
|
||||
"Return the value at K in XS; otherwise, return nil.
|
||||
Returns the first occurrence of K in XS since alists support multiple entries."
|
||||
(cdr (assoc k xs)))
|
||||
|
||||
(defun alist/get-entry (k xs)
|
||||
"Return the first key-value pair at K in XS."
|
||||
(assoc k xs))
|
||||
|
||||
;; Update
|
||||
;; TODO: Add warning about only the first occurrence being updated in the
|
||||
;; documentation.
|
||||
(defun alist/update (k f xs)
|
||||
"Apply F to the value stored at K in XS.
|
||||
If `K' is not in `XS', this function errors. Use `alist/upsert' if you're
|
||||
interested in inserting a value when a key doesn't already exist."
|
||||
(if (maybe/nil? (alist/get k xs))
|
||||
(error "Refusing to update: key does not exist in alist")
|
||||
(alist/set k (funcall f (alist/get k xs)) xs)))
|
||||
|
||||
(defun alist/update! (k f xs)
|
||||
"Call F on the entry at K in XS.
|
||||
Mutative variant of `alist/update'."
|
||||
(alist/set! k (funcall f (alist/get k xs))xs))
|
||||
|
||||
;; TODO: Support this.
|
||||
(defun alist/upsert (k v f xs)
|
||||
"If K exists in `XS' call `F' on the value otherwise insert `V'."
|
||||
(if (alist/get k xs)
|
||||
(alist/update k f xs)
|
||||
(alist/set k v xs)))
|
||||
|
||||
;; Delete
|
||||
;; TODO: Make sure `delete' and `remove' behave as advertised in the Elisp docs.
|
||||
(defun alist/delete (k xs)
|
||||
"Deletes the entry of K from XS.
|
||||
This only removes the first occurrence of K, since alists support multiple
|
||||
key-value entries. See `alist/delete-all' and `alist/dedupe'."
|
||||
(remove (assoc k xs) xs))
|
||||
|
||||
(defun alist/delete! (k xs)
|
||||
"Delete the entry of K from XS.
|
||||
Mutative variant of `alist/delete'."
|
||||
(delete (assoc k xs) xs))
|
||||
|
||||
;; Additions to the CRUD API
|
||||
;; TODO: Implement this function.
|
||||
(defun alist/dedupe-keys (xs)
|
||||
"Remove the entries in XS where the keys are `equal'.")
|
||||
|
||||
(defun alist/dedupe-entries (xs)
|
||||
"Remove the entries in XS where the key-value pair are `equal'."
|
||||
(delete-dups xs))
|
||||
|
||||
(defun alist/keys (xs)
|
||||
"Return a list of the keys in XS."
|
||||
(mapcar 'car xs))
|
||||
|
||||
(defun alist/values (xs)
|
||||
"Return a list of the values in XS."
|
||||
(mapcar 'cdr xs))
|
||||
|
||||
(defun alist/has-key? (k xs)
|
||||
"Return t if XS has a key `equal' to K."
|
||||
(maybe/some? (assoc k xs)))
|
||||
|
||||
(defun alist/has-value? (v xs)
|
||||
"Return t if XS has a value of V."
|
||||
(maybe/some? (rassoc v xs)))
|
||||
|
||||
(defun alist/count (xs)
|
||||
"Return the number of entries in XS."
|
||||
(length xs))
|
||||
|
||||
;; TODO: Should I support `alist/find-key' and `alist/find-value' variants?
|
||||
(defun alist/find (p xs)
|
||||
"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 alist/map-keys (f xs)
|
||||
"Call F on the values in XS, returning a new alist."
|
||||
(list/map (lambda (x)
|
||||
`(,(funcall f (car x)) . ,(cdr x)))
|
||||
xs))
|
||||
|
||||
(defun alist/map-values (f xs)
|
||||
"Call F on the values in XS, returning a new alist."
|
||||
(list/map (lambda (x)
|
||||
`(,(car x) . ,(funcall f (cdr x))))
|
||||
xs))
|
||||
|
||||
(defun alist/reduce (acc f xs)
|
||||
"Return a new alist by calling F on k v and ACC from XS.
|
||||
F should return a tuple. See tuple.el for more information."
|
||||
(->> (alist/keys xs)
|
||||
(list/reduce acc
|
||||
(lambda (k acc)
|
||||
(funcall f k (alist/get k xs) acc)))))
|
||||
|
||||
(defun alist/merge (a b)
|
||||
"Return a new alist with a merge of alists, A and B.
|
||||
In this case, the last writer wins, which is B."
|
||||
(alist/reduce a #'alist/set b))
|
||||
|
||||
;; TODO: Support `-all' variants like:
|
||||
;; - get-all
|
||||
;; - delete-all
|
||||
;; - update-all
|
||||
|
||||
;; Scratch-pad
|
||||
(macros/comment
|
||||
(progn
|
||||
(setq person '((first-name . "William")
|
||||
(first-name . "William")
|
||||
(last-name . "Carroll")
|
||||
(last-name . "Another")))
|
||||
(alist/set 'last-name "Van Gogh" person)
|
||||
(alist/get 'last-name person)
|
||||
(alist/update 'last-name (lambda (x) "whoops") person)
|
||||
(alist/delete 'first-name person)
|
||||
(alist/keys person)
|
||||
(alist/values person)
|
||||
(alist/count person)
|
||||
(alist/has-key? 'first-name person)
|
||||
(alist/has-value? "William" person)
|
||||
;; (alist/dedupe-keys person)
|
||||
(alist/dedupe-entries person)
|
||||
(alist/count person)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(when alist/enable-tests?
|
||||
(prelude/assert
|
||||
(equal '((2 . one)
|
||||
(3 . two))
|
||||
(alist/map-keys #'1+
|
||||
'((1 . one)
|
||||
(2 . two)))))
|
||||
(prelude/assert
|
||||
(equal '((one . 2)
|
||||
(two . 3))
|
||||
(alist/map-values #'1+
|
||||
'((one . 1)
|
||||
(two . 2))))))
|
||||
|
||||
|
||||
;; TODO: Support test cases for the entire API.
|
||||
|
||||
(provide 'alist)
|
||||
;;; alist.el ends here
|
||||
|
|
@ -1,66 +0,0 @@
|
|||
;;; bag.el --- Working with bags (aka multi-sets) -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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 '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 (alist/new)))
|
||||
|
||||
(defun bag/contains? (x xs)
|
||||
"Return t if XS has X."
|
||||
(alist/has-key? x (bag-xs xs)))
|
||||
|
||||
;; TODO: Tabling this for now since working with structs seems to be
|
||||
;; disappointingly difficult. Where is `struct/update'?
|
||||
;; (defun bag/add (x xs)
|
||||
;; "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
|
||||
|
|
@ -1,26 +0,0 @@
|
|||
;;; bills.el --- Helping me manage my bills -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; For personal use only.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defconst bills/whitelist '(("Council Tax" . "rbkc.gov.uk/onlinepayments/counciltaxpayments/")
|
||||
("Internet". "plus.net/member-centre/login"))
|
||||
"Maps searchable labels to URLs to pay these bills.")
|
||||
|
||||
(defun bills/url ()
|
||||
"Copies the URL to pay a bill onto the clipboard."
|
||||
(ivy-read
|
||||
"Bill: "
|
||||
bills/whitelist
|
||||
:action (lambda (entry)
|
||||
(kill-new (cdr entry))
|
||||
(alert "Copied to clipboard!"))))
|
||||
|
||||
(macros/comment
|
||||
(bills/url))
|
||||
|
||||
(provide 'bills)
|
||||
;;; bills.el ends here
|
||||
|
|
@ -1,145 +0,0 @@
|
|||
;;; bookmark.el --- Saved files and directories on my filesystem -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(cl-defstruct bookmark label path kbd)
|
||||
|
||||
(defconst bookmark/install-kbds? t
|
||||
"When t, install keybindings.")
|
||||
|
||||
;; 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 "depot"
|
||||
:path "~/depot"
|
||||
:kbd "t")
|
||||
(make-bookmark :label "org"
|
||||
:path "~/Dropbox/org"
|
||||
:kbd "o")
|
||||
(make-bookmark :label "universe"
|
||||
:path "~/universe"
|
||||
:kbd "m")
|
||||
(make-bookmark :label "dotfiles"
|
||||
:path "~/dotfiles"
|
||||
:kbd "d")
|
||||
(make-bookmark :label "current project"
|
||||
:path constants/current-project
|
||||
:kbd "p"))
|
||||
"List of registered bookmarks.")
|
||||
|
||||
(defun bookmark/from-label (label)
|
||||
"Return the bookmark with LABEL or nil."
|
||||
(->> bookmark/whitelist
|
||||
(list/find (lambda (b) (equal label (bookmark-label b))))))
|
||||
|
||||
(defun bookmark/magit-status ()
|
||||
"Use ivy to select a bookmark and jump to its `magit-status' buffer."
|
||||
(interactive)
|
||||
(let ((labels (set/new "dotfiles" "universe" "depot"))
|
||||
(all-labels (->> bookmark/whitelist
|
||||
(list/map (>> bookmark-label))
|
||||
set/from-list)))
|
||||
(prelude/assert (set/subset? labels all-labels))
|
||||
(ivy-read "Repository: "
|
||||
(set/to-list labels)
|
||||
:require-match t
|
||||
:action (lambda (label)
|
||||
(->> label
|
||||
bookmark/from-label
|
||||
bookmark-path
|
||||
magit-status)))))
|
||||
|
||||
;; TODO: Consider `ivy-read' extension that takes a list of structs,
|
||||
;; `struct-to-label' and `label-struct' functions.
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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/ivy-open ()
|
||||
"Use ivy to filter available bookmarks."
|
||||
(interactive)
|
||||
(ivy-read "Bookmark: "
|
||||
(->> bookmark/whitelist
|
||||
(list/map #'bookmark-label))
|
||||
:require-match t
|
||||
:action (lambda (label)
|
||||
(bookmark/open (bookmark/from-label label)))))
|
||||
|
||||
(when bookmark/install-kbds?
|
||||
(general-define-key
|
||||
:prefix "<SPC>"
|
||||
:states '(normal)
|
||||
"jj" #'bookmark/ivy-open)
|
||||
(->> bookmark/whitelist
|
||||
(list/map
|
||||
(lambda (b)
|
||||
(general-define-key
|
||||
:prefix "<SPC>"
|
||||
:states '(normal)
|
||||
(string/concat "j" (bookmark-kbd b))
|
||||
;; TODO: Consider `cl-labels' so `which-key' minibuffer is more
|
||||
;; helpful.
|
||||
(lambda () (interactive) (bookmark/open b))))))
|
||||
(general-define-key
|
||||
:states '(normal)
|
||||
:prefix "<SPC>"
|
||||
"gS" #'bookmark/magit-status))
|
||||
|
||||
(provide 'bookmark)
|
||||
;;; bookmark.el ends here
|
||||
|
|
@ -1,198 +0,0 @@
|
|||
;;; buffer.el --- Working with Emacs buffers -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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
|
||||
'magit-status-mode
|
||||
'magit-process-mode
|
||||
'magit-log-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)
|
||||
"Cycle forwards or backwards 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
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
;;; bytes.el --- Working with byte values -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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
|
||||
|
|
@ -1,80 +0,0 @@
|
|||
;;; cache.el --- Caching things -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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:
|
||||
|
||||
(require 'prelude)
|
||||
(require 'struct)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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
|
||||
|
|
@ -1,82 +0,0 @@
|
|||
;;; chrome.el --- Helpers for Google Chrome -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; Some helper functions for working with Google Chrome.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Dependencies
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'macros)
|
||||
(require 'alist)
|
||||
(require 'list)
|
||||
(require 'general)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Library
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defvar chrome/install-kbds? t
|
||||
"If t, install keybinding.")
|
||||
|
||||
;; TODO: Consider modelling this as a rose-tree that can nest itself
|
||||
;; arbitrarily.
|
||||
;; TODO: Consider exporting existing chrome bookmarks.
|
||||
(defconst chrome/label->url
|
||||
'(("Google" . "www.google.com")
|
||||
("Hacker News" . "news.ycombinator.com")
|
||||
("Gmail" . "www.gmail.com")
|
||||
("WhatsApp" . "web.whatsapp.com")
|
||||
("Google Chat" . "chat/")
|
||||
("Google Calendar" . "calendar/")
|
||||
("Teknql" . "teknql.slack.com/messages")
|
||||
("Twitter" . "twitter.com"))
|
||||
"Mapping labels to urls for my bookmarks.")
|
||||
|
||||
(defconst chrome/splash-pages
|
||||
'("Google Calendar"
|
||||
"Gmail"
|
||||
"Google Chat"
|
||||
"WhatsApp"
|
||||
"Teknql")
|
||||
"The pages that should open when I open Chrome.")
|
||||
|
||||
;; TODO: Add defensive check to start chrome if it isn't already open.
|
||||
|
||||
;; TODO: Support option to create new session even if one already exists.
|
||||
|
||||
(defun chrome/open-splash-pages ()
|
||||
"Opens Chrome with my preferred splash pages."
|
||||
(interactive)
|
||||
(->> chrome/splash-pages
|
||||
(-map (lambda (x) (alist/get x chrome/label->url)))
|
||||
chrome/open-urls))
|
||||
|
||||
;; TODO: Support optional kwargs.
|
||||
(cl-defun chrome/open-url (url &key new-window?)
|
||||
"Opens `URL' in google-chrome.
|
||||
Will open without toolbars if APP-MODE? is t."
|
||||
(shell-command (s-concat
|
||||
"google-chrome "
|
||||
(if new-window? "--new-window " "")
|
||||
url)))
|
||||
|
||||
(defun chrome/open-urls (urls)
|
||||
"Open multiple `URLS' in chrome."
|
||||
(chrome/open-url
|
||||
(list/join " " urls)))
|
||||
|
||||
(defun chrome/browse ()
|
||||
"Display a counsel window for browsing URLs."
|
||||
(interactive)
|
||||
(ivy-read
|
||||
"URL: "
|
||||
chrome/label->url
|
||||
:action (lambda (entry)
|
||||
(chrome/open-url (cdr entry)))))
|
||||
|
||||
(provide 'chrome)
|
||||
;;; chrome.el ends here
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
;;; clipboard.el --- Working with X11's pasteboard -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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 'prelude)
|
||||
(require 'ivy-clipmenu)
|
||||
|
||||
(prelude/assert (prelude/executable-exists? "clipmenu"))
|
||||
(prelude/assert (prelude/executable-exists? "clipmenud"))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Library
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(cl-defun clipboard/copy (x &key (message "[clipboard.el] Copied!"))
|
||||
"Copy string, X, to X11's clipboard."
|
||||
(kill-new x)
|
||||
(message message))
|
||||
|
||||
(cl-defun clipboard/paste (&key (message "[clipboard.el] Pasted!"))
|
||||
"Paste contents of X11 clipboard."
|
||||
(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
|
||||
|
|
@ -1,96 +0,0 @@
|
|||
;;; colorscheme.el --- Syntax highlight and friends -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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 'general)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defcustom colorscheme/install-kbds? t
|
||||
"If non-nil, enable the keybindings.")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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))
|
||||
|
||||
;; Keybindings
|
||||
(when colorscheme/install-kbds?
|
||||
(general-define-key
|
||||
:prefix "<SPC>"
|
||||
:states '(normal)
|
||||
"Ft" #'colorscheme/next
|
||||
"Pt" #'colorscheme/prev))
|
||||
|
||||
(provide 'colorscheme)
|
||||
;;; colorscheme.el ends here
|
||||
|
|
@ -1,41 +0,0 @@
|
|||
;;; constants.el --- Constants for organizing my Emacs -*- lexical-binding: t -*-
|
||||
;; Authpr: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; This file contains constants that are shared across my configuration.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Dependencies
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'prelude)
|
||||
(require 'f)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Configuration
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; 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 "~/universe"
|
||||
"Variable holding the directory for my currently active project.")
|
||||
|
||||
(prelude/assert (f-directory? constants/current-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
|
||||
|
|
@ -1,155 +0,0 @@
|
|||
;;; cycle.el --- Simple module for working with cycles. -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; 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)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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/new (&rest xs)
|
||||
"Create an empty cycle."
|
||||
(make-cycle :current-index 0
|
||||
:previous-index nil
|
||||
:xs xs))
|
||||
|
||||
(defun cycle/from-list (xs)
|
||||
"Create a cycle from a list of `XS'."
|
||||
(make-cycle :current-index 0
|
||||
:previous-index nil
|
||||
:xs xs))
|
||||
|
||||
(defun cycle/to-list (xs)
|
||||
"Return the list representation of a cycle, XS."
|
||||
(cycle-xs xs))
|
||||
|
||||
(defun 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 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 (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 (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/contains? (x xs)
|
||||
"Return t if cycle, XS, has member X."
|
||||
(->> xs
|
||||
cycle-xs
|
||||
(list/contains? x)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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)))))
|
||||
|
||||
(provide 'cycle)
|
||||
;;; cycle.el ends here
|
||||
|
|
@ -1,38 +0,0 @@
|
|||
;;; device.el --- Physical device information -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; Functions for querying device information.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'alist)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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."
|
||||
(alist/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)))
|
||||
|
||||
(provide 'device)
|
||||
;;; device.el ends here
|
||||
|
|
@ -1,98 +0,0 @@
|
|||
;;; display.el --- Working with single or multiple displays -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; Mostly wrappers around xrandr.
|
||||
;;
|
||||
;; TODO: Look into autorandr to see if it could be useful.
|
||||
;;
|
||||
;; Troubleshooting:
|
||||
;; The following commands help me when I (infrequently) interact with xrandr.
|
||||
;; - xrandr --listmonitors
|
||||
;; - xrandr --query
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Dependencies
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'prelude)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defconst display/install-kbds? t
|
||||
"When t, install the keybindings defined in this module.")
|
||||
|
||||
;; TODO: Consider if this logic should be conditioned by `device/work-laptop?'.
|
||||
(defconst display/laptop-monitor "eDP1"
|
||||
"The xrandr identifier for my primary screen (on work laptop).")
|
||||
|
||||
;; TODO: Why is HDMI-1, eDP-1 sometimes and HDMI1, eDP1 other times.
|
||||
(defconst display/4k-monitor "HDMI1"
|
||||
"The xrandr identifer for my 4K monitor.")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Library
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; TODO: Debug why something this scales to 4k appropriately and other times it
|
||||
;; doesn't.
|
||||
(defun display/enable-4k ()
|
||||
"Attempt to connect to my 4K monitor."
|
||||
(interactive)
|
||||
(prelude/start-process
|
||||
:name "display/enable-4k"
|
||||
:command (string/format
|
||||
"xrandr --output %s --above %s --primary --auto --dpi 144"
|
||||
display/4k-monitor
|
||||
display/laptop-monitor)))
|
||||
|
||||
(defun display/disable-4k ()
|
||||
"Disconnect from the 4K monitor."
|
||||
(interactive)
|
||||
(prelude/start-process
|
||||
:name "display/disable-4k"
|
||||
:command (string/format "xrandr --output %s --off"
|
||||
display/4k-monitor)))
|
||||
|
||||
(defun display/enable-laptop ()
|
||||
"Turn the laptop monitor off.
|
||||
Sometimes this is useful when I'm sharing my screen in a Google Hangout and I
|
||||
only want to present one of my monitors."
|
||||
(interactive)
|
||||
(prelude/start-process
|
||||
:name "display/disable-laptop"
|
||||
:command (string/format "xrandr --output %s --auto"
|
||||
display/laptop-monitor)))
|
||||
|
||||
(defun display/disable-laptop ()
|
||||
"Turn the laptop monitor off.
|
||||
Sometimes this is useful when I'm sharing my screen in a Google Hangout and I
|
||||
only want to present one of my monitors."
|
||||
(interactive)
|
||||
(prelude/start-process
|
||||
:name "display/disable-laptop"
|
||||
:command (string/format "xrandr --output %s --off"
|
||||
display/laptop-monitor)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Keybindings
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(when display/install-kbds?
|
||||
(general-define-key
|
||||
:prefix "<SPC>"
|
||||
:states '(normal)
|
||||
"d0" #'display/disable-laptop
|
||||
"d1" #'display/enable-laptop)
|
||||
(general-define-key
|
||||
:prefix "<SPC>"
|
||||
:states '(normal)
|
||||
"D0" #'display/disable-4k
|
||||
"D1" #'display/enable-4k))
|
||||
|
||||
(provide 'display)
|
||||
;;; display.el ends here
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
;;; do.el --- Small assertion library for Elisp -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; Assertion library inspired by Elixir's core testing library.
|
||||
;;
|
||||
;; The goal here is to create this module without relying on other non-core
|
||||
;; Elisp libraries. I will attempt to do this as long as I'm not sacrificing
|
||||
;; the readability of this code nor the ease at which it can be written.
|
||||
;;
|
||||
;; A note on testing:
|
||||
;; Another goal with this library is to blur the line between testing code and
|
||||
;; runtime code. Developers should ideally be using `do/assert' and `do/refute'
|
||||
;; in their library code. Because of this, I'm avoiding referring
|
||||
;; to the notion of testing in the names of these functions.
|
||||
;;
|
||||
;; Hypothesis:
|
||||
;; The lower the friction is for writing tests, the more likely people will
|
||||
;; write tests.
|
||||
|
||||
;; TODO: Support better error messages, which might include information about
|
||||
;; line numbers in source code where the assertion failed.
|
||||
|
||||
;; TODO: Consider offering the ability to have some of these functions compile
|
||||
;; to nothing at runtime if developers want to use them while developing without
|
||||
;; incurring the costs at runtime.
|
||||
|
||||
;; TODO: Consider using this module instead of prelude.el. Right now, I'm
|
||||
;; having troubling preferring one to the other. The benefit of this module is
|
||||
;; that it's independent of prelude, but that might also be a downside, since
|
||||
;; the messaging that asserting should be a critical part of any core library
|
||||
;; like prelude.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Library
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defmacro do/assert (x)
|
||||
"Errors unless X is t.
|
||||
These are strict assertions and purposely do not rely on truthiness."
|
||||
(let ((as-string (format "%s" x)))
|
||||
`(unless (equal t ,x)
|
||||
(error (concat "Assertion failed: " ,as-string)))))
|
||||
|
||||
(defmacro do/refute (x)
|
||||
"Errors unless X is nil."
|
||||
(let ((as-string (format "%s" x)))
|
||||
`(unless (eq nil ,x)
|
||||
(error (concat "Refutation failed: " ,as-string)))))
|
||||
|
||||
(provide 'do)
|
||||
;;; do.el ends here
|
||||
|
|
@ -1,53 +0,0 @@
|
|||
;;; dotfiles.el --- Elisp to make dotfile management -*- lexical-binding: t -*-
|
||||
;; Author: William Carroll <wpcarro@gmail.com>
|
||||
|
||||
;;; Commentary:
|
||||
;; Quickly edit commonly used files.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Dependencies
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'macros)
|
||||
(require 'f)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defconst dotfiles/install-kbds? t
|
||||
"When t, install the keybindings.")
|
||||
|
||||
(defconst dotfiles/whitelist
|
||||
'(("compton" . "~/.config/compton.conf")
|
||||
("dotfiles" . "~/dotfiles/")
|
||||
("functions" . "~/functions.zsh")
|
||||
("aliases" . "~/aliases.zsh")
|
||||
("variables" . "~/variables.zsh")
|
||||
("Xresources" . "~/.Xresources.shared")
|
||||
("xsession" . "~/.xsessionrc.shared")
|
||||
("tmux" . "~/.tmux.conf")
|
||||
("zshrc" . "~/.zshrc")
|
||||
("config.fish" . "~/.config/fish/config.fish")
|
||||
("configuration.nix" . "~/Dropbox/programming/nixify/configuration.nix")
|
||||
("init.el" . "~/.emacs.d/init.el")
|
||||
("init.vim" . "~/.config/nvim/init.vim"))
|
||||
"Dotfiles that I commonly edit.")
|
||||
|
||||
(defun dotfiles/edit ()
|
||||
"Select a dotfile from ivy and edit it in an Emacs buffer."
|
||||
(interactive)
|
||||
(ivy-read
|
||||
"Dotfile: "
|
||||
dotfiles/whitelist
|
||||
:action (>> cdr find-file)))
|
||||
|
||||
(defun dotfiles/find-emacs-file (name)
|
||||
"Call `find-file' on NAME located in dotfiles's emacs.d directory."
|
||||
(find-file
|
||||
(f-join "~/dotfiles/configs/shared/.emacs.d" name)))
|
||||
|
||||
(provide 'dotfiles)
|
||||
;;; dotfiles.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