3 files changed, 288 insertions, 0 deletions
diff --git a/.config/emacs/site-lisp/gh.el b/.config/emacs/site-lisp/gh.el
new file mode 100644
index 0000000..23086e5
--- /dev/null
+++ b/.config/emacs/site-lisp/gh.el
@@ -0,0 +1,59 @@
+;;; 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")
+    (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)))
+    (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/highlighter.el b/.config/emacs/site-lisp/highlighter.el
new file mode 100644
index 0000000..ce67ac8
--- /dev/null
+++ b/.config/emacs/site-lisp/highlighter.el
@@ -0,0 +1,128 @@
+;;; 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/live-jq.el b/.config/emacs/site-lisp/live-jq.el
new file mode 100644
index 0000000..f8a0a7f
--- /dev/null
+++ b/.config/emacs/site-lisp/live-jq.el
@@ -0,0 +1,101 @@
+;; 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)