Issue 4992/4: Add never-embed-font-list for OpenType/CFF (OTF, OTC) fonts

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

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index a4041196789c989d7f7a5616cdd1c8ecd10b876c..8bafb758f07bd0c52186359f0b0b930629f1a3fb 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -214,6 +214,8 @@
    (define-fonts paper ps-define-font ps-define-pango-pf)
    (output-variables paper)))
 
+(define never-embed-font-list (list))
+
 (define (cff-font? font)
   (let* ((cff-string (ly:otf-font-table-data font "CFF ")))
     (> (string-length cff-string) 0)))
@@ -241,9 +243,12 @@
          (footer "\n%%EndData
 %%EndResource
 %%EndResource\n"))
-    (string-append header
-                   binary-data
-                   footer)))
+    (begin
+      (set! never-embed-font-list
+            (append never-embed-font-list (list font-set-name)))
+      (string-append header
+                     binary-data
+                     footer))))
 
 (define check-conflict-and-embed-cff
   (let ((font-list '()))
@@ -400,7 +405,9 @@
       (cond
        ((eq? font-format (string->symbol "Type 1"))
         ;; Type 1 (PFA and PFB) fonts
-        (ly:type1->pfa file-name))
+        (begin (set! never-embed-font-list
+                     (append never-embed-font-list (list name)))
+               (ly:type1->pfa file-name)))
        ((eq? font-format 'TrueType)
         ;; TrueType fonts (TTF) and TrueType Collection (TTC)
         (ly:ttf->pfa file-name font-index))
@@ -485,12 +492,23 @@
    port
    "/lilypond-datadir where {pop} {userdict /lilypond-datadir (~a) put } ifelse"
    (ly:get-option 'datadir))
+  (set! never-embed-font-list (list))
   (if load-fonts?
       (for-each (lambda (f)
                   (format port "\n%%BeginFont: ~a\n" (car f))
                   (display (cdr f) port)
                   (display "%%EndFont\n" port))
                 (load-fonts paper)))
+  (if (ly:get-option 'gs-never-embed-fonts)
+      (begin
+        (display "\nsystemdict /DEVICE known\n" port)
+        (display " { systemdict /DEVICE get (pdfwrite) eq {\n" port)
+        (display ".setpdfwrite << /NeverEmbed [" port)
+        (display (string-concatenate
+                  (map (lambda (f) (string-append " /" f))
+                       never-embed-font-list)) port)
+        (display " ] >> setdistillerparams\n" port)
+        (display " } if } if\n" port)))
   (if (ly:bigpdfs)
       (display (procset "encodingdefs.ps") port))
   (display (setup-variables paper) port)