summaryrefslogtreecommitdiff
path: root/.config/emacs/site-lisp
diff options
context:
space:
mode:
Diffstat (limited to '.config/emacs/site-lisp')
-rw-r--r--.config/emacs/site-lisp/emmet.el349
-rw-r--r--.config/emacs/site-lisp/gh.el62
-rw-r--r--.config/emacs/site-lisp/grab.el215
-rw-r--r--.config/emacs/site-lisp/highlighter.el128
-rw-r--r--.config/emacs/site-lisp/html-escape.el55
-rw-r--r--.config/emacs/site-lisp/increment.el132
-rw-r--r--.config/emacs/site-lisp/line-selection-mode.el18
-rw-r--r--.config/emacs/site-lisp/live-jq.el101
-rw-r--r--.config/emacs/site-lisp/number-format-mode.el129
-rw-r--r--.config/emacs/site-lisp/surround.el122
10 files changed, 0 insertions, 1311 deletions
diff --git a/.config/emacs/site-lisp/emmet.el b/.config/emacs/site-lisp/emmet.el
deleted file mode 100644
index eefb4ba..0000000
--- a/.config/emacs/site-lisp/emmet.el
+++ /dev/null
@@ -1,349 +0,0 @@
-;;; tree-exp-mode.el --- Minor mode for expanding tree-like syntax -*- lexical-binding: t; -*-
-
-(eval-when-compile
- (require 'cl-macs)
- (require 'tempo))
-
-(defgroup tree-exp nil
- "Customization group for `emmet-mode'."
- :group 'convenience)
-
-(defcustom tree-exp-html-self-closing-style ""
- "Self-closing tag style for HTML.
-This setting specifies how `tree-exp' should generate self-closing tags
-when expanding to HTML. When generating a self-closing tag the value of
-`tree-exp-html-self-closing-style' is inserted verbatim between the end
-of the element attributes and the closing angle-bracket.
-
-Note that the variable of this setting has no bearing on the validity of
-the generated HTML; infact the HTML standard instructs parsers to ignore
-a trailing slash."
- :type '(choice (const :tag "")
- (const :tag "/")
- (const :tag " /"))
- :package-version '(tree-exp . "1.0.0")
- :group 'tree-exp)
-
-(defcustom tree-exp-set-marks t
- "TODO"
- :type 'boolean
- :package-version '(tree-exp . "1.0.0")
- :group 'tree-exp)
-
-(defvar-keymap tree-exp-mode-map
- :doc "TODO")
-
-(defvar tree-exp-expand-functions
- '(((html-mode mhtml-mode html-ts-mode) . tree-exp-expand-html)
- (gsp-ts-mode . tree-exp-expand-gsp))
- "TODO")
-
-(defvar tree-exp-operator-alist-alist
- '(((html-mode mhtml-mode html-ts-mode gsp-ts-mode)
- . ((?+ . sibling)
- (?^ . parent)
- (?> . child)
- (?. . extra)
- (?# . extra)
- (?@ . extra)
- (?* . repeat))))
- "TODO")
-
-(defvar tree-exp-after-expansion-hook nil
- "TODO")
-
-
-;; Private Variables
-
-(defvar-local tree-exp--mark-index 0)
-
-(defconst tree-exp--html-void-elements
- #s(hash-table size 13
- test equal
- purecopy t
- data ("area" t
- "base" t
- "br" t
- "col" t
- "embed" t
- "hr" t
- "img" t
- "input" t
- "link" t
- "meta" t
- "source" t
- "track" t
- "wbr" t)))
-
-
-;; Parsing
-
-(defun tree-exp--pattern-start ()
- (max (save-excursion
- (skip-syntax-backward "^ ")
- (point))
- (pos-bol)))
-
-(defun tree-exp--pattern-bounds ()
- (if (use-region-p)
- (progn
- (when (region-noncontiguous-p)
- (error "Noncontiguous regions are not supported yet."))
- (car (region-bounds)))
- (cons (tree-exp--pattern-start) (point))))
-
-(defun tree-exp--symbol-end (operator-alist)
- (while (and (memq (car (syntax-after (point))) '(2 3))
- (not (assq (char-after (point)) operator-alist)))
- (goto-char (1+ (point))))
- (point))
-
-(defun tree-exp--set-children-of-leaves (tree values)
- (dolist (node tree)
- (if-let ((children (nth 2 node)))
- (tree-exp--set-children-of-leaves children values)
- (setf (nth 2 node) values)))
- tree)
-
-(defun tree-exp--append-extra-to-leaves (tree value)
- (dolist (node tree)
- (if-let ((children (nth 2 node)))
- (tree-exp--append-extra-to-leaves children value)
- (setf
- (nth 1 node)
- (append (nth 1 node) (cons value nil)))))
- tree)
-
-(defun tree-exp--parse-count ()
- (let* ((start (point))
- (end (+ start (skip-chars-forward "0-9")))
- (num (string-to-number
- (buffer-substring-no-properties start end)
- 10)))
- (unless (zerop num)
- num)))
-
-(defun tree-exp--parse-atom (operator-alist)
- (let ((start (point))
- (end (tree-exp--symbol-end operator-alist)))
- (if (= start end)
- (when (= ?\( (char-after end))
- (goto-char (1+ end))
- (let ((tree (tree-exp--parse-expr operator-alist))
- (char (char-after (point))))
- (if (eq ?\) char)
- (progn
- (goto-char (1+ (point)))
- tree)
- (message (if char
- (format "Invalid operator `%c'" char)
- "Missing closing parenthesis"))
- nil)))
- (list (list (buffer-substring-no-properties start end) nil nil)))))
-
-(defun tree-exp--parse-term (operator-alist)
- (let ((terms (tree-exp--parse-atom operator-alist)))
- (catch 'loop
- (while t
- (let* ((operator (assq (char-after (point)) operator-alist))
- (op-char (car-safe operator))
- (op-type (cdr-safe operator))
- start end)
- (unless (eq op-type 'extra)
- (throw 'loop terms))
- (setq
- start (goto-char (1+ (point)))
- end (tree-exp--symbol-end operator-alist))
- (when (= start end)
- (message "Operator `%c' missing right-hand side" op-char)
- (throw 'loop nil))
- (tree-exp--append-extra-to-leaves
- terms (cons op-char (buffer-substring-no-properties start end))))))))
-
-;; Gross hack
-(defun tree-exp--parse-expr-with-lhs (operator-alist lhs)
- (let* ((op-char (char-after (point)))
- (op-type (alist-get op-char operator-alist))
- rhs)
- (cond
- ((not lhs)
- nil)
- ((or (not op-char)
- (not op-type))
- lhs)
- (t
- (goto-char (1+ (point)))
- (setq rhs (if (eq op-type 'repeat)
- (tree-exp--parse-count)
- (tree-exp--parse-expr operator-alist)))
- (when rhs
- (pcase op-type
- ('child (tree-exp--set-children-of-leaves lhs rhs))
- ('parent (tree-exp--set-children-of-leaves rhs lhs))
- ('sibling (append lhs rhs))
- ('repeat (tree-exp--parse-expr-with-lhs
- operator-alist
- ;; FIXME: We need to call ‘copy-tree’ or else the
- ;; generated AST has cycles in it… why is that? How
- ;; can we fix it?
- (cl-loop for _ from 1 to rhs append (copy-tree lhs))))))))))
-
-(defun tree-exp--parse-expr (operator-alist)
- (tree-exp--parse-expr-with-lhs
- operator-alist
- (tree-exp--parse-term operator-alist)))
-
-(defun tree-exp--build-ast (bounds)
- (save-excursion
- (with-restriction (car bounds) (cdr bounds)
- (goto-char 1)
- (when-let* ((operator-alist (tree-exp--alist-get
- major-mode tree-exp-operator-alist-alist))
- (tree (tree-exp--parse-expr operator-alist)))
- (if (= (point) (point-max))
- tree
- (message "Superfluous character `%c'" (char-after (point)))
- nil)))))
-
-
-;; Expansion
-
-(defun tree-exp--alist-get (key alist)
- (cdr (or (assq key alist)
- (catch 'tree-exp--break
- (dolist (pair alist)
- (when (and (listp (car pair))
- (memq key (car pair)))
- (throw 'tree-exp--break pair)))))))
-
-(defun tree-exp--ast-siblings-p (ast)
- (cond ((not ast) nil)
- ((length> ast 1) t)
- (t (tree-exp--ast-siblings-p (caddar ast)))))
-
-(defun tree-exp-expand-html--format-attr (attr)
- (declare ((pure t) (side-effect-free t)))
- (let* ((parts (string-split attr "="))
- (name (car parts))
- (value-parts (cdr parts)))
- (if value-parts
- (format "%s=\"%s\"" name (string-join value-parts "="))
- name)))
-
-(defun tree-exp-expand-html--helper (ast indentp)
- (dolist (node ast)
- (let* ((name (nth 0 node))
- (attrs (nth 1 node))
- (children (nth 2 node))
- (classes (cl-loop for (op . attr) in attrs
- if (= ?. op)
- collect attr)))
- (insert (format "<%s" name))
- (when classes
- (insert (format " class=\"%s\"" (string-join classes " "))))
- (cl-loop for (op . attr) in attrs
- if (= ?# op)
- do (insert (format " id=\"%s\"" attr))
- else if (= ?@ op)
- do (thread-last
- attr
- (tree-exp-expand-html--format-attr)
- (concat " ")
- (insert)))
- (if (and (not children)
- (gethash name tree-exp--html-void-elements))
- (insert (format "%s>" tree-exp-html-self-closing-style))
- (insert ?>)
- (if children
- (progn
- (when indentp
- (insert ?\n))
- (tree-exp-expand-html--helper children indentp))
- (when tree-exp-set-marks
- (insert #x1B)))
- (insert (format "</%s>" name))))
- (when indentp
- (insert ?\n))))
-
-(defun tree-exp-expand-html (ast)
- "TODO"
- (tree-exp-expand-html--helper ast (tree-exp--ast-siblings-p ast))
- (when (= ?\n (char-before (point-max)))
- (delete-region (1- (point-max)) (point-max)))
- (when tree-exp-set-marks
- (insert #x1B)))
-
-;; (defun tree-exp-expand-gsp--helper (ast indentp)
-;; (dolist (node ast)
-;; (let ((name (nth 0 node))
-;; (attrs (nth 1 node))
-;; (children (nth 2 node)))
-
-
-;; ;; (insert (format "<%s" name))
-;; ;; (dolist (attr attrs)
-;; ;; (insert (format " %s" (cdr attr))))
-;; ;; (if (and (not children)
-;; ;; (gethash name tree-exp--html-void-elements))
-;; ;; (insert (format "%s>" tree-exp-html-self-closing-style))
-;; ;; (insert ?>)
-;; ;; (if children
-;; ;; (progn
-;; ;; (when indentp
-;; ;; (insert ?\n))
-;; ;; (tree-exp-expand-html--helper children indentp))
-;; ;; (when tree-exp-set-marks
-;; ;; (insert #x1B)))
-;; ;; (insert (format "</%s>" name)))
-;; )
-;; (when indentp
-;; (insert ?\n))))
-
-(defun tree-exp-expand-gsp (ast)
- "TODO"
- (tree-exp-expand-gsp--helper ast (tree-exp--ast-siblings-p ast))
- (when (= ?\n (char-before (point-max)))
- (delete-region (1- (point-max)) (point-max)))
- (when tree-exp-set-marks
- (insert #x1B)))
-
-;;;###autoload
-(defun tree-exp-expand ()
- "TODO"
- (interactive)
- (when-let* ((current-buffer (current-buffer))
- (bounds (tree-exp--pattern-bounds))
- (ast (tree-exp--build-ast bounds))
- (expander (tree-exp--alist-get
- major-mode tree-exp-expand-functions)))
- (delete-region (car bounds) (cdr bounds))
- (with-temp-buffer
- (funcall expander ast)
- (insert-into-buffer current-buffer))
- (let ((start-pos (car bounds))
- (end-pos (point-marker))
- (delete-active-region nil) ; For ‘delete-backward-char’
- marks)
- (when tree-exp-set-marks
- (save-excursion
- (goto-char start-pos)
- (while (search-forward "\x1B" end-pos :noerror)
- (delete-backward-char 1)
- (push (point-marker) marks)))
- (push (point-marker) marks)
- (setq marks (nreverse marks))
- (goto-char (car marks))
- (mapc #'tempo-insert-mark marks))
- ;; Set the start of the region to the start bound
- (unless (region-active-p)
- (set-mark start-pos))
- (indent-region start-pos end-pos)
- (run-hooks tree-exp-after-expansion-hook))))
-
-;;;###autoload
-(define-minor-mode tree-exp-mode
- "TODO"
- :lighter " Tree-Expand"
- :keymap tree-exp-mode-map)
-
-(provide 'tree-exp)
diff --git a/.config/emacs/site-lisp/gh.el b/.config/emacs/site-lisp/gh.el
deleted file mode 100644
index 39dc339..0000000
--- a/.config/emacs/site-lisp/gh.el
+++ /dev/null
@@ -1,62 +0,0 @@
-;;; gh.el --- GitHub integration for Emacs -*- lexical-binding: t; -*-
-
-(defun gh-get-labels ()
- "Return a list of labels in the current GitHub repository."
- (with-temp-buffer
- (call-process "gh" nil t nil "label" "list"
- "--sort" "name" "--json" "name" "--limit" "1000000")
- (goto-char (point-min))
- (seq-map (lambda (x) (gethash "name" x))
- (json-parse-buffer))))
-
-;; TODO: Set title and body in a buffer like Magit
-(defun gh-create-pr (title &optional labels draftp)
- "Create a GitHub pull request.
-If DRAFTP is non-nil, the PR will be created as a draft.
-
-LABELS is a list of labels. A list of available labels can be fetched
-via `gh-get-labels'."
- (interactive
- (list
- (read-string (format-prompt "PR Title" nil))
- (completing-read-multiple (format-prompt "PR Labels" nil)
- (gh-get-labels))
- (y-or-n-p "Create PR as a draft? ")))
- (let* ((project (project-name (project-current)))
- (flags `("--fill-verbose" "--assignee" "@me"))
- (label-string (mapconcat #'identity labels ",")))
- ;; TODO: Remove this
- (when (string= project "blixem")
- (setq title (format "%s %s" (car (vc-git-branches)) title))
- (when (member "Patch" labels)
- (setq flags (append flags '("--base" "release")))))
- (setq flags (append flags `("--title" ,title)))
- (when draftp
- (setq flags (append flags '("--draft"))))
- (when labels
- (setq flags (append flags `("--label" ,label-string))))
- (with-temp-buffer
- (apply #'call-process "gh" nil t nil "pr" "create" flags)
- (message (buffer-string)))))
-
-(defvar gh-pr-regexp
- "\\`https://\\(?:www\\.\\)?github\\.com/[^/]+/[^/]+/pull/[[:digit:]]+\\'")
-
-(defun gh--pr-link-p (s)
- (declare (pure t) (side-effect-free t))
- (string-match-p gh-pr-regexp s))
-
-(defun gh-open-previous-pr ()
- "Open the previous GitHub pull request.
-Opens the previous pull request created by `gh-create-pr' by searching
-for the echoed URL in the `*Messages*' buffer."
- (interactive)
- (with-current-buffer "*Messages*"
- (goto-char (point-max))
- (while (not (gh--pr-link-p (buffer-substring-no-properties
- (pos-bol) (pos-eol))))
- (unless (line-move -1 :noerror)
- (user-error "No previous pull request found.")))
- (browse-url-at-point)))
-
-(provide 'gh)
diff --git a/.config/emacs/site-lisp/grab.el b/.config/emacs/site-lisp/grab.el
deleted file mode 100644
index 2482d5d..0000000
--- a/.config/emacs/site-lisp/grab.el
+++ /dev/null
@@ -1,215 +0,0 @@
-;;; grab.el --- Emacs integration for grab -*- lexical-binding: t; -*-
-
-;; Author: Thomas Voss <mail@thomasvoss.com>
-;; Description: TODO
-;; Keywords: matching, tools
-
-;;; Commentary:
-
-;; TODO
-
-;;; Code:
-
-(require 'ansi-color)
-(require 'dired)
-(require 'project)
-(require 'rx)
-(require 'xref)
-
-(defgroup grab nil
- "Settings for `grab'."
- :group 'tools)
-
-(defcustom grab-command "grab"
- "The base executable for the Grab tool."
- :type 'string)
-
-(defcustom git-grab-command "git-grab"
- "The base executable for the Git Grab tool."
- :type 'string)
-
-(defcustom grab-command-arguments '("-c" "-Hmulti")
- "Arguments to pass to `grab-command'."
- :type '(repeat string))
-
-(defcustom git-grab-command-arguments grab-command-arguments
- "Arguments to pass to `git-grab-command'."
- :type '(repeat string))
-
-(defcustom grab-default-pattern '("x// h//" . 3)
- "The default pattern in Grab prompts"
- :type '(choice (cons string natnum)
- (string)))
-
-(defvar grab-history nil
- "Minibuffer history for Grab search patterns.")
-
-
-;;; Xref Location Class
-
-(cl-defstruct grab-location
- "A location in a file specified by a byte offset."
- file offset)
-
-(cl-defmethod xref-location-marker ((loc grab-location))
- "Return a marker for the grab location LOC."
- (let* ((file (grab-location-file loc))
- (offset (grab-location-offset loc))
- (buf (find-file-noselect file)))
- (with-current-buffer buf
- (save-restriction
- (widen)
- (goto-char (byte-to-position (1+ offset)))
- (point-marker)))))
-
-(cl-defmethod xref-location-group ((loc grab-location))
- "Group matches by their file name in the xref buffer."
- (grab-location-file loc))
-
-(cl-defmethod xref-location-line ((loc grab-location))
- "Return the position of the match.
-
-`xref' internally performs a log on this value, so we need to handle the
-0 case."
- (max 1 (grab-location-offset loc)))
-
-
-;;; Process Management & Parsing
-
-(defvar grab--header-regexp
- (rx-let ((ansi-escape (seq "\e[" (* (any "0-9;")) "m"))
- (highlighted (thing)
- (seq (* ansi-escape)
- thing
- (* ansi-escape))))
- (rx line-start
- (highlighted (group (+ (not (any ?: ?\e ?\n)))))
- (highlighted ?:)
- (highlighted (group (+ digit)))
- (highlighted ?:)))
- "Regular expression matching the grab output header.")
-
-(defun grab--format-summary (summary)
- (let* ((summary (ansi-color-apply (string-trim-right summary)))
- (pos 0)
- (len (length summary)))
- (while (< pos len)
- (let ((next (next-property-change pos summary len)))
- (when (or (get-text-property pos 'font-lock-face summary)
- (get-text-property pos 'face summary))
- (put-text-property pos next 'font-lock-face 'xref-match summary)
- (remove-list-of-text-properties pos next '(face) summary))
- (setq pos next)))
- summary))
-
-(defun grab--parse-output (dir)
- (let (xrefs file offset match-start)
- (goto-char (point-min))
- (while (re-search-forward grab--header-regexp nil :noerror)
- (let ((next-file (match-string-no-properties 1))
- (next-offset (string-to-number (match-string-no-properties 2)))
- (next-start (point)))
- (when file
- (let* ((summary (buffer-substring-no-properties
- match-start (match-beginning 0)))
- (summary (grab--format-summary summary))
- (full-path (expand-file-name file dir))
- (loc (make-grab-location :file full-path :offset offset)))
- (push (xref-make summary loc) xrefs)))
- (setq file next-file
- offset next-offset
- match-start next-start)))
- (when file
- (let* ((summary (buffer-substring-no-properties
- match-start (point-max)))
- (summary (grab--format-summary summary))
- (full-path (expand-file-name file dir))
- (loc (make-grab-location :file full-path :offset offset)))
- (push (xref-make summary loc) xrefs)))
- (unless xrefs
- (user-error "No matches found for grab pattern"))
- (nreverse xrefs)))
-
-(defun grab--directory (cmd args pattern dir)
- (grab--files cmd args pattern dir
- (directory-files-recursively dir "." nil t)))
-
-(defun grab--files (cmd args pattern dir files)
- (lambda ()
- (let ((default-directory dir))
- (with-temp-buffer
- (apply #'call-process cmd nil t nil
- (flatten-tree (list args "--" pattern files)))
- (grab--parse-output dir)))))
-
-(defun grab--read-pattern ()
- (read-string (format-prompt "Grab Pattern" nil)
- grab-default-pattern
- 'grab-history))
-
-
-;;; Interactive Commands
-
-;;;###autoload
-(defun grab (pattern)
- "Run grab with PATTERN in the current directory."
- (interactive (list (grab--read-pattern)))
- (xref-show-xrefs
- (grab--directory grab-command
- grab-command-arguments
- pattern
- default-directory)
- nil))
-
-;;;###autoload
-(defun git-grab (pattern)
- "Run git grab with PATTERN in the current directory."
- (interactive (list (grab--read-pattern)))
- (xref-show-xrefs
- (grab--files git-grab-command
- git-grab-command-arguments
- pattern
- default-directory
- nil)
- nil))
-
-;;;###autoload
-(defun project-grab (pattern)
- "Run grab with PATTERN at the project root."
- (interactive (list (grab--read-pattern)))
- (let* ((project (project-current t))
- (default-directory (project-root project)))
- (xref-show-xrefs
- (grab--directory grab-command
- grab-command-arguments
- pattern
- default-directory)
- nil)))
-
-;;;###autoload
-(defun project-git-grab (pattern)
- "Run git grab with PATTERN at the project root."
- (interactive (list (grab--read-pattern)))
- (let* ((project (project-current t))
- (default-directory (project-root project)))
- (xref-show-xrefs
- (grab--files git-grab-command
- git-grab-command-arguments
- pattern
- default-directory
- nil)
- nil)))
-
-;;;###autoload
-(defun dired-grab-marked-files (pattern)
- "TODO"
- (interactive (list (grab--read-pattern)))
- (let* ((project (project-current t))
- (default-directory (project-root project)))
- (xref-show-xrefs
- (grab--files grab-command grab-command-arguments pattern
- default-directory (dired-get-marked-files))
- nil)))
-
-(provide 'grab)
-;;; grab.el ends here
diff --git a/.config/emacs/site-lisp/highlighter.el b/.config/emacs/site-lisp/highlighter.el
deleted file mode 100644
index ce67ac8..0000000
--- a/.config/emacs/site-lisp/highlighter.el
+++ /dev/null
@@ -1,128 +0,0 @@
-;;; highlighter.el --- In-buffer highlighting commands -*- lexical-binding: t; -*-
-
-(require 'seq)
-
-(defgroup highlighter nil
- "Customization group for `highlighter'."
- :group 'convenience)
-
-(defcustom highlighter-default-face 'match
- "The default face used by `highlighter-mark'."
- :type 'face
- :package-version '(highlighter . "1.0.0")
- :group 'highlighter)
-
-(defun highlighter-mark (arg)
- "Highlight text in the buffer.
-Highlight the current line or region if it is active. Text is
-highlighted using the face specified by `highlighter-default-face'.
-
-With ARG, interactively pick a face to highlight with."
- (declare (interactive-only t))
- (interactive "P")
- (let ((bounds (if (use-region-p)
- (region-bounds)
- `((,(pos-bol) . ,(pos-eol)))))
- (face (when arg
- (highlighter--read-face-name "Highlight with face" #'facep))))
- (highlighter-mark-region bounds face))
- (when (region-active-p)
- (deactivate-mark)))
-
-(defun highlighter-unmark (arg)
- "Remove highlights in the buffer.
-
-Remove highlights from the current line or region if it is active.
-
-With ARG, interactively pick a face. Only highlights using the chosen
-face will be removed."
- (declare (interactive-only t))
- (interactive "P")
- (let ((bounds (if (use-region-p)
- (region-bounds)
- `((,(pos-bol) . ,(pos-eol)))))
- (face (when arg
- (highlighter--read-face-name
- "Clear highlights using face"
- #'highlighter--used-face-p))))
- (highlighter-unmark-region bounds face))
- (when (region-active-p)
- (deactivate-mark)))
-
-(defun highlighter-mark-region (bounds &optional face)
- "Highlight text in the buffer within BOUNDS.
-BOUNDS uses the same format as returned by `region-bounds'.
-
-Text is highlighted using the face specified by `highlighter-default-face'.
-
-If FACE is nil or omitted, `highlighter-default-face' is used."
- (dolist (x bounds) (highlighter--mark-region (car x) (cdr x) face)))
-
-(defun highlighter-unmark-region (bounds &optional face)
- "Remove highlights in the buffer within BOUNDS.
-BOUNDS uses the same format as returned by `region-bounds'.
-
-If FACE is non-nil, only remove highlights using FACE."
- (dolist (x bounds) (highlighter--unmark-region (car x) (cdr x) face)))
-
-(defun highlighter--mark-region (beg end &optional face)
- (let ((ov (make-overlay beg end nil :front-advance))
- (face (or face highlighter-default-face 'match)))
- (overlay-put ov 'priority 1)
- (overlay-put ov 'face face)
- (overlay-put ov 'evaporate t)
- (overlay-put ov 'highlighter--mark-p t)
- (overlay-put ov 'highlighter--face face)))
-
-(defun highlighter--unmark-region (beg end &optional face)
- (if face
- (remove-overlays beg end 'highlighter--face face)
- (remove-overlays beg end 'highlighter--mark-p t)))
-
-(defun highlighter-unmark-buffer (arg)
- "Remove highlights in the buffer.
-
-With ARG, interactively pick a face. Only highlights using the chosen
-face will be removed."
- (declare (interactive-only t))
- (interactive "P")
- (let ((face (when arg
- (highlighter--read-face-name
- "Clear highlights using face"
- #'highlighter--used-face-p))))
- (highlighter--unmark-region (point-min) (point-max) face)))
-
-(defun highlighter--read-face-name (prompt face-predicate)
- (let (default defaults)
- (let ((prompt (format "%s: " prompt))
- (completion-extra-properties
- `(:affixation-function
- ,(lambda (faces)
- (mapcar
- (lambda (face)
- (list face
- (concat (propertize read-face-name-sample-text
- 'face face)
- "\t")
- ""))
- faces))))
- aliasfaces nonaliasfaces faces)
- ;; Build up the completion tables.
- (mapatoms (lambda (s)
- (when (apply face-predicate s nil)
- (if (get s 'face-alias)
- (push (symbol-name s) aliasfaces)
- (push (symbol-name s) nonaliasfaces)))))
- (let ((face (completing-read
- prompt
- (completion-table-in-turn nonaliasfaces aliasfaces)
- nil t nil 'face-name-history defaults)))
- (when (facep face) (if (stringp face)
- (intern face)
- face))))))
-
-(defun highlighter--used-face-p (face)
- (seq-filter (lambda (ov) (eq face (overlay-get ov 'highlighter--face)))
- (overlays-in (point-min) (point-max))))
-
-(provide 'highlighter)
diff --git a/.config/emacs/site-lisp/html-escape.el b/.config/emacs/site-lisp/html-escape.el
deleted file mode 100644
index afdbb4d..0000000
--- a/.config/emacs/site-lisp/html-escape.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; html-escape.el --- HTML escaping functions -*- lexical-binding: t; -*-
-
-(defgroup html-escape nil
- "Customization group for `html-escape'."
- :group 'convenience)
-
-(defvar html-escape-table
- (let ((table (make-hash-table :test #'eq)))
- (puthash ?& "&amp;" table)
- (puthash ?< "&lt;" table)
- (puthash ?> "&gt;" table)
- (puthash ?\" "&quot;" table)
- (puthash ?' "&#39;" table)
- table)
- "Hash table mapping character codes to their HTML entity equivalents.")
-
-;;;###autoload
-(defun html-escape ()
- "HTML escape text in the current buffer.
-
-Perform HTML escaping on the text in the current buffer. If the region
-is active then only escape the contents of the active region."
- (declare (interactive-only t))
- (interactive)
- (if (use-region-p)
- (html-escape-region (region-bounds))
- (html-escape-region-1 (pos-bol) (pos-eol)))
- (when (region-active-p)
- (deactivate-mark)))
-
-(defun html-escape-region (bounds)
- "HTML escape text in the current buffer within BOUNDS.
-
-BOUNDS takes the same form as the return value of `region-bounds'. This
-function is prefered as it supports noncontiguous regions, but there also
-exists `html-escape-region-1' with a simpler bounds interface."
- (dolist (x bounds) (html-escape-region-1 (car x) (cdr x))))
-
-(defun html-escape-region-1 (beg end)
- "HTML escape text in the current buffer within BEG and END.
-
-This function is the same as the prefered `html-escape-region', but takes
-BEG and END parameters instead of a BOUNDS parameter. For noncontiguous
-region support use `html-escape-region'."
- (save-restriction
- (narrow-to-region beg end)
- (save-excursion
- (goto-char (point-min))
- (save-match-data
- (while (re-search-forward "[&<>\"']" nil :noerror)
- (let* ((char (char-after (match-beginning 0)))
- (replacement (gethash char html-escape-table)))
- (replace-match replacement)))))))
-
-(provide 'html-escape)
diff --git a/.config/emacs/site-lisp/increment.el b/.config/emacs/site-lisp/increment.el
deleted file mode 100644
index b5bea53..0000000
--- a/.config/emacs/site-lisp/increment.el
+++ /dev/null
@@ -1,132 +0,0 @@
-;;; increment.el -- Increment numbers at point -*- lexical-binding: t; -*-
-
-(require 'cl-macs)
-(require 'rx)
-
-(defvar increment--binary-number-regexp
- (rx (group (or ?- word-start))
- "0b"
- (group (* ?0))
- (group (+ (any "01")))
- word-end))
-
-(defvar increment--octal-number-regexp
- (rx (group (or ?- word-start))
- "0o"
- (group (* ?0))
- (group (+ (any "0-7")))
- word-end))
-
-(defvar increment--decimal-number-regexp
- (rx (group (? ?-))
- (group (* ?0))
- (group (+ (any digit)))))
-
-(defvar increment--hexadecimal-number-regexp
- (rx (group (or ?- word-start))
- "0x"
- (group (* ?0))
- (group (+ (any hex-digit)))
- word-end))
-
-(defvar increment--hexadecimal-lower-number-regexp
- (rx (group (or ?- word-start))
- "0o"
- (group (* ?0))
- (group (+ (any "0-9a-f")))
- word-end))
-
-(defvar increment--number-regexp
- (rx (or (seq (or ?- word-start)
- (or (seq "0b" (+ (any "01")))
- (seq "0o" (+ (any "0-7")))
- (seq "0x" (+ (any hex-digit))))
- word-end)
- (seq (? ?-) (+ (any digit))))))
-
-(defun increment--number-to-binary-string (number)
- (nreverse
- (cl-loop for x = number then (ash x -1)
- while (not (= x 0))
- concat (if (= 0 (logand x 1)) "0" "1"))))
-
-(defun increment--format-number-with-base
- (number base leading-zeros buffer-substr hex-style)
- (let* ((neg (> 0 number))
- (number (abs number))
- (number-string
- (pcase base
- (2 (increment--number-to-binary-string number))
- (8 (format "%o" number))
- (10 (number-to-string number))
- (16 (format (if (eq hex-style 'lower) "%x" "%X") number))))
- (length-diff (- (length buffer-substr)
- (length number-string)))
- (leading-zeros (if (> leading-zeros 0)
- (+ leading-zeros length-diff)
- 0)))
- (concat
- (when neg
- "-")
- (pcase base
- (2 "0b")
- (8 "0o")
- (16 "0x"))
- (when (> leading-zeros 0)
- (make-string leading-zeros ?0))
- number-string)))
-
-(defun increment--match-number-at-point ()
- (cond ((thing-at-point-looking-at
- increment--binary-number-regexp)
- (cons 2 nil))
- ((thing-at-point-looking-at
- increment--octal-number-regexp)
- (cons 8 nil))
- ((thing-at-point-looking-at
- increment--hexadecimal-number-regexp)
- (cons 16 nil))
- ((thing-at-point-looking-at
- increment--hexadecimal-lower-number-regexp)
- (cons 16 'lower))
- ((thing-at-point-looking-at
- increment--decimal-number-regexp)
- (cons 10 nil))))
-
-;;;###autoload
-(cl-defun increment-number-at-point (&optional arg)
- "Increment the number at point by ARG or 1 if ARG is nil. If called
-interactively, the universal argument can be used to specify ARG. If
-the number at point has leading zeros then the width of the number is
-preserved."
- (interactive "*p")
- (save-match-data
- (let (case-fold-search
- (match-pair (increment--match-number-at-point)))
- (unless match-pair
- (let ((save-point (point)))
- (unless (re-search-forward
- increment--number-regexp
- (line-end-position) :noerror)
- (goto-char save-point)
- (cl-return-from increment-number-at-point))
- (setq match-pair (increment--match-number-at-point))))
- (let* ((base (car match-pair))
- (hex-style (cdr match-pair))
- (substr (buffer-substring-no-properties
- (match-beginning 3) (match-end 3)))
- (sign (if (= (match-beginning 1) (match-end 1)) +1 -1))
- (result (+ (* (string-to-number substr base) sign)
- (or arg 1))))
- (replace-match
- (increment--format-number-with-base
- result base (- (match-end 2) (match-beginning 2))
- substr hex-style))))))
-
-;;;###autoload
-(defun decrement-number-at-point (&optional arg)
- "The same as `increment-number-at-point', but ARG is negated."
- (interactive "*p")
- (increment-number-at-point (- (or arg 1))))
-
-(provide 'increment)
diff --git a/.config/emacs/site-lisp/line-selection-mode.el b/.config/emacs/site-lisp/line-selection-mode.el
deleted file mode 100644
index 83da013..0000000
--- a/.config/emacs/site-lisp/line-selection-mode.el
+++ /dev/null
@@ -1,18 +0,0 @@
-;;; line-selection-mode.el --- Minor mode for selection by lines -*- lexical-binding: t; -*-
-
-(defvar-local line-selection-mode--cursor-type nil)
-
-;;;###autoload
-(define-minor-mode line-selection-mode
- "Enable `hl-line-mode' and hide the current cursor."
- :global nil
- :init-value nil
- (if line-selection-mode
- (progn
- (hl-line-mode)
- (setq line-selection-mode--cursor-type cursor-type)
- (setq-local cursor-type nil))
- (hl-line-mode -1)
- (setq-local cursor-type line-selection-mode--cursor-type)))
-
-(provide 'line-selection-mode)
diff --git a/.config/emacs/site-lisp/live-jq.el b/.config/emacs/site-lisp/live-jq.el
deleted file mode 100644
index f8a0a7f..0000000
--- a/.config/emacs/site-lisp/live-jq.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;; TODO: ‘defcustom’ this
-(defvar live-jq-major-mode
- (cond ((fboundp #'json-ts-mode) #'json-ts-mode)
- ((fboundp #'json-mode) #'json-mode))
- "TODO")
-
-(defvar live-jq--input-buffer nil
- "The buffer containing the original JSON data.")
-
-(defvar live-jq--preview-buffer "*JQ Preview*"
- "The buffer showing the live jq results.")
-
-(defvar live-jq--last-query "")
-
-(defun live-jq--get-json-input ()
- "Return the contents of the input buffer as a string."
- (with-current-buffer live-jq--input-buffer
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defun live-jq--run-jq (query)
- "Run jq QUERY on the input buffer's content and return result string or nil on error."
- (let ((json-input (live-jq--get-json-input)))
- (with-temp-buffer
- (insert json-input)
- (let ((exit-code (call-process-region
- (point-min) (point-max)
- "jq" :delete t nil "--tab" query)))
- (when (zerop exit-code)
- (buffer-string))))))
-
-(defun live-jq--render-jq-preview (query)
- "Update preview buffer with the result or error of jq QUERY."
- (let* ((preview-buffer (get-buffer-create live-jq--preview-buffer))
- (json-input (live-jq--get-json-input))
- (inhibit-read-only t))
- (with-current-buffer preview-buffer
- (erase-buffer)
- (condition-case err
- (with-temp-buffer
- (insert json-input)
- (let ((exit-code (call-process-region
- (point-min) (point-max)
- "jq" nil preview-buffer nil "--tab" query)))
- (when (not (zerop exit-code))
- (erase-buffer)
- (insert "%s\n%s"
- (propertize (format "jq error (exit %d): %s" exit-code query)
- 'face 'error)
- json-input))))
- (error
- (insert "%s\n%s"
- (propertize (format "Error: %s" err) 'face 'error)
- input-json)))
- (goto-char (point-min))
- (when live-jq-major-mode
- (funcall live-jq-major-mode))))
- (display-buffer live-jq--preview-buffer))
-
-(defun live-jq--minibuffer-update ()
- "Update preview as user types."
- (let ((query (minibuffer-contents)))
- (unless (equal query live-jq--last-query)
- (setq live-jq--last-query query)
- (live-jq--render-jq-preview query))))
-
-;;;###autoload
-(defun live-jq ()
- "Prompt for a jq query, show live results, and replace buffer on confirmation."
- (interactive)
- (unless (executable-find "jq")
- (user-error "`jq' not found in PATH."))
-
- (setq live-jq--input-buffer (current-buffer))
- (setq live-jq--last-query "")
-
- ;; Clean up preview buffer if user cancels with C-g
- (let ((minibuffer-setup-hook
- (list (lambda ()
- ;; Add post-command-hook for live preview
- (add-hook 'post-command-hook #'live-jq--minibuffer-update nil t)
- ;; Add abort cleanup
- (add-hook 'minibuffer-exit-hook
- (lambda ()
- (when (get-buffer live-jq--preview-buffer)
- (kill-buffer live-jq--preview-buffer)))
- nil t)))))
- (let ((query (read-from-minibuffer (format-prompt "Query" nil))))
- (unwind-protect
- (let ((result (live-jq--run-jq query)))
- (if result
- (with-current-buffer live-jq--input-buffer
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert result))
- (message "jq applied."))
- (user-error "Invalid jq query: see *jq-preview* for details")))
- ;; Cleanup preview buffer after any outcome
- (when (get-buffer live-jq--preview-buffer)
- (kill-buffer live-jq--preview-buffer))))))
-
-(provide 'live-jq)
diff --git a/.config/emacs/site-lisp/number-format-mode.el b/.config/emacs/site-lisp/number-format-mode.el
deleted file mode 100644
index cbc5937..0000000
--- a/.config/emacs/site-lisp/number-format-mode.el
+++ /dev/null
@@ -1,129 +0,0 @@
-;;; number-format-mode.el --- Format numbers in the current buffer -*- lexical-binding: t; -*-
-
-(eval-when-compile
- (require 'cl-macs)
- (require 'seq))
-
-(defgroup number-format nil
- "Customization group for `number-format'."
- :group 'convenience) ; TODO: Is this the right group?
-
-(defcustom number-format-separator "."
- "Thousands separator to use in numeric literals."
- :type 'string
- :package-version '(number-format-mode . "1.0.0")
- :group 'number-format)
-
-(defcustom number-format-predicate nil
- "Function determining if a number should be formatted.
-When formatting a number, this function is called with the START and END
-range of the number in the buffer. If this function returns non-nil the
-number is formatted.
-
-If this function is nil then all numbers are formatted."
- :type 'function
- :package-version '(number-format-mode . "1.0.0")
- :group 'number-format)
-
-(defvar-local number-format--overlays (make-hash-table :test 'eq))
-(defconst number-format--regexp "\\b[0-9]\\{4,\\}\\b")
-
-(defun number-format--add-separators (s)
- (while (string-match "\\(.*[0-9]\\)\\([0-9][0-9][0-9].*\\)" s)
- (setq s (concat (match-string 1 s)
- number-format-separator
- (match-string 2 s))))
- s)
-
-(defun number-format--adjust-overlays (ov _1 beg end &optional _2)
- (let* ((ov-beg (overlay-start ov))
- (ov-end (overlay-end ov))
- (overlays (overlays-in ov-beg ov-end)))
- (mapcar #'delete-overlay (gethash ov number-format--overlays))
- (save-excursion
- (goto-char ov-beg)
- (if (looking-at number-format--regexp :inhibit-modify)
- (puthash ov (number-format--at-range ov-beg ov-end)
- number-format--overlays)
- (delete-overlay ov)
- (remhash ov number-format--overlays)))))
-
-(defun number-format--at-range (beg end)
- (when (or (null number-format-predicate)
- (funcall number-format-predicate beg end))
- (let* ((offsets [3 1 2])
- (len (- end beg))
- (off (aref offsets (mod len 3))))
- (goto-char (+ beg off)))
- (let (overlays)
- (while (< (point) end)
- (let* ((group-end (+ (point) 3))
- (ov (make-overlay (point) group-end)))
- (overlay-put ov 'before-string ".")
- (overlay-put ov 'evaporate t)
- (push ov overlays)
- (goto-char group-end)))
- overlays)))
-
-(defun number-format--jit-lock (beg end)
- (let ((line-beg (save-excursion (goto-char beg) (line-beginning-position)))
- (line-end (save-excursion (goto-char end) (line-end-position))))
- (number-unformat-region line-beg line-end)
- (number-format-region line-beg line-end)))
-
-;;;###autoload
-(defun number-format-region (beg end)
- "Format numbers between BEG and END.
-When called interactively, format numbers in the active region."
- (interactive "r")
- (save-excursion
- (goto-char beg)
- (save-restriction
- (narrow-to-region beg end)
- (number-unformat-region beg end)
- (while (re-search-forward number-format--regexp nil :noerror)
- (save-excursion
- (cl-destructuring-bind (beg end) (match-data)
- (let ((ov (make-overlay beg end nil nil :rear-advance)))
- (overlay-put ov 'evaporate t)
- (dolist (sym '(insert-behind-hooks
- insert-in-front-hooks
- modification-hooks))
- (overlay-put ov sym '(number-format--adjust-overlays)))
- (puthash ov (number-format--at-range beg end)
- number-format--overlays))))))))
-
-;;;###autoload
-(defun number-unformat-region (beg end)
- "Unformat numbers between BEG and END.
-When called interactively, unformat numbers in the active region."
- (interactive "r")
- (dolist (ov (overlays-in beg end))
- (when-let ((overlays (gethash ov number-format--overlays)))
- (mapcar #'delete-overlay overlays)
- (remhash ov number-format--overlays)
- (delete-overlay ov))))
-
-;;;###autoload
-(defun number-format-buffer ()
- "Format numbers in the current buffer."
- (interactive)
- (number-format-region (point-min) (point-max)))
-
-;;;###autoload
-(defun number-unformat-buffer ()
- "Unformat numbers in the current buffer."
- (interactive)
- (number-unformat-region (point-min) (point-max)))
-
-;;;###autoload
-(define-minor-mode number-format-mode
- "TODO"
- :lighter " Number-Format"
- :group 'number-format
- (number-unformat-buffer)
- (if number-format-mode
- (jit-lock-register #'number-format--jit-lock)
- (jit-lock-unregister #'number-format--jit-lock)))
-
-(provide 'number-format) \ No newline at end of file
diff --git a/.config/emacs/site-lisp/surround.el b/.config/emacs/site-lisp/surround.el
deleted file mode 100644
index b5f679d..0000000
--- a/.config/emacs/site-lisp/surround.el
+++ /dev/null
@@ -1,122 +0,0 @@
-;;; surround.el --- Surround a region with delimeters -*- lexical-binding: t; -*-
-
-(require 'cl-macs)
-
-(defgroup surround nil
- "Customization group for `surround'."
- :group 'convenience)
-
-(defcustom surround-with-paired-bracket-p t
- "Surround text with paired brackets.
-If non-nil surrounding text with a character (assuming that character is
-not configured in `surround-pairs-alist') will attempt to surround the
-text with the supplied character and its paired bracket.
-
-As an example, if `surround-with-paired-bracket-p' is non-nil and the
-user attempts to surround the word “foo” with the character “｢” the
-result would be “｢foo｣”.
-
-Whether or not an opening- or closing bracket is provided is not
-important; the opening bracket will always be placed at the front of the
-region and the closing bracket at the end of the region (assuming
-left-to-right writing).
-
-In more technical terms this function surrounds text with both the
-provided character and the characters corresponding Bidi_Paired_Bracket
-Unicode property."
- :type 'boolean
- :package-version '(surround . "1.0.0")
- :group 'surround)
-
-(defcustom surround-with-mirror-p t
- "Surround text with mirrored characters.
-If non-nil surrounding text with a character (assuming that character is
-not configured in `surround-pairs-alist') will attempt to surround the
-text with the supplied character and its mirror.
-
-As an example, if `surround-with-mirror-p' is non-nil and the user
-attempts to surround the word “foo” with the character “«” the result
-would be “«foo»”.
-
-Note that unlike `surround-with-paired-bracket-p', because there is no
-concept of an “opening” or “closing” bracket — because this option
-doesn't work in terms of brackets — ordering matters. This means that
-surrounding “Ελλάδα” with “«” will result in “«Ελλάδα»” while
-surrounding “Österreich” with “»” will result in “»Österreich«”.
-
-In more technical terms this function surrounds text with both the
-provided character and the characters corresponding Bidi_Mirroring_Glyph
-Unicode property."
- :type 'boolean
- :package-version '(surround . "1.0.0")
- :group 'surround)
-
-(defvar surround-pairs-alist '((emacs-lisp-mode
- . ((?` ("`" . "'")))))
- "TODO")
-
-(defun surround--get-pair-from-alist (char)
- (declare (ftype (function (char) (cons string string)))
- (side-effect-free t))
- (catch 'surround--break
- (let ((char-as-string (char-to-string char)))
- (dolist (pair surround-pairs-alist)
- (let ((mode-or-t (car pair))
- (pairs (cdr pair)))
- (when (or (derived-mode-p mode-or-t)
- (eq t mode-or-t))
- (dolist (pair pairs)
- (let ((open-or-trigger (car pair))
- (closing-or-pair (cdr pair)))
- (if (numberp open-or-trigger) ; Implies trigger
- (when (= char open-or-trigger)
- (throw 'surround--break (car closing-or-pair)))
- (when (string= char-as-string open-or-trigger)
- (throw 'surround--break pair)))))))))))
-
-(defun surround--get-pair (char)
- (declare (ftype (function (char) (cons string string)))
- (side-effect-free t))
- (or (surround--get-pair-from-alist char)
- (let ((char (char-to-string char))
- (other (char-to-string
- (or (when surround-with-paired-bracket-p
- (get-char-code-property char 'paired-bracket))
- (when surround-with-mirror-p
- (get-char-code-property char 'mirroring))
- char)))
- (bracket-type (get-char-code-property char 'bracket-type)))
- (pcase bracket-type
- ((or 'c 'n) (cons other char))
- ('o (cons char other))))))
-
-(defun surround--region (pair beginning end)
- (save-excursion
- (goto-char beginning)
- (insert (car pair))
- (goto-char end)
- (insert (cdr pair))))
-
-(defun surround-region (char)
- (interactive
- (list (read-char-from-minibuffer
- (format-prompt "Surround with" nil))))
- (when-let ((pair (surround--get-pair char)))
- (dolist (bounds (cl-loop for (beginning . end) in (region-bounds)
- collect (cons (set-marker (make-marker) beginning)
- (set-marker (make-marker) end))))
- (surround--region pair (car bounds) (cdr bounds)))))
-
-(defun surround-padded-region (char)
- (interactive
- (list (read-char-from-minibuffer
- (format-prompt "Surround with" nil))))
- (when-let ((pair (surround--get-pair char))
- (pair (cons (concat (car pair) " ")
- (concat " " (cdr pair)))))
- (dolist (bounds (cl-loop for (beginning . end) in (region-bounds)
- collect (cons (set-marker (make-marker) beginning)
- (set-marker (make-marker) end))))
- (surround--region pair (car bounds) (cdr bounds)))))
-
-(provide 'surround)