1 ;;********************************************************
3 ;; description: Initialize Maxima
4 ;; date: Wed Jan 13 1999 - 20:27
5 ;; author: Liam Healy <Liam.Healy@nrl.navy.mil>
6 ;;********************************************************
8 ;;; An ANSI-CL portable initializer to replace init_max1.lisp
10 ;; CL-USER:*MAXIMA-BUILD-TIME* is defined in maxima.asd and maxima.system,
11 ;; but I guess ECL doesn't see that, so define it here.
14 (defvar *maxima-build-time
* '#.
(multiple-value-list (get-decoded-time)))
15 (export '*maxima-build-time
*))
19 ;;; Locations of various types of files. These variables are discussed
20 ;;; in more detail in the file doc/implementation/dir_vars.txt. Since
21 ;;; these are already in the maxima package, the maxima- prefix is
22 ;;; redundant. It is kept for consistency with the same variables in
23 ;;; shell scripts, batch scripts and environment variables.
26 (defvar *maxima-topdir
*) ;; top-level installation or build directory
27 (defvar *maxima-imagesdir
*)
28 (defvar *maxima-sharedir
*)
29 (defvar *maxima-srcdir
*)
30 (defvar *maxima-docdir
*)
31 (defvar *maxima-layout-autotools
*)
32 (defvar *maxima-demodir
*)
33 (defvar *maxima-objdir
*) ;; Where to store object (fasl) files.
35 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
36 (defmacro def-lisp-shadow
(root-name)
37 "Create a maxima variable $root_name that is an alias for the lisp name *root-name*.
38 When one changes, the other does too."
39 (let ((maxima-name (intern (concatenate 'string
"$"
40 (substitute #\_
#\-
(string root-name
)))))
41 (lisp-name (intern (concatenate 'string
"*" (string root-name
) "*"))))
43 (defmvar ,maxima-name
)
44 (putprop ',maxima-name
'shadow-string-assignment
'assign
)
45 (putprop ',maxima-name
',lisp-name
'lisp-shadow
)))))
47 (def-lisp-shadow maxima-tempdir
)
48 (def-lisp-shadow maxima-userdir
)
49 (def-lisp-shadow maxima-objdir
)
51 (defun shadow-string-assignment (var value
)
54 (setf (symbol-value (get var
'lisp-shadow
)) value
)
57 (merror (intl:gettext
"assignment: must assign a string to ~:M; found: ~M") var value
))))
59 (defun print-directories ()
60 (format t
"maxima-prefix=~a~%" *maxima-prefix
*)
61 (format t
"maxima-topdir=~a~%" *maxima-topdir
*)
62 (format t
"maxima-imagesdir=~a~%" *maxima-imagesdir
*)
63 (format t
"maxima-sharedir=~a~%" *maxima-sharedir
*)
64 (format t
"maxima-srcdir=~a~%" *maxima-srcdir
*)
65 (format t
"maxima-demodir=~a~%" *maxima-demodir
*)
66 (format t
"maxima-testsdir=~a~%" *maxima-testsdir
*)
67 (format t
"maxima-docdir=~a~%" *maxima-docdir
*)
68 (format t
"maxima-infodir=~a~%" *maxima-infodir
*)
69 (format t
"maxima-htmldir=~a~%" *maxima-htmldir
*)
70 (format t
"maxima-plotdir=~a~%" *maxima-plotdir
*)
71 (format t
"maxima-layout-autotools=~a~%" *maxima-layout-autotools
*)
72 (format t
"maxima-userdir=~a~%" *maxima-userdir
*)
73 (format t
"maxima-tempdir=~a~%" *maxima-tempdir
*)
74 (format t
"maxima-lang-subdir=~a~%" *maxima-lang-subdir
*)
75 (format t
"maxima-objdir=~A~%" *maxima-objdir
*))
77 (defvar *maxima-lispname
*
86 #+lispworks
"lispworks"
88 #-
(or clisp cmu scl sbcl gcl allegro openmcl abcl lispworks ecl
) "unknownlisp")
90 (defun maxima-parse-dirstring (str)
92 (if (position (character "\\") str
)
94 (setf str
(concatenate 'string
(string-right-trim sep str
) sep
))
96 (let ((dev (pathname-device str
)))
98 (setf dev
(first dev
)))
99 (if (and dev
(not (eq dev
:unspecific
))
100 (not (string= dev
"")))
101 (concatenate 'string
(string-right-trim ":" dev
) ":")
104 (apply #'combine-path
(rest (pathname-directory str
))))))
106 (defun set-pathnames-with-autoconf (maxima-prefix-env maxima-docprefix-env
)
107 (declare (ignore maxima-docprefix-env
))
108 (let (libdir libexecdir datadir infodir
109 (package-version (combine-path *autoconf-package
* *autoconf-version
*))
110 (binary-subdirectory (concatenate 'string
"binary-" *maxima-lispname
*)))
111 (if maxima-prefix-env
113 (setq libdir
(combine-path maxima-prefix-env
"lib"))
114 (setq libexecdir
(combine-path maxima-prefix-env
"libexec"))
115 (setq datadir
(combine-path maxima-prefix-env
"share"))
116 (setq infodir
(combine-path maxima-prefix-env
#+(or cygwin windows win32 win64
) "share" "info")))
118 (setq libdir
(maxima-parse-dirstring *autoconf-libdir
*))
119 (setq libexecdir
(maxima-parse-dirstring *autoconf-libexecdir
*))
120 (setq datadir
(maxima-parse-dirstring *autoconf-datadir
*))
121 (setq infodir
(maxima-parse-dirstring *autoconf-infodir
*))))
122 (setq *maxima-topdir
* (combine-path datadir package-version
))
123 (setq *maxima-imagesdir
* (combine-path libdir package-version binary-subdirectory
))
124 (setq *maxima-sharedir
* (combine-path datadir package-version
"share"))
125 (setq *maxima-srcdir
* (combine-path datadir package-version
"src"))
126 (setq *maxima-demodir
* (combine-path datadir package-version
"demo"))
127 (setq *maxima-testsdir
* (combine-path datadir package-version
"tests"))
128 (setq *maxima-docdir
* (combine-path datadir package-version
"doc"))
129 (setq *maxima-infodir
* infodir
)
130 (setq *maxima-htmldir
* (combine-path datadir package-version
"doc" "html"))
131 (setq *maxima-plotdir
* (combine-path libexecdir package-version
))))
133 (defun set-pathnames-without-autoconf (maxima-prefix-env maxima-docprefix-env
)
134 (let* ((maxima-prefix (if maxima-prefix-env
136 (maxima-parse-dirstring *autoconf-prefix
*)))
137 (binary-subdirectory (concatenate 'string
"binary-" *maxima-lispname
*)))
139 (setq *maxima-topdir
* maxima-prefix
)
140 (setq *maxima-imagesdir
* (combine-path maxima-prefix
"src" binary-subdirectory
))
141 (setq *maxima-sharedir
* (combine-path maxima-prefix
"share"))
142 (setq *maxima-srcdir
* (combine-path maxima-prefix
"src"))
143 (setq *maxima-demodir
* (combine-path maxima-prefix
"demo"))
144 (setq *maxima-testsdir
* (combine-path maxima-prefix
"tests"))
145 (let ((maxima-doc-prefix (if maxima-docprefix-env
148 (setq *maxima-docdir
* (combine-path maxima-doc-prefix
"doc"))
149 (setq *maxima-infodir
* (combine-path maxima-doc-prefix
"doc" "info"))
150 (setq *maxima-htmldir
* (combine-path maxima-doc-prefix
"doc" "html")))
151 (setq *maxima-plotdir
* (combine-path maxima-prefix
"plotting"))))
153 (defun default-userdir ()
154 (let ((home-env (maxima-getenv "HOME"))
156 (maxima-dir (if (string= *autoconf-windows
* "true")
160 (if (and home-env
(string/= home-env
""))
162 (if (string= home-env
"c:\\")
163 ;; but not if home-env = c:\, which results in slow startups
164 ;; under windows. Ick.
167 ;; we have to make a guess
168 (if (string= *autoconf-windows
* "true")
171 (combine-path (maxima-parse-dirstring base-dir
) maxima-dir
)))
173 (defun default-tempdir ()
174 (maxima-parse-dirstring
175 (let ((tmpdir-windows (maxima-getenv "TEMP"))
176 (tmpdir-posix (maxima-getenv "TMPDIR"))
177 (tmpdir-nonstandard1 (maxima-getenv "TMP"))
178 (tmpdir-nonstandard2 (maxima-getenv "TEMPDIR")))
181 ((and tmpdir-windows
(string/= tmpdir-windows
"")) tmpdir-windows
)
182 ((and tmpdir-posix
(string/= tmpdir-windows
"")) tmpdir-posix
)
183 ((and tmpdir-nonstandard1
(string/= tmpdir-nonstandard1
"")) tmpdir-nonstandard1
)
184 ((and tmpdir-nonstandard2
(string/= tmpdir-nonstandard2
"")) tmpdir-nonstandard2
)
185 ; A fallback for windows if everything else has failed
186 ((string= *autoconf-windows
* "true") "C:\\Windows\\temp")
187 ; A fallback for the rest of the operating systems
190 (defun set-locale-subdir ()
191 (let (language territory
#+nil codeset
)
192 ;; Determine *maxima-lang-subdir*
193 ;; 1. from MAXIMA_LANG_SUBDIR environment variable
194 ;; 2. from INTL::*LOCALE* if (1) fails
195 (unless (setq *maxima-lang-subdir
* (maxima-getenv "MAXIMA_LANG_SUBDIR"))
196 (cond ((or (null intl
::*locale
*) (equal intl
::*locale
* ""))
197 (setq *maxima-lang-subdir
* nil
))
198 ((member intl
::*locale
* '("C" "POSIX" "c" "posix") :test
#'equal
)
199 (setq *maxima-lang-subdir
* nil
))
201 ;; Code to parse code set in locale string, in case we figure out
202 ;; something to do with it; it isn't needed for language
203 ;; subdirectory any more, since all language files are UTF-8.
204 ;; We might make use of code set in ADJUST-CHARACTER-ENCODING.
205 #+nil
(when (eql (position #\. intl
::*locale
*) 5)
206 (setq codeset
(string-downcase (subseq intl
::*locale
* 6))))
207 (when (eql (position #\_ intl
::*locale
*) 2)
208 (setq territory
(string-downcase (subseq intl
::*locale
* 3 5))))
209 (setq language
(string-downcase (subseq intl
::*locale
* 0 2)))
210 ;; Set *maxima-lang-subdir* only for known languages.
211 ;; Extend procedure below as soon as new translation
213 (cond ((equal language
"en") ;; English
214 (setq *maxima-lang-subdir
* nil
))
215 ;; Latin-1 aka iso-8859-1 languages
216 ((member language
'("es" "pt" "de") :test
#'equal
)
217 (if (and (string= language
"pt") (string= territory
"br"))
218 (setq *maxima-lang-subdir
* (concatenate 'string language
"_BR"))
219 (setq *maxima-lang-subdir
* language
)))
221 ((string= language
"ja")
222 (setq *maxima-lang-subdir
* language
))
224 ((string= language
"ru")
225 (setq *maxima-lang-subdir
* language
))
226 (t (setq *maxima-lang-subdir
* nil
))))))))
228 (flet ((sanitize-string (s)
229 (map 'string
(lambda(x) (if (alphanumericp x
) x
#\_
))
230 (subseq s
0 (min 142 (length s
))))))
231 (defun lisp-implementation-version1 ()
232 (sanitize-string (lisp-implementation-version)))
233 (defun maxima-version1 ()
234 (sanitize-string *autoconf-version
*)))
236 (defun set-pathnames ()
237 (let ((maxima-prefix-env (maxima-getenv "MAXIMA_PREFIX"))
238 (maxima-layout-autotools-env (maxima-getenv "MAXIMA_LAYOUT_AUTOTOOLS"))
239 (maxima-userdir-env (maxima-getenv "MAXIMA_USERDIR"))
240 (maxima-docprefix-env (maxima-getenv "MAXIMA_DOC_PREFIX"))
241 (maxima-tempdir-env (maxima-getenv "MAXIMA_TEMPDIR"))
242 (maxima-objdir-env (maxima-getenv "MAXIMA_OBJDIR"))
243 (maxima-htmldir-env (maxima-getenv "MAXIMA_HTMLDIR")))
244 ;; MAXIMA_DIRECTORY is a deprecated substitute for MAXIMA_PREFIX
245 (unless maxima-prefix-env
246 (setq maxima-prefix-env
(maxima-getenv "MAXIMA_DIRECTORY")))
247 (if maxima-prefix-env
248 (setq *maxima-prefix
* maxima-prefix-env
)
249 (setq *maxima-prefix
* (maxima-parse-dirstring *autoconf-prefix
*)))
250 (if maxima-layout-autotools-env
251 (setq *maxima-layout-autotools
*
252 (string-equal maxima-layout-autotools-env
"true"))
253 (setq *maxima-layout-autotools
*
254 (string-equal *maxima-default-layout-autotools
* "true")))
255 (if *maxima-layout-autotools
*
256 (set-pathnames-with-autoconf maxima-prefix-env maxima-docprefix-env
)
257 (set-pathnames-without-autoconf maxima-prefix-env maxima-docprefix-env
))
258 (if maxima-userdir-env
259 (setq *maxima-userdir
* (maxima-parse-dirstring maxima-userdir-env
))
260 (setq *maxima-userdir
* (default-userdir)))
261 (if maxima-tempdir-env
262 (setq *maxima-tempdir
* (maxima-parse-dirstring maxima-tempdir-env
))
263 (setq *maxima-tempdir
* (default-tempdir)))
264 ;; Default *MAXIMA-OBJDIR* is <userdir>/binary/binary-<foo>lisp,
265 ;; because userdir is almost surely writable, and we don't want to clutter up
266 ;; random directories with Maxima stuff.
267 ;; Append binary-<foo>lisp whether objdir is the default or obtained from environment.
268 (setq *maxima-objdir
*
270 (if maxima-objdir-env
271 (maxima-parse-dirstring maxima-objdir-env
)
272 (concatenate 'string
*maxima-userdir
* "/binary"))
273 "/" (maxima-version1) "/" *maxima-lispname
* "/" (lisp-implementation-version1)))
275 (when maxima-htmldir-env
276 (setq *maxima-htmldir
* (combine-path (maxima-parse-dirstring maxima-htmldir-env
) "doc" "info")))
278 ;; On ECL the testbench fails mysteriously if this directory doesn't exist =>
279 ;; let's create it by hand as a workaround.
280 #+ecl
(ensure-directories-exist (concatenate 'string
*maxima-objdir
* "/"))
282 ; On Windows Vista gcc requires explicit include
284 (when (string= *autoconf-windows
* "true")
285 (let ((mingw-gccver (maxima-getenv "mingw_gccver")))
288 (concatenate 'string compiler
::*cc
* " -I\"" *maxima-prefix
* "\\include\""
289 " -I\"" *maxima-prefix
* "\\lib\\gcc-lib\\mingw32\\"
290 mingw-gccver
"\\include\" ")))))
292 ; Assign initial values for Maxima shadow variables
293 (setq $maxima_userdir
*maxima-userdir
*)
294 (setf (gethash '$maxima_userdir
*variable-initial-values
*) *maxima-userdir
*)
295 (setq $maxima_tempdir
*maxima-tempdir
*)
296 (setf (gethash '$maxima_tempdir
*variable-initial-values
*) *maxima-tempdir
*)
297 (setq $maxima_objdir
*maxima-objdir
*)
298 (setf (gethash '$maxima_objdir
*variable-initial-values
*) *maxima-objdir
*))
300 (let* ((ext #+gcl
"o"
301 #+(or cmu scl
) (c::backend-fasl-file-type c
::*target-backend
*)
305 #+openmcl
(pathname-type ccl
::*.fasl-pathname
*)
306 #+lispworks
(pathname-type (compile-file-pathname "foo.lisp"))
309 #-
(or gcl cmu scl sbcl clisp allegro openmcl lispworks ecl abcl
)
311 (lisp-patterns (concatenate 'string
"$$$.{" ext
",lisp,lsp}"))
312 (maxima-patterns "$$$.{mac,mc,wxm}")
313 (lisp+maxima-patterns
(concatenate 'string
"$$$.{" ext
",lisp,lsp,mac,mc,wxm}"))
314 (demo-patterns "$$$.{dem,dm1,dm2,dm3,dmt}")
315 (usage-patterns "$$.{usg,texi}")
316 (share-subdirs-list (share-subdirs-list))
317 ;; Smash the list of share subdirs into a string of the form
318 ;; "{affine,algebra,...,vector}" .
319 (share-subdirs (format nil
"{~{~A~^,~}}" share-subdirs-list
)))
321 (setq $file_search_lisp
323 ;; actually, this entry is not correct.
324 ;; there should be a separate directory for compiled
325 ;; lisp code. jfa 04/11/02
326 (combine-path *maxima-userdir
* lisp-patterns
)
327 (combine-path *maxima-sharedir
* lisp-patterns
)
328 (combine-path *maxima-sharedir
* share-subdirs lisp-patterns
)
329 (combine-path *maxima-srcdir
* lisp-patterns
)
330 (combine-path *maxima-topdir
* lisp-patterns
)))
331 (setq $file_search_maxima
333 (combine-path *maxima-userdir
* maxima-patterns
)
334 (combine-path *maxima-sharedir
* maxima-patterns
)
335 (combine-path *maxima-sharedir
* share-subdirs maxima-patterns
)
336 (combine-path *maxima-topdir
* maxima-patterns
)))
337 (setq $file_search_demo
339 (combine-path *maxima-sharedir
* demo-patterns
)
340 (combine-path *maxima-sharedir
* share-subdirs demo-patterns
)
341 (combine-path *maxima-demodir
* demo-patterns
)))
342 (setq $file_search_usage
344 (combine-path *maxima-sharedir
* usage-patterns
)
345 (combine-path *maxima-sharedir
* share-subdirs usage-patterns
)
346 (combine-path *maxima-docdir
* usage-patterns
)))
347 (setq $file_search_tests
348 `((mlist) ,(combine-path *maxima-testsdir
* lisp
+maxima-patterns
)))
350 ;; If *maxima-lang-subdir* is not nil test whether corresponding info directory
351 ;; with some data really exists. If not this probably means that required
352 ;; language pack wasn't installed and we reset *maxima-lang-subdir* to nil.
353 (when (and *maxima-lang-subdir
*
354 (not (probe-file (combine-path *maxima-infodir
* *maxima-lang-subdir
* "maxima-index.lisp"))))
355 (setq *maxima-lang-subdir
* nil
))))
357 (defun get-dirs (path &aux
(ns (namestring path
)))
358 (directory (concatenate 'string
360 (if (eql #\
/ (char ns
(1- (length ns
)))) "" "/")
362 #+(or :clisp
:sbcl
:ecl
:openmcl
:gcl
) "/")
363 #+openmcl
:directories
#+openmcl t
))
365 (defun unix-like-basename (path)
366 (let* ((pathstring (namestring path
))
367 (len (length pathstring
)))
368 (when (equal (subseq pathstring
(- len
1) len
) "/")
370 (setf pathstring
(subseq pathstring
0 len
)))
371 (subseq pathstring
(1+ (or (position #\
/ pathstring
:from-end t
)
372 (position #\\ pathstring
:from-end t
))) len
)))
374 (defun unix-like-dirname (path)
375 (let* ((pathstring (namestring path
))
376 (len (length pathstring
)))
377 (when (equal (subseq pathstring
(- len
1) len
) "/")
379 (setf pathstring
(subseq pathstring
0 len
)))
380 (subseq pathstring
0 (or (position #\
/ pathstring
:from-end t
)
381 (position #\\ pathstring
:from-end t
)))))
383 (defun list-avail-action ()
384 (let* ((maxima-verpkglibdir (if (maxima-getenv "MAXIMA-VERPKGLIBDIR")
385 (maxima-getenv "MAXIMA-VERPKGLIBDIR")
386 (if (maxima-getenv "MAXIMA_PREFIX")
387 (combine-path (maxima-getenv "MAXIMA_PREFIX") "lib"
388 *autoconf-package
* *autoconf-version
*)
389 (combine-path (maxima-parse-dirstring *autoconf-libdir
*)
390 *autoconf-package
* *autoconf-version
*))))
391 (len (length maxima-verpkglibdir
))
393 (format t
"Available versions:~%")
394 (unless (equal (subseq maxima-verpkglibdir
(- len
1) len
) "/")
395 (setf maxima-verpkglibdir
(concatenate 'string maxima-verpkglibdir
"/")))
396 (dolist (version (get-dirs (unix-like-dirname maxima-verpkglibdir
)))
397 (dolist (lisp (get-dirs version
))
398 (setf lisp-string
(unix-like-basename lisp
))
399 (when (search "binary-" lisp-string
)
400 (setf lisp-string
(subseq lisp-string
(length "binary-") (length lisp-string
)))
401 (format t
"version ~a, lisp ~a~%" (unix-like-basename version
) lisp-string
))))
404 (defun process-maxima-args (input-stream batch-flag
)
405 ;; (format t "processing maxima args = ")
406 ;; (mapc #'(lambda (x) (format t "\"~a\"~%" x)) (get-application-args))
409 (let ((maxima-options nil
))
410 ;; Note: The current option parsing code expects every short
411 ;; option to have an equivalent long option. No check is made for
412 ;; this, so please make sure this holds. Or change the code in
413 ;; process-args in command-line.lisp.
415 ;; The help strings should not have any special manual formatting
416 ;; but extraneous white space is ok. They are automatically
417 ;; printed with extraneous whitespace (including newlines) removed
418 ;; and lines wrapped neatly.
421 (make-cl-option :names
'("-b" "--batch")
423 :action
#'(lambda (file)
425 (make-string-input-stream
426 (format nil
"batch(\"~a\");"
428 (setf batch-flag
:batch
))
430 "Process maxima file <file> in batch mode.")
431 (make-cl-option :names
'("--batch-lisp")
433 :action
#'(lambda (file)
435 (make-string-input-stream
436 #-sbcl
(format nil
":lisp (load \"~a\");" file
)
437 #+sbcl
(format nil
":lisp (with-compilation-unit nil (load \"~a\"));" file
)))
438 (setf batch-flag
:batch
))
440 "Process lisp file <file> in batch mode.")
441 (make-cl-option :names
'("--batch-string")
443 :action
#'(lambda (string)
445 (make-string-input-stream string
))
446 (setf batch-flag
:batch
))
448 "Process maxima command(s) <string> in batch mode.")
449 (make-cl-option :names
'("-d" "--directories")
450 :action
#'(lambda () (print-directories) ($quit
))
452 "Display maxima internal directory information.")
453 (make-cl-option :names
'("--disable-readline")
456 (if (find :readline
*features
*)
458 :help-string
"Disable readline support.")
459 (make-cl-option :names
'("-g" "--enable-lisp-debugger")
461 (setf *debugger-hook
* nil
))
463 "Enable underlying lisp debugger.")
464 (make-cl-option :names
'("-h" "--help")
466 (format t
"usage: maxima [options]~%")
467 (list-cl-options maxima-options
)
469 :help-string
"Display this usage message.")
470 (make-cl-option :names
'("--userdir")
471 :argument
"<directory>"
473 :help-string
"Use <directory> for user directory (default is %USERPROFILE%/maxima for Windows, and $HOME/.maxima for other operating systems).")
474 (make-cl-option :names
'("--init")
480 ;; Strip off everything before
481 ;; the last "/" (or "\"). Then
482 ;; strip off everything after
484 (let* ((dot (position #\. f
:from-end t
))
487 (member c
'(#\
/ #\\)))
490 (base (subseq f
(if dir
(1+ dir
) 0) dot
)))
492 (mtell (intl:gettext
"Warning: Using basename ~S for init files instead of ~S" )
495 (let ((base-name (get-base-name file
)))
496 (setf *maxima-initmac
*
497 (concatenate 'string base-name
".mac"))
498 (setf *maxima-initlisp
*
499 (concatenate 'string base-name
".lisp")))))
500 :help-string
(format nil
"Set the base name of the Maxima & Lisp initialization files (default is ~s.) The last extension and any directory parts are removed to form the base name. The resulting files, <base>.mac and <base>.lisp are only searched for in userdir (see --userdir option). This may be specified for than once, but only the last is used."
501 (subseq *maxima-initmac
* 0
502 (- (length *maxima-initmac
*) 4))))
504 (make-cl-option :names
'("--init-mac")
506 :action
#'(lambda (file)
507 (setf *maxima-initmac
* file
))
508 :help-string
(format nil
"Set the name of the Maxima initialization file (default is ~s)"
509 *default-maxima-initmac
*))
511 (make-cl-option :names
'("--init-lisp")
513 :action
#'(lambda (file)
514 (setf *maxima-initlisp
* file
))
515 :help-string
(format nil
"Set the name of the Lisp initialization file (default is ~s)" *default-maxima-initlisp
*))
516 (make-cl-option :names
'("-l" "--lisp")
519 :help-string
"Use lisp implementation <lisp>.")
520 (make-cl-option :names
'("--list-avail")
521 :action
'list-avail-action
523 "List the installed version/lisp combinations.")
524 ;; --preload-lisp is left for backward compatibility. We
525 ;; no longer distinguish between mac and lisp files. Any
526 ;; file type that $LOAD supports is acceptable.
527 ;; "--init-mac" and "--init-lisp" are now also (deprecated)
528 ;; aliases for --preload.
529 (make-cl-option :names
'("-p" "--preload" "--preload-lisp" "--init-mac" "--init-lisp")
531 :action
#'(lambda (file)
534 "Preload <file>, which may be any file time accepted by
535 Maxima's LOAD function. The <file> is loaded before any other
536 system initialization is done. This will be searched for in
537 the locations given by file_search_maxima and
538 file_search_lisp. This can be specified multiple times to
539 load multiple files. The equivalent options --preload-lisp,
540 --init-mac, and --init-lisp are deprecated.")
541 (make-cl-option :names
'("-q" "--quiet")
543 (declare (special *maxima-quiet
*))
544 (setq *maxima-quiet
* t
))
545 :help-string
"Suppress Maxima start-up message.")
546 (make-cl-option :names
'("-r" "--run-string")
548 :action
#'(lambda (string)
549 (declare (special *maxima-run-string
*))
550 (setq *maxima-run-string
* t
)
552 (make-string-input-stream string
))
553 (setf batch-flag nil
))
555 "Process maxima command(s) <string> in interactive mode.")
556 (make-cl-option :names
'("-s" "--server")
558 :action
#'(lambda (port-string)
559 (start-client (parse-integer
561 (setf input-stream
*standard-input
*))
562 :help-string
"Connect Maxima to server on <port>.")
563 (make-cl-option :names
'("-u" "--use-version")
564 :argument
"<version>"
566 :help-string
"Use maxima version <version>.")
567 (make-cl-option :names
'("-v" "--verbose")
570 "Display lisp invocation in maxima wrapper script.")
571 (make-cl-option :names
'("--version")
573 (format t
"Maxima ~a~%"
577 "Display the default installed version.")
578 (make-cl-option :names
'("--very-quiet")
580 (declare (special *maxima-quiet
*))
581 (setq *maxima-quiet
* t
*display-labels-p
* nil
))
582 :help-string
"Suppress expression labels and Maxima start-up message.")
583 (make-cl-option :names
'("-X" "--lisp-options")
584 :argument
"<Lisp options>"
585 :action
#'(lambda (&rest opts
)
586 (declare (special *maxima-quiet
*))
587 (unless *maxima-quiet
*
588 (format t
"Lisp options: ~A" opts
)))
589 :help-string
"Options to be given to the underlying Lisp")
590 (make-cl-option :names
'("--no-init" "--norc")
592 (setf *maxima-load-init-files
* nil
))
593 :help-string
"Do not load the init file(s) on startup")
595 (process-args (get-application-args) maxima-options
))
596 (values input-stream batch-flag
))
598 ;; Delete all files *temp-files-list* contains.
599 (defun delete-temp-files ()
600 (maphash #'(lambda(filename param
)
601 (declare (ignore param
))
602 (let ((file (ignore-errors (probe-file filename
))))
604 (if (not (apparently-a-directory-p file
))
605 (delete-file file
)))))
608 (defun cl-user::run
()
609 "Run Maxima in its own package."
611 (initialize-runtime-globals)
612 (let ((input-stream *standard-input
*)
616 (setf (values input-stream batch-flag
)
617 (process-maxima-args input-stream batch-flag
))
619 (with-simple-restart (macsyma-quit "Maxima top-level")
620 (macsyma-top-level input-stream batch-flag
))))
624 (defun disable-some-lisp-warnings ()
625 ;; Suppress warnings about redefining functions;
626 ;; it appears that only Clisp and SBCL emit these warnings
627 ;; (ECL, GCL, CMUCL, and Clozure CL apparently do not).
628 ;; Such warnings are generated by the autoload mechanism.
629 ;; I guess it is plausible that we could also avoid the warnings by
630 ;; reworking autoload to not trigger them. I don't have enough
631 ;; motivation to attempt that right now.
632 #+sbcl
(setq sb-ext
:*muffled-warnings
* '(or sb-kernel
:redefinition-with-defun
sb-kernel:uninteresting-redefinition
))
633 #+sbcl
(declaim (sb-ext:muffle-conditions sb-ext
:compiler-note
))
634 #+clisp
(setq custom
:*suppress-check-redefinition
* t
)
636 ;; Suppress compiler output messages.
637 ;; These include the "0 errors, 0 warnings" message output from Clisp,
638 ;; and maybe other messages from other Lisps.
639 (setq *compile-verbose
* nil
))
641 (defun enable-some-lisp-warnings ()
642 ;; SB-KERNEL:UNINTERESTING-REDEFINITION appears to be the default value.
643 #+sbcl
(setq sb-ext
:*muffled-warnings
* 'sb-kernel
:uninteresting-redefinition
)
644 #+sbcl
(declaim (sb-ext:unmuffle-conditions sb-ext
:compiler-note
))
645 #+clisp
(setq custom
:*suppress-check-redefinition
* nil
)
646 (setq *compile-verbose
* t
))
648 (defun initialize-runtime-globals ()
649 (setf *load-verbose
* nil
)
651 (disable-some-lisp-warnings)
653 (setf *debugger-hook
* #'maxima-lisp-debugger
)
654 ;; See discussion on the maxima list
655 ;; http://www.math.utexas.edu/pipermail/maxima/2011/024014.html.
656 ;; Set *print-length* and *print-level* to some reasonable values so
657 ;; that normal Lisp structure is shown, but prevent typical circular
658 ;; structures from hanging Lisp.
660 ;; (We do we set these instead of binding them?)
661 (setf *print-circle
* nil
)
662 (setf *print-length
* 100)
663 (setf *print-level
* 15)
665 ;; GCL: print special floats, which are generated whether or not this flag is enabled
666 #+gcl
(setf si
:*print-nans
* t
)
669 (setf ccl
::*invoke-debugger-hook-on-interrupt
* t
)
670 ;; CCL 1.5 makes *read-default-float-format* a thread-local
671 ;; variable. Hence we need to set it here to get our desired
673 (setf *read-default-float-format
* 'double-float
))
677 (set-readtable-for-macsyma)
678 (setf *read-default-float-format
* 'lisp
::double-float
))
680 #+sbcl
(setf *read-default-float-format
* 'double-float
)
682 ;; GCL: disable readline symbol completion,
683 ;; leaving other functionality (line editing, anything else?) enabled.
685 ;; This is kind of terrible. I don't see a flag to only disable completion,
686 ;; or a way to set the symbol list to Maxima symbols and disable case inversion,
687 ;; so set the completion prefix to a nonexistent package.
688 ;; If ever package BLURFLE is actually defined, and contains external symbols,
689 ;; those symbols will be completed. I can live with that.
691 #+gcl
(setq si
::*readline-prefix
* "BLURFLE:")
693 (initialize-real-and-run-time)
696 (adjust-character-encoding)
698 (catch 'return-from-debugger
699 (cl-info::load-primary-index
))
700 (when (boundp '*maxima-prefix
*)
701 (push (pathname (concatenate 'string
*maxima-prefix
*
702 (if *maxima-layout-autotools
*
705 intl
::*locale-directories
*))
706 ;; Set up $browser for displaying help in browser.
707 (cond ((and (boundp '*autoconf-windows
*)
708 (string-equal *autoconf-windows
* "true"))
709 ;; Starts the default browser on Windows.
710 (setf $browser
"start ~A"))
711 ((boundp '*autoconf-host
*)
712 ;; Determine what kind of OS we're using from the host and
713 ;; set up the default browser appropriately.
714 (cond ((pregexp:pregexp-match-positions
"(?:darwin)" *autoconf-host
*)
715 (setf $browser
"open '~A'"))
716 ((pregexp:pregexp-match-positions
"(?i:linux)" *autoconf-host
*)
717 (setf $browser
"xdg-open '~A'"))))))
719 (defun adjust-character-encoding ()
720 #+sbcl
(setf sb-impl
::*default-external-format
* :utf-8
)
722 (handler-bind ((error #'(lambda (c)
723 ;; If there's a continue restart, restart
724 ;; to set the filename encoding anyway.
725 (if (find-restart 'cl
:continue c
)
726 (invoke-restart 'cl
:continue
)))))
727 ;; Set both the terminal external format and filename encoding to
728 ;; utf-8. The handler-bind is needed in case the filename
729 ;; encoding was already set to something else; we forcibly change
730 ;; it to utf-8. (Is that right?)
731 (setf stream
:*default-external-format
* :utf-8
)
732 (stream:set-system-external-format
:utf-8
:utf-8
))
735 (progn (setf custom
:*default-file-encoding
*
736 (ext:make-encoding
:input-error-action
#\?))
737 (setf custom
:*terminal-encoding
*
738 custom
:*default-file-encoding
*))))
740 (import 'cl-user
::run
)
743 (format t
"~&Type (to-maxima) to restart, ($quit) to quit Maxima.~%")
744 (let ((old-debugger-hook *debugger-hook
*))
747 (maxima-read-eval-print-loop)
748 (setf *debugger-hook
* old-debugger-hook
)
749 (format t
"Returning to Maxima~%")))))
752 (throw 'to-maxima t
))
754 (defun maxima-read-eval-print-loop ()
755 (when *debugger-hook
*
756 ; Only set a new debugger hook if *DEBUGGER-HOOK* has not been set to NIL
757 (setf *debugger-hook
* #'maxima-lisp-debugger-repl
))
758 (let ((eof (gensym)))
760 (catch 'to-maxima-repl
761 (format-prompt t
"~%~A> " (package-name *package
*))
763 (let ((input (read *standard-input
* nil eof
)))
764 ; Return to Maxima on EOF
768 (format t
"~{~&~S~}" (multiple-value-list (eval input
))))))))
770 (defun maxima-lisp-debugger-repl (condition me-or-my-encapsulation
)
771 (declare (ignore me-or-my-encapsulation
))
772 (format t
"~&Maxima encountered a Lisp error:~%~% ~A" condition
)
773 (format t
"~&~%Automatically continuing.~%To reenable the Lisp debugger set *debugger-hook* to nil.~%")
775 (throw 'to-maxima-repl t
))
777 (defvar $help
"type `describe(topic);' or `example(topic);' or `? topic'")
779 (defmfun $help
(&rest dummy
)
780 (declare (ignore dummy
))
783 (eval-when (:load-toplevel
:execute
)
784 (let ((context '$global
))
785 (declare (special context
))
786 (dolist (x '($%pi $%i $%e $%phi %i $%gamma
;numeric constants
787 $inf $minf $und $ind $infinity
;pseudo-constants
788 t nil
)) ;logical constants (Maxima names: true, false)
790 (setf (get x
'sysconst
) t
))))
792 ;;; Now that all of maxima has been loaded, define the various lists
793 ;;; and hashtables of builtin symbols and values.
795 ;;; The assume database structures for numeric constants such as $%pi and $%e
796 ;;; are circular. Attempting to copy a circular structure
797 ;;; into *builtin-symbol-props* would cause a hang. Therefore
798 ;;; the properties are copied into *builtin-symbol-props* before
799 ;;; initializing the assume database.
800 (let ((maxima-package (find-package :maxima
)))
801 (do-symbols (s maxima-package
)
802 (when (and (eql (symbol-package s
) maxima-package
)
804 (member (char (symbol-name s
) 0) '(#\$
#\%
) :test
#'char
=))
805 (push s
*builtin-symbols
*)
806 (setf (gethash s
*builtin-symbol-props
*)
807 (copy-tree (symbol-plist s
))))))
809 ;; Also store the property lists for symbols associated with operators;
810 ;; e.g. MPLUS, MTIMES, etc.
811 ;; Here we find them via the MHEADER property, which is used by the parser.
812 ;; I don't know any better way to find these properties.
814 (let ((maxima-package (find-package :maxima
)))
815 (do-symbols (s maxima-package
)
816 (let ((h (get s
'mheader
)))
818 (let ((s1 (first h
)))
819 (unless (gethash s1
*builtin-symbol-props
*)
820 (push s1
*builtin-symbols
*)
821 (setf (gethash s1
*builtin-symbol-props
*)
822 (copy-tree (symbol-plist s1
)))))))))
824 ;; Initialize assume database for $%pi, $%e, etc
825 (dolist (c *builtin-numeric-constants
*)
826 (initialize-numeric-constant c
))
828 (dolist (s *builtin-symbols
*)
830 (push s
*builtin-symbols-with-values
*)))
832 (dolist (s *builtin-symbols-with-values
*)
833 (setf (gethash s
*builtin-symbol-values
*) (symbol-value s
)))
835 (setf *builtin-$props
* (copy-list $props
))
836 (setf *builtin-$rules
* (copy-list $rules
))
838 (defun maxima-objdir (&rest subdirs
)
839 "Return a pathname string such that subdirs is a subdirectory of maxima_objdir"
840 (apply #'combine-path
*maxima-objdir
* subdirs
))
842 (defun maxima-load-pathname-directory ()
843 "Return the directory part of *load-pathname*."
844 (let ((path #-gcl
*load-pathname
*
845 ;; Accommodate standard and nonstandard definitions of *LOAD-PATHNAME* in GCL.
846 ;; This can go away someday when nonstandard GCL's (<= 2.6.12) are ancient history.
847 #+gcl
(symbol-value (or (find-symbol "*LOAD-PATHNAME*" :sys
) (find-symbol "*LOAD-PATHNAME*" :common-lisp
)))))
848 (make-pathname :directory
(pathname-directory path
)
849 :device
(pathname-device path
))))