Write a navi integration

This commit is contained in:
Jeremy Dormitzer 2024-05-03 15:29:31 -04:00
parent 3108252710
commit 7a74212089
3 changed files with 342 additions and 0 deletions

View File

@ -0,0 +1,29 @@
;; -*- lexical-binding: t; -*-
(use-package navi
:straight `(:local-repo ,(expand-file-name "~/.emacs.d/packages/navi"))
:defer t
:init
(defvar-keymap embark-navi-map
:doc "Keymap for actions on Navi cheats"
"f" #'navi-visit-cheat-file)
(with-eval-after-load 'embark
(add-to-list 'embark-keymap-alist '(navi . embark-navi-map)))
(defun run-command-recipe-navi ()
(let* ((dir (or (projectile-project-root) default-directory))
(cheat-files
(append
(navi-cheats-matching-filename (regexp-quote dir)))))
(-mapcat
(lambda (cheat-file)
(-map (lambda (cheat)
(list :command-name (navi-cheat-summary cheat)
:command-line (lambda () (navi-cheat-render cheat))
:working-dir dir))
(oref cheat-file cheats)))
cheat-files)))
(with-eval-after-load 'run-command
(add-to-list 'run-command-recipes 'run-command-recipe-navi)))
(provide 'init-navi)

View File

@ -123,6 +123,7 @@
(require 'init-mermaid)
(require 'init-games)
(require 'handwriting)
(require 'init-navi)
(when (string-equal system-type "darwin")
(require 'init-mac))

View File

@ -0,0 +1,312 @@
;;; navi.el --- Emacs interface to the Navi shell cheatsheat utility -*- lexical-binding: t; -*-
;; Copyright (C) 2024 Jeremy Isaac Dormitzer
;; Author: Jeremy Isaac Dormitzer <jeremydormitzer@hummingbird.co>
;; Keywords: tools
;; Package-Requires: ((emacs "25.1") (s "1.13") (ht "2.4"))
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'eieio)
(require 's)
(require 'ht)
(defclass navi-cheat-registry ()
((cheat-files :initarg :cheat-files
:initform (make-hash-table :test 'equal)
:type hash-table
:documentation "Maps tag lists to a list of cheat files with those tags.")
(tags-index :initarg :tags-index
:initform (make-hash-table :test 'equal)
:type hash-table
:documentation "Maps individual tags to cheat files."))
"A registry of Navi cheat files.")
(defclass navi-cheat-file ()
((filename :initarg :filename
:initform ""
:type string
:documentation "The name of the cheat file.")
(tags :initarg :tags
:initform nil
:type list
:documentation "Tags for the cheat file.")
(generators :initarg :generators
:initform (make-hash-table :test 'equal)
:type hash-table
:documenation "Commands that generate possible values for variables.")
(imports :initarg :imports
:initform nil
:type list
:documentation "A list of lists of tags identifying other cheat files to import.")
(cheats :initarg :cheats
:initform nil
:type list
:documentation "A list of navi-cheat objects.")
(registry :initarg :registry
:type navi-cheat-registry
:documentation "The registry this cheat file belongs to."))
"A Navi cheat file.")
(defclass navi-cheat ()
((description :initarg :description
:initform ""
:type string
:documentation "Command description.")
(command :initarg :command
:initform ""
:type string
:documentation "The template of the command to run.")
(cheat-file :initarg :cheat-file
:type navi-cheat-file
:documentation "The cheat file this command belongs to."))
"A Navi command cheat template.")
(cl-defmethod navi-cheat-registry-add-cheat-file ((registry navi-cheat-registry) (cheat-file navi-cheat-file))
"Add CHEAT-FILE to REGISTRY."
(let ((tags (oref cheat-file tags)))
(puthash tags (append (gethash tags (oref registry cheat-files)) (list cheat-file)) (oref registry cheat-files))
(dolist (tag tags)
(puthash tag (append (gethash tag (oref registry tags-index)) (list cheat-file)) (oref registry tags-index)))))
(cl-defmethod navi-cheat-registry-tags ((registry navi-cheat-registry))
"Return a list of all tags in REGISTRY."
(hash-table-keys (oref registry tags-index)))
(cl-defmethod navi-cheat-registry-cheat-files ((registry navi-cheat-registry) &optional tags)
(if (seq-empty-p tags)
(-flatten (hash-table-values (oref registry cheat-files)))
(apply #'append (mapcar (lambda (tag) (gethash tag (oref registry tags-index))) tags))))
(cl-defmethod navi-cheat-file-generators ((cheat-file navi-cheat-file))
(let ((imported-generators (make-hash-table :test 'equal))
(imports (oref cheat-file imports))
(registry (oref cheat-file registry)))
(dolist (tags imports)
(let ((imported-files (gethash tags (oref registry cheat-files))))
(dolist (imported-file imported-files)
;; TODO: this doesn't handle cycles
(ht-update! imported-generators (navi-cheat-file-generators imported-file)))))
(ht-merge imported-generators (oref cheat-file generators))))
(cl-defmethod navi-cheat-render ((cheat navi-cheat))
"Render the command for CHEAT."
(let* ((cmd (oref cheat command))
(cheat-file (oref cheat cheat-file))
(generators (navi-cheat-file-generators cheat-file))
(var-values (make-hash-table :test 'equal)))
(-navi--interpolate-vars cmd var-values generators)))
(defun -navi--run-generator (generator)
(with-temp-buffer
(if (not (eq (call-process-shell-command generator nil t) 0))
(error "%s" (buffer-string))
(split-string (buffer-string) "\n" t " "))))
(defun -navi--interpolate-vars (str vars generators)
(let ((var-matches (s-match-strings-all "<\\(.*?\\)>" str)))
(dolist (match var-matches)
(let* ((placeholder (car match))
(var (cadr match))
(cached-value (gethash var vars))
(value (if cached-value
cached-value
(let* ((generator (gethash var generators))
(generator (when generator (-navi--interpolate-vars generator vars generators)))
(value (if generator
(consult--read (-navi--run-generator generator)
:prompt (format "%s: " var)
:category (cond
((string-match-p "^\\(find\\|ls\\)" generator) 'file)))
(read-string (format "%s: " var)))))
(puthash var value vars)
value))))
(setq str (replace-regexp-in-string (regexp-quote placeholder) value str t t)))))
str)
(defun navi-parse-cheat-file (file registry)
"Parse the cheat file FILE and returns a navi-cheat-file object."
(let ((cheat-file (navi-cheat-file :filename file :registry registry)))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (not (eobp))
(let* ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
(prefix (when (not (string-empty-p line))
(substring line 0 2))))
(cond
((string-empty-p line) (forward-line))
((string= prefix "% ")
(let ((tags (split-string (substring line 2) ", " t " ")))
(oset cheat-file :tags (append (oref cheat-file tags) tags))
(forward-line)))
((string= prefix "# ")
(let ((desc (substring line 2))
(cmd (progn
(forward-line)
(-navi--parse-multiline-string))))
(object-add-to-list cheat-file
:cheats
(navi-cheat :description desc :command cmd :cheat-file cheat-file)
t)
(forward-line)))
((string= prefix "; ") (forward-line))
((string= prefix "$ ")
(let* ((generator-def (substring line 2))
(split (split-string generator-def ": " t " "))
(var (car split))
(cmd (cadr split)))
(puthash var cmd (oref cheat-file generators))
(forward-line)))
((string= prefix "@ ")
(let ((tags (split-string (substring line 2) ", " t " ")))
(object-add-to-list cheat-file :imports tags t)
(forward-line)))
;; default: assume it's a command
(t (let ((cmd (-navi--parse-multiline-string)))
(object-add-to-list cheat-file :cheats (navi-cheat :command cmd :cheat-file cheat-file) t)
(forward-line)))))))
cheat-file))
(defun -navi--parse-multiline-string ()
(cl-loop with cmd = ""
until (or (string-empty-p (buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))
(eobp))
do (setq cmd (concat cmd
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position))
"\n"))
do (forward-line)
finally return (s-trim cmd)))
(defvar -navi--cheat-cache (make-hash-table :test 'equal)
"Map of cheat file checksums to navi-cheat-file objects.")
(defun -navi--cheat-file-checksum (file)
(let ((cksum (shell-command-to-string
(format "%s %s"
(or (executable-find "cksum")
(error "cksum not found"))
file))))
(string-trim (car (split-string cksum " ")))))
(defun -navi--get-or-cache-cheat-file (file registry)
(let ((checksum (-navi--cheat-file-checksum file)))
(unless (gethash checksum -navi--cheat-cache)
(puthash checksum (navi-parse-cheat-file file registry) -navi--cheat-cache))
(gethash checksum -navi--cheat-cache)))
(defun navi-cheat-files (&optional path)
"Return a navi-registry of navi-cheat-file objects in PATH, which defaults to $NAVI_PATH."
(let* ((registry (navi-cheat-registry))
(navi-path (or path (getenv "NAVI_PATH")))
(dirs (when navi-path (split-string navi-path ":" t " "))))
(when dirs
(dolist (file (->> dirs
(-map (lambda (dir) (directory-files dir t ".*\\.cheat$")))
(-flatten)
(-map (lambda (file) (navi-parse-cheat-file file registry)))))
(navi-cheat-registry-add-cheat-file registry file)))
registry))
;;;###autoload
(defun navi-all-cheats ()
"Returns all Navi cheats on $NAVI_PATH."
(navi-cheat-registry-cheat-files (navi-cheat-files)))
;;;###autoload
(defun navi-cheats-for-tags (tags)
"Returns all Navi cheats on $NAVI_PATH tagged with TAGS."
(navi-cheat-registry-cheat-files (navi-cheat-files) tags))
;;;###autoload
(defun navi-cheats-matching-filename (rx)
"Returns all Navi cheats on $NAVI_PATH whose filenames match RX."
(seq-filter
(lambda (cheat-file)
(string-match-p rx (oref cheat-file filename)))
(navi-all-cheats)))
;;;###autoload
(cl-defmethod navi-cheat-summary ((cheat navi-cheat))
"Return a summary of CHEAT."
(format "%s: %s [%s]"
(oref cheat description)
(oref cheat command)
(s-join " " (oref (oref cheat cheat-file) tags))))
(defun -navi--build-completion-table (cheats)
(-map
(lambda (cheat)
(cons (navi-cheat-summary cheat)
cheat))
cheats))
(defun -navi-interactive (cheat-files)
(let* ((cheats (->> cheat-files
(-mapcat (lambda (cheat-file) (oref cheat-file cheats)))
(-navi--build-completion-table)))
(cheat (consult--read cheats
:prompt "Command: "
:category 'navi
:require-match t))
(cmd (navi-cheat-render (alist-get cheat cheats nil nil 'equal))))
(let ((compilation-buffer-name-function (lambda (_) (format "*%s*" cmd))))
(compile cmd))))
;;;###autoload
(defun navi ()
"Run a command from a Navi cheatsheet."
(interactive)
(-navi-interactive (navi-all-cheats)))
;;;###autoload
(defun navi-by-tags (tags)
"Run a command from a Navi cheatsheet tagged with TAGS."
(interactive (list (completing-read-multiple "Tags: " (navi-cheat-registry-tags (navi-cheat-files)))))
(-navi-interactive (navi-cheats-for-tags tags)))
;;;###autoload
(defun navi-matching-current-directory ()
"Run a command from a Navi cheatsheet whose filename matches the current directory."
(interactive)
(-navi-interactive
(navi-cheats-matching-filename (regexp-quote (file-name-directory default-directory)))))
;;;###autoload
(defun navi-visit-cheat-file (cheat)
"Visit the cheat file for CHEAT."
(interactive (list (let* ((cheats (-navi--build-completion-table
(-mapcat (lambda (cheat-file)
(oref cheat-file cheats))
(navi-all-cheats))))
(selected (consult--read cheats
:prompt "Cheat file: "
:category 'navi
:require-match t)))
(alist-get selected cheats nil nil 'equal))))
(find-file (oref (oref cheat cheat-file) filename)))
(provide 'navi)
;;; navi.el ends here