home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / xlisp / xl21freq.zip / INIT.LSP < prev    next >
Lisp/Scheme  |  1993-12-17  |  4KB  |  110 lines
  1. ; initialization file for XLISP-PLUS 2.1f
  2.  
  3. (princ "XLISP-PLUS 2.1f contains contributed code by:
  4. Tom Almy, Mikael Pettersson, Neal Holtz, Johnny Greenblatt, Ken Whedbee,
  5. Blake McBride, Pete Yadlowsky, Hume Smith, and Richard Zidlicky.
  6. Portions copyright (c) 1988, Luke Tierney.\n")
  7.  
  8. ;; Set this up however you want it
  9. (setq *features* (list :xlisp :21f))
  10.  
  11. ;; Differences in various implementations, needed by example programs
  12. (when (fboundp 'export)
  13.       (setq *features* (cons :packages *features*)))
  14. #+:packages
  15. (in-package "XLISP")
  16. (when (fboundp 'get-internal-run-time) 
  17.       (setq *features* (cons :times *features*)))
  18. (when (fboundp 'generic) 
  19.       (setq *features* (cons :generic *features*)))
  20. (when (fboundp 'find-if)
  21.       (setq *features* (cons :posfcns *features*)))
  22. (when (fboundp 'log)
  23.       (setq *features* (cons :math *features*)))
  24. (when (alphanumericp #\M-C-@)
  25.       (setq *features* (cons :pc8 *features*)))
  26. (when (fboundp 'values)
  27.       (setq *features* (cons :mulvals *features*)))
  28.  
  29. #+:packages  ;; These should not be exported from XLISP
  30. (unexport '(%copy-struct %struct-set %struct-ref %struct-type-p %make-struct))
  31.  
  32. #-:packages
  33. (defun export (x))    ;; dummy definitions for package functions
  34. #-:packages
  35. (defun in-package (x))
  36.  
  37. (export '(strcat set-macro-character get-macro-character savefun
  38.       debug nodebug))
  39.  
  40. (defun strcat (&rest str)    ;; Backwards compatibility
  41.        (apply #'concatenate 'string str))
  42.  
  43.  
  44. ; (set-macro-character ch fun [ tflag ])
  45. (defun set-macro-character (ch fun &optional tflag)
  46.     (setf (aref *readtable* (char-int ch))
  47.           (cons (if tflag :tmacro :nmacro) fun))
  48.     t)
  49.  
  50. ; (get-macro-character ch)
  51. (defun get-macro-character (ch)
  52.   (if (consp (aref *readtable* (char-int ch)))
  53.     (cdr (aref *readtable* (char-int ch)))
  54.     nil))
  55.  
  56. ; (savefun fun) - save a function definition to a file
  57. (defmacro savefun (fun)
  58.   `(let* ((fname (strcat (symbol-name ',fun) ".lsp"))
  59.           (fval (get-lambda-expression (symbol-function ',fun)))
  60.           (fp (open fname :direction :output)))
  61.      (cond (fp (print (cons (if (eq (car fval) 'lambda)
  62.                                 'defun
  63.                                 'defmacro)
  64.                             (cons ',fun (cdr fval))) fp)
  65.                (close fp)
  66.                fname)
  67.            (t nil))))
  68.  
  69. ; (debug) - enable debug breaks
  70. (defun debug ()
  71.        (setq *breakenable* t))
  72.  
  73. ; (nodebug) - disable debug breaks
  74. (defun nodebug ()
  75.        (setq *breakenable* nil))
  76.  
  77. ; initialize to enable breaks but no trace back
  78. (setq *breakenable* t *tracenable* nil)
  79.  
  80.  
  81. ; macros get displaced with expansion
  82. ; Good feature, but commented out to avoid shock.
  83. (setq *displace-macros* t)
  84.  
  85. ;; Select one of these three choices
  86. ;; Other modes will not read in other standard lsp files
  87.  
  88.  
  89. ; print in upper case, case insensitive input
  90. ;(setq *print-case* :upcase *readtable-case* :upcase)
  91.  
  92. ; print in lower case
  93. ;(setq *print-case* :downcase *readtable-case* :upcase)
  94.  
  95. ; case sensitive, lowercase and uppercase swapped (favors lower case)
  96. (setq *print-case* :downcase *readtable-case* :invert)
  97.  
  98. ; Make this "T" to use doskey or run under Epsilon
  99. ; Comment out altogether for non-MSDOS environments
  100. (setq *dos-input* nil)
  101.  
  102. ;; Define Class and Object to be class and object when in case sensitive
  103. ;; mode
  104.  
  105. (when (eq *readtable-case* :invert)
  106.       (defconstant Class class)
  107.       (defconstant Object object)
  108.       (export '(Class Object)))
  109.  
  110.