diff options
| -rw-r--r-- | doc/ref/guile/util.texi | 8 | ||||
| -rw-r--r-- | module/hnh/util/path.scm | 17 |
2 files changed, 18 insertions, 7 deletions
diff --git a/doc/ref/guile/util.texi b/doc/ref/guile/util.texi index 016c21c7..79d9eaab 100644 --- a/doc/ref/guile/util.texi +++ b/doc/ref/guile/util.texi @@ -295,6 +295,14 @@ Converts @var{any} to a string, as per @var{write}. @defun path-append strings ... Joins all strings into a path, squeezing duplicated delimiters, but ensuring that all delimiters that are needed are there. + +Note that delimiters embedded inside the string, which aren't first or +last in a substring (or are the only thing in a string) are +kept. Meaning that +@example +(path-append "/" "hello") ⇒ "/hello" +(path-append "/usr/local/bin" "cmd") ⇒ "/usr/local/bin/cmd" +@end example @end defun diff --git a/module/hnh/util/path.scm b/module/hnh/util/path.scm index 49338d01..7e40259a 100644 --- a/module/hnh/util/path.scm +++ b/module/hnh/util/path.scm @@ -2,21 +2,24 @@ :use-module (srfi srfi-1) :use-module (hnh util)) -;; TODO shouldn't this use `file-name-separator-string'? (define-public (path-append . strings) (fold (lambda (s done) (string-append done (if (string-null? s) - (string-append s "/") - (if (char=? #\/ (string-last done)) - (if (char=? #\/ (string-first s)) + (string-append s file-name-separator-string) + (if (file-name-separator? (string-last done)) + (if (file-name-separator? (string-first s)) (string-drop s 1) s) - (if (char=? #\/ (string-first s)) - s (string-append "/" s)))))) + (if (file-name-separator? (string-first s)) + s (string-append file-name-separator-string s)))))) + ;; If first component is empty, add a leading slash to make + ;; the path absolute. This isn't exactly correct if we have + ;; drive letters, but on those system the user should make + ;; sure that the first component of the path is non-empty. (let ((s (car strings))) (if (string-null? s) - "/" s)) + file-name-separator-string s)) (cdr strings))) (define-public (path-join lst) (apply path-append lst)) |