diff options
Diffstat (limited to '.config/emacs/site-lisp')
| -rw-r--r-- | .config/emacs/site-lisp/gh.el | 59 | ||||
| -rw-r--r-- | .config/emacs/site-lisp/highlighter.el | 128 | ||||
| -rw-r--r-- | .config/emacs/site-lisp/live-jq.el | 101 | ||||
| -rw-r--r-- | .config/emacs/site-lisp/number-format-mode.el | 129 |
4 files changed, 417 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) diff --git a/.config/emacs/site-lisp/number-format-mode.el b/.config/emacs/site-lisp/number-format-mode.el new file mode 100644 index 0000000..cbc5937 --- /dev/null +++ b/.config/emacs/site-lisp/number-format-mode.el @@ -0,0 +1,129 @@ +;;; 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 |