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