+
+ (define (load-font-via-GS font-name-filename)
+ (define (ps-load-file name)
+ (format
+ (if (string? name)
+ "(~a) (r) file .loadfont\n"
+ "% can't find font file: ~a\n")
+ name))
+
+ (let* ((font (car font-name-filename))
+ (name (cadr font-name-filename))
+ (file-name (caddr font-name-filename))
+ (bare-file-name (ly:find-file file-name)))
+
+ (cons
+ (munge-lily-font-name name)
+ (cond
+ ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name)
+ (ps-load-file (ly:find-file
+ (format "~a.pfa" (munge-lily-font-name file-name)))))
+ ((string? bare-file-name)
+ (ps-load-file (munge-lily-font-name file-name)))
+ (else
+ (ly:warning (_ "can't embed ~S=~S") name file-name)
+ "")))))
+
+ (define (dir-join a b)
+ (if (equal? a "")
+ b
+ (string-append a "/" b)))
+
+ (define (dir-listing dir-name)
+ (define (dir-helper dir lst)
+ (let ((e (readdir dir)))
+ (if (eof-object? e) lst (dir-helper dir (cons e lst)))))
+ (reverse (dir-helper (opendir dir-name) '())))
+
+ (define (handle-mac-font name filename)
+ (let*
+ ((dir-name (tmpnam))
+ (files '())
+ (status 0)
+ (embed #f))
+
+
+ (mkdir dir-name #o700)
+
+ (set! status (ly:system
+ (format "cd ~a && fondu -force '~a'" dir-name filename)))
+
+ (set! files (dir-listing dir-name))
+
+ (for-each
+ (lambda (f)
+ (if (and (not embed)
+ (string-match (string-append name "\\.") f))
+ (set! embed
+ (font-file-as-ps-string name (dir-join dir-name f))))
+
+ (if (or (equal? "." f)
+ (equal? ".." f))
+ #t
+ (delete-file (dir-join dir-name f))))
+ files)
+ (rmdir dir-name)
+
+ (if (not embed)
+ (begin
+ (set! embed "% failed \n")
+ (ly:warning (_ "can't extract file matching ~a from ~a") name filename)))
+ embed))
+
+ (define (font-file-as-ps-string name file-name)
+ (let*
+ ((downcase-file-name (string-downcase file-name)))
+
+ (cond
+ ((and file-name (string-match "\\.pfa" downcase-file-name))
+ (cached-file-contents file-name))
+ ((and file-name (string-match "\\.pfb" downcase-file-name))
+ (ly:pfb->pfa file-name))
+ ((and file-name (string-match "\\.ttf" downcase-file-name))
+ (ly:ttf->pfa file-name))
+ ((and file-name (string-match "\\.otf" downcase-file-name))
+ (ps-embed-cff (ly:otf->cff file-name) name 0))
+ (else
+ (ly:warning (_ "don't know how to embed ~S=~S") name file-name)
+ ""))))
+
+ (define (load-font font-name-filename)
+ (let* ((font (car font-name-filename))
+ (name (cadr font-name-filename))
+ (file-name (caddr font-name-filename))
+ (bare-file-name (ly:find-file file-name)))
+
+ (cons
+ (munge-lily-font-name name)
+ (cond
+ ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name)
+ (cached-file-contents
+ (format "~a.pfa" (munge-lily-font-name file-name))))
+ ((and
+ (eq? PLATFORM 'darwin)
+ bare-file-name (string-match "\\.dfont" bare-file-name))
+ (handle-mac-font name bare-file-name))
+
+ ((and
+ (eq? PLATFORM 'darwin)
+ bare-file-name (= (stat:size (stat bare-file-name)) 0))
+ (handle-mac-font name bare-file-name))
+
+ ((and font (cff-font? font))
+ (ps-embed-cff (ly:otf-font-table-data font "CFF ")
+ name
+ 0))
+
+ (bare-file-name (font-file-as-ps-string name bare-file-name))
+ (else
+ (ly:warning (_ "don't know how to embed font ~s ~s ~s")
+ name file-name font))))))
+
+