home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / xlisp / ufg.arc / INIT.LSP < prev    next >
Lisp/Scheme  |  1987-06-02  |  2KB  |  42 lines
  1. ;;; Initialisation for XLISP (V1.7) to be more Common Lisp compatible.
  2. (setq *breakenable* t)    ; DGUTS! ("Don't give up the ship")
  3. (setq *tracenable* t)    ; Show, what went wrong
  4. (setq *tracelimit* 3)    ; Usually enough to see what's wrong
  5.  
  6. (defun divide (x y) (/ x y))    ; To provide compatibility with CLtL
  7.                 ; In Common Lisp this is (FLOOR X Y)
  8.                 ; and won't give you any ratio's
  9.  
  10. ; The next is not perfect or correct, but it works...
  11. (defmacro defvar (symbol &optional value documentation)
  12.   (if (not (boundp symbol)) `(setq ,symbol ,value)))
  13.  
  14. ; READLN is made for compatibility with Common Lisp (where you have to
  15. ; specify a NIL-result at EOF explicitely:
  16. (defun readln (&optional stream)
  17.   (if stream (read-line stream) (read-line *standard-input*)))
  18.  
  19. ; Next is my own invention (Winston & Horn wasn't satisfying)
  20. (defun pprint (thing &optional stream)
  21.   (pprint-aux thing 0 (if stream stream *standard-output*))
  22.   (terpri (if stream stream *standard-output*)))
  23. (defun pprint-aux (thing column stream)
  24.   (if    (<= column 0)
  25.     (progn    (terpri stream) (setq column (- column))
  26.         (dotimes (tmp column) (princ " " stream))))
  27.   (if    (or (atom thing) (not (listp (cdr thing))))
  28.     (prin1 thing stream)
  29.     (prog    ((tmp (flatsize (car thing))))
  30.         (princ "(" stream)
  31.                (if (> tmp (/ (- 80 column) 2)) (go car-no-fit))
  32.                (prin1 (car thing) stream)
  33.                (if (null (cdr thing)) (go one-item-list))
  34.                (setq column (+ column tmp 1))
  35.                (princ " " stream) (setq thing (cdr thing))
  36.                car-no-fit (setq column (+ column 1))
  37.                (pprint-aux (car thing) column stream)
  38.                (dolist    (tmp (cdr thing))
  39.                 (pprint-aux tmp (- column) stream))
  40.                one-item-list (princ ")" stream))))
  41.  
  42.