suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Switch ~n to \n in format strings

Browse Source 
* Use test -h on solaris instead of -L
* Clearly mark bindir-finding section

svn: r3437
This commit is contained in:
Eli Barzilay 2006-06-22 18:35:12 +00:00
parent 80676c721a
commit 35d662e582
1 changed files with 35 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/launcher/launcher-unit.ss
View File

@ -214,19 +214,19 @@
one-arg-x-flags) one-arg-x-flags)
(map (map
(lambda (f) (lambda (f)
(format " ~a)~n ~a=yes~n ;;~n" (or-flags (cdr f)) (car f))) (format " ~a)\n ~a=yes\n ;;\n" (or-flags (cdr f)) (car f)))
no-arg-x-flags) no-arg-x-flags)
(list (list
(format (string-append (format (string-append
" *)~n ~a~a~a ;;~n" " *)\n ~a~a~a ;;\n"
" esac~n" " esac\n"
" shift~n" " shift\n"
" if [ \"$oneargflag\" != '' ] ; then~n" " if [ \"$oneargflag\" != '' ] ; then\n"
" if [ \"${1+n}\" != 'n' ] ; then echo $0: missing argument for standard X flag $oneargflag ; exit 1 ; fi~n" " if [ \"${1+n}\" != 'n' ] ; then echo $0: missing argument for standard X flag $oneargflag ; exit 1 ; fi\n"
" shift~n" " shift\n"
" fi~n" " fi\n"
" findxend ${1+\"$@\"}~n" " findxend ${1+\"$@\"}\n"
"}~nfindxend ${1+\"$@\"}~n") "}\nfindxend ${1+\"$@\"}\n")
exec exec
(apply (apply
string-append string-append
@ -270,7 +270,7 @@
(string-append (string-append
"# Make this PATH-independent\n" "# Make this PATH-independent\n"
"saveP=\"$PATH\"\n" "saveP=\"$PATH\"\n"
"PATH=/usr/bin:/bin\n" "PATH=\"/usr/bin:/bin\"\n"
"\n" "\n"
(if has-readlink? "" (if has-readlink? ""
(string-append (string-append
@ -288,7 +288,14 @@
"D=`dirname \"$0\"`\n" "D=`dirname \"$0\"`\n"
"F=`basename \"$0\"`\n" "F=`basename \"$0\"`\n"
"cd \"$D\"\n" "cd \"$D\"\n"
"while [ -L \"$F\" ]; do\n" "while test "
;; On solaris, Edward Chrzanowski from Waterloo says that the man
;; page says that -L is not supported, but -h is; on other systems
;; (eg, freebsd) -h is listed as a compatibility feature
(if (regexp-match #rx"solaris" (path->string
(system-library-subpath)))
"-h" "-L")
" \"$F\"; do\n"
" P=`readlink \"$F\"`\n" " P=`readlink \"$F\"`\n"
" D=`dirname \"$P\"`\n" " D=`dirname \"$P\"`\n"
" F=`basename \"$P\"`\n" " F=`basename \"$P\"`\n"
@ -306,13 +313,12 @@
(protect-shell-string s)) (protect-shell-string s))
"")) ""))
"\"\n" "\"\n"
"PATH=\"$saveP\"\n" "PATH=\"$saveP\"\n")
"\n")
;; fallback to absolute path header ;; fallback to absolute path header
(make-absolute-path-header bindir)))) (make-absolute-path-header bindir))))
(define (make-absolute-path-header bindir) (define (make-absolute-path-header bindir)
(string-append "bindir=\""(protect-shell-string bindir)"\"\n\n")) (string-append "bindir=\""(protect-shell-string bindir)"\"\n"))
(define (make-unix-launcher kind variant flags dest aux) (define (make-unix-launcher kind variant flags dest aux)
(install-template dest kind "sh" "sh") ; just for something that's executable (install-template dest kind "sh" "sh") ; just for something that's executable
@ -341,8 +347,8 @@
[post-str (str-list->sh-str post-flags)] [post-str (str-list->sh-str post-flags)]
[header (string-append [header (string-append
"#!/bin/sh\n" "#!/bin/sh\n"
"# This script was created by make-"(symbol->string kind)"-launcher\n" "# This script was created by make-"
"\n")] (symbol->string kind)"-launcher\n")]
[dir-finder [dir-finder
(let ([bindir (if alt-exe (let ([bindir (if alt-exe
(find-gui-bin-dir) (find-gui-bin-dir)
@ -357,8 +363,8 @@
(if alt-exe "" (variant-suffix variant)) (if alt-exe "" (variant-suffix variant))
pre-str)] pre-str)]
[args (format [args (format
"~a ~a ${1+\"$@\"}~n" "~a~a ${1+\"$@\"}\n"
(if alt-exe "" " -N \"$0\"") (if alt-exe "" "-N \"$0\" ")
post-str)] post-str)]
[assemble-exec (if (and (eq? kind 'mred) [assemble-exec (if (and (eq? kind 'mred)
(not (memq variant '(script scrip-3m))) (not (memq variant '(script scrip-3m)))
@ -367,12 +373,16 @@
string-append)]) string-append)])
(unless (find-console-bin-dir) (unless (find-console-bin-dir)
(error 'make-unix-launcher "unable to locate bin directory")) (error 'make-unix-launcher "unable to locate bin directory"))
(let ([p (open-output-file dest 'truncate)]) (with-output-to-file dest
(fprintf p "~a~a~a" (lambda ()
header (display header)
dir-finder (newline)
(assemble-exec exec args)) (display "# {{{ bindir\n")
(close-output-port p)))) (display dir-finder)
(display "# }}} bindir\n")
(newline)
(display (assemble-exec exec args)))
'truncate)))
(define (utf-16-regexp b) (define (utf-16-regexp b)
(byte-regexp (bytes-append (bytes->utf-16-bytes b) (byte-regexp (bytes-append (bytes->utf-16-bytes b)