From 5f5ca98a2456b913742f7857b174c81cdf15624c Mon Sep 17 00:00:00 2001
From: Werner Lemberg <wl@gnu.org>
Date: Thu, 25 Dec 2008 10:56:40 +0100
Subject: [PATCH] Formatting.

---
 scm/framework-ps.scm | 366 +++++++++++++++++++------------------------
 1 file changed, 159 insertions(+), 207 deletions(-)

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 595fedcfa8..0c7ab8624f 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -27,7 +27,6 @@
 (define-public (ps-font-command font)
   (let* ((name (ly:font-file-name font))
 	 (magnify (ly:font-magnification font)))
-
     (string-append
      "magfont"
      (ly:string-substitute
@@ -40,24 +39,27 @@
 
 (define (define-fonts paper)
   (define font-list (ly:paper-fonts paper))
+
   (define (define-font command fontname scaling)
     (string-append
-      "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n"))
+      "/" command
+      " { /" fontname
+      " " (ly:number->string scaling) " output-scale div selectfont }"
+      " bind def\n"))
 
   (define (font-load-command font)
     (let* ((specced-font-name (ly:font-name font))
 	   (fontname (if specced-font-name
-			  specced-font-name
+			 specced-font-name
 			 (ly:font-file-name font)))
 	   (command (ps-font-command font))
 
-	   ;; FIXME -- see (ps-font-command )
+	   ;; FIXME -- see (ps-font-command)
 	   (plain (ps-font-command font))
 	   (designsize (ly:font-design-size font))
 	   (magnification (* (ly:font-magnification font)))
 	   (ops (ly:output-def-lookup paper 'output-scale))
 	   (scaling (* ops magnification designsize)))
-
       (if (equal? fontname "unknown")
 	  (display (list font fontname)))
       (define-font plain fontname scaling)))
@@ -85,15 +87,13 @@
 
   (string-append
    "/lily-output-units "
-     (number->string (/ (ly:bp 1)))
-     " def %% millimeter\n"
+     (number->string (/ (ly:bp 1))) " def %% millimeter\n"
    (output-entry "staff-line-thickness" 'line-thickness)
    (output-entry "line-width" 'line-width)
    (output-entry "paper-size" 'papersizename)
    (output-entry "staff-height" 'staff-height)	;junkme.
    "/output-scale "
-     (number->string (ly:output-def-lookup layout 'output-scale))
-     " def\n"
+     (number->string (ly:output-def-lookup layout 'output-scale)) " def\n"
    (output-entry "page-height" 'paper-height)
    (output-entry "page-width" 'paper-width)))
 
@@ -107,11 +107,9 @@
 	"page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n"
 	"")
     "%%EndPageSetup\n"
-    
+    "\n"
     "true setstrokeadjust\n"
-    "gsave 0 paper-height translate "
-    "set-ps-scale-to-lily-scale "
-    "\n"))
+    "gsave 0 paper-height translate set-ps-scale-to-lily-scale\n"))
   (ly:outputter-dump-stencil outputter page)
   (ly:outputter-dump-string outputter "stroke grestore\nshowpage\n"))
 
@@ -123,90 +121,81 @@
 
   (let* ((fonts (ly:paper-fonts paper))
 	 (names (apply append (map extract-names fonts))))
-
     (apply string-append
 	   (map (lambda (f)
 		  (format
 		   (if load-fonts?
-		    "%%DocumentSuppliedResources: font ~a\n"
-		    "%%DocumentNeededResources: font ~a\n")
+		       "%%DocumentSuppliedResources: font ~a\n"
+		       "%%DocumentNeededResources: font ~a\n")
 		   f))
 		(uniq-list (sort names string<?))))))
 
 (define (eps-header paper bbox load-fonts?)
   (string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
-		 "%%Creator: LilyPond "
-		 (lilypond-version)
-		 "\n"
+		 "%%Creator: LilyPond " (lilypond-version) "\n"
 		 "%%BoundingBox: "
-		 (string-join (map ly:number->string bbox) " ") "\n"
+		   (string-join (map ly:number->string bbox) " ") "\n"
 		 "%%Orientation: "
-		 (if (eq? (ly:output-def-lookup paper 'landscape) #t)
-		     "Landscape\n"
-		     "Portrait\n")
+		   (if (eq? (ly:output-def-lookup paper 'landscape) #t)
+		       "Landscape\n"
+		       "Portrait\n")
 		 (supplies-or-needs paper load-fonts?)
 		 "%%EndComments\n"))
 
-(define (ps-document-media paper) 
- (let* ((w (/ (*
-	       (ly:output-def-lookup paper 'output-scale)
-	       (ly:output-def-lookup paper 'paper-width)) (ly:bp 1)))
-	(h (/ (*
-	       (ly:output-def-lookup paper 'paper-height)
-	       (ly:output-def-lookup paper 'output-scale))
-	    (ly:bp 1)))
-	(landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
-  (ly:format "%%DocumentMedia: ~a ~2f ~2f ~a ~a ~a\n"
-	     (ly:output-def-lookup paper 'papersizename)
-	     (if landscape? h w)
-	     (if landscape? w h)
-	     80  ;; weight
-	     "()" ;; color
-	     "()"  ;; type
-  )))
-
+(define (ps-document-media paper)
+  (let* ((w (/ (*
+		(ly:output-def-lookup paper 'output-scale)
+		(ly:output-def-lookup paper 'paper-width)) (ly:bp 1)))
+	 (h (/ (*
+		(ly:output-def-lookup paper 'paper-height)
+		(ly:output-def-lookup paper 'output-scale))
+	       (ly:bp 1)))
+	 (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
+    (ly:format "%%DocumentMedia: ~a ~2f ~2f ~a ~a ~a\n"
+	       (ly:output-def-lookup paper 'papersizename)
+	       (if landscape? h w)
+	       (if landscape? w h)
+	       80  ;; weight
+	       "()" ;; color
+	       "()" ;; type
+    )))
 
 (define (file-header paper page-count load-fonts?)
   (string-append "%!PS-Adobe-3.0\n"
-		 "%%Creator: LilyPond "
-		 (lilypond-version)
-		 "\n"
-		 
+		 "%%Creator: LilyPond " (lilypond-version) "\n"
 		 "%%Pages: " (number->string page-count) "\n"
 		 "%%PageOrder: Ascend\n"
 		 "%%Orientation: "
-		 (if (eq? (ly:output-def-lookup paper 'landscape) #t)
-		     "Landscape\n"
-		     "Portrait\n")
+		   (if (eq? (ly:output-def-lookup paper 'landscape) #t)
+		       "Landscape\n"
+		       "Portrait\n")
 		 (ps-document-media paper)
 		 (supplies-or-needs paper load-fonts?)
 		 "%%EndComments\n"))
 
 (define (procset file-name)
   (format
-    "%%BeginResource: procset (~a) 1 0
+   "%%BeginResource: procset (~a) 1 0
 ~a
 %%EndResource
 "
-    file-name (cached-file-contents file-name)))
+   file-name (cached-file-contents file-name)))
 
 (define (embed-document file-name)
   (format "%%BeginDocument: ~a
 ~a
 %%EndDocument
-" 
-    file-name (cached-file-contents file-name)))
+"
+   file-name (cached-file-contents file-name)))
 
 (define (setup-variables paper)
   (string-append
    "\n"
    (define-fonts paper)
-   (output-variables paper)
-   ))
+   (output-variables paper)))
 
 (define (cff-font? font)
-  (let*
-      ((cff-string (ly:otf-font-table-data font "CFF ")))
+  (let* ((cff-string (ly:otf-font-table-data font "CFF ")))
     (> (string-length cff-string) 0)))
 
 (define-public (ps-embed-cff body font-set-name version)
@@ -214,7 +203,6 @@
 	  (string-append
 	   (format "/~a ~s StartData " font-set-name (string-length body))
 	   body))
-
 	 (header
 	  (format
 	   "%%BeginResource: font ~a
@@ -233,12 +221,9 @@
 	 (footer "\n%%EndData
 %%EndResource
 %%EndResource\n"))
-
-    (string-append
-     header
-     binary-data
-     footer)))
-
+    (string-append header
+		   binary-data
+		   footer)))
 
 (define (write-preamble paper load-fonts? port)
   (define (internal-font? file-name)
@@ -246,14 +231,17 @@
 	(string-startswith file-name "emmentaler")
 	(string-startswith file-name "aybabtu")
 	(string-startswith file-name "Aybabtu")))
-  (define (load-font-via-GS font-name-filename)       
+
+  (define (load-font-via-GS font-name-filename)
     (define (ps-load-file file-name)
       (if (string? file-name)
 	  (if (string-contains file-name (ly:get-option 'datadir))
 	      (begin
-		(set! file-name (ly:string-substitute (ly:get-option 'datadir) "" file-name))
-		(format "lilypond-datadir (~a) concatstrings (r) file .loadfont" file-name))
-	      
+		(set! file-name (ly:string-substitute (ly:get-option 'datadir)
+						      "" file-name))
+		(format
+		 "lilypond-datadir (~a) concatstrings (r) file .loadfont"
+		 file-name))
 	      (format "(~a) (r) file .loadfont\n" file-name))
 	  (format "% cannot find font file: ~a\n" file-name)))
 
@@ -261,79 +249,63 @@
 	   (name (cadr font-name-filename))
 	   (file-name (caddr font-name-filename))
 	   (bare-file-name (ly:find-file file-name)))
-
-      (cons
-       name
-       
-       (if (mac-font? bare-file-name)
-	   (handle-mac-font name bare-file-name)
-	   (cond
-	    ((internal-font? file-name)
-	     (ps-load-file (ly:find-file
-			    (format "~a.otf"  file-name))))
-	    ((string? bare-file-name)
-	     (ps-load-file file-name))
-	    (else
-	     (ly:warning (_ "cannot embed ~S=~S") name file-name)
-	     "")))
-
-	  )))
+      (cons name
+	    (if (mac-font? bare-file-name)
+		(handle-mac-font name bare-file-name)
+		(cond
+		 ((internal-font? file-name)
+		  (ps-load-file (ly:find-file
+				 (format "~a.otf"  file-name))))
+		 ((string? bare-file-name)
+		  (ps-load-file file-name))
+		 (else
+		  (ly:warning (_ "cannot 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)))))
+	(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))
 
+  (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)
-	 (let*
-	     ((full-name  (dir-join dir-name f)))
-	   
+	 (let* ((full-name (dir-join dir-name f)))
 	   (if (and (not embed)
 		    (equal? 'regular (stat:type (stat full-name)))
 		    (equal? name (ly:ttf-ps-name full-name)))
-	       
-	       (set! embed
-		     (font-file-as-ps-string name full-name)))
-	   
-	   (if (or (equal? "." f) 
+	       (set! embed (font-file-as-ps-string name full-name)))
+	   (if (or (equal? "." f)
 		   (equal? ".." f))
 	       #t
 	       (delete-file full-name))))
-
-
        files)
       (rmdir dir-name)
-
       (if (not embed)
 	  (begin
 	    (set! embed "% failed\n")
-	    (ly:warning (_ "cannot extract file matching ~a from ~a") name filename)))
+	    (ly:warning (_ "cannot 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)))
-	
+  (define (font-file-as-ps-string name file-name)
+    (let* ((downcase-file-name (string-downcase file-name)))
       (cond
        ((and file-name (string-endswith downcase-file-name ".pfa"))
 	(embed-document file-name))
@@ -349,38 +321,30 @@
 	(ly:warning (_ "do not know how to embed ~S=~S") name file-name)
 	""))))
 
-    (define (mac-font? bare-file-name)
-      (and
-       (eq? PLATFORM 'darwin)
-       bare-file-name
-       (or
-	(string-endswith  bare-file-name ".dfont")
-	(= (stat:size (stat bare-file-name)) 0))))
+  (define (mac-font? bare-file-name)
+    (and (eq? PLATFORM 'darwin)
+	 bare-file-name
+	 (or (string-endswith bare-file-name ".dfont")
+	     (= (stat:size (stat bare-file-name)) 0))))
 
   (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
-       name
-       (cond
-
-	((mac-font? bare-file-name)
-	 (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 (_ "do not know how to embed font ~s ~s ~s")
-		     name file-name font))))))
+      (cons name
+	    (cond ((mac-font? bare-file-name)
+		   (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 (_ "do not know how to embed font ~s ~s ~s")
+			       name file-name font))))))
 	
-
   (define (load-fonts paper)
     (let* ((fonts (ly:paper-fonts paper))
 
@@ -388,69 +352,57 @@
 	   (all-font-names
 	    (map
 	     (lambda (font)
-	       (cond
-		((string? (ly:font-file-name font))
-		 (list (list
-			font
-			(ly:font-name font)
-			(ly:font-file-name font))))
-		((ly:pango-font? font)
-		 (map
-		  (lambda (name-psname-pair)
-		    (list #f
-			  (car name-psname-pair)
-			  (cdr name-psname-pair)))
-		  (ly:pango-font-physical-fonts font)))
-
-		(else
-		 (ly:font-sub-fonts font))))
-
+	       (cond ((string? (ly:font-file-name font))
+		      (list (list font
+				  (ly:font-name font)
+				  (ly:font-file-name font))))
+		     ((ly:pango-font? font)
+		      (map (lambda (name-psname-pair)
+			     (list #f
+				   (car name-psname-pair)
+				   (cdr name-psname-pair)))
+			   (ly:pango-font-physical-fonts font)))
+		     (else
+		      (ly:font-sub-fonts font))))
 	     fonts))
-	   (font-names
-	    (uniq-list
-	     (sort (apply append all-font-names)
-		   (lambda (x y) (string<? (cadr x) (cadr y))))))
+	   (font-names (uniq-list
+			(sort (apply append all-font-names)
+			      (lambda (x y) (string<? (cadr x) (cadr y))))))
 
 	   ;; slightly spaghetti-ish: deciding what to load where
 	   ;; is smeared out.
-	   (font-loader (lambda (name)
-			  (cond
-			   ((ly:get-option 'gs-load-fonts) 
-			    (load-font-via-GS name))
-			   ((ly:get-option 'gs-load-lily-fonts)
-			    (if (or
-				 (string-contains (caddr name) (ly:get-option 'datadir))
-				 (internal-font? (caddr name)))
-
-				(load-font-via-GS name)
-				(load-font name)))
-			   (else (load-font name)))))
-			 
+	   (font-loader
+	    (lambda (name)
+	      (cond ((ly:get-option 'gs-load-fonts)
+		     (load-font-via-GS name))
+		    ((ly:get-option 'gs-load-lily-fonts)
+		     (if (or (string-contains (caddr name)
+					      (ly:get-option 'datadir))
+			     (internal-font? (caddr name)))
+			 (load-font-via-GS name)
+			 (load-font name)))
+		    (else
+		     (load-font name)))))
 	   (pfas (map font-loader font-names)))
       pfas))
 
   (display "%%BeginProlog\n" port)
-
-  (format port
-	    "/lilypond-datadir where {pop} {userdict /lilypond-datadir (~a) put } ifelse"
-	    (ly:get-option 'datadir))
-  
+  (format
+   port
+   "/lilypond-datadir where {pop} {userdict /lilypond-datadir (~a) put } ifelse"
+   (ly:get-option 'datadir))
   (if load-fonts?
-      (for-each
-       (lambda (f)
-	 (format port "\n%%BeginFont: ~a\n" (car f))
-	 (display (cdr f) port)
-	 (display "\n%%EndFont\n" port))
-       (load-fonts paper)))
-
+      (for-each (lambda (f)
+		  (format port "\n%%BeginFont: ~a\n" (car f))
+		  (display (cdr f) port)
+		  (display "\n%%EndFont\n" port))
+		(load-fonts paper)))
   (display (setup-variables paper) port)
 
   ;; adobe note 5002: should initialize variables before loading routines.
   (display (procset "music-drawing-routines.ps") port)
   (display (procset "lilyponddefs.ps") port)
-
   (display "%%EndProlog\n" port)
-  
   (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port))
 
 (define-public (output-framework basename book scopes fields)
@@ -464,7 +416,7 @@
 	 (paper (ly:paper-book-paper book))
 	 (systems (ly:paper-book-systems book))
 	 (page-stencils (map page-stencil (ly:paper-book-pages book)))
-	 
+	
 	 (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
 	 (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
 	 (page-count (length page-stencils))
@@ -476,13 +428,13 @@
 
     (if (ly:get-option 'dump-signatures)
 	(write-system-signatures basename (ly:paper-book-systems book) 1))
-  
+
     (output-scopes scopes fields basename)
     (display (file-header paper page-count #t) port)
-    
-    ;; don't do BeginDefaults PageMedia: A4 
+
+    ;; don't do BeginDefaults PageMedia: A4
     ;; not necessary and wrong
-    
+
     (write-preamble paper #t port)
 
     (for-each
@@ -498,7 +450,7 @@
 
 (define-public (dump-stencil-as-EPS paper dump-me filename
 				    load-fonts)
-  
+
   (let*
       ((xext (ly:stencil-extent dump-me X))
        (yext (ly:stencil-extent dump-me Y))
@@ -519,7 +471,7 @@
 	   ;; bar numbers  stick out of margin uniformly.
 	   ;;
 	   (list
-	    
+	
 	    (if (number? left-overshoot)
 		(min left-overshoot (car xext))
 		(car xext))
@@ -527,13 +479,13 @@
 
        (dump-stencil-as-EPS-with-bbox paper dump-me filename load-fonts bbox)
        ))
-	 
-	   
+	
+	
 (define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename
 					      load-fonts
 					      bbox)
   "Create an EPS file from stencil DUMP-ME to FILENAME. BBOX has format
-   (left-x, lower-y, right x, up-y).  If LOAD-FONTS set, include fonts inline." 
+   (left-x, lower-y, right x, up-y).  If LOAD-FONTS set, include fonts inline."
 
   (define (to-rounded-bp-box box)
     "Convert box to 1/72 inch with rounding to enlarge the box."
@@ -587,10 +539,10 @@
 	     (if x-ext
 		 (cons x-ext paper-system)
 		 #f)))
-	 
+	
 	 systems))
        (count 0))
-    
+
     (for-each
      (lambda (ext-system-pair)
        (let*
@@ -626,7 +578,7 @@
     (let*
 	((layout (ly:grob-layout (paper-system-system-grob (car systems))))
 	 (regions (ly:output-def-lookup layout 'clip-regions)))
-      
+
       (for-each
        (lambda (region)
 	 (clip-systems-to-region
@@ -636,9 +588,9 @@
 		  (rhythmic-location->file-string (cdr region)))
 	  layout systems region
 	  do-pdf))
-       
+
        regions)))
-  
+
 
   ;; partition in system lists sharing their layout blocks
   (let*
@@ -646,22 +598,22 @@
        (count 0)
        (score-system-list '()))
 
-    (fold 
+    (fold
      (lambda (system last-system)
-    
-       
+
+
        (if (not (and last-system
 		     (equal? (paper-system-layout last-system)
 			     (paper-system-layout system))))
 	   (set! score-system-list (cons '() score-system-list)))
-       
+
        (if (paper-system-layout system)
 	   (set-car! score-system-list (cons system (car score-system-list))))
 
        ;; pass value.
        system)
 
-     #f 
+     #f
      systems)
 
     (for-each
@@ -738,7 +690,7 @@
 	 (landscape (ly:output-def-lookup defs 'landscape))
 	 (output-scale (ly:output-def-lookup defs 'output-scale))
 	 (convert (lambda (x) (* x output-scale (/ (ly:bp 1)))))
-	 
+	
 	 (paper-width (convert (ly:output-def-lookup defs 'paper-width)))
 	 (paper-height (convert (ly:output-def-lookup defs 'paper-height)))
 
@@ -770,8 +722,8 @@
 
 (define-public (output-classic-framework basename book scopes fields)
 
-  (ly:error (_ "\nThe PostScript backend does not support the system-by-system 
-output. For that, 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 -dbackend=eps FILE
 
-- 
2.39.5