(make-ps-images): backport: make PS images

without globbing.

diff --git a/ChangeLog b/ChangeLog
index bb8cc56b532b2dbb510f96e5b28c7ab76b74b273..7b7448eca4e0467dd51b9b3c916ef89dcb0b8988 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-10-09  Han-Wen Nienhuys  <hanwen@xs4all.nl>
+
+       * scm/ps-to-png.scm (make-ps-images): backport: make PS images
+       without globbing. 
+
 2005-10-09  Jan Nieuwenhuizen  <janneke@gnu.org>
 
        * flower/file-name.cc (dos_to_posix)[__CYGWIN__]: Return

diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc
index fe3327880266f684bc0ac190f51a90890808a9d0..3796707c51c501475087d289126645c153171335 100644 (file)
--- a/lily/general-scheme.cc
+++ b/lily/general-scheme.cc
@@ -56,7 +56,8 @@ LY_DEFINE (ly_gulp_file, "ly:gulp-file",
           "Read the file @var{name}, and return its contents in a string.  "
           "The file is looked up using the search path.")
 {
-  SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
+  SCM_ASSERT_TYPE (scm_is_string (name), name,
+                  SCM_ARG1, __FUNCTION__, "string");
   String contents = gulp_file_to_string (ly_scm2string (name), true);
   return scm_from_locale_stringn (contents.get_str0 (), contents.length ());
 }

diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly
index b1f468d10e4e289703d060a613e12e332b6928aa..ae0cf7fc0a89e625750db0f886fb885de287866a 100644 (file)
--- a/ly/engraver-init.ly
+++ b/ly/engraver-init.ly
@@ -606,6 +606,7 @@ AncientRemoveEmptyStaffContext = \context {
 \context {
   \Voice
   \name "TabVoice"
+  \alias "Voice"
   \consists "Tab_note_heads_engraver"
   \remove "Note_heads_engraver"
   \remove "Fingering_engraver"

diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index dfcb9551b08bb942e2b170ee03f6edf705cd2dd9..8f35539e67cf7561cabcb753f9ef7fb5fec55d62 100644 (file)
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -111,6 +111,15 @@
   (delete-file old)
   ))
 
+(define-public (ps-page-count ps-name)
+  (let*
+      ((header (gulp-port (open-file ps-name "r") 10240))
+       (match (string-match "%%Pages: ([0-9]+)" header))
+       (count (if match
+                 (string->number (match:substring match 1))
+                 0)))
+    count))
+
 (define-public (make-ps-images ps-name . rest)
   (let-optional
    rest ((resolution 90)
@@ -121,19 +130,22 @@
         )
    
    (let* ((base (basename (re-sub "[.]e?ps" "" ps-name)))
-         (header (gulp-port (open-file ps-name "r") 10240))
+         (header (gulp-port (open-file ps-name "r")  10240))
          (png1 (string-append base ".png"))
          (pngn (string-append base "-page%d.png"))
-         (pngn-re (re-sub "%d" "[0-9]*" pngn))
-         (multi-page? (and (string-match "\n%%Pages: " header)
-                           (not (string-match "\n%%Pages: 1\n" header))))
+         (page-count (ps-page-count ps-name))
+         
+         (multi-page? (> page-count 1))
          (output-file (if multi-page? pngn png1))
 
-         ;;png16m is because Lily produces color nowadays.
+         ;; png16m is because Lily produces color nowadays.
+         ;; can't use pngalpha device, since IE is broken.
+         ;;
          (gs-variable-options
            (if multi-page?
                (format #f "-sPAPERSIZE=~a" paper-size)
                "-dEPSCrop"))
+
          (cmd (format #f "~a\
  ~a\
  ~a\
@@ -152,10 +164,7 @@
                           (* aa-factor resolution) ps-name))
          (status 0)
          (files '()))
-     
-     (for-each delete-file (append (dir-re "." png1)
-                                  (dir-re "." pngn-re)))
-     
+
      ;; The wrapper on windows cannot handle `=' signs,
      ;; gs has a workaround with #.
      (if (eq? PLATFORM 'windows)
@@ -166,20 +175,26 @@
      (set! status (my-system verbose? #f cmd))
 
      (set! files
-          (append (dir-re "." png1) (dir-re "." pngn-re)))
-
+          (if multi-page?
+              (map
+               (lambda (n)
+                 (format "~a-page~a.png" base (1+ n)))
+               (iota page-count))
+              (list (format "~a.png" base))))
+     
      (if (not (= 0 status))
         (begin
           (map delete-file files)
           (exit 1)))
-     
+
      (if (and rename-page-1? multi-page?)
-        (rename-file (re-sub "%d" "1" pngn) png1))
-     
-     (set! files
-          (append (dir-re "." png1) (dir-re "." pngn-re)))
+        (begin
+          (rename-file (re-sub "%d" "1" pngn) png1)
+          (set! files
+                (cons png1
+                      (cdr files)))
+          ))
 
-     
      (if (not (= 1 aa-factor))
         (for-each  (lambda (f) (scale-down-image verbose? aa-factor f))
                    files))