Basic structural editing for VIP editor

vip-lispMode.l

# lispMode - a modified 'insMode'
#
# - balanced parens
# - line editing shortcuts (ctrl prefix with motion)
#     e.g. "^B" to move word backward, "^X" to delete char under cursor
# - indents code as you go

# installation
#
# - add this code to '~/.pil/viprc'
# - add forms to *KeyMap or *KeyMap-g, e.g.
#
#   ("i"
#      (insertLisp-i)
#      (lispMode) )

(de lispMode ()
   (while @@
      (move 'goUp 1)
      (indent)
      (move 'goDown 1)
      (let [I (indentationLevel)
            P (indentationLevel (get (: buffer text) (- (: posY) 1))) ]
         (cond
            ((=0 I)
               (paste (list (need (* P 3) " ")))
               (insertLisp-a) )
            (T
               (move1)
               (insertLisp-i) ) ) ) ) )

(de insLispMode (Flg Win Rpl . @)
   (change
      (let (P (or Pos (=: buffer text (cons)))  Chg)
         (cond
            ((=0 Flg)
               (con P (cons (car P) (cdr P)))
               (set P)
               (goto 1 (: posY)) )
            ((=1 Flg))
            (Flg
               (setq P (con P (cons NIL (cdr P))))
               (goto 1 (inc (: posY)))
               (setq Chg (0)) ) )
         (cursor)
         (off *Complete)
         (while
            (case (or (next) (getch))
               (NIL (off @@))
               (("\n" "\r")
                  (cond
                     (Rpl (beep) T)
                     ((== This *CmdWin)
                        (nil (command (or Win This) (car P))) )
                     (T
                        (push 'Chg 0)
                        (con P
                           (cons (nth (car P) (: posX)) (cdr P)) )
                        (set P (head (dec (: posX)) (car P)))
                        (setq P (cdr P))
                        (goto 1 (inc (: posY)))
                        (cursor)
                        (on @@)  # pop out to 'lispMode' to indent
                        NIL ) ) )
               # line editing motions (ctrl prefix)
               ("^L"
                  (move 'goRight 1)
                  (cursor) )
               ("^W"
                  (move 'goForward 'word 1)
                  (cursor) )
               ("^B"
                  (move 'goBackward 'word 1)
                  (cursor) )
               ("^E"
                  (move 'goForward 'end 1)
                  (cursor) )
               ("^X"
                  (let *Change "d" (move 'goRight 1))
                  (cursor) )
               ("^D"
                  (let *Change "d" (move 'goForward 'end 1))
                  (cursor) )
               # backspace
               (("^H" "^?")
                  (cond
                     ((= (prevChar) ")")
                        (move 'goLeft 1)
                        (cursor) )
                     ((= (prevChar) "]")
                        (move 'goLeft 1)
                        (cursor) )
                     ((posChar? ")")
                        (when (= (prevChar) "(")
                           (let *Change "d"
                              (move 'goRight 1) ) )
                        (when (and (posChar? "(") (not (nextChar)))
                           (when (get (: buffer text) (: posY) 1)
                              (inc (:: posX)) ) )
                        (_bs)
                        (chgLine (car P)) )
                     ((posChar? "]")
                        (when (= (prevChar) "[")
                           (let *Change "d"
                              (move 'goRight 1) ) )
                        (when (and (posChar? "[") (not (nextChar)))
                           (when (get (: buffer text) (: posY) 1)
                              (inc (:: posX)) ) )
                        (_bs)
                        (chgLine (car P)) )
                     ((and Chg (n0 (car Chg)))
                        (_bs)
                        (chgLine (car P)) ) )
                  T )
               (T
                  (let S (list @)
                     (cond
                        ((<> @ "\t") (off *Complete))
                        ((= '(":" " ") (get (: buffer text) (: posY)))
                           (setq S
                              (chop (car (rot (setq *Complete (history))))) ) )
                        ((or Rpl (nor *Complete (setq S (pack (getWord)))))
                           (setq S
                              (make
                                 (do (- 3 (% (dec (: posX)) 3))
                                    (link (name " ")) ) ) ) )
                        (T
                           (default *Complete (cons S (flip (all* S))))
                           (do (length (car *Complete)) (_bs))
                           (setq S (chop (car (rot *Complete)))) ) )
                     (when (= "^V" (car S))
                        (set S (or (next) (getch2 "^V"))) )
                     (for C S
                        (cond  # insert balanced parens
                           ((= C "(")
                              (paste '((")"))) )
                           ((= C ")")
                              (cond
                                 ((not (nextChar))
                                    (let *Change "d" (move 'goRight 1))
                                    (when (get (: buffer text) (: posY) 1)
                                       (inc (:: posX)) ) )
                                 ((posChar? ")")
                                    (let *Change "d" (move 'goRight 1)) ) ) )
                           ((= C "[")
                              (paste '(("]"))) )
                           ((= C "]")
                              (cond
                                 ((not (nextChar))
                                    (let *Change "d" (move 'goRight 1))
                                    (when (get (: buffer text) (: posY) 1)
                                       (inc (:: posX)) ) )
                                 ((posChar? "]")
                                    (let *Change "d" (move 'goRight 1)) ) ) ) )
                        (push 'Chg C)
                        (set P
                           ((if (and Rpl (car P)) place insert)
                              (: posX)
                              (car P)
                              C ) )
                        (inc (:: posX)) )
                     (goto (: posX) (: posY) T) )
                  (chgLine (car P))
                  T ) ) )
         (=: posX (max 1 (dec (: posX))))
         (cond
            ((=0 Flg) (push 'Chg 0))
            ((=1 Flg) (and (> PosX1 1) (dec 'PosX1))) )
         (split (reverse Chg) 0) ) ) )

(de insertLisp-i ()
   (when (insLispMode)
      (setq *Repeat (list 'paste (lit @))) ) )

(de insertLisp-I ()
   (goto 1 (: posY))
   (when (insLispMode)
      (setq *Repeat (list 'paste (lit @) 0)) ) )

(de insertLisp-a ()
   (when (get (: buffer text) (: posY) 1)
      (inc (:: posX)) )
   (when (insLispMode 1)
      (setq *Repeat (list 'paste (lit @) 1)) ) )

(de insertLisp-A ()
   (goto
      (inc (length (get (: buffer text) (: posY))))
      (: posY)
      T )
   (when (insLispMode 1)
      (setq *Repeat (list 'paste (lit @) T)) ) )

# utils

(de posChar? @
   (member (posChar) (rest)) )

(de prevChar (N)
   (default N 1)
   (get (: buffer text)
      (: posY)
      (- (: posX) N) ) )

(de nextChar (N)
   (default N 1)
   (get (: buffer text)
      (: posY)
      (+ (: posX) N) ) )

# move to first non-space char
(de move1 ()
   (move 'goAbs 1 (: posY))
   (while (and (posChar? " ") (nextChar))
      (move 'goRight 1) ) )

(de indentationLevel (Line)
   (default Line (get (: buffer text) (: posY)))
   (let N 0
      (while (= " " (++ Line))
         (inc 'N) )
      (/ N 3) ) )