fix `raco setup' reported name for Windows

This commit is contained in:
Matthew Flatt 2010-08-06 13:54:18 -06:00
parent 561d33fddd
commit 804ff115e7
2 changed files with 25 additions and 21 deletions

View File

@ -24,7 +24,7 @@
ns))) ns)))
(define-values (short-name long-names raco?) (define-values (short-name long-names raco?)
;; Load the name modulewithout using .zos, and in its own namespace to ;; Load the name module without using .zos, and in its own namespace to
;; avoid poluting the cm-managed namespace later ;; avoid poluting the cm-managed namespace later
(parameterize ([use-compiled-file-paths null] (parameterize ([use-compiled-file-paths null]
[current-namespace (make-kernel-namespace)]) [current-namespace (make-kernel-namespace)])

View File

@ -2,28 +2,32 @@
;; so minimize its dependencies ;; so minimize its dependencies
(module command-name '#%kernel (module command-name '#%kernel
(#%require raco/command-name) (#%require raco/command-name '#%utils)
(#%provide get-names) (#%provide get-names)
(define-values (get-names) (define-values (get-names)
(lambda () (lambda ()
(let-values ([(p) (find-system-path 'run-file)]) (let-values ([(p) (find-system-path 'run-file)])
(let-values ([(base name dir?) (split-path p)]) (let-values ([(p) (if (eq? (system-type) 'windows)
(if (current-command-name) (path-replace-suffix p #"")
(values (format "~a ~a" name (current-command-name)) p)])
(program+command-name)) (let-values ([(base name dir?) (split-path p)])
;; Hack for bootstrapping, if the program name is "raco", (if (current-command-name)
;; then claim to be the "setup" command: (values (format "~a ~a" name (current-command-name))
;; if the program name is "racket", assume that there's a "racket -l setup" (program+command-name))
;; going on in there and also claim to be the "raco setup" command ;; Hack for bootstrapping, if the program name is "raco",
(if (if (equal? (path->string name) "raco") ;; then claim to be the "setup" command:
#t ;; if the program name is "racket", assume that there's a "racket -l setup"
(equal? (path->string name) "racket")) ;; going on in there and also claim to be the "raco setup" command
(values "raco setup" (if (if (equal? (path->string name) "raco")
(string-append (regexp-replace* #t
#rx"racket$" (equal? (path->string name) "racket"))
(format "~a" p) (values "raco setup"
"raco") (string-append (regexp-replace*
" setup") #rx"racket$"
#t) (format "~a" p)
(values (path->string name) p #f)))))))) "raco")
" setup")
#t)
(values (path->string name) p #f)))))))))