486 lines
18 KiB
EmacsLisp
486 lines
18 KiB
EmacsLisp
;;; 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)
|