bump.

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

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 23d0f10dfc1ebc00074b507b6df9c0136a609147..213d995c2c463a3eb7dd3897190ba192643693ca 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -8,9 +8,7 @@
 
 ;;; this is still too big a mess.
 
-(use-modules (ice-9 regex)
-            (ice-9 string-fun)
-            (ice-9 format)
+(use-modules (ice-9 string-fun)
             (guile)
             (scm page)
             (scm paper-system)
@@ -19,6 +17,10 @@
             (scm clip-region)
             (lily))
 
+(define (format dest . rest)
+  (if (string? dest)
+      (apply simple-format (cons #f (cons dest rest)))
+      (apply simple-format (cons dest rest))))
 
 (define framework-ps-module (current-module))
 
@@ -31,7 +33,12 @@
 
     (string-append
      "magfont"
-     (string-regexp-substitute "[ /%]" "_" name)
+     (ly:string-substitute
+      " " "_"
+      (ly:string-substitute
+       "/" "_"
+       (ly:string-substitute
+       "%" "_" name)))
      "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
 
 (define (tex-font? fontname)
@@ -45,10 +52,6 @@
     (string-append
       "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n"))
 
-  (define (standard-tex-font? x)
-    (or (equal? (substring x 0 2) "ms")
-       (equal? (substring x 0 2) "cm")))
-
   (define (font-load-command font)
     (let* ((specced-font-name (ly:font-name font))
           (fontname (if specced-font-name
@@ -63,10 +66,6 @@
           (ops (ly:output-def-lookup paper 'output-scale))
           (scaling (* ops magnification designsize)))
 
-      ;; Bluesky pfbs have UPCASE names (sigh.)
-      ;; FIXME - don't support Bluesky?
-      (if (standard-tex-font? fontname)
-         (set! fontname (string-upcase fontname)))
       (if (equal? fontname "unknown")
          (display (list font fontname)))
       (define-font plain fontname scaling)))
@@ -165,10 +164,10 @@
               (ly:output-def-lookup paper 'output-scale))
            (ly:bp 1)))
        (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
-  (format "%%DocumentMedia: ~a ~$ ~$ ~a ~a ~a\n"
+  (format "%%DocumentMedia: ~a ~a ~a ~a ~a ~a\n"
    (ly:output-def-lookup paper 'papersizename)
-   (if landscape? h w)
-   (if landscape? w h)
+   (round2 (if landscape? h w))
+   (round2 (if landscape? w h))
    80  ;; weight
    "()" ;; color
    "()"  ;; type
@@ -270,7 +269,10 @@
        (if (mac-font? bare-file-name)
           (handle-mac-font name bare-file-name)
           (cond
-           ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name)
+           ((or (string-startswith file-name "Emmentaler")
+                (string-startswith file-name "emmentaler")
+                (string-startswith file-name "aybabtu")
+                (string-startswith file-name "Aybabtu"))
             (ps-load-file (ly:find-file
                            (format "~a.otf"  file-name))))
            ((string? bare-file-name)
@@ -337,13 +339,13 @@
          ((downcase-file-name (string-downcase file-name)))
        
       (cond
-       ((and file-name (string-match "\\.pfa" downcase-file-name))
+       ((and file-name (string-endswith downcase-file-name ".pfa"))
        (embed-document file-name))
-       ((and file-name (string-match "\\.pfb" downcase-file-name))
+       ((and file-name (string-endswith downcase-file-name ".pfb"))
        (ly:pfb->pfa file-name))
-       ((and file-name (string-match "\\.ttf" downcase-file-name))
+       ((and file-name (string-endswith downcase-file-name ".ttf"))
        (ly:ttf->pfa file-name))
-       ((and file-name (string-match "\\.otf" downcase-file-name))
+       ((and file-name (string-endswith downcase-file-name ".otf"))
        (ps-embed-cff (ly:otf->cff file-name) name 0))
        (else
        (ly:warning (_ "do not know how to embed ~S=~S") name file-name)
@@ -354,7 +356,7 @@
        (eq? PLATFORM 'darwin)
        bare-file-name
        (or
-       (string-match "\\.dfont" bare-file-name)
+       (string-endswith  bare-file-name ".dfont")
        (= (stat:size (stat bare-file-name)) 0))))
 
   (define (load-font font-name-filename)
@@ -487,7 +489,10 @@
   (let*
       ((xext (ly:stencil-extent dump-me X))
        (yext (ly:stencil-extent dump-me Y))
-       (left-overshoot (ly:get-option 'eps-box-padding))
+       (padding (ly:get-option 'eps-box-padding))
+       (left-overshoot (if (number? padding)
+                          (* -1 padding (ly:output-def-lookup paper 'mm))
+                          #f))
        (bbox
        (map
         (lambda (x)
@@ -755,10 +760,16 @@
 
 (define-public (output-classic-framework basename book scopes fields)
 
-  (ly:error (_ "\nThe PostScript backend does not support the 'classic'
-framework. Use the EPS backend instead,
+  (ly:error (_ "\nThe PostScript backend does not support the system-by-system 
+output. For that, use the EPS backend instead,
 
   lilypond -b eps <file>
 
-or remove the lilypond-book specific settings from the input.
+If have cut & pasted a lilypond fragment from a webpage, be sure
+to only remove anything before
+
+  %% ****************************************************************
+  %% Start cut-&-pastable-section
+  %% ****************************************************************
+
 ")))