#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)
{
(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.
(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)
(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)))
(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."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(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)
(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)))))
(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)
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
projects / lilypond.git / commitdiff