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