Index: scm/backend-library.scm |
diff --git a/scm/backend-library.scm b/scm/backend-library.scm |
index 9702ed67ebac26a14a9380c3d0dbef2a5f398562..94ab3d141bd97eaf6d445171b86ca811a6032c16 100644 |
--- a/scm/backend-library.scm |
+++ b/scm/backend-library.scm |
@@ -135,6 +135,68 @@ |
(ly:message (_ "Copying to `~a'...\n") ps-name) |
(copy-binary-file tmp-name ps-name))))) |
+(define-public (mkdir-if-not-exist path . mode) |
+ (catch |
+ 'system-error |
+ (lambda () |
+ ;; mkdir: |
+ ;; If the directory already exists, it raises system-error. |
+ (if (null? mode) |
+ (mkdir path) |
+ (mkdir path (car mode))) |
+ #t) |
+ (lambda stuff |
+ ;; Catch the system-error |
+ (if (= EEXIST (system-error-errno stuff)) |
+ ;; If the directory already exists, avoid error and return #f. |
+ (begin #f) |
+ ;; If the cause is something else, re-throw the error. |
+ (throw 'system-error (cdr stuff)))))) |
+ |
+(define-public (symlink-if-not-exist oldpath newpath) |
+ (catch |
+ 'system-error |
+ (lambda () |
+ ;; symlink: |
+ ;; If the file already exists, it raises system-error. |
+ (symlink oldpath newpath) |
+ #t) |
+ (lambda stuff |
+ ;; Catch the system-error |
+ (if (= EEXIST (system-error-errno stuff)) |
+ ;; If the file already exists, avoid error and return #f. |
+ (begin #f) |
+ ;; If the cause is something else, re-throw the error. |
+ (throw 'system-error (cdr stuff)))))) |
+ |
+(define-public (symlink-or-copy-if-not-exist oldpath newpath) |
+ (if (eq? PLATFORM 'windows) |
+ (let ((port (create-file-exclusive newpath))) |
+ (if port |
+ (begin |
+ (close port) |
+ (copy-binary-file oldpath newpath) |
+ #t) |
+ (begin #f))) |
+ (symlink-if-not-exist oldpath newpath))) |
+ |
+(define-public (create-file-exclusive path . mode) |
+ (catch |
+ 'system-error |
+ (lambda () |
+ ;; Exclusive file create: |
+ ;; If the file already exists, it raises system-error. |
+ (if (null? mode) |
+ (open path (logior O_WRONLY O_CREAT O_EXCL)) |
+ (open path (logior O_WRONLY O_CREAT O_EXCL) (car mode)))) |
+ (lambda stuff |
+ ;; Catch the system-error |
+ (if (= EEXIST (system-error-errno stuff)) |
+ ;; If the file already exists, avoid error and return #f. |
+ (begin #f) |
+ ;; If the cause is something else, re-throw the error. |
+ (throw 'system-error (cdr stuff)))))) |
+ |
(define-public (copy-binary-file from-name to-name) |
(if (eq? PLATFORM 'windows) |
;; MINGW hack: MinGW Guile's copy-file is broken. |