1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
;;;
;;; 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)
|