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