Le 18/01/2022 à 20:43, Simon Albrecht a écrit :
Dear list,
I have started using the experimental 2.23.5 build with Guile 2.2 [1]
and it turns out to be incompatible with the core of openLilyLib.
Here are the error messages I got—it may be that only the first is
relevant:
[...]
Take a look at the attached patch (apply with 'git am').
For me, it makes the file
edition-engraver/usage-examples/example-1.ly work. Note,
however, that ...
I would have to delve in order to find the root of the error and solve
the problem, which I don’t really have time for, unless I must…
... this applies to me as well, so I haven't tested
anything else and don't intend to delve deeper than
this for now.
Best,
Jean
From 84078085af9d83e4f5fa3bfa93f7804e99803698 Mon Sep 17 00:00:00 2001
From: Jean Abou Samra <[email protected]>
Date: Wed, 19 Jan 2022 01:37:41 +0100
Subject: [PATCH] Quick fixes for Guile 2 compatibility
Don't define when and unless in Guile 2, they're already defined and
the functionality of (ice-9 syncase) has been made available by
default, thus removing the module.
Use #f as explicit destination in format calls to silence warning.
Load <tree> as identifier because define-method apparently no longer
accepts it as expression.
---
internal/control.scm | 28 ++++++++++++++++------------
internal/file-handling.scm | 3 +--
internal/logging.scm | 10 +++++-----
internal/named-alists.scm | 3 +--
internal/options.scm | 2 +-
internal/os-path.scm | 6 +++---
load/templates.ily | 2 +-
load/tools.ily | 2 +-
temp-package-declaration.ily | 6 +++---
tree.scm | 15 ++++++++-------
usage-examples/properties.ly | 4 ++--
usage-examples/stack.ly | 6 ++----
util/consist-to-contexts.ily | 3 +--
util/include-pattern.ily | 2 +-
14 files changed, 46 insertions(+), 46 deletions(-)
diff --git a/internal/control.scm b/internal/control.scm
index 8a9c0b7..c1d9c19 100644
--- a/internal/control.scm
+++ b/internal/control.scm
@@ -5,20 +5,24 @@
(define-module (oll-core internal control))
-(use-syntax (ice-9 syncase))
+(cond-expand
+ (guile-2)
+ (else
+ (use-syntax (ice-9 syncase))
-;; when and unless from R6RS
+ ;; when and unless from R6RS
-(define-syntax when
- (syntax-rules ()
- ((when test result1 result2 ...)
- (if test
- (begin result1 result2 ...)))))
+ (define-syntax when
+ (syntax-rules ()
+ ((when test result1 result2 ...)
+ (if test
+ (begin result1 result2 ...)))))
-(define-syntax unless
- (syntax-rules ()
- ((unless test result1 result2 ...)
- (if (not test)
- (begin result1 result2 ...)))))
+ (define-syntax unless
+ (syntax-rules ()
+ ((unless test result1 result2 ...)
+ (if (not test)
+ (begin result1 result2 ...)))))
+))
diff --git a/internal/file-handling.scm b/internal/file-handling.scm
index ff5c07b..ff9b75d 100644
--- a/internal/file-handling.scm
+++ b/internal/file-handling.scm
@@ -46,7 +46,7 @@
(let ((parser (ly:parser-clone)))
(ly:parser-parse-string parser "\\language \"nederlands\"")
(ly:parser-parse-string parser
- (format "\\include \"~a\"" file))
+ (format #f "\\include \"~a\"" file))
#t)
#f))
@@ -63,4 +63,3 @@
(set! lines (cons line lines))
(lp (read-line h 'concat))))))
#f)))
-
diff --git a/internal/logging.scm b/internal/logging.scm
index 3360287..7de996b 100644
--- a/internal/logging.scm
+++ b/internal/logging.scm
@@ -38,12 +38,12 @@
; Generic function to consistently format the output for the logging functions
(define (oll-format-log fmt vals)
- (apply format (format "\n\n~a\n" fmt) vals))
+ (apply format #f (format "\n\n~a\n" fmt) vals))
; Open log file
(define oll-logfile
(open-output-file
- (format "~a.oll.log" (ly:parser-output-name (*parser*)))))
+ (format #f "~a.oll.log" (ly:parser-output-name (*parser*)))))
; Generic function to consistently write to log file.
; <title> is a sectioning header in the log file
@@ -57,7 +57,7 @@
(number->string (cadr (ly:input-file-line-char-column (*location*))))
"\n~a:\n"
- (apply format fmt vals)
+ (apply format #f fmt vals)
"\n\n")
title))
@@ -70,7 +70,7 @@
(begin
;log-to-file "Error" fmt vals)
(ly:input-message (*location*)
- (format "Error:~a" (oll-format-log fmt vals)))
+ (format #f "Error:~a" (oll-format-log fmt vals)))
(ly:error ""))))
(define (oll:warn fmt . vals)
@@ -99,4 +99,4 @@
(export oll:error)
(export oll:warn)
(export oll:log)
-(export oll:debug)
\ No newline at end of file
+(export oll:debug)
diff --git a/internal/named-alists.scm b/internal/named-alists.scm
index e494e72..147eafb 100644
--- a/internal/named-alists.scm
+++ b/internal/named-alists.scm
@@ -78,7 +78,7 @@ using key '~a' and ~a. This will create a new alist instead,
which is probably not intended."
alst-name funcname key-name
(if val
- (format "value '~a'" val)
+ (format #f "value '~a'" val)
"no value"))))
;; Wrapper function around set-in-alist
@@ -197,4 +197,3 @@ Please use the equivalent context-mod->props instead.")
(map (lambda (o)
(cons (cadr o) (caddr o)))
(ly:get-context-mods ctx-mods))))
-
diff --git a/internal/options.scm b/internal/options.scm
index d61ea03..09b6b23 100644
--- a/internal/options.scm
+++ b/internal/options.scm
@@ -91,7 +91,7 @@
(begin
(setAtree 'oll-options path val)
(oll:log "Option set: ~a"
- (format "~a: ~a"
+ (format #f "~a: ~a"
(os-path-join-dots path) val))
)
;; reject setting unknown options and report that
diff --git a/internal/os-path.scm b/internal/os-path.scm
index 11597c0..b024f97 100644
--- a/internal/os-path.scm
+++ b/internal/os-path.scm
@@ -51,7 +51,7 @@
(define os-path-separator-char
(if (eq? PLATFORM 'windows) #\\ #\/ ))
-(define os-path-separator-string (format "~a" os-path-separator-char))
+(define os-path-separator-string (format #f "~a" os-path-separator-char))
;%%%%%%%%%%%%%%%%
; Path operations
@@ -133,7 +133,7 @@
(define-public (os-path-absolute path)
"Return absolute and normalized path of given 'path'.
If 'path' is already an absolute path it is simply normalized,
- if it is a relative path it is interpreted as relative
+ if it is a relative path it is interpreted as relative
to the current working directory."
(let* ((path-list (os-path-normalize path)))
(if (os-path-absolute? path-list)
@@ -271,7 +271,7 @@
; Returns a string wtih the absolute path to the input file, without file extension
(define (os-path-input-basename)
- (format "~a/~a"
+ (format #f "~a/~a"
(os-path-input-dirname)
(ly:parser-output-name (*parser*))))
diff --git a/load/templates.ily b/load/templates.ily
index 41bb688..1e23fdb 100644
--- a/load/templates.ily
+++ b/load/templates.ily
@@ -62,7 +62,7 @@ loadTemplate =
(let*
(;TODO: replace dots with slashes (to load tools from subdirectories)
(template-path #f)
- (template-file (format "~a/~a.ily" directory template-name))
+ (template-file (format #f "~a/~a.ily" directory template-name))
(exists (file-exists? template-file))
(loaded (immediate-include template-file)))
(if (not loaded)
diff --git a/load/tools.ily b/load/tools.ily
index 2c326a3..c7fb52c 100644
--- a/load/tools.ily
+++ b/load/tools.ily
@@ -62,7 +62,7 @@ loadTool =
(let*
(;TODO: replace dots with slashes (to load tools from subdirectories)
(tool-path #f)
- (tool-file (format "~a/~a.ily" directory tool-name))
+ (tool-file (format #f "~a/~a.ily" directory tool-name))
(exists (file-exists? tool-file))
(loaded (immediate-include tool-file)))
(if (not loaded)
diff --git a/temp-package-declaration.ily b/temp-package-declaration.ily
index 5c83d43..b781411 100644
--- a/temp-package-declaration.ily
+++ b/temp-package-declaration.ily
@@ -86,7 +86,7 @@ declareLibrary =
(lambda (o)
(let ((mand-opt (car o)))
(if (not (assoc-ref options mand-opt))
- (oll:error (format "
+ (oll:error (format #f "
Missing option in library declaration!
Library: \"~a\"
Option: \"~a\"" display-name mand-opt) ""))
@@ -103,14 +103,14 @@ declareLibrary =
;; check for type if there is a predicate (-> true for mandatory options)
(if (and predicate?
(not (predicate? opt-val)))
- (oll:error (format "
+ (oll:error (format #f "
Type check failed for mandatory option in library declaration!
Library: \"~a\"
Option: \"~a\"
Predicate: ~a" display-name opt-name predicate?) ""))
(if (and known-opt-pred?
(not (known-opt-pred? opt-val)))
- (oll:error (format "
+ (oll:error (format #f "
Type check failed for known option in library declaration!
Library: \"~a\"
Option: \"~a\"
diff --git a/tree.scm b/tree.scm
index 8f98e70..5b23d0d 100644
--- a/tree.scm
+++ b/tree.scm
@@ -73,7 +73,7 @@
(has-value! tree #t))
(begin
(ly:input-warning (*location*)
- (format "TODO: Format warning about typecheck error in tree-set!
+ (format #f "TODO: Format warning about typecheck error in tree-set!
Expected ~a, got ~a" (procedure-name pred?) val))
(set! val #f)))
;; if no typecheck is set simply set the value
@@ -95,7 +95,7 @@ Expected ~a, got ~a" (procedure-name pred?) val))
;; recursively walk path
(tree-set! create child cpath val)
(ly:input-warning (*location*)
- (format "TODO: Format missing path warning in tree-set!
+ (format #f "TODO: Format missing path warning in tree-set!
Path: ~a" path)))))
val)
@@ -275,9 +275,10 @@ Path: ~a" path)))))
(tree-collect tree path (stack-create) (lambda (v) #t)))
(define-method (tree-collect (tree <tree>) (path <list>) (pred? <procedure>))
(tree-collect tree path (stack-create) pred?))
-(define-method (tree-collect (tree <tree>) (path <list>) (vals (@@ (oll-core stack) <stack>))) ; there is also a <stack> class in (oop goops)
+(define <stack> (@@ (oll-core stack) <stack>))
+(define-method (tree-collect (tree <tree>) (path <list>) (vals <stack>)) ; there is also a <stack> class in (oop goops)
(tree-collect tree path vals (lambda (v) #t)))
-(define-method (tree-collect (tree <tree>) (path <list>) (vals (@@ (oll-core stack) <stack>)) (pred? <procedure>))
+(define-method (tree-collect (tree <tree>) (path <list>) (vals <stack>) (pred? <procedure>))
(let ((val (value tree)))
(if (> (length path) 0)
(let* ((ckey (car path))
@@ -297,7 +298,7 @@ Path: ~a" path)))))
(cond
((and (number? v1) (number? v2)) (< v1 v2))
((and (ly:moment? v1) (ly:moment? v2)) (ly:moment<? v1 v2))
- (else (string-ci<? (format "~A" v1) (format "~A" v2)))
+ (else (string-ci<? (format #f "~A" v1) (format #f "~A" v2)))
)))
; walk the tree and call callback for every node
@@ -330,8 +331,8 @@ Path: ~a" path)))))
(sortby (assoc-get 'sortby opt stdsort)) ; sort-function
(empty (ly:assoc-get 'empty opt #f #f)) ; display empty nodes
(dval (ly:assoc-get 'value opt #t #f)) ; display value
- (vformat (ly:assoc-get 'vformat opt (lambda (v)(format "~A" v)) #f)) ; format value
- (pformat (ly:assoc-get 'pformat opt (lambda (v)(format "~A" v)) #f)) ; format path
+ (vformat (ly:assoc-get 'vformat opt (lambda (v)(format #f "~A" v)) #f)) ; format value
+ (pformat (ly:assoc-get 'pformat opt (lambda (v)(format #f "~A" v)) #f)) ; format path
(pathsep (ly:assoc-get 'pathsep opt "/" #f)) ; separator for path
(port (ly:assoc-get 'port opt (current-output-port)))) ; output-port
(tree-walk-branch tree path
diff --git a/usage-examples/properties.ly b/usage-examples/properties.ly
index 008f45a..be413fa 100644
--- a/usage-examples/properties.ly
+++ b/usage-examples/properties.ly
@@ -54,8 +54,8 @@ testFunc =
(text (property 'text))
(content
(if do-use
- (format "~a. ~a" (property 'index) text)
- (format "~a" text))))
+ (format #f "~a. ~a" (property 'index) text)
+ (format #f "~a" text))))
(if do-use
(markup #:with-color (property 'color) content)
(markup content)
diff --git a/usage-examples/stack.ly b/usage-examples/stack.ly
index 7a274c7..994f379 100644
--- a/usage-examples/stack.ly
+++ b/usage-examples/stack.ly
@@ -54,12 +54,12 @@ mystack = #(stack-create)
% read the topmost entry from the stack
#(define top-one (get mystack))
-#(display (format "'get' topmost item, remains on stack: ~a\n" top-one))
+#(display (format #f "'get' topmost item, remains on stack: ~a\n" top-one))
#(display mystack)#(newline)
% Fetch topmost entry from stack
#(define top-two (pop mystack))
-#(display (format "Topmost item, now popped from stack: ~a\n" top-two))
+#(display (format #f "Topmost item, now popped from stack: ~a\n" top-two))
#(display mystack)#(newline)
% Push arbitrary items on top of stack
@@ -67,5 +67,3 @@ mystack = #(stack-create)
#(display "Arbitrary item pushed on top of stack.\n")
#(display mystack)
-
-
diff --git a/util/consist-to-contexts.ily b/util/consist-to-contexts.ily
index b991dea..e35f53c 100644
--- a/util/consist-to-contexts.ily
+++ b/util/consist-to-contexts.ily
@@ -46,7 +46,6 @@ consistToContexts =
}
#}
; TODO: Make the input location point to the location of the *caller*
- (oll:warn (format "Trying to install engraver to non-existent context ~a" ctx))))
+ (oll:warn (format #f "Trying to install engraver to non-existent context ~a" ctx))))
contexts)
} #})
-
diff --git a/util/include-pattern.ily b/util/include-pattern.ily
index 7935e69..ae621bd 100644
--- a/util/include-pattern.ily
+++ b/util/include-pattern.ily
@@ -78,7 +78,7 @@ includePattern =
;; in files opened previously in the same execution of \includePattern
(for-each
(lambda (file)
- (let ((include-string (format "\\include \"~A\"\n" file)))
+ (let ((include-string (format #f "\\include \"~A\"\n" file)))
(ly:parser-include-string include-string)))
includefiles)
--
2.32.0
