Refactor command-name

This commit is contained in:
Jack Firth 2015-09-17 11:14:04 -07:00 committed by Matthew Flatt
parent c05db1ecf4
commit d305ceffe1

View File

@ -10,24 +10,25 @@
(define-values (program+command-name) (define-values (program+command-name)
(lambda () (lambda ()
(let-values ([(p) (find-system-path 'run-file)] (define-values (p) (find-system-path 'run-file))
[(n) (current-command-name)]) (define-values (n) (current-command-name))
(if n (if n (format "~a ~a" p n) p)))
(format "~a ~a" p n)
p))))
(define-values (short-program+command-name) (define-values (short-program+command-name)
(lambda () (lambda ()
(let-values ([(p) (find-system-path 'run-file)] (define-values (p) (find-system-path 'run-file))
[(n) (current-command-name)]) (define-values (n) (current-command-name))
(let-values ([(base name dir?) (split-path p)]) (define-values (base name dir?) (split-path p))
(let-values ([(name) (if (eq? (system-type) 'windows) (define-values (converted-name) (convert-name name))
(string->path-element (if n
(regexp-replace #rx"(?i:[.]exe)$" (format "~a ~a" converted-name n)
(path-element->string name) (path->string converted-name))))
""))
name)])
(if n
(format "~a ~a" name n)
(path->string name))))))))
(define-values (convert-name)
(lambda (name)
(if (eq? (system-type) 'windows)
(string->path-element
(regexp-replace #rx"(?i:[.]exe)$"
(path-element->string name)
""))
name))))