;;********************************************************
;; file: init-cl.lisp
;; description: Initialize Maxima
;; date: Wed Jan 13 1999 - 20:27
;; author: Liam Healy <Liam.Healy@nrl.navy.mil>
;;********************************************************
;;; An ANSI-CL portable initializer to replace init_max1.lisp
;; CL-USER:*MAXIMA-BUILD-TIME* is defined in maxima.asd and maxima.system,
;; but I guess ECL doesn't see that, so define it here.
#+ecl (progn
(in-package :cl-user)
(defvar *maxima-build-time* '#.(multiple-value-list (get-decoded-time)))
(export '*maxima-build-time*))
(in-package :maxima)
(defvar *verify-html-index* nil
"If non-NIL, verify the contents of the html index versus the text
index. Set via the command-line option --verify-html-index.")
(defvar *quit-on-error* nil
"If a run-time error or warning is called, then $QUIT Maxima with a
non-zero exit code. Should only be set by the command-line option
--quit-on-error.")
(defmvar $batch_answers_from_file nil
"If T, then during batch testing, if Maxima asks a question, then the
answer is read from the input file that is being batched. This flag is
set to T by the command-line option --batch-string.
To disable it,
maxima [options] --batch-string='batch_answers_from_file:false; ...'
")
(defun shadow-string-assignment (var value)
(cond
((stringp value)
(setf (symbol-value (get var 'lisp-shadow)) value)
value)
(t
(merror (intl:gettext "assignment: must assign a string to ~:M; found: ~M") var value))))
(defun print-directories ()
(dolist (var '(*maxima-prefix*
*maxima-topdir*
*maxima-imagesdir*
*maxima-sharedir*
*maxima-srcdir*
*maxima-demodir*
*maxima-testsdir*
*maxima-docdir*
*maxima-infodir*
*maxima-htmldir*
*maxima-layout-autotools*
*maxima-userdir*
*maxima-tempdir*
*maxima-lang-subdir*
*maxima-objdir*))
;; Neatly print out the name of the variable (sans *) and the
;; corresponding value.
(format t "~a:~25t~a~%"
(string-trim "*" (string-downcase var))
(symbol-value var))))
(defun maxima-parse-dirstring (str)
(let ((sep "/"))
(if (position (character "\\") str)
(setq sep "\\"))
(setf str (concatenate 'string (string-right-trim sep str) sep))
(concatenate 'string
(let ((dev (pathname-device str)))
(if (consp dev)
(setf dev (first dev)))
(if (and dev (not (eq dev :unspecific))
(not (string= dev "")))
(concatenate 'string (string-right-trim ":" dev) ":")
""))
"/"
(apply #'combine-path (rest (pathname-directory str))))))
(defun set-pathnames-with-autoconf (maxima-prefix-env maxima-docprefix-env)
(declare (ignore maxima-docprefix-env))
(let (libdir datadir infodir
(package-version (combine-path *autoconf-package* *autoconf-version*))
(binary-subdirectory (concatenate 'string "binary-" *maxima-lispname*)))
(if maxima-prefix-env
(progn
(setq libdir (combine-path maxima-prefix-env "lib"))
(setq datadir (combine-path maxima-prefix-env "share"))
(setq infodir (combine-path maxima-prefix-env #+(or cygwin windows win32 win64) "share" "info")))
(progn
(setq libdir (maxima-parse-dirstring *autoconf-libdir*))
(setq datadir (maxima-parse-dirstring *autoconf-datadir*))
(setq infodir (maxima-parse-dirstring *autoconf-infodir*))))
(setq *maxima-topdir* (combine-path datadir package-version))
(setq *maxima-imagesdir* (combine-path libdir package-version binary-subdirectory))
(setq *maxima-sharedir* (combine-path datadir package-version "share"))
(setq *maxima-srcdir* (combine-path datadir package-version "src"))
(setq *maxima-demodir* (combine-path datadir package-version "demo"))
(setq *maxima-testsdir* (combine-path datadir package-version "tests"))
(setq *maxima-docdir* (combine-path datadir package-version "doc"))
(setq *maxima-infodir* infodir)
(setq *maxima-htmldir* (combine-path datadir package-version "doc" "html"))))
(defun set-pathnames-without-autoconf (maxima-prefix-env maxima-docprefix-env)
(let* ((maxima-prefix (if maxima-prefix-env
maxima-prefix-env
(maxima-parse-dirstring *autoconf-prefix*)))
(binary-subdirectory (concatenate 'string "binary-" *maxima-lispname*)))
(setq *maxima-topdir* maxima-prefix)
(setq *maxima-imagesdir* (combine-path maxima-prefix "src" binary-subdirectory))
(setq *maxima-sharedir* (combine-path maxima-prefix "share"))
(setq *maxima-srcdir* (combine-path maxima-prefix "src"))
(setq *maxima-demodir* (combine-path maxima-prefix "demo"))
(setq *maxima-testsdir* (combine-path maxima-prefix "tests"))
(let ((maxima-doc-prefix (if maxima-docprefix-env
maxima-docprefix-env
maxima-prefix)))
(setq *maxima-docdir* (combine-path maxima-doc-prefix "doc"))
(setq *maxima-infodir* (combine-path maxima-doc-prefix "doc" "info"))
(setq *maxima-htmldir* (combine-path maxima-doc-prefix "doc" "html")))))
(defun default-userdir ()
(let ((home-env (or (maxima-getenv "HOME") (maxima-getenv "USERPROFILE")))
(base-dir "")
(maxima-dir (if (string= *autoconf-windows* "true")
"maxima"
".maxima")))
(setf base-dir
(if (and home-env (string/= home-env ""))
;; use home-env...
(if (string= home-env "c:\\")
;; but not if home-env = c:\, which results in slow startups
;; under windows. Ick.
"c:\\user\\"
home-env)
;; we have to make a guess
(if (string= *autoconf-windows* "true")
"c:\\user\\"
"/tmp")))
(combine-path (maxima-parse-dirstring base-dir) maxima-dir)))
(defun default-tempdir ()
(maxima-parse-dirstring
(let ((tmpdir-windows (maxima-getenv "TEMP"))
(tmpdir-posix (maxima-getenv "TMPDIR"))
(tmpdir-nonstandard1 (maxima-getenv "TMP"))
(tmpdir-nonstandard2 (maxima-getenv "TEMPDIR")))
(cond
((and tmpdir-windows (string/= tmpdir-windows "")) tmpdir-windows)
((and tmpdir-posix (string/= tmpdir-windows "")) tmpdir-posix)
((and tmpdir-nonstandard1 (string/= tmpdir-nonstandard1 "")) tmpdir-nonstandard1)
((and tmpdir-nonstandard2 (string/= tmpdir-nonstandard2 "")) tmpdir-nonstandard2)
; A fallback for windows if everything else has failed
((string= *autoconf-windows* "true") "C:\\Windows\\temp")
; A fallback for the rest of the operating systems
(t "/tmp")))))
(defun set-locale-subdir ()
(let (language territory #+nil codeset)
;; Determine *maxima-lang-subdir*
;; 1. from MAXIMA_LANG_SUBDIR environment variable
;; 2. from INTL::*LOCALE* if (1) fails
(unless (setq *maxima-lang-subdir* (maxima-getenv "MAXIMA_LANG_SUBDIR"))
(cond ((or (null intl::*locale*) (equal intl::*locale* ""))
(setq *maxima-lang-subdir* nil))
((member intl::*locale* '("C" "POSIX" "c" "posix") :test #'equal)
(setq *maxima-lang-subdir* nil))
(t
;; Code to parse code set in locale string, in case we figure out
;; something to do with it; it isn't needed for language
;; subdirectory any more, since all language files are UTF-8.
;; We might make use of code set in ADJUST-CHARACTER-ENCODING.
#+nil (when (eql (position #\. intl::*locale*) 5)
(setq codeset (string-downcase (subseq intl::*locale* 6))))
(when (eql (position #\_ intl::*locale*) 2)
(setq territory (string-downcase (subseq intl::*locale* 3 5))))
(setq language (string-downcase (subseq intl::*locale* 0 2)))
;; Set *maxima-lang-subdir* only for known languages.
;; Extend procedure below as soon as new translation
;; is available.
(cond ((equal language "en") ;; English
(setq *maxima-lang-subdir* nil))
;; Latin-1 aka iso-8859-1 languages
((member language '("es" "pt" "de") :test #'equal)
(if (and (string= language "pt") (string= territory "br"))
(setq *maxima-lang-subdir* (concatenate 'string language "_BR"))
(setq *maxima-lang-subdir* language)))
;; Japanese.
((string= language "ja")
(setq *maxima-lang-subdir* language))
;; Russian.
((string= language "ru")
(setq *maxima-lang-subdir* language))
(t (setq *maxima-lang-subdir* nil))))))))
(defun setup-search-lists ()
"Set up the default values for $file_search_lisp, $file_search_maxima,
$file_search_demo, $file_search_usage, and $file_search_test."
(let* ((ext (pathname-type (compile-file-pathname "foo.lisp")))
(lisp-patterns (list ext "lisp"))
(maxima-patterns '("mac" "wxm"))
(lisp+maxima-patterns (append lisp-patterns maxima-patterns))
(demo-patterns '("dem" "demo"))
(usage-patterns '("usg")))
(flet ((build-search-list (path-info)
(let (search-path)
(dolist (info path-info)
(destructuring-bind (dir extensions)
info
(dolist (ext extensions)
(push (combine-path dir (concatenate 'string "*." ext))
search-path))))
(make-mlist-l (nreverse search-path)))))
(setf $file_search_lisp
(build-search-list (list (list (combine-path *maxima-userdir* "**")
lisp-patterns)
(list (combine-path *maxima-sharedir* "**")
;; sharedir should only have lisp files.
'("lisp"))
(list *maxima-srcdir* lisp-patterns)
(list *maxima-topdir* lisp-patterns))))
(setf $file_search_maxima
(build-search-list (list (list (combine-path *maxima-userdir* "**")
maxima-patterns)
(list (combine-path *maxima-sharedir* "**")
;; sharedir should only have mac files.
'("mac"))
;; See
;; https://sourceforge.net/p/maxima/bugs/4174/.
;; This is a work around so that
;; we can load zeilberger on ecl.
#+ecl
(list (combine-path *maxima-sharedir* "contrib" "**")
'("mac"))
#+ecl
(list (combine-path *maxima-sharedir* "simplex" "**")
'("mac"))
(list *maxima-srcdir*
'("mac"))
(list *maxima-topdir*
'("mac")))))
(setf $file_search_demo
(build-search-list (list (list (combine-path *maxima-sharedir* "**")
demo-patterns)
(list *maxima-demodir* demo-patterns))))
(setf $file_search_usage
(build-search-list (list (list (combine-path *maxima-sharedir* "**")
usage-patterns)
(list *maxima-docdir* usage-patterns))))
(setf $file_search_tests
(build-search-list (list (list *maxima-testsdir* lisp+maxima-patterns)))))))
(defun set-pathnames ()
(let ((maxima-prefix-env (maxima-getenv "MAXIMA_PREFIX"))
(maxima-layout-autotools-env (maxima-getenv "MAXIMA_LAYOUT_AUTOTOOLS"))
(maxima-userdir-env (maxima-getenv "MAXIMA_USERDIR"))
(maxima-docprefix-env (maxima-getenv "MAXIMA_DOC_PREFIX"))
(maxima-tempdir-env (maxima-getenv "MAXIMA_TEMPDIR"))
(maxima-objdir-env (maxima-getenv "MAXIMA_OBJDIR"))
(maxima-htmldir-env (maxima-getenv "MAXIMA_HTMLDIR")))
;; MAXIMA_DIRECTORY is a deprecated substitute for MAXIMA_PREFIX
(unless maxima-prefix-env
(setq maxima-prefix-env (maxima-getenv "MAXIMA_DIRECTORY")))
(if maxima-prefix-env
(setq *maxima-prefix* maxima-prefix-env)
(setq *maxima-prefix* (maxima-parse-dirstring *autoconf-prefix*)))
(if maxima-layout-autotools-env
(setq *maxima-layout-autotools*
(string-equal maxima-layout-autotools-env "true"))
(setq *maxima-layout-autotools*
(string-equal *maxima-default-layout-autotools* "true")))
(if *maxima-layout-autotools*
(set-pathnames-with-autoconf maxima-prefix-env maxima-docprefix-env)
(set-pathnames-without-autoconf maxima-prefix-env maxima-docprefix-env))
(if maxima-userdir-env
(setq *maxima-userdir* (maxima-parse-dirstring maxima-userdir-env))
(setq *maxima-userdir* (default-userdir)))
(if maxima-tempdir-env
(setq *maxima-tempdir* (maxima-parse-dirstring maxima-tempdir-env))
(setq *maxima-tempdir* (default-tempdir)))
;; Default *MAXIMA-OBJDIR* is <userdir>/binary/binary-<foo>lisp,
;; because userdir is almost surely writable, and we don't want to clutter up
;; random directories with Maxima stuff.
;; Append binary-<foo>lisp whether objdir is the default or obtained from environment.
(setq *maxima-objdir*
(concatenate 'string
(if maxima-objdir-env
(maxima-parse-dirstring maxima-objdir-env)
(concatenate 'string *maxima-userdir* "/binary"))
"/" (maxima-version1) "/" *maxima-lispname* "/" (lisp-implementation-version1)))
;; NOTE: If this format is changed (e.g. by adding more subdirectories),
;; the function MAXIMA-OBJDIR-BASE may have to be adapted,
;; because its job is to strip these subdirectories.
(when maxima-htmldir-env
(setq *maxima-htmldir* (combine-path (maxima-parse-dirstring maxima-htmldir-env) "doc" "info")))
;; On ECL the testbench fails mysteriously if this directory doesn't exist =>
;; let's create it by hand as a workaround.
#+ecl (ensure-directories-exist (concatenate 'string *maxima-objdir* "/"))
; Assign initial values for Maxima shadow variables
(setq $maxima_userdir *maxima-userdir*)
(setf (gethash '$maxima_userdir *variable-initial-values*) *maxima-userdir*)
(setq $maxima_tempdir *maxima-tempdir*)
(setf (gethash '$maxima_tempdir *variable-initial-values*) *maxima-tempdir*)
(setq $maxima_objdir *maxima-objdir*)
(setf (gethash '$maxima_objdir *variable-initial-values*) *maxima-objdir*))
(setup-search-lists)
;; If *maxima-lang-subdir* is not nil test whether corresponding info directory
;; with some data really exists. If not this probably means that required
;; language pack wasn't installed and we reset *maxima-lang-subdir* to nil.
(when (and *maxima-lang-subdir*
(not (probe-file (combine-path *maxima-infodir* *maxima-lang-subdir* "maxima-index.lisp"))))
(setq *maxima-lang-subdir* nil)))
(defun list-avail-action ()
(cond
((maxima-getenv "MAXIMA_LOCAL")
;; We're running maxima-local in the src tree.
(let ((maxima-dir (maxima-getenv "MAXIMA_PREFIX"))
;; I (rtoy) am lazy. Just use regexp to match
;; "src/binary-foo" which is the directory containing the
;; build using lisp "foo". Since it's a directory, the
;; pattern should not include the slash.
(pattern (pregexp:pregexp "src/binary-([^/]+)")))
;; maxima-local MUST define MAXIMA_PREFIX envvar so we know where we are.
(unless maxima-dir
(format t "Environment variable MAXIMA_PREFIX not defined by maxima-local.~%~
Cannot list available versions. Exiting.~%")
(bye))
(setf maxima-dir (combine-path maxima-dir "src"))
(format t "Available versions:~%")
(dolist (p (get-dirs (concatenate 'string maxima-dir "/*")))
(destructuring-bind (&optional whole-match lisp-name)
(pregexp:pregexp-match pattern (namestring p))
(declare (ignore whole-match))
(when lisp-name
(format t "version ~a, lisp ~a~%" *autoconf-version* lisp-name))))))
(t
(let* ((maxima-verpkglibdir (if (maxima-getenv "MAXIMA-VERPKGLIBDIR")
(maxima-getenv "MAXIMA-VERPKGLIBDIR")
(if (maxima-getenv "MAXIMA_PREFIX")
(combine-path (maxima-getenv "MAXIMA_PREFIX") "lib"
*autoconf-package* *autoconf-version*)
(combine-path (maxima-parse-dirstring *autoconf-libdir*)
*autoconf-package* *autoconf-version*))))
(len (length maxima-verpkglibdir))
(lisp-string nil))
(format t "Available versions:~%")
(unless (equal (subseq maxima-verpkglibdir (- len 1) len) "/")
(setf maxima-verpkglibdir (concatenate 'string maxima-verpkglibdir "/")))
(dolist (version (get-dirs (unix-like-dirname maxima-verpkglibdir)))
(dolist (lisp (get-dirs version))
(setf lisp-string (unix-like-basename lisp))
(when (search "binary-" lisp-string)
(setf lisp-string (subseq lisp-string (length "binary-") (length lisp-string)))
(format t "version ~a, lisp ~a~%" (unix-like-basename version) lisp-string)))))))
(bye))
(defvar *maxima-commandline-options* nil
"All of the recognized command line options for maxima")
(defun process-maxima-args (input-stream batch-flag)
;; (format t "processing maxima args = ")
;; (mapc #'(lambda (x) (format t "\"~a\"~%" x)) (get-application-args))
;; (terpri)
;; (finish-output)
;; Note: The current option parsing code expects every short
;; option to have an equivalent long option. No check is made for
;; this, so please make sure this holds. Or change the code in
;; process-args in command-line.lisp.
;;
;; The help strings should not have any special manual formatting
;; but extraneous white space is ok. They are automatically
;; printed with extraneous whitespace (including newlines) removed
;; and lines wrapped neatly.
;;
;; NOTE: If you add or remove command-line options, be sure to
;; update doc/info/commandline-options.texi. Use (list-cl-options
;; *maxima-commandline-options* :texi-table-form t) to get the table
;; to paste into commandline-options.texi.
(setf *maxima-commandline-options*
(list
(make-cl-option :names '("-b" "--batch")
:argument "<file>"
:action #'(lambda (file)
(setf input-stream
(make-string-input-stream
(format nil "batch(\"~a\");"
file)))
(setf batch-flag :batch))
:help-string
"Process maxima file <file> in batch mode.")
(make-cl-option :names '("--batch-lisp")
:argument "<file>"
:action #'(lambda (file)
(setf input-stream
(make-string-input-stream
#-sbcl (format nil ":lisp (load \"~a\");" file)
#+sbcl (format nil ":lisp (with-compilation-unit nil (load \"~a\"));" file)))
(setf batch-flag :batch))
:help-string
"Process lisp file <file> in batch mode.")
(make-cl-option :names '("--batch-string")
:argument "<string>"
:action #'(lambda (string)
(declare (special $batch_answers_from_file))
(setf $batch_answers_from_file t
input-stream (make-string-input-stream string))
;; see RETRIEVE in macsys.lisp
(setf *standard-input* input-stream)
(setf *query-io* (make-two-way-stream input-stream (make-string-output-stream)))
(setf batch-flag :batch))
:help-string
"Process maxima command(s) <string> in batch mode.")
(make-cl-option :names '("-d" "--directories")
:action #'(lambda () (print-directories) ($quit))
:help-string
"Display maxima internal directory information.")
(make-cl-option :names '("--disable-readline")
:action #'(lambda ()
#+gcl
(if (find :readline *features*)
(si::readline-off)))
:help-string "Disable readline support.")
(make-cl-option :names '("-g" "--enable-lisp-debugger")
:action #'(lambda ()
(setf *debugger-hook* nil))
:help-string
"Enable underlying lisp debugger.")
(make-cl-option :names '("-h" "--help")
:action #'(lambda ()
(format t "usage: maxima [options]~%")
(list-cl-options *maxima-commandline-options*)
(bye))
:help-string "Display this usage message.")
(make-cl-option :names '("--userdir")
:argument "<directory>"
:action nil
:help-string "Use <directory> for user directory (default is %USERPROFILE%/maxima for Windows, and $HOME/.maxima for other operating systems).")
(make-cl-option :names '("--init")
:argument "<file>"
:action
#'(lambda (file)
(flet
((get-base-name (f)
;; Strip off everything before
;; the last "/" (or "\"). Then
;; strip off everything after
;; the last dot.
(let* ((dot (position #\. f :from-end t))
(dir (position-if
#'(lambda (c)
(member c '(#\/ #\\)))
f
:from-end t))
(base (subseq f (if dir (1+ dir) 0) dot)))
(when (or dot dir)
(mtell (intl:gettext "Warning: Using basename ~S for init files instead of ~S" )
base f))
base)))
(let ((base-name (get-base-name file)))
(setf *maxima-initmac*
(concatenate 'string base-name ".mac"))
(setf *maxima-initlisp*
(concatenate 'string base-name ".lisp")))))
: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."
(subseq *maxima-initmac* 0
(- (length *maxima-initmac*) 4))))
#+nil
(make-cl-option :names '("--init-mac")
:argument "<file>"
:action #'(lambda (file)
(setf *maxima-initmac* file))
:help-string (format nil "Set the name of the Maxima initialization file (default is ~s)"
*default-maxima-initmac*))
#+nil
(make-cl-option :names '("--init-lisp")
:argument "<file>"
:action #'(lambda (file)
(setf *maxima-initlisp* file))
:help-string (format nil "Set the name of the Lisp initialization file (default is ~s)" *default-maxima-initlisp*))
(make-cl-option :names '("-l" "--lisp")
:argument "<lisp>"
:action nil
:help-string "Use lisp implementation <lisp>.")
(make-cl-option :names '("--list-avail")
:action 'list-avail-action
:help-string
"List the installed version/lisp combinations.")
;; --preload-lisp is left for backward compatibility. We
;; no longer distinguish between mac and lisp files. Any
;; file type that $LOAD supports is acceptable.
;; "--init-mac" and "--init-lisp" are now also (deprecated)
;; aliases for --preload.
(make-cl-option :names '("-p" "--preload" "--preload-lisp" "--init-mac" "--init-lisp")
:argument "<file>"
:action #'(lambda (file)
;; $loadprint T so we can see the file being loaded;
;; unless *maxima-quiet* is T.
(let (($loadprint (not *maxima-quiet*)))
;; If there's an error, catch
(catch 'macsyma-quit
($load file))))
:help-string
"Preload <file>, which may be any file time accepted by
Maxima's LOAD function. The <file> is loaded before any other
system initialization is done. This will be searched for in
the locations given by file_search_maxima and
file_search_lisp. This can be specified multiple times to
load multiple files. The equivalent options --preload-lisp,
--init-mac, and --init-lisp are deprecated.")
(make-cl-option :names '("-q" "--quiet")
:action #'(lambda ()
(declare (special *maxima-quiet*))
(setq *maxima-quiet* t))
:help-string "Suppress Maxima start-up message.")
(make-cl-option :names '("-Q" "--quit-on-error")
:action #'(lambda ()
(declare (special *quit-on-error*))
(setq *quit-on-error* t))
:help-string
"Quit, and return an exit code 1, when Maxima encounters an error.")
(make-cl-option :names '("-r" "--run-string")
:argument "<string>"
:action #'(lambda (string)
(declare (special *maxima-run-string*))
(setq *maxima-run-string* t)
(setf input-stream
(make-string-input-stream string))
(setf batch-flag nil))
:help-string
"Process maxima command(s) <string> in interactive mode.")
(make-cl-option :names '("-s" "--server")
:argument "<port>"
:action #'(lambda (port-string)
(start-client (parse-integer
port-string))
(setf input-stream *standard-input*))
:help-string "Connect Maxima to server on <port>.")
(make-cl-option :names '("--suppress-input-echo")
:action #'(lambda ()
(declare (special *suppress-input-echo*))
(setq *suppress-input-echo* t))
:help-string
"Do not print input expressions when processing noninteractively.")
(make-cl-option :names '("-u" "--use-version")
:argument "<version>"
:action nil
:help-string "Use maxima version <version>.")
(make-cl-option :names '("-v" "--verbose")
:action nil
:help-string
"Display lisp invocation in maxima wrapper script.")
(make-cl-option :names '("--version")
:action #'(lambda ()
(format t "Maxima ~a~%"
*autoconf-version*)
($quit))
:help-string
"Display the default installed version.")
(make-cl-option :names '("--very-quiet")
:action #'(lambda ()
(declare (special *maxima-quiet* *display-labels-p* *verify-html-index* *warn-deprecated-defmvar-options*))
(setq *maxima-quiet* t *display-labels-p* nil *verify-html-index* nil *warn-deprecated-defmvar-options* nil))
:help-string "Suppress expression labels, Maxima start-up message and verification of html index.")
(make-cl-option :names '("--very-very-quiet")
:action #'(lambda ()
(declare (special *maxima-quiet* *display-labels-p* *verify-html-index* $ttyoff *warn-deprecated-defmvar-options*))
(setq *maxima-quiet* t *display-labels-p* nil *verify-html-index* nil $ttyoff t *warn-deprecated-defmvar-options* nil))
:help-string "In addition to --very-quiet, suppress most printed output by setting TTYOFF to T.")
(make-cl-option :names '("-X" "--lisp-options")
:argument "<Lisp options>"
:action #'(lambda (&rest opts)
(declare (special *maxima-quiet*))
(unless *maxima-quiet*
(format t "Lisp options: ~A" opts)))
:help-string "Options to be given to the underlying Lisp")
(make-cl-option :names '("--no-init" "--norc")
:action #'(lambda ()
(setf *maxima-load-init-files* nil))
:help-string "Do not load the init file(s) on startup")
(make-cl-option :names '("--verify-html-index")
:action #'(lambda ()
(setf *verify-html-index* t))
:help-string "Verify on startup that the set of html topics is consistent with text topics.")
))
(process-args (get-application-args) *maxima-commandline-options*)
(values input-stream batch-flag))
;; Delete all files *temp-files-list* contains.
(defun delete-temp-files ()
(maphash #'(lambda(filename param)
(declare (ignore param))
(let ((file (ignore-errors (probe-file filename))))
(if file
(if (not (apparently-a-directory-p file))
(delete-file file)))))
*temp-files-list*))
(defun cl-user::run ()
"Run Maxima in its own package."
(in-package :maxima)
(initialize-runtime-globals)
(let ((input-stream *standard-input*)
(batch-flag nil))
(unwind-protect
(catch 'to-lisp
(setf (values input-stream batch-flag)
(process-maxima-args input-stream batch-flag))
(when *verify-html-index*
($verify_html_index))
(load-user-init-file)
(loop
(with-simple-restart (macsyma-quit "Maxima top-level")
(macsyma-top-level input-stream batch-flag))))
(delete-temp-files)
)))
;; If the user specified an init file, use it. If not, use the
;; default init file in the userdir directory, but only if it
;; exists. A user-specified init file is searched in the search
;; paths.
(defun load-user-init-file ()
(flet
((maybe-load-init-file (loader default-init)
(let ((init-file
(combine-path *maxima-userdir* default-init)))
(when (and *maxima-load-init-files*
(file-exists-p init-file))
(format t "Loading ~A~%" init-file)
(funcall loader init-file)))))
;; Catch errors from $load or $batchload which can throw to 'macsyma-quit.
(catch 'macsyma-quit
(maybe-load-init-file #'$load *maxima-initlisp*)
(maybe-load-init-file #'$batchload *maxima-initmac*))))
(defun initialize-runtime-globals ()
(setf *load-verbose* nil)
(disable-some-lisp-warnings)
(setf *debugger-hook* #'maxima-lisp-debugger)
;; See discussion on the maxima list
;; http://www.math.utexas.edu/pipermail/maxima/2011/024014.html.
;; Set *print-length* and *print-level* to some reasonable values so
;; that normal Lisp structure is shown, but prevent typical circular
;; structures from hanging Lisp.
;;
;; (We do we set these instead of binding them?)
(setf *print-circle* nil)
(setf *print-length* 100)
(setf *print-level* 15)
;; GCL: print special floats, which are generated whether or not this flag is enabled
#+gcl (setf si:*print-nans* t)
#+ccl
(progn
(setf ccl::*invoke-debugger-hook-on-interrupt* t)
;; CCL 1.5 makes *read-default-float-format* a thread-local
;; variable. Hence we need to set it here to get our desired
;; behavior.
(setf *read-default-float-format* 'double-float))
#+allegro
(progn
(set-readtable-for-macsyma)
(setf *read-default-float-format* 'lisp::double-float))
#+sbcl (setf *read-default-float-format* 'double-float)
;; GCL: disable readline symbol completion,
;; leaving other functionality (line editing, anything else?) enabled.
;;
;; This is kind of terrible. I don't see a flag to only disable completion,
;; or a way to set the symbol list to Maxima symbols and disable case inversion,
;; so set the completion prefix to a nonexistent package.
;; If ever package BLURFLE is actually defined, and contains external symbols,
;; those symbols will be completed. I can live with that.
#+gcl (setq si::*readline-prefix* "BLURFLE:")
;; CLISP needs to create distinct streams for stdout and stderr
;; https://clisp.sourceforge.io/impnotes/streams-interactive.html
#+clisp
(setq *standard-output* (ext:make-stream :output :buffered t)
*error-output* (ext:make-stream :error :buffered t))
(initialize-real-and-run-time)
(intl::setlocale)
(set-locale-subdir)
(adjust-character-encoding)
(set-pathnames)
(catch 'return-from-debugger
(cl-info::load-primary-index))
(when (boundp '*maxima-prefix*)
(push (pathname (concatenate 'string *maxima-prefix*
(if *maxima-layout-autotools*
"/share/locale/"
"/locale/")))
intl::*locale-directories*))
;; Set up $browser for displaying help in browser in Linux.
(cond ((and (boundp '*autoconf-windows*)
(string-equal *autoconf-windows* "true"))
;; "start" will open the default browser in Windows.
(setf $browser "start"))
((boundp '*autoconf-host*)
(cond ((pregexp:pregexp-match-positions "(?:darwin)" *autoconf-host*)
;; "open" will open the default browser in MacOS.
(setf $browser "open"))
((pregexp:pregexp-match-positions "(?i:linux)" *autoconf-host*)
;; "xdg-open" will open the default browser in Linux.
(setf $browser "xdg-open")))))
(setf %e-val (mget '$%e '$numer))
;; Initialize *bigprimes* here instead of globals.lisp because we
;; need the NEXT-PRIME function.
(setf *bigprimes*
(loop with p = (ash most-positive-fixnum -1)
repeat 20
do (setq p (next-prime (1- p) -1))
collect p))
;; Initialize *alpha and $pointbound. Since both of these are
;; defmvars, we need to set the initial values appropriately too so
;; they get reset correctly.
(setf *alpha (car *bigprimes*))
(setf (gethash '*alpha *variable-initial-values*)
(car *bigprimes*))
(setf $pointbound *alpha)
(setf (gethash '$pointbound *variable-initial-values*)
*alpha)
(initialize-atan2-hashtable)
(values))
(defun adjust-character-encoding ()
#+sbcl (setf sb-impl::*default-external-format* :utf-8)
#+cmu
(handler-bind ((error #'(lambda (c)
;; If there's a continue restart, restart
;; to set the filename encoding anyway.
(if (find-restart 'cl:continue c)
(invoke-restart 'cl:continue)))))
;; Set both the terminal external format and filename encoding to
;; utf-8. The handler-bind is needed in case the filename
;; encoding was already set to something else; we forcibly change
;; it to utf-8. (Is that right?)
(setf stream:*default-external-format* :utf-8)
(stream:set-system-external-format :utf-8 :utf-8)
(setf ext:*default-external-format* :utf-8))
#+clisp
(ignore-errors
(setf custom:*terminal-encoding*
(ext:make-encoding
:charset "utf-8"
:line-terminator (ext:encoding-line-terminator custom:*terminal-encoding*))
custom:*default-file-encoding* custom:*terminal-encoding*)))
(defmfun $to_lisp ()
(format t "~&Type (to-maxima) to restart, ($quit) to quit Maxima.~%")
(let ((old-debugger-hook *debugger-hook*))
(catch 'to-maxima
(unwind-protect
(maxima-read-eval-print-loop)
(setf *debugger-hook* old-debugger-hook)
(format t "Returning to Maxima~%")))))
(defun to-maxima ()
(throw 'to-maxima t))
(defun interactive-eval (form)
"Evaluate FORM, returning whatever it returns but adjust ***, **, *, +++, ++,
+, ///, //, /, and -."
(setf - form)
(let ((results (multiple-value-list (eval form))))
(setf /// //
// /
/ results
*** **
** *
* (car results)))
(setf +++ ++
++ +
+ -)
(unless (boundp '*)
;; The bogon returned an unbound marker.
(setf * nil)
(cerror (intl:gettext "Go on with * set to NIL.")
(intl:gettext "EVAL returned an unbound marker.")))
/)
(defun maxima-read-eval-print-loop ()
(when *debugger-hook*
; Only set a new debugger hook if *DEBUGGER-HOOK* has not been set to NIL
(setf *debugger-hook* #'maxima-lisp-debugger-repl))
(let ((eof (gensym)))
(loop
(catch 'to-maxima-repl
(format-prompt t "~%~A> " (package-name *package*))
(finish-output)
(let ((input (read *standard-input* nil eof)))
; Return to Maxima on EOF
(when (eq input eof)
(fresh-line)
(to-maxima))
(format t "~{~&~S~}" (interactive-eval input)))))))
(defun maxima-lisp-debugger-repl (condition me-or-my-encapsulation)
(declare (ignore me-or-my-encapsulation))
(format t "~&Maxima encountered a Lisp error:~%~% ~A" condition)
(format t "~&~%Automatically continuing.~%To re-enable the Lisp debugger set *debugger-hook* to nil.~%")
(finish-output)
(throw 'to-maxima-repl t))
(defvar $help "type `describe(topic);' or `example(topic);' or `? topic'")
(defmfun $help (&rest dummy)
(declare (ignore dummy))
$help)
(eval-when (:load-toplevel :execute)
(let ((context '$global))
(declare (special context))
(dolist (x '($%pi $%i $%e $%phi %i $%gamma $%catalan ;numeric constants
$inf $minf $und $ind $infinity ;pseudo-constants
t nil)) ;logical constants (Maxima names: true, false)
(kind x '$constant)
(setf (get x 'sysconst) t))))
;; Optimizes a symbol's property list by moving properties that are frequently
;; accessed by the simplifier to the front of the list (unless it's empty),
;; adding an explicit nil entry for absent properties.
(defun optimize-symbol-plist (s)
(when (symbol-plist s)
(dolist (key '(msimpind operators distribute_over opers))
(let ((val (get s key)))
(when val
(remprop s key))
(putprop s val key)))))
;;; Now that all of maxima has been loaded, define the various lists
;;; and hashtables of builtin symbols and values.
;;; The assume database structures for numeric constants such as $%pi and $%e
;;; are circular. Attempting to copy a circular structure
;;; into *builtin-symbol-props* would cause a hang. Therefore
;;; the properties are copied into *builtin-symbol-props* before
;;; initializing the assume database.
;;; At the same time, optimize the symbols' property lists for faster lookup.
(let ((maxima-package (find-package :maxima)))
(do-symbols (s maxima-package)
(when (and (eql (symbol-package s) maxima-package)
(not (eq s '||))
(member (char (symbol-name s) 0) '(#\$ #\%) :test #'char=))
(push s *builtin-symbols*)
(optimize-symbol-plist s)
(setf (gethash s *builtin-symbol-props*)
(copy-tree (symbol-plist s))))))
;; Also store the property lists for symbols associated with operators;
;; e.g. MPLUS, MTIMES, etc.
;; Here we find them via the MHEADER property, which is used by the parser.
;; I don't know any better way to find these properties.
;; At the same time, optimize the symbols' property lists for faster lookup.
(let ((maxima-package (find-package :maxima)))
(do-symbols (s maxima-package)
(let ((h (get s 'mheader)))
(when h
(let ((s1 (first h)))
(unless (gethash s1 *builtin-symbol-props*)
(push s1 *builtin-symbols*)
(optimize-symbol-plist s1)
(setf (gethash s1 *builtin-symbol-props*)
(copy-tree (symbol-plist s1)))))))))
;; Initialize assume database for $%pi, $%e, etc
(dolist (c *builtin-numeric-constants*)
(initialize-numeric-constant c))
(setf %e-val (mget '$%e '$numer))
;; Make sure derivatives defined by DEFGRAD are simplified and that
;; the variables and derivatives are consistent.
(process-defgrad)
(dolist (s *builtin-symbols*)
(when (boundp s)
(push s *builtin-symbols-with-values*)))
(dolist (s *builtin-symbols-with-values*)
(setf (gethash s *builtin-symbol-values*) (symbol-value s)))
(setf *builtin-$props* (copy-list $props))
(setf *builtin-$rules* (copy-list $rules))
(defun maxima-objdir (&rest subdirs)
"Return a pathname string such that subdirs is a subdirectory of maxima_objdir"
(apply #'combine-path *maxima-objdir* subdirs))
(defun maxima-objdir-base ()
"Return the Maxima object directory stripped of the subdirectories
that are specific to the Maxima version, Lisp implementation and Lisp version.
If the user has overridden $maxima_objdir manually, return the directory itself.
A trailing slash is always added, if necessary.
Example for default path: '/home/user/.maxima/binary/5_47post/sbcl/2_6_3'
-> '/home/user/.maxima/binary/'"
(let ((path (pathname (combine-path *maxima-objdir* "")))) ; ensure trailing slash
(if (string= *maxima-objdir* (gethash '$maxima_objdir *variable-initial-values*))
;; *MAXIMA-OBJDIR* has its default value: strip the last 3 subdirectories
(namestring (make-pathname :directory (butlast (pathname-directory path) 3)
:defaults path))
;; User override: return the path as-is (with ensured trailing slash)
(namestring path))))
(defun maxima-load-pathname-directory ()
"Return the directory part of *load-pathname*."
(let ((path *load-pathname*))
(make-pathname :directory (pathname-directory path)
:device (pathname-device path))))
