msyds/sydnix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: Progress towards comfortable Lisp editing

Browse Source
This commit is contained in:
Madeleine Sydney
2025-02-02 14:51:04 -07:00
parent a345b5a72d
commit fc14c41edd
11 changed files with 623 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

485
users/crumb/programs/emacs/lib/syd-lisp-lib.el Normal file
View File

@@ -0,0 +1,485 @@
;;; syd-lisp-lib.el -*- lexical-binding: t; -*-
(require 'general)
(require 'clj-lib)
(use-package smartparens
:defer t)
(use-package evil-surround
:defer t)
;; Include various lispy symbols as word constituents.
(dolist (c '(?- ?_ ?? ?! ?+ ?* ?/ ?: ?> ?< ?= ?&))
(modify-syntax-entry c "w" lisp-data-mode-syntax-table))
;;;###autoload
(defvar-keymap syd-lisp-mode-map
:doc "Keymap for `syd-lisp-mode'.")
;;;###autoload
(define-minor-mode syd-lisp-mode
"A minor mode for editing lispy languages."
:keymap syd-lisp-mode-map)
;;;###autoload
(defun syd-wrap-sexp (char)
"Wrap the sexp at point (using `smartparens') with the pair corresponding to
CHAR (using `evil-surround'). Unlike other `evil-surround' operations, the
point will be preserved and the wrapped region will be re-indented."
(interactive (evil-surround-input-char))
(sp-get (sp-get-thing)
(save-excursion
(evil-surround-region :beg :end 'inclusive char)
(indent-region :beg :end))))
;;;###autoload
(evil-define-motion syd-get-enclosing-sexp ()
"Like `sp-get-enclosing-sexp', but with a slightly different meaning of
\"enclosing sexp\" that matches Vim-sexp's"
(or (let ((sexp-at-point (sp-get-sexp)))
(sp-get sexp-at-point
(when (or (and :beg (= (point) :beg))
(and :end (= (point) (- :end 1))))
sexp-at-point)))
(let ((sp-enclosing-sexp (sp-get-enclosing-sexp)))
(sp-get sp-enclosing-sexp
(when :beg
sp-enclosing-sexp)))))
;;;###autoload
(evil-define-motion syd-backward-up-sexp (count)
"Move point to the opening bracket of the enclosing sexp. The precise meaning
of \"enclosing sexp\" differs slightly from that used by Smartparens for the
sake of a more Vim-like feel inspired by vim-sexp."
:type exclusive
(dotimes (_ (or count 1))
;; REVIEW: Is there a better way to do this? I'm slightly uncomfortable
;; calling two different `sp-get-*' functions.
(or (sp-get (sp-get-sexp)
(when (and :end (= (point) (- :end 1)))
(goto-char :beg)))
(sp-get (sp-get-enclosing-sexp)
(when :beg
(goto-char :beg))))))
;;;###autoload
(evil-define-motion syd-forward-up-sexp (&optional count)
"Move point to the closing bracket of the enclosing sexp. See
`syd-backward-up-sexp'."
:type exclusive
(dotimes (_ (or count 1))
(or (sp-get (sp-get-sexp)
(when (and :beg (= (point) :beg))
(goto-char (- :end 1))))
(sp-get (sp-get-enclosing-sexp)
(when :end
(if (= (point) (- :end 1))
(sp-get (save-excursion (forward-char)
(sp-get-enclosing-sexp))
(when :end
(goto-char (- :end 1))))
(goto-char (- :end 1))))))))
;;;###autoload
(defun syd-get-top-level-sexp ()
"Get the top-level sexp enclosing point. Destructure with `sp-get'.'"
;; The end position returned by `bounds-of-thing-at-point' includes an
;; unpredictable amount of trailing whitespace, so we discard it and compute
;; our own figure.
(let ((original-point (point)))
(-when-let ((beg . _) (bounds-of-thing-at-point 'defun))
(save-excursion
(goto-char beg)
;; We can trust Smarparents to get the desired end position.
(-let* ((top-level-sexp (sp-get-sexp))
((_ . end) (sp-get top-level-sexp (cons :beg :end))))
;; If the sexp is behind point, we aren't interested in it; find one
;; /ahead/ of point.
(if (< original-point end)
top-level-sexp
(goto-char end)
(sp-next-sexp)
(sp-get-sexp)))))))
;;;###autoload
(defun syd-get-top-level-sexp-and-attached-comment-bounds ()
"Get the bounds of top-level sexp enclosing point and the \"attached\"
comment, if there is one. Returns nil or a pair (BEG . END)."
(-when-let ((beg . end) (sp-get (syd-get-top-level-sexp) (cons :beg :end)))
(let ((attached-comment-beg (save-excursion
(goto-char beg)
(syd-sexp--backward-attached-comment))))
(cons (or attached-comment-beg beg)
end))))
(evil-define-motion syd-forward-defun (count)
:jump t
(sp-get (syd-get-top-level-sexp)
(goto-char :beg)
(dotimes (_ (or count 1))
(sp-next-sexp))))
(defvar syd-sexp-cleanup-operators '(evil-delete)
"When `syd-evil-a-defun' is used in combination with one of these operators,
some cleanup will be performed.")
(defun syd-sexp--backward-attached-comment ()
"Assuming point is on the opening delimiter of a sexp, move point backward to
the beginning of the \"attached\" comment."
(let ((sexp-line (line-number-at-pos))
(sexp-column (current-column)))
(-when-let ((beg . _end) (save-excursion
(goto-line (- sexp-line 1))
(evil-forward-char sexp-column t)
(sp-get-comment-bounds)))
(goto-char beg))))
;;;###autoload
(evil-define-text-object syd-evil-a-defun (count _beg _end _type)
"Selects the enclosing top-level sexp. With a COUNT of N, that many
consequtive top-level sexps will be selected. TODO: Special care will be taken
to clean up whitespace following certain operators."
:type inclusive
(when (< count 0)
(user-error "TODO: Negative count"))
(-let ((cleanup-p (memq evil-this-operator syd-sexp-cleanup-operators))
((beg-0 . end-0)
(syd-get-top-level-sexp-and-attached-comment-bounds)))
(if (or (null count) (= count 1))
(list beg-0 end-0)
(goto-char end-0)
(dotimes (_ (- count 1))
(sp-next-sexp))
(sp-get (sp-get-sexp)
(list beg-0 :end)))))
;; IDEA: How about the inner-defun text object selects the defun /without/ the
;; comment? Is that more useful, or less? I can't think of the last time I've
;; needed the top-level sexp without the brackets.
;;;###autoload
(evil-define-text-object syd-evil-inner-defun (_count _beg _end _type)
"Select the *content* of the enclosing top-level sexp, i.e. without the
delimiters."
:type inclusive
(sp-get (syd-get-top-level-sexp)
(list (+ :beg 1)
(- :end 1))))
(defun syd-sexp--forward-trailing-whitespace (sexp)
"Move point to the end of the whitespace trailing after SEXP."
(goto-char (sp-get sexp :end))
(skip-chars-forward "[:blank:]")
(when (= (char-after) ?\n)
(forward-char)
(skip-chars-forward "[:blank:]")))
(defun syd-sexp--backward-leading-whitespace (sexp)
"Move point to the beginning of the whitespace preceding SEXP."
(goto-char (sp-get sexp :beg))
(skip-chars-backward "[:blank:]")
(when (= (char-before) ?\n)
(backward-char)
(skip-chars-backward "[:blank:]")))
;;;###autoload
(evil-define-text-object syd-evil-a-form (count _beg _end _type)
(let* ((cleanup-p (memq evil-this-operator syd-sexp-cleanup-operators))
(sexp (syd-get-enclosing-sexp)))
(if cleanup-p
(save-excursion
(if (syd-sexp--looking-at-last-p)
(progn (syd-sexp--backward-leading-whitespace sexp)
(list (point) (sp-get sexp :end)))
(syd-sexp--forward-trailing-whitespace sexp)
(list (sp-get sexp :beg) (point))))
(sp-get sexp (list :beg :end)))))
;;;###autoload
(evil-define-text-object syd-evil-inner-form (count _beg _end _type)
(sp-get (syd-get-enclosing-sexp)
(list (+ :beg 1) (- :end 1))))
;;;###autoload
(evil-define-command syd-open-sexp-below ()
"Insert a newline with appropriate indentation after the enclosing sexp. A
sexp-wise analogue to Evil's line-wise `evil-open-below'."
:suppress-operator t
(evil-with-single-undo
;; We want to add an additional blank line when operating at the top level.
;; Instead of parsing upward until we can no longer find an enclosing sexp, we
;; simply check if the opening bracket is on the first column. This is not
;; very correct, but it's way less work (for myself and the CPU). If we
;; switch to a tree-sitter–based parser, I'd love to switch to the correct
;; algorithm.
(-let* (((beg . end) (sp-get (syd-get-enclosing-sexp) (cons :beg :end)))
(col (save-excursion (goto-char beg) (current-column))))
(goto-char end)
(if (= col 0)
(newline 2)
(newline-and-indent))))
(evil-insert-state 1))
;;;###autoload
(evil-define-command syd-open-sexp-above ()
"Insert a newline with appropriate indentation above the enclosing sexp. A
sexp-wise analogue to Evil's line-wise `evil-open-above'."
:suppress-operator t
(evil-with-single-undo
(let ((beg (sp-get (syd-get-enclosing-sexp) :beg)))
(goto-char beg)
(syd-sexp--backward-attached-comment)
(let ((col (current-column)))
(save-excursion
;; We want to add an additional blank line when operating at the top
;; level. Instead of parsing upward until we can no longer find an
;; enclosing sexp, we simply check if the opening bracket is on the
;; first column. This is not very correct, but it's way less work (for
;; myself and the CPU). If we switch to a tree-sitter–based parser, I'd
;; love to switch to the correct algorithm.
(if (= col 0)
(newline 2)
(newline-and-indent)))
(indent-to col)
(evil-insert-state 1)))))
(defun syd-sexp-get-last-thing ()
(-let (((enclosing-beg . enclosing-end)
(sp-get (syd-get-enclosing-sexp) (cons :beg :end))))
(save-excursion
;; Imperative andy. }:\
(let (thing)
(while (sp-get (syd-get-thing)
(and (< enclosing-beg :beg enclosing-end)
(< enclosing-beg :end enclosing-end))))))))
(defun syd-sexp--looking-at-last-p ()
"Return non-nil if the sexp beginning at point is the last element of its
enclosing sexp."
(save-excursion
(let ((point-0 (point))
(sexp (sp-get-enclosing-sexp)))
(sp-next-sexp)
(if sexp
(or
;; If `sp-next-sexp' moved backwards, `point-0' was the last
;; element.
(<= (point) point-0)
;; If `sp-next-sexp' moved outside of the previously-enclosing
;; sexp, `point-0' was final.
(<= (sp-get sexp :end) (point)))
;; No enclosing sexp — we're looking at a top-level sexp.
(= (point) point-0)))))
(defun syd-sexp--next-thing ()
"Helper for `syd-sexo->'. Find the next thing relative to the sexp assumed to
begin at point, and the region covering the closing delimiters."
(save-excursion
(condition-case err
(cl-loop for relative-height from 0
while (syd-sexp--looking-at-last-p)
do (or (sp-backward-up-sexp)
;; Nothing to slurp!
(signal 'top))
finally return (cons (sp-next-sexp) relative-height))
(top nil))))
(defun syd-sexp--slurp-forward ()
"Slurp forward. Do not call this function directly; see `syd-sexp->'."
;; REVIEW: This is rather unoptimised when used with a count.
(when-let* ((consumer (sp-get-sexp)))
(goto-char (sp-get consumer :beg))
(-if-let ((next-thing . relative-height) (syd-sexp--next-thing))
(progn (goto-char (sp-get consumer :beg-in))
(sp-forward-slurp-sexp (+ 1 relative-height))
(sp-get (sp-get-enclosing-sexp)
(goto-char (- :end 1))))
(user-error "ra"))))
(defun syd-sexp--barf-forward ()
"Barf forward. Do not call this function directly; see `syd-sexp-<'."
(sp-forward-barf-sexp))
;;;###autoload
(evil-define-command syd-sexp-> (&optional count)
(interactive "<c>")
(evil-with-single-undo
(when-let* ((sexp (sp-get-sexp)))
(let ((fn (cond ((= (point) (sp-get sexp (- :end 1)))
#'syd-sexp--slurp-forward))))
(dotimes (_ (or count 1))
(funcall fn))))))
;;;###autoload
(evil-define-command syd-sexp-< (&optional count)
(interactive "<c>")
(evil-with-single-undo
(when-let* ((sexp (sp-get-sexp)))
(let ((fn (cond ((= (point) (sp-get sexp (- :end 1)))
#'syd-sexp--barf-forward))))
(dotimes (_ (or count 1))
(funcall fn))))))
(defun syd-sexp--looking-at-delimiter-p ()
(sp-get (sp-get-sexp)
(and (not (sp-point-in-string-or-comment))
(or (= (point) :beg)
(= (point) (- :end 1))))))
;; REVIEW: It might be neat to, iff the point is already in a comment/string,
;; goto delimiters that are also in comments/strings. For now, let's just
;; ignore comments.
(defun syd-sexp--goto-delimiter (delimiter-type direction count)
(let* ((point-0 (point))
(delimiters (mapcar (clj-condp eq delimiter-type
('opening #'car)
('closing #'cdr))
sp-pair-list))
(delimiter-regexp (rx-to-string `(or ,@delimiters)))
(forward-p (clj-condp eq direction
('forward t)
('backward nil)
(t (error "todo errrrare"))))
(move (lambda ()
;; `forward-p' never changes between calls to `move'; we are
;; doing many more checks than we need to.
(and (condition-case er
(prog1 t (when forward-p
(forward-char)))
(end-of-buffer (throw 'no-move 'no-move)))
(if (if forward-p
(re-search-forward delimiter-regexp nil t)
(re-search-backward delimiter-regexp nil t))
(goto-char (match-beginning 0))
(throw 'no-move 'no-move))))))
;; If `syd-sexp--looking-at-delimiter-p' returns nil, we may be looking at
;; the right string of characters, but we are likely inside of a string,
;; or a comment, or something. If we aren't at a "real" delimiter, move
;; again.
(let ((r (catch 'no-move
(dotimes (_ count)
(while (and (funcall move)
(not (syd-sexp--looking-at-delimiter-p))))))))
(if (eq r 'no-move)
(progn (goto-char point-0)
(user-error "Nowhere to go"))
r))))
(evil-define-motion syd-sexp-forward-opening (count)
(syd-sexp--goto-delimiter 'opening 'forward (or count 1)))
(evil-define-motion syd-sexp-backward-opening (count)
(syd-sexp--goto-delimiter 'opening 'backward (or count 1)))
(evil-define-motion syd-sexp-forward-closing (count)
(syd-sexp--goto-delimiter 'closing 'forward (or count 1)))
(evil-define-motion syd-sexp-backward-closing (count)
(syd-sexp--goto-delimiter 'closing 'backward (or count 1)))
(defun syd-sexp-get-sexp-with-prefix ()
(-when-let* ((thing (sp-get-thing))
;; TODO: Rewrite using :beg-prf
((beg . prefix) (sp-get thing (cons :beg :prefix)))
(prefix-beg (- beg (length prefix))))
;; HACK: Relies on Smartparen's internal representation, which
;; they explicitly recommend against. This could break at any
;; time!
;; Reminder that `plist-put' is an in-place update. }:)
(plist-put thing :beg prefix-beg)
(plist-put thing :prefix "")
(goto-char prefix-beg)
thing))
(evil-define-motion syd-sexp-next (count)
"Like `sp-next-sexp', but prefixes will be considered as part of the sexp."
;; If point is resting on a prefix when `syd-sexp-next' is called,
;; `sp-next-sexp' will move to the beginning of the prefixed form. This is
;; undesirable, as `syd-sexp-next' considers the prefix and the prefixed form
;; to be a single thing. To get around this, we make sure to move point past
;; the prefixed sexp.
(let ((count* (or count 1)))
(when-let* ((_ (<= 0 count*))
(first-prefixed-sexp (syd-sexp-get-sexp-with-prefix)))
(sp-get first-prefixed-sexp
(when (<= :beg (point) :end)
(goto-char :end))))
(let ((current-prefix-arg count*))
(call-interactively #'sp-next-sexp)))
(syd-sexp-get-sexp-with-prefix))
(evil-define-motion syd-sexp-previous (count)
"Like `sp-next-sexp' (as if called with a negative count), but prefixes will
be considered as part of the sexp."
(syd-sexp-next (- (or count 1))))
;;;###autoload
(evil-define-command syd-sexp-insert ()
(evil-with-single-undo
(sp-get (syd-get-enclosing-sexp)
(goto-char (+ 1 :beg))
(save-excursion (insert-char ?\s))
(evil-insert-state 1))))
;;;###autoload
(evil-define-command syd-sexp-append ()
(evil-with-single-undo
(sp-get (syd-get-enclosing-sexp)
(goto-char (- :end 1))
(evil-insert-state 1))))
;; Text objects.
(general-def
:keymaps 'syd-lisp-mode-map
:states '(visual operator)
"ad" #'syd-evil-a-defun
"id" #'syd-evil-inner-defun
"af" #'syd-evil-a-form
"if" #'syd-evil-inner-form)
;; Bind editing commands in normal node, and motion commands in motion
;; mode.
(general-def
:keymaps 'syd-lisp-mode-map
:states 'normal
">" #'syd-sexp->
"<" #'syd-sexp-<
"M-w" #'syd-wrap-sexp
"M-r" #'sp-raise-sexp
"M-c" #'sp-clone-sexp
"M-S" #'sp-split-sexp
"M-J" #'sp-join-sexp
"M-u" #'sp-splice-sexp-killing-backward
"M-U" #'sp-splice-sexp-killing-around
"M-v" #'sp-convolute-sexp
"M-o" #'syd-open-sexp-below
"M-O" #'syd-open-sexp-above
"M-i" #'syd-sexp-insert
"M-a" #'syd-sexp-append)
;; Bind editing commands in normal node, and motion commands in motion
;; mode.
(general-def
:keymaps 'syd-lisp-mode-map
:states 'motion
"C-h" #'sp-backward-up-sexp
"C-j" #'syd-sexp-next
"C-k" #'syd-sexp-previous
"C-l" #'sp-down-sexp
"(" #'syd-backward-up-sexp
")" #'syd-forward-up-sexp
"{" #'syd-sexp-backward-opening
"}" #'syd-sexp-forward-opening
"M-{" #'syd-sexp-backward-closing
"M-}" #'syd-sexp-forward-closing)
(with-eval-after-load 'smartparens
(setq
;; By default, Smartparens will move backwards to the initial character of
;; the enclosing expression, and only move forwards when the point is already
;; on that initial character. This is not expected behaviour for an ex-Vim
;; user.
sp-navigate-interactive-always-progress-point t))
(provide 'syd-lisp-lib)