;;;
;;; Help the Windows installer
;;;


;; In the final destination bin directory, make a Bourne shell script
;; to launch GCL.

(defun kill-backs ( s )
  (let ((pos (search "\\" s)))
    (if pos 
	(let ((start (subseq s 0 pos))
	      (finish (subseq s (1+ pos))))
	  (kill-backs (concatenate 'string start "/" finish)))
      s)))

(defun kill-double-forwards ( s )
  (let ((pos (search "//" s)))
    (if pos 
	(let ((start (subseq s 0 pos))
	      (finish (subseq s (+ pos 2))))
	  (kill-double-forwards (concatenate 'string start "/" finish)))
      s)))

(defun kill-forwards ( s )
  (let ((pos (search "/" s)))
    (if pos 
	(let ((start (subseq s 0 pos))
	      (finish (subseq s (1+ pos))))
	  (kill-forwards (concatenate 'string start "\\" finish)))
      s)))

(defun kill-double-backs ( s )
  (let ((pos (search "\\\\" s)))
    (if pos 
	(let ((start (subseq s 0 pos))
	      (finish (subseq s (+ pos 2))))
	  (kill-double-backs (concatenate 'string start "\\" finish)))
      s)))

(defun split-by-one-fs (string)
    (loop for i = 0 then (1+ j)
          as j = (position #\/ string :start i)
          collect (subseq string i j)
          while j))


; Remove dos colon for MSYS and \\
(defun msysarise (s)
  (if (equal (char s 1) #\:)
      (kill-double-forwards (kill-backs (concatenate 'string "/" (subseq s 0 1) (subseq s 2))))
    (kill-double-forwards (kill-backs s))))

(setq *msys-system-directory* (msysarise *system-directory*))

;; The following few lines remove the lib/gcl-???/unixport string.
;; Can't do this by simple string substitution as W98 paths are shortened.
;; All depends on path format including end separator.

; Canonicalise directory separators
(setq *root-directory* 
      (kill-double-forwards (kill-backs *system-directory*)))

; Remove end dir separator
(setq *root-directory* 
      (subseq *root-directory* 0 (search "/"  *root-directory*  :from-end t)))

; Remove unixport and dir separator
(setq *root-directory* 
      (subseq *root-directory* 0 (search "/"  *root-directory*  :from-end t)))

; Remove gcl-?.?.? and dir separator
(setq *root-directory* 
      (subseq *root-directory* 0 (search "/"  *root-directory*  :from-end t)))

; Remove lib but not the dir separator
(setq *root-directory* 
      (subseq *root-directory* 0 (1+ (search "/"  *root-directory*  :from-end t))))

; Canonicalise directory separators
(setq *msys-root-directory* 
      (kill-double-forwards (kill-backs *msys-system-directory*)))

; Remove end dir separator
(setq *msys-root-directory* 
      (subseq *msys-root-directory* 0 (search "/"  *msys-root-directory*  :from-end t)))

; Remove unixport and dir separator
(setq *msys-root-directory* 
      (subseq *msys-root-directory* 0 (search "/"  *msys-root-directory*  :from-end t)))

; Remove gcl-?.?.? and dir separator
(setq *msys-root-directory* 
      (subseq *msys-root-directory* 0 (search "/"  *msys-root-directory*  :from-end t)))

; Remove lib but not the dir separator
(setq *msys-root-directory* 
      (subseq *msys-root-directory* 0 (1+ (search "/"  *msys-root-directory*  :from-end t))))

(setq *lib-directory* 
      (format nil "~a~a" *root-directory* "lib/gcl-@VERSION@/"))

(setq *h-directory* 
      (format nil "~a~a" *msys-root-directory* "/lib/gcl-@VERSION@/h"))

(setq *bin-directory* 
      (format nil "~a~a" *root-directory* "bin/"))

(setq gclscript (format nil "~a~a" *bin-directory* "gcl"))

(with-open-file (s gclscript :direction :output :if-exists :supersede)
		(format s "#!/bin/sh~%")
		(format s "# export C_INCLUDE_PATH=~a~%" *h-directory* )
		(format s "export PATH=~a/mingw/bin:~a/lib/gcl-@VERSION@/unixport:${PATH}~%" *msys-root-directory* *msys-root-directory* )
		(format s "exec ~a@FLISP@.exe -dir ~a -libdir ~a -eval \"(setq si::*allow-gzipped-file* t)\" \"$@\""
			*msys-system-directory*
			(kill-double-forwards *system-directory*)
			*lib-directory* ))

; Now make a batch file to launch GCL
(setq *dos-system-directory* (kill-double-backs (kill-forwards  *system-directory*)))

; Now make a batch file to launch GCL
(setq *dos-root-directory* (kill-double-backs (kill-forwards  *dos-system-directory*)))

; Remove end dir separator
(setq *dos-root-directory* 
      (subseq *dos-root-directory* 0 (search "\\"  *dos-root-directory*  :from-end t)))

; Remove unixport and dir separator
(setq *dos-root-directory* 
      (subseq *dos-root-directory* 0 (search "\\"  *dos-root-directory*  :from-end t)))

; Remove gcl-?.?.? and dir separator
(setq *dos-root-directory* 
      (subseq *dos-root-directory* 0 (search "\\"  *dos-root-directory*  :from-end t)))

; Remove lib but not the dir separator
(setq *dos-root-directory* 
      (subseq *dos-root-directory* 0 (1+ (search "\\"  *dos-root-directory*  :from-end t))))

(setq *dos-h-directory* 
      (format nil "~a~a" *dos-root-directory* "lib\\gcl-@VERSION@\\h"))

(setq *dos-bin-directory* 
      (format nil "~a~a" *dos-root-directory* "bin\\"))

(setq gclbatch (format nil "~a~a" *bin-directory* "gcl.bat"))

;; Output CRLF line terminated batch file

(setf crstr (make-string 1 :initial-element #\Return))
(setf lfstr (make-string 1 :initial-element #\Linefeed))
(defun crlf (s) (format s "~a~a" crstr lfstr))

(with-open-file (s gclbatch :direction :output :if-exists :supersede)
		(format s "@echo off") (crlf s)
		(format s "REM set C_INCLUDE_PATH=~a" *dos-h-directory* ) (crlf s)
		(format s "path ~amingw\\bin;~alib\\gcl-@VERSION@\\unixport;%PATH%" *dos-root-directory* *dos-root-directory* ) (crlf s)
		(format s "start ~a@FLISP@.exe -dir ~a -libdir ~a -eval \"(setq si::*allow-gzipped-file* t)\" %1 %2 %3 %4 %5 %6 %7 %8 %9"
			*dos-system-directory*
			(kill-double-forwards *system-directory*)
			*lib-directory* ) (crlf s))

(quit)
