1(defun replace-substring (in-string old new)
2  (let ((result ""))
3    (do ((begin 0)
4	 (end (search old in-string)
5	      (search old in-string :start2 begin)))
6	((>= begin (length in-string)) 'done)
7      (if end
8	  (progn (setf result (concatenate 'string result
9					   (subseq in-string begin end)
10					   new))
11		 (setf begin (+ end (length old))))
12	  (progn (setf result (concatenate 'string result
13					   (subseq in-string begin
14						   (length in-string))))
15		 (setf begin (length in-string)))))
16    result))
17
18(defun process-file (in-filename out-filename substitutions)
19  (with-open-file (in in-filename :direction :input)
20    (with-open-file (out out-filename :direction :output
21			 :if-exists :supersede)
22      (do ((line (read-line in nil 'eof)
23		 (read-line in nil 'eof)))
24	  ((eql line 'eof))
25	(mapc #'(lambda (pair)
26		  (setf line (replace-substring line
27						(first pair)
28						(rest pair))))
29	      substitutions)
30	(format out "~a~%" line)))))
31
32(defun read-with-default (prompt default)
33  (format t "~a [~a]: " prompt default)
34  (terpri)
35  (let ((response (string-right-trim '(#\Return) (read-line))))
36    (if (string= response "") default response)))
37
38
39;;; This function (only) modified from CLOCC http://clocc.sourceforge.net
40(defun default-directory-string ()
41  (string-right-trim
42   "\\" (string-right-trim
43	 "/"
44	 (namestring
45	  #+allegro (excl:current-directory)
46	  #+clisp (#+lisp=cl ext:default-directory
47			     #-lisp=cl lisp:default-directory)
48	  #+cmu (ext:default-directory)
49	  #+scl (unix-namestring (ext:default-directory))
50	  #+cormanlisp (ccl:get-current-directory)
51	  #+lispworks (hcl:get-working-directory)
52	  #+lucid (lcl:working-directory)
53	  #-(or allegro clisp cmu scl cormanlisp lispworks lucid)
54	  (truename ".")))))
55
56(defun get-version ()
57  (with-open-file (in "configure.ac" :direction :input)
58    (do ((line (read-line in nil 'eof)
59               (read-line in nil 'eof))
60         (version "")
61         temp)
62        ((eq line 'eof)
63         (when (string= version "")
64           (format t "Warning: No version information found.~%~%"))
65         version)
66      (when (search "AC_INIT([maxima]," line)
67        (setq line (string-trim '(#\Return) line))
68        (setq temp
69              (replace-substring line "AC_INIT([maxima], [" ""))
70        (setq version
71              (replace-substring temp "])" ""))
72        (when (or (string= temp line)
73                  (string= temp version))
74          ; Failed substitution
75          (format t "Warning: Problem parsing version information. ")
76          (format t "Found: \"~a\"~%~%" version))))))
77
78(defvar *maxima-lispname* #+clisp "clisp"
79	#+cmu "cmucl"
80	#+scl "scl"
81	#+sbcl "sbcl"
82	#+gcl "gcl"
83	#+allegro "acl"
84	#+openmcl "openmcl"
85    #+abcl "abcl"
86    #+ecl "ecl"
87	#-(or clisp cmu scl sbcl gcl allegro openmcl abcl ecl) "unknownlisp")
88
89(defun configure (&key (interactive t) (verbose nil)
90		  is-win32
91		  maxima-directory
92		  posix-shell
93		  clisp-name
94		  cmucl-name
95		  scl-name
96		  acl-name
97		  openmcl-name
98		  sbcl-name
99		  ecl-name
100		  gcl-name)
101  (let ((prefix (if maxima-directory
102		    maxima-directory
103		    (default-directory-string)))
104	(win32-string (if is-win32 "true" "false"))
105	(shell (if posix-shell posix-shell "/bin/sh"))
106	(clisp (if clisp-name clisp-name "clisp"))
107	(cmucl (if cmucl-name cmucl-name "lisp"))
108	(scl (if scl-name scl-name "lisp"))
109	(acl (if acl-name acl-name "acl"))
110	(openmcl (if openmcl-name openmcl-name "mcl"))
111	(sbcl (if sbcl-name sbcl-name "sbcl"))
112	(ecl (if ecl-name ecl-name "ecl"))
113	(gcl (if gcl-name gcl-name "gcl"))
114	(files (list "maxima-local.in" "src/maxima.in" "src/maxima.bat.in"
115		     "src/autoconf-variables.lisp.in"))
116	(substitutions))
117    (if interactive
118	(progn
119	  (setf prefix (read-with-default "Enter the Maxima directory" prefix))
120	  (setf win32-string
121		(read-with-default "Is this a Windows system? (true/false)"
122				   win32-string))
123	  (setf shell (read-with-default "Posix shell (optional)" shell))
124	  (setf clisp
125		(read-with-default "Name of the Clisp executable (optional)"
126				   clisp))
127	  (setf cmucl
128		(read-with-default "Name of the CMUCL executable (optional)"
129				   cmucl))
130	  (setf scl
131		(read-with-default "Name of the SCL executable (optional)"
132				   scl))
133	  (setf acl
134		(read-with-default "Name of the Allegro executable (optional)"
135				   acl))
136	  (setf openmcl
137		(read-with-default "Name of the OpenMCL executable (optional)"
138				   openmcl))
139	  (setf ecl
140		(read-with-default "Name of the ECL executable (optional)"
141				   ecl))
142	  (setf gcl
143		(read-with-default "Name of the GCL executable (optional)"
144				   gcl))
145	  (setf sbcl
146		(read-with-default "Name of the SBCL executable (optional)"
147				   sbcl))))
148    (setf substitutions (list (cons "@prefix@"
149				    (replace-substring prefix "\\" "\\\\"))
150			      (cons "@PACKAGE@" "maxima")
151			      (cons "@VERSION@" (get-version))
152			      (cons "@host@" "unknown")
153			      (cons "@win32@" win32-string)
154			      (cons "@default_layout_autotools@" "false")
155			      (cons "@POSIX_SHELL@" shell)
156			      (cons "@expanded_top_srcdir@"
157				    (replace-substring prefix "\\" "\\\\"))
158			      (cons "@lisp_only_build@" "t")
159			      (cons "@DEFAULTLISP@" *maxima-lispname*)
160			      (cons "@CLISP_NAME@" clisp)
161			      (cons "@CMUCL_NAME@" cmucl)
162			      (cons "@SCL_NAME@" scl)
163			      (cons "@ACL_NAME@" acl)
164			      (cons "@OPENMCL_NAME@" openmcl)
165			      (cons "@ECL_NAME@" ecl)
166			      (cons "@GCL_NAME@" gcl)
167			      (cons "@SBCL_NAME@" sbcl)))
168    (if verbose
169	(mapc #'(lambda (pair) (format t "~a=~a~%" (first pair) (rest pair)))
170	      substitutions))
171    (mapc #'(lambda (filename)
172	      (let ((out-filename (replace-substring filename ".in" "")))
173		(process-file filename out-filename substitutions)
174		(format t "Created ~a~%" out-filename)))
175	  files)))
176