scm/lily-library.scm

   1 ;;;;
   2 ;;;; lily-library.scm -- utilities
   3 ;;;;
   4 ;;;;  source file of the GNU LilyPond music typesetter
   5 ;;;;
   6 ;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
   8
   9 ; for take, drop, take-while, list-index, and find-tail:
  10 (use-modules (srfi srfi-1))
  11
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13 ;; constants.
  14
  15 (define-public X 0)
  16 (define-public Y 1)
  17 (define-safe-public START -1)
  18 (define-safe-public STOP 1)
  19 (define-public LEFT -1)
  20 (define-public RIGHT 1)
  21 (define-public UP 1)
  22 (define-public DOWN -1)
  23 (define-public CENTER 0)
  24
  25 (define-safe-public DOUBLE-FLAT-QTS -4)
  26 (define-safe-public THREE-Q-FLAT-QTS -3)
  27 (define-safe-public FLAT-QTS -2)
  28 (define-safe-public SEMI-FLAT-QTS -1)
  29 (define-safe-public NATURAL-QTS 0)
  30 (define-safe-public SEMI-SHARP-QTS 1)
  31 (define-safe-public SHARP-QTS 2)
  32 (define-safe-public THREE-Q-SHARP-QTS 3)
  33 (define-safe-public DOUBLE-SHARP-QTS 4)
  34 (define-safe-public SEMI-TONE-QTS 2)
  35
  36 (define-safe-public DOUBLE-FLAT  -1)
  37 (define-safe-public THREE-Q-FLAT -3/4)
  38 (define-safe-public FLAT -1/2)
  39 (define-safe-public SEMI-FLAT -1/4)
  40 (define-safe-public NATURAL 0)
  41 (define-safe-public SEMI-SHARP 1/4)
  42 (define-safe-public SHARP 1/2)
  43 (define-safe-public THREE-Q-SHARP 3/4)
  44 (define-safe-public DOUBLE-SHARP 1)
  45 (define-safe-public SEMI-TONE 1/2)
  46
  47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48 ;; moments
  49
  50 (define-public ZERO-MOMENT (ly:make-moment 0 1))
  51
  52 (define-public (moment-min a b)
  53   (if (ly:moment<? a b) a b))
  54
  55 (define-public (moment<=? a b)
  56   (or (equal? a b)
  57       (ly:moment<? a b)))
  58
  59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60 ;; arithmetic
  61 (define-public (average x . lst)
  62   (/ (+ x (apply + lst)) (1+ (length lst))))
  63
  64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65 ;; parser <-> output hooks.
  66
  67 (define-public (collect-bookpart-for-book parser book-part)
  68   "Toplevel book-part handler"
  69   (define (add-bookpart book-part)
  70     (ly:parser-define!
  71        parser 'toplevel-bookparts
  72        (cons book-part (ly:parser-lookup parser 'toplevel-bookparts))))
  73   ;; If toplevel scores have been found before this \bookpart,
  74   ;; add them first to a dedicated bookpart
  75   (if (pair? (ly:parser-lookup parser 'toplevel-scores))
  76       (begin
  77         (add-bookpart (ly:make-book-part
  78                        (ly:parser-lookup parser 'toplevel-scores)))
  79         (ly:parser-define! parser 'toplevel-scores (list))))
  80   (add-bookpart book-part))
  81
  82 (define-public (collect-scores-for-book parser score)
  83   (ly:parser-define!
  84    parser 'toplevel-scores
  85    (cons score (ly:parser-lookup parser 'toplevel-scores))))
  86
  87 (define-public (collect-music-aux score-handler parser music)
  88   (define (music-property symbol)
  89     (let ((value (ly:music-property music symbol)))
  90       (if (not (null? value))
  91           value
  92           #f)))
  93   (cond ((music-property 'page-marker)
  94          ;; a page marker: set page break/turn permissions or label
  95          (begin
  96            (let ((label (music-property 'page-label)))
  97              (if (symbol? label)
  98                  (score-handler (ly:make-page-label-marker label))))
  99            (for-each (lambda (symbol)
 100                        (let ((permission (music-property symbol)))
 101                          (if (symbol? permission)
 102                              (score-handler
 103                               (ly:make-page-permission-marker symbol
 104                                                               (if (eqv? 'forbid permission)
 105                                                                   '()
 106                                                                   permission))))))
 107                      (list 'line-break-permission 'page-break-permission
 108                            'page-turn-permission))))
 109         ((not (music-property 'void))
 110          ;; a regular music expression: make a score with this music
 111          ;; void music is discarded
 112          (score-handler (scorify-music music parser)))))
 113
 114 (define-public (collect-music-for-book parser music)
 115   "Top-level music handler"
 116   (collect-music-aux (lambda (score)
 117                        (collect-scores-for-book parser score))
 118                      parser
 119                      music))
 120
 121 (define-public (collect-book-music-for-book parser book music)
 122   "Book music handler"
 123   (collect-music-aux (lambda (score)
 124                        (ly:book-add-score! book score))
 125                      parser
 126                      music))
 127
 128 (define-public (scorify-music music parser)
 129   "Preprocess MUSIC."
 130
 131   (for-each (lambda (func)
 132               (set! music (func music parser)))
 133             toplevel-music-functions)
 134
 135   (ly:make-score music))
 136
 137
 138 (define (get-outfile-name parser base)
 139   (let* ((output-suffix (ly:parser-lookup parser 'output-suffix))
 140          (counter-alist (ly:parser-lookup parser 'counter-alist))
 141          (output-count (assoc-get output-suffix counter-alist 0))
 142          (result base))
 143     ;; Allow all ASCII alphanumerics, including accents
 144     (if (string? output-suffix)
 145         (set! result (format "~a-~a"
 146                              base (string-regexp-substitute
 147                                     "[^-[:alnum:]]" "_" output-suffix))))
 148
 149     ;; assoc-get call will always have returned a number
 150     (if (> output-count 0)
 151         (set! result (format #f "~a-~a" result output-count)))
 152
 153     (ly:parser-define!
 154       parser 'counter-alist
 155       (assoc-set! counter-alist output-suffix (1+ output-count)))
 156     result))
 157
 158 (define (print-book-with parser book process-procedure)
 159   (let* ((paper (ly:parser-lookup parser '$defaultpaper))
 160          (layout (ly:parser-lookup parser '$defaultlayout))
 161          (count (ly:parser-lookup parser 'output-count))
 162          (base (ly:parser-output-name parser))
 163          (outfile-name (get-outfile-name parser base)))
 164
 165     (process-procedure book paper layout outfile-name)))
 166
 167 (define-public (print-book-with-defaults parser book)
 168   (print-book-with parser book ly:book-process))
 169
 170 (define-public (print-book-with-defaults-as-systems parser book)
 171   (print-book-with parser book ly:book-process-to-systems))
 172
 173 ;;;;;;;;;;;;;;;;
 174 ;; alist
 175
 176 (define-public assoc-get ly:assoc-get)
 177
 178 (define-public (uniqued-alist alist acc)
 179   (if (null? alist) acc
 180       (if (assoc (caar alist) acc)
 181           (uniqued-alist (cdr alist) acc)
 182           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
 183
 184 (define-public (alist<? x y)
 185   (string<? (symbol->string (car x))
 186             (symbol->string (car y))))
 187
 188 (define-public (chain-assoc-get x alist-list . default)
 189   "Return ALIST entry for X. Return DEFAULT (optional, else #f) if not
 190 found."
 191
 192   (define (helper x alist-list default)
 193     (if (null? alist-list)
 194         default
 195         (let* ((handle (assoc x (car alist-list))))
 196           (if (pair? handle)
 197               (cdr handle)
 198               (helper x (cdr alist-list) default)))))
 199
 200   (helper x alist-list
 201           (if (pair? default) (car default) #f)))
 202
 203 (define (map-alist-vals func list)
 204   "map FUNC over the vals of  LIST, leaving the keys."
 205   (if (null?  list)
 206       '()
 207       (cons (cons  (caar list) (func (cdar list)))
 208             (map-alist-vals func (cdr list)))))
 209
 210 (define (map-alist-keys func list)
 211   "map FUNC over the keys of an alist LIST, leaving the vals. "
 212   (if (null?  list)
 213       '()
 214       (cons (cons (func (caar list)) (cdar list))
 215             (map-alist-keys func (cdr list)))))
 216
 217 (define-public (first-member members lst)
 218   "Return first successful MEMBER of member from MEMBERS in LST."
 219   (if (null? members)
 220       #f
 221       (let ((m (member (car members) lst)))
 222         (if m m (first-member (cdr members) lst)))))
 223
 224 (define-public (first-assoc keys lst)
 225   "Return first successful ASSOC of key from KEYS in LST."
 226   (if (null? keys)
 227       #f
 228       (let ((k (assoc (car keys) lst)))
 229         (if k k (first-assoc (cdr keys) lst)))))
 230
 231 (define-public (flatten-alist alist)
 232   (if (null? alist)
 233       '()
 234       (cons (caar alist)
 235             (cons (cdar alist)
 236                   (flatten-alist (cdr alist))))))
 237
 238 ;;;;;;;;;;;;;;;;
 239 ;; vector
 240
 241 (define-public (vector-for-each proc vec)
 242   (do
 243       ((i 0 (1+ i)))
 244       ((>= i (vector-length vec)) vec)
 245     (vector-set! vec i (proc (vector-ref vec i)))))
 246
 247 ;;;;;;;;;;;;;;;;
 248 ;; hash
 249
 250 (define-public (hash-table->alist t)
 251   (hash-fold (lambda (k v acc) (acons  k v  acc))
 252              '() t))
 253
 254 ;; todo: code dup with C++.
 255 (define-safe-public (alist->hash-table lst)
 256   "Convert alist to table"
 257   (let ((m (make-hash-table (length lst))))
 258     (map (lambda (k-v) (hashq-set! m (car k-v) (cdr k-v))) lst)
 259     m))
 260
 261 ;;;;;;;;;;;;;;;;
 262 ;; list
 263
 264 (define (functional-or . rest)
 265   (if (pair? rest)
 266       (or (car rest)
 267            (apply functional-and (cdr rest)))
 268       #f))
 269
 270 (define (functional-and . rest)
 271   (if (pair? rest)
 272       (and (car rest)
 273            (apply functional-and (cdr rest)))
 274       #t))
 275
 276 (define (split-list lst n)
 277   "Split LST in N equal sized parts"
 278
 279   (define (helper todo acc-vector k)
 280     (if (null? todo)
 281         acc-vector
 282         (begin
 283           (if (< k 0)
 284               (set! k (+ n k)))
 285
 286           (vector-set! acc-vector k (cons (car todo) (vector-ref acc-vector k)))
 287           (helper (cdr todo) acc-vector (1- k)))))
 288
 289   (helper lst (make-vector n '()) (1- n)))
 290
 291 (define (list-element-index lst x)
 292   (define (helper todo k)
 293     (cond
 294      ((null? todo) #f)
 295      ((equal? (car todo) x) k)
 296      (else
 297       (helper (cdr todo) (1+ k)))))
 298
 299   (helper lst 0))
 300
 301 (define-public (count-list lst)
 302   "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... )  "
 303
 304   (define (helper l acc count)
 305     (if (pair? l)
 306         (helper (cdr l) (cons (cons (car l) count) acc) (1+ count))
 307         acc))
 308
 309
 310   (reverse (helper lst '() 1)))
 311
 312 (define-public (list-join lst intermediate)
 313   "put INTERMEDIATE  between all elts of LST."
 314
 315   (fold-right
 316    (lambda (elem prev)
 317             (if (pair? prev)
 318                 (cons  elem (cons intermediate prev))
 319                 (list elem)))
 320           '() lst))
 321
 322 (define-public (filtered-map proc lst)
 323   (filter
 324    (lambda (x) x)
 325    (map proc lst)))
 326
 327
 328 (define (flatten-list lst)
 329   "Unnest LST"
 330   (if (null? lst)
 331       '()
 332       (if (pair? (car lst))
 333           (append (flatten-list (car lst)) (flatten-list  (cdr lst)))
 334           (cons (car lst) (flatten-list (cdr lst))))))
 335
 336 (define (list-minus a b)
 337   "Return list of elements in A that are not in B."
 338   (lset-difference eq? a b))
 339
 340 (define-public (uniq-list lst)
 341   "Uniq LST, assuming that it is sorted. Uses equal? for comparisons."
 342
 343   (reverse!
 344    (fold (lambda (x acc)
 345            (if (null? acc)
 346                (list x)
 347                (if (equal? x (car acc))
 348                    acc
 349                    (cons x acc))))
 350          '() lst) '()))
 351
 352 (define (split-at-predicate pred lst)
 353   "Split LST into two lists at the first element that returns #f for
 354   (PRED previous_element element). Return the two parts as a pair.
 355   Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
 356   (if (null? lst)
 357       (list lst)
 358       (let ((i (list-index pred (cdr lst) lst)))
 359         (if i
 360             (cons (take lst (1+ i)) (drop lst (1+ i)))
 361             (list lst)))))
 362
 363 (define-public (split-list-by-separator lst pred)
 364   "Split LST at each element that satisfies PRED, and return the parts
 365   (with the separators removed) as a list of lists. Example:
 366   (split-list-by-separator '(a 0 b c 1 d) number?) ==> ((a) (b c) (d))"
 367   (let loop ((result '()) (lst lst))
 368     (if (and lst (not (null? lst)))
 369         (loop
 370           (append result
 371                   (list (take-while (lambda (x) (not (pred x))) lst)))
 372           (let ((tail (find-tail pred lst)))
 373             (if tail (cdr tail) #f)))
 374        result)))
 375
 376 (define-public (offset-add a b)
 377   (cons (+ (car a) (car b))
 378         (+ (cdr a) (cdr b))))
 379
 380 (define-public (offset-flip-y o)
 381   (cons (car o) (- (cdr o))))
 382
 383 (define-public (offset-scale o scale)
 384   (cons (* (car o) scale)
 385         (* (cdr o) scale)))
 386
 387 (define-public (ly:list->offsets accum coords)
 388   (if (null? coords)
 389       accum
 390       (cons (cons (car coords) (cadr coords))
 391             (ly:list->offsets accum (cddr coords)))))
 392
 393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 394 ;; numbers
 395
 396 (if (not (defined? 'nan?)) ;; guile 1.6 compat
 397     (define-public (nan? x) (not (or (< 0.0 x)
 398                                      (> 0.0 x)
 399                                      (= 0.0 x)))))
 400
 401 (if (not (defined? 'inf?))
 402     (define-public (inf? x) (= (/ 1.0 x) 0.0)))
 403
 404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 405 ;; intervals
 406
 407 (define-public empty-interval '(+inf.0 . -inf.0))
 408
 409 (define-public (symmetric-interval expr)
 410   (cons (- expr) expr))
 411
 412 (define-public (interval-length x)
 413   "Length of the number-pair X, when an interval"
 414   (max 0 (- (cdr x) (car x))))
 415
 416 (define-public (ordered-cons a b)
 417   (cons (min a b)
 418         (max a b)))
 419
 420 (define-public (interval-bound interval dir)
 421   ((if (= dir RIGHT) cdr car) interval))
 422
 423 (define-public (interval-index interval dir)
 424   "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)"
 425
 426   (* (+  (interval-start interval) (interval-end interval)
 427          (* dir (- (interval-end interval) (interval-start interval))))
 428      0.5))
 429
 430 (define-public (interval-center x)
 431   "Center the number-pair X, when an interval"
 432   (if (interval-empty? x)
 433       0.0
 434       (/ (+ (car x) (cdr x)) 2)))
 435
 436 (define-public interval-start car)
 437
 438 (define-public interval-end cdr)
 439
 440 (define-public (interval-translate iv amount)
 441   (cons (+ amount (car iv))
 442         (+ amount (cdr iv))))
 443
 444 (define (other-axis a)
 445   (remainder (+ a 1) 2))
 446
 447 (define-public (interval-widen iv amount)
 448    (cons (- (car iv) amount)
 449          (+ (cdr iv) amount)))
 450
 451 (define-public (interval-empty? iv)
 452    (> (car iv) (cdr iv)))
 453
 454 (define-public (interval-union i1 i2)
 455    (cons (min (car i1) (car i2))
 456          (max (cdr i1) (cdr i2))))
 457
 458 (define-public (interval-sane? i)
 459   (not (or  (nan? (car i))
 460             (inf? (car i))
 461             (nan? (cdr i))
 462             (inf? (cdr i))
 463             (> (car i) (cdr i)))))
 464
 465 (define-public (add-point interval p)
 466   (cons (min (interval-start interval) p)
 467         (max (interval-end interval) p)))
 468
 469 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 470 ;; string
 471
 472 (define-public (string-endswith s suffix)
 473   (equal? suffix (substring s
 474                             (max 0 (- (string-length s) (string-length suffix)))
 475                             (string-length s))))
 476
 477 (define-public (string-startswith s prefix)
 478   (equal? prefix (substring s 0 (min (string-length s) (string-length prefix)))))
 479
 480 (define-public (string-encode-integer i)
 481   (cond
 482    ((= i  0) "o")
 483    ((< i 0)   (string-append "n" (string-encode-integer (- i))))
 484    (else (string-append
 485           (make-string 1 (integer->char (+ 65 (modulo i 26))))
 486           (string-encode-integer (quotient i 26))))))
 487
 488 (define (number->octal-string x)
 489   (let* ((n (inexact->exact x))
 490          (n64 (quotient n 64))
 491          (n8 (quotient (- n (* n64 64)) 8)))
 492     (string-append
 493      (number->string n64)
 494      (number->string n8)
 495      (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
 496
 497 (define-public (ly:inexact->string x radix)
 498   (let ((n (inexact->exact x)))
 499     (number->string n radix)))
 500
 501 (define-public (ly:number-pair->string c)
 502   (string-append (ly:number->string (car c)) " "
 503                  (ly:number->string (cdr c))))
 504
 505 (define-public (dir-basename file . rest)
 506   "Strip suffixes in REST, but leave directory component for FILE."
 507   (define (inverse-basename x y) (basename y x))
 508   (simple-format #f "~a/~a" (dirname file)
 509                  (fold inverse-basename file rest)))
 510
 511 (define-public (write-me message x)
 512   "Return X.  Display MESSAGE and write X.  Handy for debugging,
 513 possibly turned off."
 514   (display message) (write x) (newline) x)
 515 ;;  x)
 516
 517 (define-public (stderr string . rest)
 518   (apply format (cons (current-error-port) (cons string rest)))
 519   (force-output (current-error-port)))
 520
 521 (define-public (debugf string . rest)
 522   (if #f
 523       (apply stderr (cons string rest))))
 524
 525 (define (index-cell cell dir)
 526   (if (equal? dir 1)
 527       (cdr cell)
 528       (car cell)))
 529
 530 (define (cons-map f x)
 531   "map F to contents of X"
 532   (cons (f (car x)) (f (cdr x))))
 533
 534 (define-public (list-insert-separator lst between)
 535   "Create new list, inserting BETWEEN between elements of LIST"
 536   (define (conc x y )
 537     (if (eq? y #f)
 538         (list x)
 539         (cons x  (cons between y))))
 540   (fold-right conc #f lst))
 541
 542 (define-public (string-regexp-substitute a b str)
 543   (regexp-substitute/global #f a str 'pre b 'post))
 544
 545 (define (regexp-split str regex)
 546   (define matches '())
 547   (define end-of-prev-match 0)
 548   (define (notice match)
 549
 550     (set! matches (cons (substring (match:string match)
 551                                    end-of-prev-match
 552                                    (match:start match))
 553                         matches))
 554     (set! end-of-prev-match (match:end match)))
 555
 556   (regexp-substitute/global #f regex str notice 'post)
 557
 558   (if (< end-of-prev-match (string-length str))
 559       (set!
 560        matches
 561        (cons (substring str end-of-prev-match (string-length str)) matches)))
 562
 563    (reverse matches))
 564
 565 ;;;;;;;;;;;;;;;;
 566 ;; other
 567
 568 (define (sign x)
 569   (if (= x 0)
 570       0
 571       (if (< x 0) -1 1)))
 572
 573 (define-public (binary-search start end getter target-val)
 574   (_i "Find the index between @var{start} and @var{end} (an integer)
 575 which will produce the closest match to @var{target-val} when
 576 applied to function @var{getter}.")
 577   (if (<= end start)
 578       start
 579       (let* ((compare (quotient (+ start end) 2))
 580              (get-val (getter compare)))
 581         (cond
 582          ((< target-val get-val)
 583           (set! end (1- compare)))
 584          ((< get-val target-val)
 585           (set! start (1+ compare))))
 586         (binary-search start end getter target-val))))
 587
 588 (define-public (car< a b)
 589   (< (car a) (car b)))
 590
 591 (define-public (symbol<? lst r)
 592   (string<? (symbol->string lst) (symbol->string r)))
 593
 594 (define-public (symbol-key<? lst r)
 595   (string<? (symbol->string (car lst)) (symbol->string (car r))))
 596
 597 ;;
 598 ;; don't confuse users with #<procedure .. > syntax.
 599 ;;
 600 (define-public (scm->string val)
 601   (if (and (procedure? val)
 602            (symbol? (procedure-name val)))
 603       (symbol->string (procedure-name val))
 604       (string-append
 605        (if (self-evaluating? val)
 606            (if (string? val)
 607                "\""
 608                "")
 609            "'")
 610        (call-with-output-string (lambda (port) (display val port)))
 611        (if (string? val)
 612            "\""
 613            ""))))
 614
 615 (define-public (!= lst r)
 616   (not (= lst r)))
 617
 618 (define-public lily-unit->bigpoint-factor
 619   (cond
 620    ((equal? (ly:unit) "mm") (/ 72.0 25.4))
 621    ((equal? (ly:unit) "pt") (/ 72.0 72.27))
 622    (else (ly:error (_ "unknown unit: ~S") (ly:unit)))))
 623
 624 (define-public lily-unit->mm-factor
 625   (* 25.4 (/ lily-unit->bigpoint-factor 72)))
 626
 627 ;;; FONT may be font smob, or pango font string...
 628 (define-public (font-name-style font)
 629   ;; FIXME: ughr, barf: feta-alphabet is actually emmentaler
 630   (if (and (string? font)
 631            (string-prefix? "feta-alphabet" font))
 632       (string-append "emmentaler"
 633                      "-"
 634                      (substring font
 635                                 (string-length "feta-alphabet")
 636                                 (string-length font)))
 637       (let* ((font-name (ly:font-name font))
 638              (full-name (if font-name font-name (ly:font-file-name font))))
 639         (if (string-prefix? "Aybabtu" full-name)
 640             "aybabtu"
 641             (string-downcase full-name)))))
 642
 643 (define-public (modified-font-metric-font-scaling font)
 644   (let* ((designsize (ly:font-design-size font))
 645          (magnification (* (ly:font-magnification font)))
 646          (scaling (* magnification designsize)))
 647     (debugf "scaling:~S\n" scaling)
 648     (debugf "magnification:~S\n" magnification)
 649     (debugf "design:~S\n" designsize)
 650     scaling))
 651
 652 (define-public (version-not-seen-message input-file-name)
 653   (ly:message
 654    "~a:0: ~a ~a"
 655     input-file-name
 656     (_ "warning:")
 657     (format #f
 658             (_ "no \\version statement found, please add~afor future compatibility")
 659             (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
 660
 661 (define-public (old-relative-not-used-message input-file-name)
 662   (ly:message
 663    "~a:0: ~a ~a"
 664     input-file-name
 665     (_ "warning:")
 666     (_ "old relative compatibility not used")))