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