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