Issue 5107 Fix some warnings about string-delete and

[lilypond.git] / scm / framework-ps.scm

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 4df9ba3e6f90d52da14c257690ba0dbe24f5264b..9498b2ac9dd24bff298a593707e53a9862b57609 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -309,7 +309,8 @@
 
     (define (ps-load-file file-name)
       (if (string? file-name)
-          (if (string-contains file-name (ly:get-option 'datadir))
+          (if (and (not (ly:get-option 'font-export-dir))
+                   (string-contains file-name (ly:get-option 'datadir)))
               (begin
                 (set! file-name (ly:string-substitute (ly:get-option 'datadir)
                                                       "" file-name))
@@ -535,6 +536,24 @@
    "/lilypond-datadir where {pop} {userdict /lilypond-datadir (~a) put } ifelse"
    (ly:get-option 'datadir))
   (set! never-embed-font-list (list))
+  (if (ly:get-option 'font-export-dir)
+      (let ((dirname (format #f "~a" (ly:get-option 'font-export-dir))))
+        (ly:debug
+         (_ "Making font export directory `~a'.") dirname)
+        (catch
+         'system-error
+         (lambda ()
+           ;; mkdir:
+           ;; When the directory already exists, it raises system-error.
+           (mkdir dirname))
+         (lambda stuff
+           ;; Catch the system-error
+           (if (= EEXIST (system-error-errno stuff))
+               ;; If the directory already exists, avoid error.
+               (ly:debug
+                (_ "Font export directory `~a' already exists.") dirname)
+               ;; If the cause is something else, re-throw the error.
+               (throw 'system-error (cdr stuff)))))))
   (if load-fonts?
       (for-each (lambda (f)
                   (format port "\n%%BeginFont: ~a\n" (car f))