[PATCH] Lilypond issues success/failure termination message

[Ian Hulin <ian@xxxxxxxxxxxx>]

---
 flower/include/warn.hh |    1 +
 flower/warn.cc         |    7 +++++
 lily/general-scheme.cc |   14 +++++++++-
 scm/lily.scm           |   68 ++++++++++++++++++++++++++++++++++++-----------
 4 files changed, 73 insertions(+), 17 deletions(-)

diff --git a/flower/include/warn.hh b/flower/include/warn.hh
index 170fbca..10c800c 100644
--- a/flower/include/warn.hh
+++ b/flower/include/warn.hh
@@ -28,5 +28,6 @@ void non_fatal_error (string);
 void programming_error (string s);
 void progress_indication (string s);
 void warning (string s);
+void successful (string s);
 
 #endif /* WARN_HH */
diff --git a/flower/warn.cc b/flower/warn.cc
index 0bf8983..37751f7 100644
--- a/flower/warn.cc
+++ b/flower/warn.cc
@@ -52,6 +52,13 @@ message (string s)
   progress_indication (s);
 }
 
+/* Display a success message.  Always starts on a new line.  */
+void
+successful (string s)
+{
+  message (_f ("success: %s", s.c_str ()) + "\n");
+}
+
 /* Display a warning message.  Always starts on a new line.  */
 void
 warning (string s)
diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc
index cd7e25d..6b73e48 100644
--- a/lily/general-scheme.cc
+++ b/lily/general-scheme.cc
@@ -144,6 +144,17 @@ LY_DEFINE (ly_programming_error, "ly:programming-error",
   return SCM_UNSPECIFIED;
 }
 
+LY_DEFINE (ly_success, "ly:success",
+	   1, 0, 1, (SCM str, SCM rest),
+	   "A Scheme callable function to issue a success message @code{str}."
+	   "  The message is formatted with @code{format} and @code{rest}.")
+{
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
+  str = scm_simple_format (SCM_BOOL_F, str, rest);
+  successful (ly_scm2string (str));
+  return SCM_UNSPECIFIED;
+	
+} 
 LY_DEFINE (ly_warning, "ly:warning",
 	   1, 0, 1, (SCM str, SCM rest),
 	   "A Scheme callable function to issue the warning @code{str}."
@@ -440,12 +451,13 @@ LY_DEFINE (ly_stderr_redirect, "ly:stderr-redirect",
   LY_ASSERT_TYPE (scm_is_string, file_name, 1);
 
   string m = "w";
+  FILE *stderrfile;
   if (mode != SCM_UNDEFINED && scm_string_p (mode))
     m = ly_scm2string (mode);
   /* dup2 and (fileno (current-error-port)) do not work with mingw'c
      gcc -mwindows.  */
   fflush (stderr);
-  freopen (ly_scm2string (file_name).c_str (), m.c_str (), stderr);
+  stderrfile = freopen (ly_scm2string (file_name).c_str (), m.c_str (), stderr);
   return SCM_UNSPECIFIED;
 }
 
diff --git a/scm/lily.scm b/scm/lily.scm
index c680b0f..6e2e05c 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -49,8 +49,8 @@
 "Render at higher resolution (using given factor)
 and scale down result to prevent jaggies in
 PNG images.")
-    (aux-files #t 
-"Create .tex, .texi, .count files in the 
+    (aux-files #t
+"Create .tex, .texi, .count files in the
 EPS backend.")
     (backend ps
 "Select backend.  Possible values: 'eps, 'null,
@@ -254,7 +254,11 @@ messages into errors.")
 (if (memq (ly:get-option 'backend) music-string-to-path-backends)
     (ly:set-option 'music-strings-to-paths #t))
 
-(define-public _ gettext)
+;; gettext wrapper for guile < 1.7.2
+(if (defined? 'gettext)
+    (module-define! (current-module) '_ gettext)
+    (module-define! (current-module) '_ ly:gettext))
+;(define-public ( _ x) (gettext x))
 
 (define-public (ly:load x)
   (let* ((file-name (%search-load-path x)))
@@ -272,6 +276,24 @@ messages into errors.")
     (if (null? (cdr platform)) #f
 	(member (string-downcase (cadr platform)) '("95" "98" "me")))))
 
+;; Guile 1.9 and later doesn't like dynamically defining functions this works
+;;  for both versions
+;
+;   (define (slashify x)
+;     (if (string-index x #\\)
+;	 x
+;	 (string-regexp-substitute
+;	  "//*" "/"
+;	  (string-regexp-substitute "\\\\" "/" x))))
+;  (define-public ly-getcwd)
+;
+;  (if (eq? PLATFORM 'windows)
+;      (begin
+;        (module-define! (current-module) 'native-getcwd getcwd)
+;        (set! ly-getcwd (slashify (native-getwcwd))))
+;      (set! ly-getcwd getcwd))
+
+
 (case PLATFORM
   ((windows)
    (define native-getcwd
@@ -599,20 +621,32 @@ PIDs or the number of the process."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define* (ly:exit status #:optional (silently #f) )
+    "Exit function for lilypond"
+    (if (not silently)
+    	(case status
+    	    ((0) (ly:success "Compilation successfully completed"))
+    	    ((1) (ly:warning "Compilation completed with warnings or errors"))
+	    (else (ly:message "")))
+    	)
+    (exit status)
+    )
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define-public (lilypond-main files)
   "Entry point for LilyPond."
   (eval-string (ly:command-line-code))
   (if (ly:get-option 'help)
       (begin (ly:option-usage)
-	     (exit 0)))
+      	     (ly:exit 0 #t )))
   (if (ly:get-option 'show-available-fonts)
       (begin (ly:font-config-display-fonts)
-	     (exit 0)))
+      	     (ly:exit 0 #t)))
   (if (ly:get-option 'gui)
       (gui-main files))
   (if (null? files)
       (begin (ly:usage)
-	     (exit 2)))
+      	     (ly:exit 2 #t)))
   (if (ly:get-option 'read-file-list)
       (set! files
 	    (filter (lambda (s)
@@ -668,9 +702,10 @@ PIDs or the number of the process."
 		   (if (ly:get-option 'dump-profile)
 		       (dump-profile "lily-run-total"
 				     '(0 0) (profile-measurements)))
-		   (exit (if (null? errors)
-			     0
-			     1))))))
+		   (if (null? errors)
+		       (ly:exit 0 #f)
+		       (ly:exit 1 #f))))))
+
   (if (string-or-symbol? (ly:get-option 'log-file))
       (ly:stderr-redirect (format "~a.log" (ly:get-option 'log-file)) "w"))
   (let ((failed (lilypond-all files)))
@@ -680,11 +715,10 @@ PIDs or the number of the process."
 			       (string-contains f "lilypond")))))
     (if (pair? failed)
 	(begin (ly:error (_ "failed files: ~S") (string-join failed))
-	       (exit 1))
+               (ly:exit 1 #f))
 	(begin
-	  ;; HACK: be sure to exit with single newline
-	  (ly:message "")
-	  (exit 0)))))
+	  (ly:exit 0 #f)))))
+
 
 (define-public (lilypond-all files)
   (let* ((failed '())
@@ -726,7 +760,8 @@ PIDs or the number of the process."
 	 (ly:set-option 'debug-gc-assert-parsed-dead #f)
 	 (if (ly:get-option 'debug-gc)
 	     (dump-gc-protects)
-	     (ly:reset-all-fonts))))
+	     (if (= (random 40) 1)
+		 (ly:reset-all-fonts)))))
      files)
 
     ;; we want the failed-files notice in the aggregrate logfile.
@@ -762,7 +797,7 @@ PIDs or the number of the process."
 	      (ly:error (_ "failed files: ~S") (string-join failed))
 	      ;; not reached?
 	      (exit 1))
-	    (exit 0)))))
+	    (ly:exit 0 #f)))))
 
 (define (gui-no-files-handler)
   (let* ((ly (string-append (ly:effective-prefix) "/ly/"))
@@ -771,4 +806,5 @@ PIDs or the number of the process."
 	 (cmd (get-editor-command welcome-ly 0 0 0)))
     (ly:message (_ "Invoking `~a'...\n") cmd)
     (system cmd)
-    (exit 1)))
+    (ly:exit 1 #f)))
+
-- 
1.6.3.3


--------------070506070900060507050606--

---
----
Join the Frogs!