"$Header: /usr/lib/lisp/cmufile.l,v 1.1 83/01/29 18:34:10 jkf Exp $")
(eval-when (compile eval)
(declare (special $cur$ dc-switch piport %indent dc-switch
vars body form var init label part incr limit
getdeftable $outport$ tlmacros f tmp))
(dv *digits ("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
(dv *letters (a b c d e f g h i j k l m n o p q r s t u v w x y z))
(princ (get f 'changes)))))
(%changes (terpri) (princ '<no-file>) (tab 15) (princ %changes)))
(cond ((null %changes) nil)
(setq prop (get f 'changes))
(setq prop (insert fn prop nil t)))
(putprop f prop 'changes))
(setq found (apply 'append found))
(setq %changes (set-of fn %changes (not (memq fn found)))))))))
(eval (cons dc-switch args]
(msg "Enter comment followed by <esc>" (N 1))
(eval (cons 'dc-dskin args]
((eval (cons 'helpfilter (cons (car args) (caddr args))))
(transprint getdefchan)))))
(setq dc-switch 'dc-dskin)
(setq dc-switch 'dc-define)
The new version of dskout (7/26/80) tries to keep backup versions It returns
the setof its arguments that were successfully written If it can not write
a file (typically because of protection restrictions) it offers to (try to)
write a copy to /tmp A file written to /tmp is not considered to have been
successfully written (and changes will not consider it to be up-to-date) )
(cond ((atom (errset (setq p (infile f)) nil))
(msg "old version moved to "
(cond ((not (ttyesno)) (return nil)))))))
(errset (apply (function pp)
" - try to put it on /tmp? (y/n) " D)
(setq f (cdr (memq '/ f))))
(cons ffns (eval ffns))))))
(t (msg f " written " N D )))))
(apply (function dskout) (set-of f filelst (get f 'changes)))))
((lambda (%indent) (setq val (eval (car exp)))) (+ 2 %indent))
(setq filelst (insert name filelst nil t))
((not (boundp (concat name 'fns)))
(set (concat name 'fns) nil)))
(prog (x u getdefchan found)
(setq getdefchan (infile (car %%l)))
((eq (tyipeek getdefchan) -1)
((memq (tyipeek getdefchan)
((memq (tyipeek getdefchan)
(setq y (ratom getdefchan)))
(cond (t (comment - what about
(or (setq z (ratom getdefchan))
(apply (cdr (assoc (car x) getdeftable)) (ncons x))))))
(cond ((not (eq (tyi getdefchan) 10)) (zap getdefchan)))
(cond ((or (null getdefprops) (memq p getdefprops))
(dv getdefprops (function value expr fexpr macro))
((defprop lambda (x) (getdefact (cadr x) (cadddr x) x))
((or (null getdefprops) (memq 'comment getdefprops))
(de lambda (x) (getdefact (cadr x) 'expr x))
(df lambda (x) (getdefact (cadr x) 'fexpr x))
(dm lambda (x) (getdefact (cadr x) 'macro x))
(setq lambda (x) (getdefact (cadr x) 'value x))
(dv lambda (x) (getdefact (cadr x) 'value x))
(def lambda (x) (getdefact (cadr x) 'function x))))
(setq filelst nil) ;; initial values