From 8c3d2ec5a1823689049fbdaa0bd26e32caf307fb Mon Sep 17 00:00:00 2001
From: Ian Hulin <ian@hulin.org.uk>
Date: Tue, 7 Sep 2010 01:10:07 +0100
Subject: [PATCH] T1224: Avoid using deprecated %module-public-interface in
 initialization

---
 lily/ly-module.cc   | 49 ++++++++++++++++++++--------
 scm/clip-region.scm | 66 +++++++++++---------------------------
 scm/lily.scm        | 78 ++++++++++++++++++++++++++++++---------------
 scm/output-lib.scm  | 49 ++++++++++++++++++++++++++++
 4 files changed, 155 insertions(+), 87 deletions(-)

diff --git a/lily/ly-module.cc b/lily/ly-module.cc
index 42ff2f8b06..33e187055b 100644
--- a/lily/ly-module.cc
+++ b/lily/ly-module.cc
@@ -24,49 +24,70 @@
 #include "protected-scm.hh"
 
 
+
 SCM
 ly_make_module (bool safe)
 {
   SCM mod = SCM_EOL;
   if (!safe)
     {
-      SCM maker = ly_lily_module_constant ("make-module");
-
-      SCM scm_module = ly_lily_module_constant ("the-scm-module");
+      /* Look up (evaluate) Scheme make-module function and call it */
 
+      SCM maker = ly_lily_module_constant ("make-module");
       mod = scm_call_0 (maker);
-      scm_module_define (mod, ly_symbol2scm ("%module-public-interface"),
-			 mod);
-
+      /*
+	Look up and call Guile module-export-all! or, when using
+	Guile V1.8, the compatible shim defined in lily.scm.
+      */
+      SCM module_export_all_x = ly_lily_module_constant ("module-export-all!");
+      scm_call_1 (module_export_all_x, mod);
+
+      /*
+	Evaluate Guile module "the-root-module",
+	and ensure we inherit definitions from it and the "lily" module
+	N.B. this used to be "the-scm-module" and is deprecated in
+	Guile V1.9/2.0
+      */
+      SCM scm_module = ly_lily_module_constant ("the-root-module");
       ly_use_module (mod, scm_module);
       ly_use_module (mod, global_lily_module);
     }
   else
     {
+      /* Evaluate and call make-safe-lilypond-module */
       SCM proc = ly_lily_module_constant ("make-safe-lilypond-module");
       mod = scm_call_0 (proc);
     }
 
-
   return mod;
 }
 
 SCM
 ly_use_module (SCM mod, SCM used)
 {
-  SCM expr
-    = scm_list_3 (ly_symbol2scm ("module-use!"),
-		  mod,
-		  scm_list_2 (ly_symbol2scm ("module-public-interface"),
-			      used));
-
+  /*
+    Pick up the module's interface definition.
+    TODO - Replace inline evaluations (interpreted)
+    with guile API calls if these become available.
+  */
+  SCM scm_module_use = ly_symbol2scm ("module-use!");
+  SCM scm_module_public_interface = ly_symbol2scm ("module-public-interface");
+  SCM iface = scm_list_2 (scm_module_public_interface, used);
+  /*
+    Set up to interpret
+    '(module_use! <mod> (module-public-interface <used>))'
+  */
+  SCM expr = scm_list_3 (scm_module_use, mod, iface);
+  /*
+    Now return SCM value, this is the result of interpreting
+    '(eval (module-use! <mod> (module-public-interface <used>)) "lily")'
+  */
   return scm_eval (expr, global_lily_module);
 }
 
 #define FUNC_NAME __FUNCTION__
 
 
-
 SCM
 ly_module_symbols (SCM mod)
 {
diff --git a/scm/clip-region.scm b/scm/clip-region.scm
index 14f593adc6..1c0a6409ba 100644
--- a/scm/clip-region.scm
+++ b/scm/clip-region.scm
@@ -19,55 +19,25 @@
 
 (use-modules (lily))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; The procedures shown in this list have been moved to
+;; scm/output-lib.scm
+;;
+;;
+;; 	(define-public (make-rhythmic-location bar-num num den)
+;: 	(define-public (rhythmic-location? a)
+;; 	(define-public (make-graceless-rhythmic-location loc)
+;; 	(define-public rhythmic-location-measure-position cdr)
+;; 	(define-public rhythmic-location-bar-number car)
+;; 	(define-public (rhythmic-location<? a b)
+;:	(define-public (rhythmic-location<=? a b)
+;:	(define-public (rhythmic-location>=? a b)
+;;	(define-public (rhythmic-location>? a b)
+;:	(define-public (rhythmic-location=? a b)
+;;	(define-public (rhythmic-location->file-string a)
+;;	(define-public (rhythmic-location->string a)
 
-(define-public (make-rhythmic-location bar-num num den)
-  (cons
-   bar-num (ly:make-moment num den)))
-
-(define-public (rhythmic-location? a)
-  (and (pair? a)
-       (integer? (car a))
-       (ly:moment? (cdr a))))
-
-(define-public (make-graceless-rhythmic-location loc)
-  (make-rhythmic-location
-   (car loc)
-   (ly:moment-main-numerator (rhythmic-location-measure-position loc))
-   (ly:moment-main-denominator (rhythmic-location-measure-position loc))))
-		   
-					     
-(define-public rhythmic-location-measure-position cdr)
-(define-public rhythmic-location-bar-number car)
-
-(define-public (rhythmic-location<? a b)
-  (cond
-   ((< (car a) (car b)) #t)
-   ((> (car a) (car b)) #f)
-   (else
-    (ly:moment<? (cdr a) (cdr b)))))
-
-(define-public (rhythmic-location<=? a b)
-  (not (rhythmic-location<? b a)))
-(define-public (rhythmic-location>=? a b)
-  (rhythmic-location<? a b))
-(define-public (rhythmic-location>? a b)
-  (rhythmic-location<? b a))
-
-(define-public (rhythmic-location=? a b)
-  (and (rhythmic-location<=? a b)
-       (rhythmic-location<=? b a)))
-
-
-(define-public (rhythmic-location->file-string a)
-  (ly:format "~a.~a.~a"
-	  (car a)
-	  (ly:moment-main-numerator (cdr a))
-	  (ly:moment-main-denominator (cdr a))))
-
-(define-public (rhythmic-location->string a)
-  (ly:format "bar ~a ~a"
-	  (car a)
-	  (ly:moment->string  (cdr a))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;  Actual clipping logic.
diff --git a/scm/lily.scm b/scm/lily.scm
index 4a00ab66e4..68813a49d8 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -194,20 +194,35 @@ messages into errors.")
 (if (defined? 'set-debug-cell-accesses!)
     (set-debug-cell-accesses! #f))
 
-					;(set-debug-cell-accesses! 1000)
+;;(set-debug-cell-accesses! 1000)
+
+;;; Boolean thunk - are we integrating Guile V2.0 or higher with LilyPond?
+(define-public (guile-v2)
+  (string>? (version) "1.9.10"))
 
 (use-modules (ice-9 regex)
-              (ice-9 safe)
-              (ice-9 format)
-              (ice-9 rdelim)
-              (ice-9 optargs)
-              (oop goops)
-              (srfi srfi-1)
-              (srfi srfi-13)
-              (srfi srfi-14)
-              (scm clip-region)
-              (scm memory-trace)
-              (scm coverage))
+	     (ice-9 safe)
+	     (ice-9 format)
+	     (ice-9 rdelim)
+	     (ice-9 optargs)
+	     (oop goops)
+	     (srfi srfi-1)
+	     (srfi srfi-13)
+	     (srfi srfi-14)
+	     (scm clip-region)
+	     (scm memory-trace)
+	     (scm coverage))
+
+(define-public _ gettext)
+;;; TODO:
+;;  There are new modules defined in Guile V2.0 which we need to use, e.g.
+;;  the modules and scheme files loaded by lily.scm use currying.
+;;  In Guile V2 this needs (ice-9 curried-definitions) which is not
+;;  present in Guile V1.8
+;;
+;; TODO add in modules for V1.8,7 deprecated in V2.0 and integrated
+;; into Guile base code, like (ice-9 syncase).
+;;
 
 (define-public fancy-format
   format)
@@ -258,7 +273,6 @@ 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)
 
 (define-public (ly:load x)
   (let* ((file-name (%search-load-path x)))
@@ -299,7 +313,22 @@ messages into errors.")
 		 (eq? (string-ref file-name 2) #\/))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; If necessary, emulate Guile V2 module_export_all! for Guile V1.8.n
+(cond-expand
+ ((not guile-v2)
+  (define (module-export-all! mod)
+    (define (fresh-interface!)
+      (let ((iface (make-module)))
+	(set-module-name! iface (module-name mod))
+	;; for guile 2: (set-module-version! iface (module-version mod))
+	(set-module-kind! iface 'interface)
+	(set-module-public-interface! mod iface)
+	iface))
+    (let ((iface (or (module-public-interface mod)
+		     (fresh-interface!))))
+      (set-module-obarray! iface (module-obarray mod))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (type-check-list location signature arguments)
   "Typecheck a list of arguments against a list of type predicates.
 Print a message at LOCATION if any predicate failed."
@@ -667,16 +696,15 @@ 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* (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)
@@ -761,7 +789,7 @@ PIDs or the number of the process."
 			       (string-contains f "lilypond")))))
     (if (pair? failed)
 	(begin (ly:error (_ "failed files: ~S") (string-join failed))
-               (ly:exit 1 #f))
+	       (ly:exit 1 #f))
 	(begin
 	  (ly:exit 0 #f)))))
 
@@ -808,7 +836,7 @@ PIDs or the number of the process."
              (ly:reset-all-fonts))))
      files)
 
-    ;; we want the failed-files notice in the aggregrate logfile.
+    ;; Ensure a notice re failed files is written to aggregate logfile.
     (if ping-log
 	(format ping-log "Failed files: ~a\n" failed))
     (if (ly:get-option 'dump-profile)
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 409e8c1f88..716f36a735 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -173,6 +173,55 @@ and duration-log @var{log}."
 	   letter)))
      radius X)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; clipping
+
+(define-public (make-rhythmic-location bar-num num den)
+  (cons
+   bar-num (ly:make-moment num den)))
+
+(define-public (rhythmic-location? a)
+  (and (pair? a)
+       (integer? (car a))
+       (ly:moment? (cdr a))))
+
+(define-public (make-graceless-rhythmic-location loc)
+  (make-rhythmic-location
+   (car loc)
+   (ly:moment-main-numerator (rhythmic-location-measure-position loc))
+   (ly:moment-main-denominator (rhythmic-location-measure-position loc))))
+
+(define-public rhythmic-location-measure-position cdr)
+(define-public rhythmic-location-bar-number car)
+
+(define-public (rhythmic-location<? a b)
+  (cond
+   ((< (car a) (car b)) #t)
+   ((> (car a) (car b)) #f)
+   (else
+    (ly:moment<? (cdr a) (cdr b)))))
+
+(define-public (rhythmic-location<=? a b)
+  (not (rhythmic-location<? b a)))
+(define-public (rhythmic-location>=? a b)
+  (rhythmic-location<? a b))
+(define-public (rhythmic-location>? a b)
+  (rhythmic-location<? b a))
+
+(define-public (rhythmic-location=? a b)
+  (and (rhythmic-location<=? a b)
+       (rhythmic-location<=? b a)))
+
+(define-public (rhythmic-location->file-string a)
+  (ly:format "~a.~a.~a"
+	     (car a)
+	     (ly:moment-main-numerator (cdr a))
+	     (ly:moment-main-denominator (cdr a))))
+
+(define-public (rhythmic-location->string a)
+  (ly:format "bar ~a ~a"
+	     (car a)
+	     (ly:moment->string (cdr a))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; break visibility
-- 
2.39.5