picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

ed.l (1459B)

      1 # 27feb10abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # Structure Editor
      5 (setq *Clip)
      6 
      7 (de ed ("X" "C")
      8    (when (pair "X")
      9       (setq  "C" (cdr "X")  "X" (car "X")) )
     10    (catch NIL
     11       (let (*Dbg NIL  "Done")
     12          (ifn "C"
     13             (set "X" (_ed (val "X")))
     14             (and
     15                (asoq "X" (val "C"))
     16                (con @ (_ed (cdr @))) ) )
     17          (pp "X" "C") ) ) )
     18 
     19 (de _ed (X)
     20    (use C
     21       (loop
     22          (T "Done" X)
     23          (pretty (car X))
     24          (prinl)
     25          (T (member (setq C (key)) '("^H" "^?")) X)
     26          (T (= C "^I") (on "Done") X)
     27          (setq X
     28             (if (>= "9" C "1")
     29                (cons
     30                   (head (setq C (format  C)) X)
     31                   (nth X (inc C)) )
     32                (case (uppc C)
     33                   (("^M" "^J") (cons (_ed (car X)) (cdr X)))
     34                   ("^[" (throw))
     35                   (" " (cons (car X) (_ed (cdr X))))
     36                   ("D" (cdr X))
     37                   ("I" (prin "Insert:") (cons (read) X))
     38                   ("R" (prin "Replace:") (cons (read) (cdr X)))
     39                   ("X" (setq *Clip (car X)) (cdr X))
     40                   ("C" (setq *Clip (car X)) X)
     41                   ("V" (cons *Clip X))
     42                   ("0" (append (car X) (cdr X)))
     43                   ("B"
     44                      (if (== '! (caar X))
     45                         (cons (cdar X) (cdr X))
     46                         (cons (cons '! (car X)) (cdr X)) ) )
     47                   (T X) ) ) ) ) ) )