src/init-cl.lisp

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