[net.micro.atari16] Whoops...I forgot INIT.LSP

franco@iuvax.UUCP (04/13/86)

Whoops - I forgot to insert INIT.LSP onto one of the three disks I am
copying for people.  It is so short and the number of people needing it
is so long that the only practical way to get it out is over the net.
Hopefully this will be the last such transmission.

The file below should be named INIT.LSP:

--------------------------cut here----------------------------
; get some more memory
(expand 1)

; some fake definitions for Common Lisp pseudo compatiblity
(setq first  car)
(setq second cadr)
(setq rest   cdr)

; some more cxr functions
(defun caddr (x) (car (cddr x)))
(defun cadddr (x) (cadr (cddr x)))

; (when test code...) - execute code when test is true
(defmacro when (test &rest code)
          `(cond (,test ,@code)))

; (unless test code...) - execute code unless test is true
(defmacro unless (test &rest code)
          `(cond ((not ,test) ,@code)))

; (makunbound sym) - make a symbol be unbound
(defun makunbound (sym) (setq sym '*unbound*) sym)

; (objectp expr) - object predicate
(defun objectp (x) (eq (type-of x) :OBJECT))

; (filep expr) - file predicate
(defun filep (x) (eq (type-of x) :FILE))

; (unintern sym) - remove a symbol from the oblist
(defun unintern (sym) (cond ((member sym *oblist*)
                             (setq *oblist* (delete sym *oblist*))
                             t)
                            (t nil)))

; (mapcan ...)
(defmacro mapcan (&rest args) `(apply #'nconc (mapcar ,@args)))

; (mapcon ...)
(defmacro mapcon (&rest args) `(apply #'nconc (maplist ,@args)))

; (save fun) - save a function definition to a file
(defmacro save (fun)
         `(let* ((fname (strcat (symbol-name ',fun) ".lsp"))
                 (fval ',fun)
                 (fp (openo fname)))
                (cond (fp (print (cons (if (eq (car fval) 'lambda)
                                           'defun
                                           'defmacro)
                                       (cons fun (cdr fval))) fp)
                          (close fp)
                          fname)
                      (t nil))))

; (debug) - enable debug breaks
(defun debug ()
       (setq *breakenable* t))

; (nodebug) - disable debug breaks
(defun nodebug ()
       (setq *breakenable* nil))

; initialize to enable breaks but no trace back
(setq *breakenable* t)
(setq *tracenable* nil)