;;; Eventually this file will be able to be read in along with
;;; the standard franz top level and thus allow the user to select
;;; (possible via the .lisprc) the top level he wants.
"$Header: /usr/lib/lisp/cmutpl.l,v 1.1 83/01/29 18:34:38 jkf Exp $")
(eval-when (compile eval)
(or (get 'cmumacs 'version) (load 'cmumacs))
(or (get 'cmufncs 'version) (load 'cmufncs)))
(declare (special history tlbuffer tlmacros historylength))
(cond ((matchq1 (setq xx (explode x)) (setq yy (explode y)))
(t (*** freelist xx) (*** freelist yy)))))))))
l1 (cond ((eq x y) (return t))
((or (equal y '(@)) (equal x '(@))) (return t))
((or (null x) (null y)) (return nil))
(cond ((cddr ev) (terpri) (tlprint (caddr ev)))))))
(rplacd (cdar history) (ncons val))
(cond ((null x) (car history))
((and (fixp x) (plusp x)) (assoc x history))
((and (fixp x) (minusp x)) (car (Cnth history (minus x)))))))
(cond ((setq exp (copy (cadr (tlgetevent (cadr x)))))
(t (princ '"No such event")))))
(cond ((setq exp (tlgetevent (cadr x)))
(return (ncons (cadr exp))))
(t (princ '"No such event")))))
(cond ((null (cdr x)) (showevents (reverse history)))
((null (setq e1 (tlgetevent (cadr x))))
(princ '"No such event as ")
((null (cddr x)) (showevents (ncons e1)))
((null (setq e2 (tlgetevent (caddr x))))
(princ '"No such event as ")
(t (setq e1 (memq e1 history))
(cond ((setq rest (memq e2 e1))
(cons e2 (reverse (ldiff e1 rest)))))
(ldiff (memq e2 history) e1))))))))))))
l (cond ((null x) (return (reverse ans)))
(setq ans (cons (cadr x) ans))
(t (setq ans (cons (kwote (car x)) ans)) (setq x (cdr x))))
top (cond ((not (boundp 'history)) (setq history nil)))
(princ (add1 (cond (history (caar history)) (t 0))))
((null (setq tlbuffer (lineread)))
(cond ((not (atom (setq cmd (car tlbuffer))))
(setq tlbuffer (cdr tlbuffer))
((setq cmd (assoc cmd tlmacros))
(setq cmd (apply (cdr cmd) (ncons tmp)))
(cond ((atom cmd) (go top))
(t (setq cmd (car cmd)) (go record))))
((and (null (cdr tlbuffer))
(or (numberp (car tlbuffer))
(boundp (car tlbuffer))))
(setq cmd (car tlbuffer))
((or (and (dtpr (getd (car tlbuffer)))
(memq (car (getd (car tlbuffer)))
(and (bcdp (getd (car tlbuffer)))
(eq (getdisc (getd (car tlbuffer)))
(setq cmd (cons (car tlbuffer) (tlquote (cdr tlbuffer))))
(cons (list (add1 (cond (history (caar history)) (t 0))) cmd)
((dtpr (cdr (setq tmp (Cnth history historylength))))
l (tlprint (tleval (tlread)))
; LWE 1/11/81 The following might make this sucker work after resets:
(setq user-top-level 'cmu-top-level)
(putd 'user-top-level (getd 'cmu-top-level))
(setq top-level 'cmu-top-level)
(putd 'top-level (getd 'cmu-top-level))
l (cond ((memq (tyipeek prt) '(27 -1)) (return nil))
(t (tyo (tyi prt)) (go l))))))
l (cond ((memq (tyi prt) '(10 -1)) (return nil)) (t (go l))))))