@@ -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–
;; 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–
;; 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 )
Madeleine Sydney