src/lsp/init.lsp

   1 ; initialization file for XLISP-STAT 2.1
   2
   3 (defun xlisp::small-machine-p () nil)
   4 (export 'xlisp::small-machine-p 'xlisp)
   5
   6 ;; get some more space
   7 #+unix (expand 25)
   8 #-unix (expand 15)
   9
  10 ; disable strict keyword checking
  11 (setf *strict-keywords* nil)
  12
  13 ; restore old printing
  14 ;(setf *float-format* "%g")
  15
  16 ; enable macro displacement and setf simplification (both a bit risky)
  17 (setf xlisp::*displace-macros* t)
  18 (setf xlisp::*simplify-setf* t)
  19
  20 ; load in lisp files
  21 (load "common")
  22 (load "common2")
  23 (load "common3")
  24 (load "pathname")
  25 (load "loadfsl")
  26 (load "conditns")
  27 (load "shlib")
  28 #+unix (load "cmpload")
  29
  30 ; initialize to disable breaks and trace back
  31 ;(setf *breakenable* t)
  32 ;(setf *tracenable* t)
  33 ;(setf *tracelimit* 1)
  34 ;(setf *baktrace-print-arguments* nil)
  35 (setf *interrupt-action* #'top-level)
  36 (setf *debug-print-length* 4)
  37 (setf *debug-print-level* 3)
  38
  39 (setf xlisp::*default-handler*
  40       #'(lambda (c)
  41           (when (and (null *breakenable*) (typep c 'error))
  42                 (let ((*print-readably* nil))
  43                   (format *error-output* "~&Error: ~a~%" c)
  44                   (let ((f (xlisp::debug-fun)))
  45                     (if f (format *error-output* "Happened in: ~s~%" f))))
  46                 (abort))))
  47
  48 ; load xlispstat objects and related functions
  49 (require "help")
  50 (require "objects")
  51 (require "menus")
  52 #+msdos (require "dde")
  53
  54 ; load statistics and graphics functions
  55 (require "dialogs")
  56 (require "linalg")
  57 (require "stats")
  58 (require "graphics")
  59 (require "regress")
  60
  61 (in-package "XLISP")
  62
  63 (defvar *help-file-name*)
  64 (defvar *help-stream*)
  65 (defvar *line-length* 78 "Line length used in printing help messages")
  66 (defvar *help-loaded* nil)
  67
  68 (defun initialize-system ()
  69   (setf *load-pathname-defaults*
  70         (list *default-path*
  71               (merge-pathnames (make-pathname :directory
  72                                               '(:relative "Autoload"))
  73                                *default-path*)))
  74   (setf *help-file-name* (merge-pathnames "xlisp.hlp" *default-path*))
  75
  76   ;; adjust *features*
  77   (when (system-has-windows)
  78         (pushnew :windows *features*)
  79         (pushnew :dialogs *features*)
  80         (if (screen-has-color) (pushnew :color *features*))
  81         (if (small-machine-p) (pushnew :small-machine *features*)))
  82
  83   (setf *help-stream* (open *help-file-name* :if-does-not-exist nil))
  84   ;;(setf *help-loaded* nil)
  85
  86   ;; install macintosh listener and menu bar
  87   #+macintosh
  88   (progn
  89     (setq *listener* (send listener-proto :new))
  90     (set-menu-bar *standard-menu-bar*))
  91
  92   ;; install MS Windows menu bar
  93   #+msdos
  94   (if (system-has-windows)
  95       (set-menu-bar *standard-menu-bar*))
  96
  97   ;; load autoload information
  98   (setf *condition-hook* 'condition-hook)
  99   (mapc #'register-autoloads (create-autoload-path))
 100
 101   ;; initialize module search path
 102   (setf *module-path* (create-module-path))
 103
 104   ;; load user initialization file
 105   (let ((*package* (find-package "USER")))
 106     (load "statinit" :if-does-not-exist nil)))
 107
 108 (setf *startup-functions* '(use-conditions initialize-system))