Reduce code duplication in print-directories
[maxima.git] / src / init-cl.lisp
blob8cc6e6bb17f1f43d77d24b960598167b4d8f3f72
1 ;;********************************************************
2 ;; file: init-cl.lisp
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.
12 #+ecl (progn
13 (in-package :cl-user)
14 (defvar *maxima-build-time* '#.(multiple-value-list (get-decoded-time)))
15 (export '*maxima-build-time*))
17 (in-package :maxima)
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.
24 ;;; jfa 02/07/04
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 (defvar *verify-html-index* t
36 "If non-NIL, verify the contents of the html index versus the text
37 index. Set via the command-line option --no-verify-html-index.")
39 (defun shadow-string-assignment (var value)
40 (cond
41 ((stringp value)
42 (setf (symbol-value (get var 'lisp-shadow)) value)
43 value)
45 (merror (intl:gettext "assignment: must assign a string to ~:M; found: ~M") var value))))
47 (defun print-directories ()
48 (dolist (var '(*maxima-prefix*
49 *maxima-topdir*
50 *maxima-imagesdir*
51 *maxima-sharedir*
52 *maxima-srcdir*
53 *maxima-demodir*
54 *maxima-testsdir*
55 *maxima-docdir*
56 *maxima-infodir*
57 *maxima-htmldir*
58 *maxima-plotdir*
59 *maxima-layout-autotools*
60 *maxima-userdir*
61 *maxima-tempdir*
62 *maxima-lang-subdir*
63 *maxima-objdir*))
64 ;; Neatly print out the name of the variable (sans *) and the
65 ;; corresponding value.
66 (format t "~a:~25t~a~%"
67 (string-trim "*" (string-downcase var))
68 (symbol-value var))))
70 (defvar *maxima-lispname*
71 #+clisp "clisp"
72 #+cmu "cmucl"
73 #+scl "scl"
74 #+sbcl "sbcl"
75 #+gcl "gcl"
76 #+allegro "acl"
77 #+openmcl "openmcl"
78 #+abcl "abcl"
79 #+lispworks "lispworks"
80 #+ecl "ecl"
81 #-(or clisp cmu scl sbcl gcl allegro openmcl abcl lispworks ecl) "unknownlisp")
83 (defun maxima-parse-dirstring (str)
84 (let ((sep "/"))
85 (if (position (character "\\") str)
86 (setq sep "\\"))
87 (setf str (concatenate 'string (string-right-trim sep str) sep))
88 (concatenate 'string
89 (let ((dev (pathname-device str)))
90 (if (consp dev)
91 (setf dev (first dev)))
92 (if (and dev (not (eq dev :unspecific))
93 (not (string= dev "")))
94 (concatenate 'string (string-right-trim ":" dev) ":")
95 ""))
96 "/"
97 (apply #'combine-path (rest (pathname-directory str))))))
99 (defun set-pathnames-with-autoconf (maxima-prefix-env maxima-docprefix-env)
100 (declare (ignore maxima-docprefix-env))
101 (let (libdir libexecdir datadir infodir
102 (package-version (combine-path *autoconf-package* *autoconf-version*))
103 (binary-subdirectory (concatenate 'string "binary-" *maxima-lispname*)))
104 (if maxima-prefix-env
105 (progn
106 (setq libdir (combine-path maxima-prefix-env "lib"))
107 (setq libexecdir (combine-path maxima-prefix-env "libexec"))
108 (setq datadir (combine-path maxima-prefix-env "share"))
109 (setq infodir (combine-path maxima-prefix-env #+(or cygwin windows win32 win64) "share" "info")))
110 (progn
111 (setq libdir (maxima-parse-dirstring *autoconf-libdir*))
112 (setq libexecdir (maxima-parse-dirstring *autoconf-libexecdir*))
113 (setq datadir (maxima-parse-dirstring *autoconf-datadir*))
114 (setq infodir (maxima-parse-dirstring *autoconf-infodir*))))
115 (setq *maxima-topdir* (combine-path datadir package-version))
116 (setq *maxima-imagesdir* (combine-path libdir package-version binary-subdirectory))
117 (setq *maxima-sharedir* (combine-path datadir package-version "share"))
118 (setq *maxima-srcdir* (combine-path datadir package-version "src"))
119 (setq *maxima-demodir* (combine-path datadir package-version "demo"))
120 (setq *maxima-testsdir* (combine-path datadir package-version "tests"))
121 (setq *maxima-docdir* (combine-path datadir package-version "doc"))
122 (setq *maxima-infodir* infodir)
123 (setq *maxima-htmldir* (combine-path datadir package-version "doc" "html"))
124 (setq *maxima-plotdir* (combine-path libexecdir package-version))))
126 (defun set-pathnames-without-autoconf (maxima-prefix-env maxima-docprefix-env)
127 (let* ((maxima-prefix (if maxima-prefix-env
128 maxima-prefix-env
129 (maxima-parse-dirstring *autoconf-prefix*)))
130 (binary-subdirectory (concatenate 'string "binary-" *maxima-lispname*)))
132 (setq *maxima-topdir* maxima-prefix)
133 (setq *maxima-imagesdir* (combine-path maxima-prefix "src" binary-subdirectory))
134 (setq *maxima-sharedir* (combine-path maxima-prefix "share"))
135 (setq *maxima-srcdir* (combine-path maxima-prefix "src"))
136 (setq *maxima-demodir* (combine-path maxima-prefix "demo"))
137 (setq *maxima-testsdir* (combine-path maxima-prefix "tests"))
138 (let ((maxima-doc-prefix (if maxima-docprefix-env
139 maxima-docprefix-env
140 maxima-prefix)))
141 (setq *maxima-docdir* (combine-path maxima-doc-prefix "doc"))
142 (setq *maxima-infodir* (combine-path maxima-doc-prefix "doc" "info"))
143 (setq *maxima-htmldir* (combine-path maxima-doc-prefix "doc" "html")))
144 (setq *maxima-plotdir* (combine-path maxima-prefix "plotting"))))
146 (defun default-userdir ()
147 (let ((home-env (maxima-getenv "HOME"))
148 (base-dir "")
149 (maxima-dir (if (string= *autoconf-windows* "true")
150 "maxima"
151 ".maxima")))
152 (setf base-dir
153 (if (and home-env (string/= home-env ""))
154 ;; use home-env...
155 (if (string= home-env "c:\\")
156 ;; but not if home-env = c:\, which results in slow startups
157 ;; under windows. Ick.
158 "c:\\user\\"
159 home-env)
160 ;; we have to make a guess
161 (if (string= *autoconf-windows* "true")
162 "c:\\user\\"
163 "/tmp")))
164 (combine-path (maxima-parse-dirstring base-dir) maxima-dir)))
166 (defun default-tempdir ()
167 (maxima-parse-dirstring
168 (let ((tmpdir-windows (maxima-getenv "TEMP"))
169 (tmpdir-posix (maxima-getenv "TMPDIR"))
170 (tmpdir-nonstandard1 (maxima-getenv "TMP"))
171 (tmpdir-nonstandard2 (maxima-getenv "TEMPDIR")))
173 (cond
174 ((and tmpdir-windows (string/= tmpdir-windows "")) tmpdir-windows)
175 ((and tmpdir-posix (string/= tmpdir-windows "")) tmpdir-posix)
176 ((and tmpdir-nonstandard1 (string/= tmpdir-nonstandard1 "")) tmpdir-nonstandard1)
177 ((and tmpdir-nonstandard2 (string/= tmpdir-nonstandard2 "")) tmpdir-nonstandard2)
178 ; A fallback for windows if everything else has failed
179 ((string= *autoconf-windows* "true") "C:\\Windows\\temp")
180 ; A fallback for the rest of the operating systems
181 (t "/tmp")))))
183 (defun set-locale-subdir ()
184 (let (language territory #+nil codeset)
185 ;; Determine *maxima-lang-subdir*
186 ;; 1. from MAXIMA_LANG_SUBDIR environment variable
187 ;; 2. from INTL::*LOCALE* if (1) fails
188 (unless (setq *maxima-lang-subdir* (maxima-getenv "MAXIMA_LANG_SUBDIR"))
189 (cond ((or (null intl::*locale*) (equal intl::*locale* ""))
190 (setq *maxima-lang-subdir* nil))
191 ((member intl::*locale* '("C" "POSIX" "c" "posix") :test #'equal)
192 (setq *maxima-lang-subdir* nil))
194 ;; Code to parse code set in locale string, in case we figure out
195 ;; something to do with it; it isn't needed for language
196 ;; subdirectory any more, since all language files are UTF-8.
197 ;; We might make use of code set in ADJUST-CHARACTER-ENCODING.
198 #+nil (when (eql (position #\. intl::*locale*) 5)
199 (setq codeset (string-downcase (subseq intl::*locale* 6))))
200 (when (eql (position #\_ intl::*locale*) 2)
201 (setq territory (string-downcase (subseq intl::*locale* 3 5))))
202 (setq language (string-downcase (subseq intl::*locale* 0 2)))
203 ;; Set *maxima-lang-subdir* only for known languages.
204 ;; Extend procedure below as soon as new translation
205 ;; is available.
206 (cond ((equal language "en") ;; English
207 (setq *maxima-lang-subdir* nil))
208 ;; Latin-1 aka iso-8859-1 languages
209 ((member language '("es" "pt" "de") :test #'equal)
210 (if (and (string= language "pt") (string= territory "br"))
211 (setq *maxima-lang-subdir* (concatenate 'string language "_BR"))
212 (setq *maxima-lang-subdir* language)))
213 ;; Japanese.
214 ((string= language "ja")
215 (setq *maxima-lang-subdir* language))
216 ;; Russian.
217 ((string= language "ru")
218 (setq *maxima-lang-subdir* language))
219 (t (setq *maxima-lang-subdir* nil))))))))
221 (flet ((sanitize-string (s)
222 (map 'string (lambda(x) (if (alphanumericp x) x #\_))
223 (subseq s 0 (min 142 (length s))))))
224 (defun lisp-implementation-version1 ()
225 (sanitize-string (lisp-implementation-version)))
226 (defun maxima-version1 ()
227 (sanitize-string *autoconf-version*)))
229 (defun setup-search-lists ()
230 "Set up the default values for $file_search_lisp, $file_search_maxima,
231 $file_search_demo, $file_search_usage, and $file_search_test."
232 (let* ((ext (pathname-type (compile-file-pathname "foo.lisp")))
233 (lisp-patterns (list ext "lisp"))
234 (maxima-patterns '("mac" "wxm"))
235 (lisp+maxima-patterns (append lisp-patterns maxima-patterns))
236 (demo-patterns '("dem"))
237 (usage-patterns '("usg")))
239 (flet ((build-search-list (path-info)
240 (let (search-path)
241 (dolist (info path-info)
242 (destructuring-bind (dir extensions)
243 info
244 (dolist (ext extensions)
245 (push (combine-path dir (concatenate 'string "*." ext))
246 search-path))))
247 (make-mlist-l (nreverse search-path)))))
249 (setf $file_search_lisp
250 (build-search-list (list (list (combine-path *maxima-userdir* "**")
251 lisp-patterns)
252 (list (combine-path *maxima-sharedir* "**")
253 ;; sharedir should only have lisp files.
254 '("lisp"))
255 (list *maxima-srcdir* lisp-patterns)
256 (list *maxima-topdir* lisp-patterns))))
257 (setf $file_search_maxima
258 (build-search-list (list (list (combine-path *maxima-userdir* "**")
259 maxima-patterns)
260 (list (combine-path *maxima-sharedir* "**")
261 ;; sharedir should only have mac files.
262 '("mac"))
263 ;; See
264 ;; https://sourceforge.net/p/maxima/bugs/4174/.
265 ;; This is a work around so that
266 ;; we can load zeilberger on ecl.
267 #+ecl
268 (list (combine-path *maxima-sharedir* "contrib" "**")
269 '("mac"))
270 #+ecl
271 (list (combine-path *maxima-sharedir* "simplex" "**")
272 '("mac"))
273 (list *maxima-srcdir*
274 '("mac"))
275 (list *maxima-topdir*
276 '("mac")))))
277 (setf $file_search_demo
278 (build-search-list (list (list (combine-path *maxima-sharedir* "**")
279 demo-patterns)
280 (list *maxima-demodir* demo-patterns))))
281 (setf $file_search_usage
282 (build-search-list (list (list (combine-path *maxima-sharedir* "**")
283 usage-patterns)
284 (list *maxima-docdir* usage-patterns))))
285 (setf $file_search_tests
286 (build-search-list (list (list *maxima-testsdir* lisp+maxima-patterns)))))))
288 (defun set-pathnames ()
289 (let ((maxima-prefix-env (maxima-getenv "MAXIMA_PREFIX"))
290 (maxima-layout-autotools-env (maxima-getenv "MAXIMA_LAYOUT_AUTOTOOLS"))
291 (maxima-userdir-env (maxima-getenv "MAXIMA_USERDIR"))
292 (maxima-docprefix-env (maxima-getenv "MAXIMA_DOC_PREFIX"))
293 (maxima-tempdir-env (maxima-getenv "MAXIMA_TEMPDIR"))
294 (maxima-objdir-env (maxima-getenv "MAXIMA_OBJDIR"))
295 (maxima-htmldir-env (maxima-getenv "MAXIMA_HTMLDIR")))
296 ;; MAXIMA_DIRECTORY is a deprecated substitute for MAXIMA_PREFIX
297 (unless maxima-prefix-env
298 (setq maxima-prefix-env (maxima-getenv "MAXIMA_DIRECTORY")))
299 (if maxima-prefix-env
300 (setq *maxima-prefix* maxima-prefix-env)
301 (setq *maxima-prefix* (maxima-parse-dirstring *autoconf-prefix*)))
302 (if maxima-layout-autotools-env
303 (setq *maxima-layout-autotools*
304 (string-equal maxima-layout-autotools-env "true"))
305 (setq *maxima-layout-autotools*
306 (string-equal *maxima-default-layout-autotools* "true")))
307 (if *maxima-layout-autotools*
308 (set-pathnames-with-autoconf maxima-prefix-env maxima-docprefix-env)
309 (set-pathnames-without-autoconf maxima-prefix-env maxima-docprefix-env))
310 (if maxima-userdir-env
311 (setq *maxima-userdir* (maxima-parse-dirstring maxima-userdir-env))
312 (setq *maxima-userdir* (default-userdir)))
313 (if maxima-tempdir-env
314 (setq *maxima-tempdir* (maxima-parse-dirstring maxima-tempdir-env))
315 (setq *maxima-tempdir* (default-tempdir)))
316 ;; Default *MAXIMA-OBJDIR* is <userdir>/binary/binary-<foo>lisp,
317 ;; because userdir is almost surely writable, and we don't want to clutter up
318 ;; random directories with Maxima stuff.
319 ;; Append binary-<foo>lisp whether objdir is the default or obtained from environment.
320 (setq *maxima-objdir*
321 (concatenate 'string
322 (if maxima-objdir-env
323 (maxima-parse-dirstring maxima-objdir-env)
324 (concatenate 'string *maxima-userdir* "/binary"))
325 "/" (maxima-version1) "/" *maxima-lispname* "/" (lisp-implementation-version1)))
327 (when maxima-htmldir-env
328 (setq *maxima-htmldir* (combine-path (maxima-parse-dirstring maxima-htmldir-env) "doc" "info")))
330 ;; On ECL the testbench fails mysteriously if this directory doesn't exist =>
331 ;; let's create it by hand as a workaround.
332 #+ecl (ensure-directories-exist (concatenate 'string *maxima-objdir* "/"))
334 ; Assign initial values for Maxima shadow variables
335 (setq $maxima_userdir *maxima-userdir*)
336 (setf (gethash '$maxima_userdir *variable-initial-values*) *maxima-userdir*)
337 (setq $maxima_tempdir *maxima-tempdir*)
338 (setf (gethash '$maxima_tempdir *variable-initial-values*) *maxima-tempdir*)
339 (setq $maxima_objdir *maxima-objdir*)
340 (setf (gethash '$maxima_objdir *variable-initial-values*) *maxima-objdir*))
342 (setup-search-lists)
344 ;; If *maxima-lang-subdir* is not nil test whether corresponding info directory
345 ;; with some data really exists. If not this probably means that required
346 ;; language pack wasn't installed and we reset *maxima-lang-subdir* to nil.
347 (when (and *maxima-lang-subdir*
348 (not (probe-file (combine-path *maxima-infodir* *maxima-lang-subdir* "maxima-index.lisp"))))
349 (setq *maxima-lang-subdir* nil)))
351 (defun get-dirs (path &aux (ns (namestring path)))
352 (directory (concatenate 'string
354 (if (eql #\/ (char ns (1- (length ns)))) "" "/")
356 #+(or :clisp :sbcl :ecl :openmcl :gcl) "/")
357 #+openmcl :directories #+openmcl t))
359 (defun unix-like-basename (path)
360 (let* ((pathstring (namestring path))
361 (len (length pathstring)))
362 (when (equal (subseq pathstring (- len 1) len) "/")
363 (decf len)
364 (setf pathstring (subseq pathstring 0 len)))
365 (subseq pathstring (1+ (or (position #\/ pathstring :from-end t)
366 (position #\\ pathstring :from-end t))) len)))
368 (defun unix-like-dirname (path)
369 (let* ((pathstring (namestring path))
370 (len (length pathstring)))
371 (when (equal (subseq pathstring (- len 1) len) "/")
372 (decf len)
373 (setf pathstring (subseq pathstring 0 len)))
374 (subseq pathstring 0 (or (position #\/ pathstring :from-end t)
375 (position #\\ pathstring :from-end t)))))
377 (defun list-avail-action ()
378 (let* ((maxima-verpkglibdir (if (maxima-getenv "MAXIMA-VERPKGLIBDIR")
379 (maxima-getenv "MAXIMA-VERPKGLIBDIR")
380 (if (maxima-getenv "MAXIMA_PREFIX")
381 (combine-path (maxima-getenv "MAXIMA_PREFIX") "lib"
382 *autoconf-package* *autoconf-version*)
383 (combine-path (maxima-parse-dirstring *autoconf-libdir*)
384 *autoconf-package* *autoconf-version*))))
385 (len (length maxima-verpkglibdir))
386 (lisp-string nil))
387 (format t "Available versions:~%")
388 (unless (equal (subseq maxima-verpkglibdir (- len 1) len) "/")
389 (setf maxima-verpkglibdir (concatenate 'string maxima-verpkglibdir "/")))
390 (dolist (version (get-dirs (unix-like-dirname maxima-verpkglibdir)))
391 (dolist (lisp (get-dirs version))
392 (setf lisp-string (unix-like-basename lisp))
393 (when (search "binary-" lisp-string)
394 (setf lisp-string (subseq lisp-string (length "binary-") (length lisp-string)))
395 (format t "version ~a, lisp ~a~%" (unix-like-basename version) lisp-string))))
396 (bye)))
398 (defvar *maxima-commandline-options* nil
399 "All of the recognized command line options for maxima")
401 (defun process-maxima-args (input-stream batch-flag)
402 ;; (format t "processing maxima args = ")
403 ;; (mapc #'(lambda (x) (format t "\"~a\"~%" x)) (get-application-args))
404 ;; (terpri)
405 ;; (finish-output)
407 ;; Note: The current option parsing code expects every short
408 ;; option to have an equivalent long option. No check is made for
409 ;; this, so please make sure this holds. Or change the code in
410 ;; process-args in command-line.lisp.
412 ;; The help strings should not have any special manual formatting
413 ;; but extraneous white space is ok. They are automatically
414 ;; printed with extraneous whitespace (including newlines) removed
415 ;; and lines wrapped neatly.
417 ;; NOTE: If you add or remove command-line options, be sure to
418 ;; update doc/info/commandline-options.texi. Use (list-cl-options
419 ;; *maxima-commandline-options* :texi-table-form t) to get the table
420 ;; to paste into commandline-options.texi.
421 (setf *maxima-commandline-options*
422 (list
423 (make-cl-option :names '("-b" "--batch")
424 :argument "<file>"
425 :action #'(lambda (file)
426 (setf input-stream
427 (make-string-input-stream
428 (format nil "batch(\"~a\");"
429 file)))
430 (setf batch-flag :batch))
431 :help-string
432 "Process maxima file <file> in batch mode.")
433 (make-cl-option :names '("--batch-lisp")
434 :argument "<file>"
435 :action #'(lambda (file)
436 (setf input-stream
437 (make-string-input-stream
438 #-sbcl (format nil ":lisp (load \"~a\");" file)
439 #+sbcl (format nil ":lisp (with-compilation-unit nil (load \"~a\"));" file)))
440 (setf batch-flag :batch))
441 :help-string
442 "Process lisp file <file> in batch mode.")
443 (make-cl-option :names '("--batch-string")
444 :argument "<string>"
445 :action #'(lambda (string)
446 (setf input-stream
447 (make-string-input-stream string))
448 (setf batch-flag :batch))
449 :help-string
450 "Process maxima command(s) <string> in batch mode.")
451 (make-cl-option :names '("-d" "--directories")
452 :action #'(lambda () (print-directories) ($quit))
453 :help-string
454 "Display maxima internal directory information.")
455 (make-cl-option :names '("--disable-readline")
456 :action #'(lambda ()
457 #+gcl
458 (if (find :readline *features*)
459 (si::readline-off)))
460 :help-string "Disable readline support.")
461 (make-cl-option :names '("-g" "--enable-lisp-debugger")
462 :action #'(lambda ()
463 (setf *debugger-hook* nil))
464 :help-string
465 "Enable underlying lisp debugger.")
466 (make-cl-option :names '("-h" "--help")
467 :action #'(lambda ()
468 (format t "usage: maxima [options]~%")
469 (list-cl-options *maxima-commandline-options*)
470 (bye))
471 :help-string "Display this usage message.")
472 (make-cl-option :names '("--userdir")
473 :argument "<directory>"
474 :action nil
475 :help-string "Use <directory> for user directory (default is %USERPROFILE%/maxima for Windows, and $HOME/.maxima for other operating systems).")
476 (make-cl-option :names '("--init")
477 :argument "<file>"
478 :action
479 #'(lambda (file)
480 (flet
481 ((get-base-name (f)
482 ;; Strip off everything before
483 ;; the last "/" (or "\"). Then
484 ;; strip off everything after
485 ;; the last dot.
486 (let* ((dot (position #\. f :from-end t))
487 (dir (position-if
488 #'(lambda (c)
489 (member c '(#\/ #\\)))
491 :from-end t))
492 (base (subseq f (if dir (1+ dir) 0) dot)))
493 (when (or dot dir)
494 (mtell (intl:gettext "Warning: Using basename ~S for init files instead of ~S" )
495 base f))
496 base)))
497 (let ((base-name (get-base-name file)))
498 (setf *maxima-initmac*
499 (concatenate 'string base-name ".mac"))
500 (setf *maxima-initlisp*
501 (concatenate 'string base-name ".lisp")))))
502 :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."
503 (subseq *maxima-initmac* 0
504 (- (length *maxima-initmac*) 4))))
505 #+nil
506 (make-cl-option :names '("--init-mac")
507 :argument "<file>"
508 :action #'(lambda (file)
509 (setf *maxima-initmac* file))
510 :help-string (format nil "Set the name of the Maxima initialization file (default is ~s)"
511 *default-maxima-initmac*))
512 #+nil
513 (make-cl-option :names '("--init-lisp")
514 :argument "<file>"
515 :action #'(lambda (file)
516 (setf *maxima-initlisp* file))
517 :help-string (format nil "Set the name of the Lisp initialization file (default is ~s)" *default-maxima-initlisp*))
518 (make-cl-option :names '("-l" "--lisp")
519 :argument "<lisp>"
520 :action nil
521 :help-string "Use lisp implementation <lisp>.")
522 (make-cl-option :names '("--list-avail")
523 :action 'list-avail-action
524 :help-string
525 "List the installed version/lisp combinations.")
526 ;; --preload-lisp is left for backward compatibility. We
527 ;; no longer distinguish between mac and lisp files. Any
528 ;; file type that $LOAD supports is acceptable.
529 ;; "--init-mac" and "--init-lisp" are now also (deprecated)
530 ;; aliases for --preload.
531 (make-cl-option :names '("-p" "--preload" "--preload-lisp" "--init-mac" "--init-lisp")
532 :argument "<file>"
533 :action #'(lambda (file)
534 ;; $loadprint T so we can see the file being loaded.
535 (let (($loadprint t))
536 ($load file)))
537 :help-string
538 "Preload <file>, which may be any file time accepted by
539 Maxima's LOAD function. The <file> is loaded before any other
540 system initialization is done. This will be searched for in
541 the locations given by file_search_maxima and
542 file_search_lisp. This can be specified multiple times to
543 load multiple files. The equivalent options --preload-lisp,
544 --init-mac, and --init-lisp are deprecated.")
545 (make-cl-option :names '("-q" "--quiet")
546 :action #'(lambda ()
547 (declare (special *maxima-quiet*))
548 (setq *maxima-quiet* t))
549 :help-string "Suppress Maxima start-up message.")
550 (make-cl-option :names '("-r" "--run-string")
551 :argument "<string>"
552 :action #'(lambda (string)
553 (declare (special *maxima-run-string*))
554 (setq *maxima-run-string* t)
555 (setf input-stream
556 (make-string-input-stream string))
557 (setf batch-flag nil))
558 :help-string
559 "Process maxima command(s) <string> in interactive mode.")
560 (make-cl-option :names '("-s" "--server")
561 :argument "<port>"
562 :action #'(lambda (port-string)
563 (start-client (parse-integer
564 port-string))
565 (setf input-stream *standard-input*))
566 :help-string "Connect Maxima to server on <port>.")
567 (make-cl-option :names '("-u" "--use-version")
568 :argument "<version>"
569 :action nil
570 :help-string "Use maxima version <version>.")
571 (make-cl-option :names '("-v" "--verbose")
572 :action nil
573 :help-string
574 "Display lisp invocation in maxima wrapper script.")
575 (make-cl-option :names '("--version")
576 :action #'(lambda ()
577 (format t "Maxima ~a~%"
578 *autoconf-version*)
579 ($quit))
580 :help-string
581 "Display the default installed version.")
582 (make-cl-option :names '("--very-quiet")
583 :action #'(lambda ()
584 (declare (special *maxima-quiet*))
585 (setq *maxima-quiet* t *display-labels-p* nil))
586 :help-string "Suppress expression labels and Maxima start-up message.")
587 (make-cl-option :names '("-X" "--lisp-options")
588 :argument "<Lisp options>"
589 :action #'(lambda (&rest opts)
590 (declare (special *maxima-quiet*))
591 (unless *maxima-quiet*
592 (format t "Lisp options: ~A" opts)))
593 :help-string "Options to be given to the underlying Lisp")
594 (make-cl-option :names '("--no-init" "--norc")
595 :action #'(lambda ()
596 (setf *maxima-load-init-files* nil))
597 :help-string "Do not load the init file(s) on startup")
598 (make-cl-option :names '("--no-verify-html-index")
599 :action #'(lambda ()
600 (setf *verify-html-index* nil))
601 :help-string "Do not verify on startup that the set of html topics is consistent with text topics.")
603 (process-args (get-application-args) *maxima-commandline-options*)
604 (values input-stream batch-flag))
607 ;; Delete all files *temp-files-list* contains.
608 (defun delete-temp-files ()
609 (maphash #'(lambda(filename param)
610 (declare (ignore param))
611 (let ((file (ignore-errors (probe-file filename))))
612 (if file
613 (if (not (apparently-a-directory-p file))
614 (delete-file file)))))
615 *temp-files-list*))
617 (defun cl-user::run ()
618 "Run Maxima in its own package."
619 (in-package :maxima)
620 (initialize-runtime-globals)
621 (let ((input-stream *standard-input*)
622 (batch-flag nil))
623 (unwind-protect
624 (catch 'to-lisp
625 (setf (values input-stream batch-flag)
626 (process-maxima-args input-stream batch-flag))
627 (when *verify-html-index*
628 ($verify_html_index))
629 (load-user-init-file)
630 (loop
631 (with-simple-restart (macsyma-quit "Maxima top-level")
632 (macsyma-top-level input-stream batch-flag))))
633 (delete-temp-files)
636 ;; If the user specified an init file, use it. If not, use the
637 ;; default init file in the userdir directory, but only if it
638 ;; exists. A user-specified init file is searched in the search
639 ;; paths.
641 (defun load-user-init-file ()
642 (flet
643 ((maybe-load-init-file (loader default-init)
644 (let ((init-file
645 (combine-path *maxima-userdir* default-init)))
646 (when (and *maxima-load-init-files*
647 (file-exists-p init-file))
648 (format t "Loading ~A~%" init-file)
649 (funcall loader init-file)))))
650 ;; Catch errors from $load or $batchload which can throw to 'macsyma-quit.
651 (catch 'macsyma-quit
652 (maybe-load-init-file #'$load *maxima-initlisp*)
653 (maybe-load-init-file #'$batchload *maxima-initmac*))))
655 (defun initialize-runtime-globals ()
656 (setf *load-verbose* nil)
658 (disable-some-lisp-warnings)
660 (setf *debugger-hook* #'maxima-lisp-debugger)
661 ;; See discussion on the maxima list
662 ;; http://www.math.utexas.edu/pipermail/maxima/2011/024014.html.
663 ;; Set *print-length* and *print-level* to some reasonable values so
664 ;; that normal Lisp structure is shown, but prevent typical circular
665 ;; structures from hanging Lisp.
667 ;; (We do we set these instead of binding them?)
668 (setf *print-circle* nil)
669 (setf *print-length* 100)
670 (setf *print-level* 15)
672 ;; GCL: print special floats, which are generated whether or not this flag is enabled
673 #+gcl (setf si:*print-nans* t)
674 #+ccl
675 (progn
676 (setf ccl::*invoke-debugger-hook-on-interrupt* t)
677 ;; CCL 1.5 makes *read-default-float-format* a thread-local
678 ;; variable. Hence we need to set it here to get our desired
679 ;; behavior.
680 (setf *read-default-float-format* 'double-float))
682 #+allegro
683 (progn
684 (set-readtable-for-macsyma)
685 (setf *read-default-float-format* 'lisp::double-float))
687 #+sbcl (setf *read-default-float-format* 'double-float)
689 ;; GCL: disable readline symbol completion,
690 ;; leaving other functionality (line editing, anything else?) enabled.
692 ;; This is kind of terrible. I don't see a flag to only disable completion,
693 ;; or a way to set the symbol list to Maxima symbols and disable case inversion,
694 ;; so set the completion prefix to a nonexistent package.
695 ;; If ever package BLURFLE is actually defined, and contains external symbols,
696 ;; those symbols will be completed. I can live with that.
698 #+gcl (setq si::*readline-prefix* "BLURFLE:")
700 (initialize-real-and-run-time)
701 (intl::setlocale)
702 (set-locale-subdir)
703 (adjust-character-encoding)
704 (set-pathnames)
705 (catch 'return-from-debugger
706 (cl-info::load-primary-index))
707 (when (boundp '*maxima-prefix*)
708 (push (pathname (concatenate 'string *maxima-prefix*
709 (if *maxima-layout-autotools*
710 "/share/locale/"
711 "/locale/")))
712 intl::*locale-directories*))
713 ;; Set up $browser for displaying help in browser.
714 (cond ((and (boundp '*autoconf-windows*)
715 (string-equal *autoconf-windows* "true"))
716 ;; Starts the default browser on Windows.
717 (setf $browser "start ~A"))
718 ((boundp '*autoconf-host*)
719 ;; Determine what kind of OS we're using from the host and
720 ;; set up the default browser appropriately.
721 (cond ((pregexp:pregexp-match-positions "(?:darwin)" *autoconf-host*)
722 (setf $browser "open '~A'"))
723 ((pregexp:pregexp-match-positions "(?i:linux)" *autoconf-host*)
724 (setf $browser "xdg-open '~A'")))))
725 (setf %e-val (mget '$%e '$numer))
727 ;; Initialize *bigprimes* here instead of globals.lisp because we
728 ;; need the NEXT-PRIME function.
729 (setf *bigprimes*
730 (loop with p = (ash most-positive-fixnum -1)
731 repeat 20
732 do (setq p (next-prime (1- p) -1))
733 collect p))
734 ;; Initialize *alpha and $pointbound. Since both of these are
735 ;; defmvars, we need to set the initial values appropriately too so
736 ;; they get reset correctly.
737 (setf *alpha (car *bigprimes*))
738 (setf (gethash '*alpha *variable-initial-values*)
739 (car *bigprimes*))
740 (setf $pointbound *alpha)
741 (setf (gethash '$pointbound *variable-initial-values*)
742 *alpha)
743 (values))
745 (defun adjust-character-encoding ()
746 #+sbcl (setf sb-impl::*default-external-format* :utf-8)
747 #+cmu
748 (handler-bind ((error #'(lambda (c)
749 ;; If there's a continue restart, restart
750 ;; to set the filename encoding anyway.
751 (if (find-restart 'cl:continue c)
752 (invoke-restart 'cl:continue)))))
753 ;; Set both the terminal external format and filename encoding to
754 ;; utf-8. The handler-bind is needed in case the filename
755 ;; encoding was already set to something else; we forcibly change
756 ;; it to utf-8. (Is that right?)
757 (setf stream:*default-external-format* :utf-8)
758 (stream:set-system-external-format :utf-8 :utf-8)
759 (setf ext:*default-external-format* :utf-8))
760 #+clisp
761 (ignore-errors
762 (progn (setf custom:*default-file-encoding*
763 (ext:make-encoding :input-error-action #\?))
764 (setf custom:*terminal-encoding*
765 custom:*default-file-encoding*))))
767 (import 'cl-user::run)
769 (defmfun $to_lisp ()
770 (format t "~&Type (to-maxima) to restart, ($quit) to quit Maxima.~%")
771 (let ((old-debugger-hook *debugger-hook*))
772 (catch 'to-maxima
773 (unwind-protect
774 (maxima-read-eval-print-loop)
775 (setf *debugger-hook* old-debugger-hook)
776 (format t "Returning to Maxima~%")))))
778 (defun to-maxima ()
779 (throw 'to-maxima t))
781 (defun maxima-read-eval-print-loop ()
782 (when *debugger-hook*
783 ; Only set a new debugger hook if *DEBUGGER-HOOK* has not been set to NIL
784 (setf *debugger-hook* #'maxima-lisp-debugger-repl))
785 (let ((eof (gensym)))
786 (loop
787 (catch 'to-maxima-repl
788 (format-prompt t "~%~A> " (package-name *package*))
789 (finish-output)
790 (let ((input (read *standard-input* nil eof)))
791 ; Return to Maxima on EOF
792 (when (eq input eof)
793 (fresh-line)
794 (to-maxima))
795 (format t "~{~&~S~}" (multiple-value-list (eval input))))))))
797 (defun maxima-lisp-debugger-repl (condition me-or-my-encapsulation)
798 (declare (ignore me-or-my-encapsulation))
799 (format t "~&Maxima encountered a Lisp error:~%~% ~A" condition)
800 (format t "~&~%Automatically continuing.~%To re-enable the Lisp debugger set *debugger-hook* to nil.~%")
801 (finish-output)
802 (throw 'to-maxima-repl t))
804 (defvar $help "type `describe(topic);' or `example(topic);' or `? topic'")
806 (defmfun $help (&rest dummy)
807 (declare (ignore dummy))
808 $help)
810 (eval-when (:load-toplevel :execute)
811 (let ((context '$global))
812 (declare (special context))
813 (dolist (x '($%pi $%i $%e $%phi %i $%gamma $%catalan ;numeric constants
814 $inf $minf $und $ind $infinity ;pseudo-constants
815 t nil)) ;logical constants (Maxima names: true, false)
816 (kind x '$constant)
817 (setf (get x 'sysconst) t))))
819 ;;; Now that all of maxima has been loaded, define the various lists
820 ;;; and hashtables of builtin symbols and values.
822 ;;; The assume database structures for numeric constants such as $%pi and $%e
823 ;;; are circular. Attempting to copy a circular structure
824 ;;; into *builtin-symbol-props* would cause a hang. Therefore
825 ;;; the properties are copied into *builtin-symbol-props* before
826 ;;; initializing the assume database.
827 (let ((maxima-package (find-package :maxima)))
828 (do-symbols (s maxima-package)
829 (when (and (eql (symbol-package s) maxima-package)
830 (not (eq s '||))
831 (member (char (symbol-name s) 0) '(#\$ #\%) :test #'char=))
832 (push s *builtin-symbols*)
833 (setf (gethash s *builtin-symbol-props*)
834 (copy-tree (symbol-plist s))))))
836 ;; Also store the property lists for symbols associated with operators;
837 ;; e.g. MPLUS, MTIMES, etc.
838 ;; Here we find them via the MHEADER property, which is used by the parser.
839 ;; I don't know any better way to find these properties.
841 (let ((maxima-package (find-package :maxima)))
842 (do-symbols (s maxima-package)
843 (let ((h (get s 'mheader)))
844 (when h
845 (let ((s1 (first h)))
846 (unless (gethash s1 *builtin-symbol-props*)
847 (push s1 *builtin-symbols*)
848 (setf (gethash s1 *builtin-symbol-props*)
849 (copy-tree (symbol-plist s1)))))))))
851 ;; Initialize assume database for $%pi, $%e, etc
852 (dolist (c *builtin-numeric-constants*)
853 (initialize-numeric-constant c))
855 (dolist (s *builtin-symbols*)
856 (when (boundp s)
857 (push s *builtin-symbols-with-values*)))
859 (dolist (s *builtin-symbols-with-values*)
860 (setf (gethash s *builtin-symbol-values*) (symbol-value s)))
862 (setf *builtin-$props* (copy-list $props))
863 (setf *builtin-$rules* (copy-list $rules))
865 (defun maxima-objdir (&rest subdirs)
866 "Return a pathname string such that subdirs is a subdirectory of maxima_objdir"
867 (apply #'combine-path *maxima-objdir* subdirs))
869 (defun maxima-load-pathname-directory ()
870 "Return the directory part of *load-pathname*."
871 (let ((path *load-pathname*))
872 (make-pathname :directory (pathname-directory path)
873 :device (pathname-device path))))