picolisp

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

edit.l (2108B)

      1 # 12nov12abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # "*F" "*Lst" "*X" "*K"
      5 
      6 (de edit @
      7    (let *Dbg NIL
      8       (setq "*F" (tmp '"edit.l"))
      9       (catch NIL
     10          ("edit" (rest)) ) ) )
     11 
     12 (de "edit" ("Lst")
     13    (let "N" 1
     14       (loop
     15          (out "*F"
     16             (setq "*Lst"
     17                (make
     18                   (for "S" "Lst"
     19                      ("loc" (printsp "S"))
     20                      ("loc" (val "S"))
     21                      (pretty (val "S"))
     22                      (prinl)
     23                      (for "X" (sort (getl "S"))
     24                         ("loc" "X")
     25                         (space 3)
     26                         (if (atom "X")
     27                            (println "X" T)
     28                            (printsp (cdr "X"))
     29                            (pretty (setq "X" (car "X")) -3)
     30                            (cond
     31                               ((type "X")
     32                                  (prin "  # ")
     33                                  (print @) )
     34                               ((>= 799999 "X" 700000)
     35                                  (prin "  # " (datStr "X")) ) )
     36                            (prinl) ) )
     37                      (prinl)
     38                      (println '(********))
     39                      (prinl) ) ) ) )
     40          (call 'vim
     41             "+set isk=33-34,36-38,42-90,92,94-95,97-125"
     42             "+map K yiw:call setline(line(\"$\"), \"(\" . line(\".\") . \" \" . @@ . \")\")^MZZ"
     43             "+map Q GC(0)^[ZZ"
     44             (pack "+" "N")
     45             "*F" )
     46          (apply ==== "*Lst")
     47          (in "*F"
     48             (while (and (setq "*X" (read)) (atom "*X"))
     49                (def "*X" (read))
     50                (until (= '(********) (setq "*K" (read)))
     51                   (def "*X" "*K" (read)) ) ) )
     52          (====)
     53          (NIL "*X" (throw))
     54          (T (=0 (car "*X")))
     55          (setq "N" (car "*X"))
     56          ("edit" (conc (cdr "*X") "Lst")) ) ) )
     57 
     58 (de "loc" ("X" "Lst")
     59    (cond
     60       ((memq "X" "Lst"))
     61       ((and (str? "X") (not (memq "X" (made))))
     62          (link "X") )
     63       ((pair "X")
     64          (push '"Lst" "X")
     65          ("loc" (car "X") "Lst")
     66          ("loc" (cdr "X") "Lst") ) ) )