THE
PAST
MASTER
CLUB
EDIT.LSP
EDIT.LSP
;;;;;;;;;;;;;;;;; START.BAT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\diary.bat-- @echo off txt 3 CALL C:\N\NIC9\QEDIT LISP\UFO\UFO.DT LISP\CRTN\CRTN.DT LISP\MOVI\MOVI.DT REM COPY LISP\UFO\UFO.DT LISP\UFO\BK REM COPY LISP\CRTN\CRTN.DT LISP\CRTN\BK REM COPY LISP\TALK\TALK.DT LISP\TALK\BK CALL C:\N\NIC4\LISP\LISP LISP\INIT.LSP ;;;;;;;;;;;;;;;;;;;;; EDIT FILE DRIVER ;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\init.lsp-- (defun editor() ;;VERS 2.3 JAN 1999 (defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms ) ) (unless (fboundp 'strcat) (defun strcat (&rest str) (apply #'concatenate 'string str) )) (defun sp()(princ " ")) (defun nl() (terpri) ) (defun pr(x) (nl)(princ x) ) (defun pa() (do((i 0(1+ i)))((> i 24)) (princ "\n") ))(pa) (defun o() (exit) ) (setq ot 't zp 0 ts 0) (defun tm() (when ot (setq z (-(/(get-internal-run-time) internal-time-units-per-second)zp)) (setq z1 (- z ts)) (setq ts z) (setq i(truncate z 3600)) (setq z(- z (* 3600 i))) (setq j(truncate z 60)) (setq z(- z -0.5 (* 60 j))) (setq w(truncate z 1)) (setq y1(truncate z1 60)) (setq z1(- z1 -0.5 (* 60 y1))) (setq z1(truncate z1 1)) (format t "~1,54tTIME ~d:~2,d:~2,d <<~2,@d~a~2,d~a>> " i j w y1 "'" z1 (int-char 34)) )) (defun tp(x) (setq f(open x)) (do()((eq dtfl 'nil)) ;;=WHILE DTFL (setq dtfl(read-line f)) (pr dtfl) )) (defun tst(x) (pr (type x)) (cond ((numberp x)(pr "NUMBER")) ((stringp x)(pr "STRING")) ((listp x) (pr "LIST ")) (t 'nil) ) ) (setq z 't elng 3 rl "*" rlng 14 I 0) (defun prsl(y) ;el rl i=0 test ok =FALSE (setq w 't i (1+ i) z 't) (setq n(-(length y)(length el))) (if(< n 0)(setq w 'nil)) (if (and z w (and (char el 0)(char y 0))) (unless (eq (char el 0)(char y 0))(prsl (subseq y 1))) (setq w nil) ) (when (and z w) (setq l(subseq y 0 elng)) ;subseq "nick van vliet" 2 7= "ck va" (if (string= l el) (setq z 'nil)(prsl (subseq y 1))) ) (setq z z) ) ;;(prsl "nick van vliet")(read-line) ;el="van" (defun rlte() (if (string/= rl "ZZZZZZZ") (setq z 't)(setq z 'nil) ) ) (defun rlts() (if (string= rl "*")(setq z 't)(setq z 'nil)) ) (defun rlfs() (if (string/= rl "*")(setq z 't)(setq z 'nil)) ) (setq *print-case* :downcase) ; print in lower case (defun sv (c$) ;;g=tv.dt f=tv.dtk=bak ;;c$="lisp\\tv\\tv" (setq ttla 0 ttld 0 ) ;[b$ [subseq c$ 5 9]] ==tv\\ (pr "\n MAKING A BACKUP FILE! ")(princ b$);(nl) (setq g (open (strcat c$ ".dt") :direction :io :if-exists :overwrite)) (setq ttlg (file-position g)) (setq f(open (strcat c$ ".dtk") :direction :io :if-exists :supersede)) (setq ttlf(file-position f)) (setq rl (read-line g)) (while rl (if(> (length rl) 0)(if (eq (char rl 0) "*")(setq ttld (file-position g)))) (princ (strcat rl "\n") f) (setq rl (read-line g)) (if (rlts)(setq ttla(file-position g))) ) ) (defun prntjo (x) (setq y(cdr x)) (setq rl(caar y)) (when (rlte) (if (and rl (string/= rl ""))(princ (strcat rl "\n") g)) (if y (prntjo y)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (goto-xy 1 1) (pr " <<<<<<< SORTING ALL FILES >>>>>>> NICK K. VAN VLIET, BOX 92544, CARLTON CPO, TORONTO, ONT M5A 4N9") (setq zp (/(get-internal-run-time) internal-time-units-per-second)) (setq ts 0)(tm) (defun editfile (a$) ;;a$="lisp\\tv\\tv" ;; (= 92 (char-int (char a$ i)))ok (do((i 5(1+ i)))((eq #\\ (char a$ i))) (setq b$ (subseq a$ 5 (1+ i)))) (sv a$) ;;(sv a$) ;;g=tv.dt f=tv.dtk=bak ;;a$=\\tv\\tv (close f) (file-position g ttlg) (setq j 1 lst (list '0) l nil) (setq rl(read-line g)) (pr " LOADING FILE! ") (princ b$);(nl) (while rl (if (rlts) (setq l (list j)) (setq l (append l (list (cons rl ())))) ) (setq rl(read-line g)) (when (rlts) (setq lst (append lst (list l))) (setq j(1+ j)) ) ) (setq n(- (length lst) 1)) (pr " SORTING FILE! ") (princ b$);(nl) (do ((j 1 (+ j 1)))((= j (- n 2))) (do ((k (+ j 1) (+ k 1)))((> k (- n 1))) (setq jo (nth j lst)) (setq ko (nth k lst)) (setq sl1 (caadr jo)) (setq n1 (length sl1)) (setq sl2(caadr ko)) (setq n2(length sl2)) (if (< n2 n1)(setq n3 n2)(setq n3 n1)) (setq z 0 zz 't) (do ((i 0 (1+ i)))((or(= i n3)(= z 1)(not zz))) (setq l1(char-code(char sl1 i))) (setq l2(char-code(char sl2 i))) (if (and zz (< l2 l1)) (setq z 1)) (if (/= l1 l2) (setq zz nil)) ) (if (and (= z 0) zz (< n2 n1)) (setq z 1)) (when (= z 1) (setq l1(cons k (cdr jo))) (setq l2(cons j (cdr ko))) (setq lst(subst l1 ko lst)) (setq lst(subst l2 jo lst)) ) )) (pr " WRITING SORTED FILE! ")(princ b$);(nl) (file-position g ttlg) (do ((j 1 (+ j 1)))((> j n)) (princ (strcat "*\n") g) (setq jo (nth j lst)) (prntjo jo) ) (princ "*\nZZZZZZZ\nEOF\n" g) (close g) (princ "") ;;(pr " DONE: HIT ENTER! ") (princ b$)(nl) ;;(read-line) ) (editfile "lisp\\crtn\\crtn")(tm) (editfile "lisp\\ufo\\ufo") (tm) (editfile "lisp\\dry\\dry") (tm) (editfile "lisp\\movi\\movi")(tm) (editfile "lisp\\talk\\talk")(tm) (editfile "lisp\\add\\add") (tm) (princ "\nHIT ENTER")(read-line) (exit) )(editor)
HOME PAGE
You are visitor no.
