diff --git a/command-line-test.scm b/command-line-test.scm new file mode 100644 index 0000000..daa833c --- /dev/null +++ b/command-line-test.scm @@ -0,0 +1,56 @@ +(import (scheme base) (command-line) (srfi 64)) + +(test-begin "command-line") + +(define (esc-char char) + (case char + ((#\B) #\\) + ((#\Q) #\") + (else char))) + +(define (esc s) (string-map esc-char s)) + +(define examples + '(((args) + (posix "") + (windows "")) + ((args "foo") + (posix "foo") + (windows "foo")) + ((args "-+foo/bar@baz.qux") + (posix "-+foo/bar@baz.qux") + (windows "-+foo/bar@baz.qux")) + ((args "foo" "hello world" "bar") + (posix "foo Qhello worldQ bar") + (windows "foo Qhello worldQ bar")) + ((args "foo" "helloBworld" "bar") + (posix "foo QhelloBBworldQ bar") + (windows "foo QhelloBworldQ bar")) + ((args "argument1" "argument 2" "BsomeBpath withBspaces") + (posix "argument1 Qargument 2Q QBBsomeBBpath withBBspacesQ") + (windows "argument1 Qargument 2Q QBsomeBpath withBspacesQ")) + ((args "argument1" "she said, Qyou had me at helloQ" "BsomeBpath withBspaces") + (posix + "argument1 Qshe said, BQyou had me at helloBQQ QBBsomeBBpath withBBspacesQ") + (windows + "argument1 Qshe said, BQyou had me at helloBQQ QBsomeBpath withBspacesQ")) + ((args "argument1" "argumentQ2" "argument3" "argument4") + (posix "argument1 QargumentBQ2Q argument3 argument4") + (windows "argument1 QargumentBQ2Q argument3 argument4")) + ((args "foo" "helloBworld" "bar") + (posix "foo QhelloBBworldQ bar") + (windows "foo QhelloBworldQ bar")) + ((args "BsomeBdirectory withBspacesB") + (posix "QBBsomeBBdirectory withBBspacesBBQ") + (windows "QBsomeBdirectory withBspacesBBQ")))) + +(for-each + (lambda (example) + (let ((args (map esc (cdr (assoc 'args example)))) + (posix (esc (cadr (assoc 'posix example)))) + (windows (esc (cadr (assoc 'windows example))))) + (test-equal "posix" posix (join-posix-command-line args)) + (test-equal "windows" windows (join-windows-command-line args)))) + examples) + +(test-end) diff --git a/command-line.scm b/command-line.scm new file mode 100644 index 0000000..cddc352 --- /dev/null +++ b/command-line.scm @@ -0,0 +1,73 @@ +(define (with-input-from-string string proc) + (call-with-port + (open-input-string string) + (lambda (port) + (parameterize ((current-input-port port)) + (proc))))) + +(define (with-output-to-string proc) + (call-with-port + (open-output-string) + (lambda (port) + (parameterize ((current-output-port port)) + (proc) (get-output-string port))))) + +(define (safe-without-quotes? arg) + (define (safe-char? char) + (case char + ((#\_ #\- #\+ #\/ #\@ #\.) #t) + (else (or (char<=? #\0 char #\9) + (char<=? #\A char #\Z) + (char<=? #\a char #\z))))) + (and (not (= 0 (string-length arg))) + (with-input-from-string arg + (lambda () + (let loop () + (let ((char (read-char))) + (or (eof-object? char) (and (safe-char? char) (loop))))))))) + +(define (join-command-line double-quote args) + (if (null? args) "" + (with-output-to-string + (lambda () + (let loop ((args args)) + (let ((arg (car args))) + (if (safe-without-quotes? arg) + (write-string arg) + (begin (write-char #\") + (with-input-from-string arg double-quote) + (write-char #\"))) + (unless (null? (cdr args)) + (write-char #\space) + (loop (cdr args))))))))) + +(define (double-quote-posix) + (let loop () + (let ((char (read-char))) + (unless (eof-object? char) + (case char ((#\\ #\" #\` #\$ #\newline) (write-char #\\))) + (write-char char) + (loop))))) + +(define (double-quote-windows) + (define (write-backslashes n) (write-string (make-string n #\\))) + (let loop ((backslashes 0)) + (let ((char (read-char))) + (cond ((eqv? #\\ char) + (loop (+ backslashes 1))) + ((eof-object? char) + (write-backslashes (* 2 backslashes))) + ((char=? #\" char) + (write-backslashes (+ 1 (* 2 backslashes))) + (write-char char) + (loop 0)) + (else + (write-backslashes backslashes) + (write-char char) + (loop 0)))))) + +(define (join-posix-command-line args) + (join-command-line double-quote-posix args)) + +(define (join-windows-command-line args) + (join-command-line double-quote-windows args)) diff --git a/command-line.sld b/command-line.sld new file mode 100644 index 0000000..5e0d684 --- /dev/null +++ b/command-line.sld @@ -0,0 +1,5 @@ +(define-library (command-line) + (export join-posix-command-line + join-windows-command-line) + (import (scheme base)) + (include "command-line.scm"))