From 8c3d2ec5a1823689049fbdaa0bd26e32caf307fb Mon Sep 17 00:00:00 2001 From: Ian Hulin 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! (module-public-interface ))' + */ + SCM expr = scm_list_3 (scm_module_use, mod, iface); + /* + Now return SCM value, this is the result of interpreting + '(eval (module-use! (module-public-interface )) "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->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 (car a) (car b)) #f) - (else - (ly:moment=? a b) - (rhythmic-location? a b) - (rhythmic-locationfile-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 (car a) (car b)) #f) + (else + (ly:moment=? a b) + (rhythmic-location? a b) + (rhythmic-locationfile-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