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 ;; Add a score to the current bookpart, book or toplevel
 174 (define-public (add-score parser score)
 175     (cond
 176       ((ly:parser-lookup parser '$current-bookpart)
 177           ((ly:parser-lookup parser 'bookpart-score-handler)
 178                 (ly:parser-lookup parser '$current-bookpart) score))
 179       ((ly:parser-lookup parser '$current-book)
 180           ((ly:parser-lookup parser 'book-score-handler)
 181                 (ly:parser-lookup parser '$current-book) score))
 182       (else
 183           ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
 184
 185 (define-public (add-text parser text)
 186   (add-score parser (list text)))
 187
 188 (define-public (add-music parser music)
 189   (collect-music-aux (lambda (score)
 190                        (add-score parser score))
 191                      parser
 192                      music))
 193
 194
 195 ;;;;;;;;;;;;;;;;
 196 ;; alist
 197
 198 (define-public assoc-get ly:assoc-get)
 199
 200 (define-public (uniqued-alist alist acc)
 201   (if (null? alist) acc
 202       (if (assoc (caar alist) acc)
 203           (uniqued-alist (cdr alist) acc)
 204           (uniqued-alist (cdr alist) (cons (car alist) acc)))))
 205
 206 (define-public (alist<? x y)
 207   (string<? (symbol->string (car x))
 208             (symbol->string (car y))))
 209
 210 (define-public (chain-assoc-get x alist-list . default)
 211   "Return ALIST entry for X. Return DEFAULT (optional, else #f) if not
 212 found."
 213
 214   (define (helper x alist-list default)
 215     (if (null? alist-list)
 216         default
 217         (let* ((handle (assoc x (car alist-list))))
 218           (if (pair? handle)
 219               (cdr handle)
 220               (helper x (cdr alist-list) default)))))
 221
 222   (helper x alist-list
 223           (if (pair? default) (car default) #f)))
 224
 225 (define (map-alist-vals func list)
 226   "map FUNC over the vals of  LIST, leaving the keys."
 227   (if (null?  list)
 228       '()
 229       (cons (cons  (caar list) (func (cdar list)))
 230             (map-alist-vals func (cdr list)))))
 231
 232 (define (map-alist-keys func list)
 233   "map FUNC over the keys of an alist LIST, leaving the vals. "
 234   (if (null?  list)
 235       '()
 236       (cons (cons (func (caar list)) (cdar list))
 237             (map-alist-keys func (cdr list)))))
 238
 239 (define-public (first-member members lst)
 240   "Return first successful MEMBER of member from MEMBERS in LST."
 241   (if (null? members)
 242       #f
 243       (let ((m (member (car members) lst)))
 244         (if m m (first-member (cdr members) lst)))))
 245
 246 (define-public (first-assoc keys lst)
 247   "Return first successful ASSOC of key from KEYS in LST."
 248   (if (null? keys)
 249       #f
 250       (let ((k (assoc (car keys) lst)))
 251         (if k k (first-assoc (cdr keys) lst)))))
 252
 253 (define-public (flatten-alist alist)
 254   (if (null? alist)
 255       '()
 256       (cons (caar alist)
 257             (cons (cdar alist)
 258                   (flatten-alist (cdr alist))))))
 259
 260 ;;;;;;;;;;;;;;;;
 261 ;; vector
 262
 263 (define-public (vector-for-each proc vec)
 264   (do
 265       ((i 0 (1+ i)))
 266       ((>= i (vector-length vec)) vec)
 267     (vector-set! vec i (proc (vector-ref vec i)))))
 268
 269 ;;;;;;;;;;;;;;;;
 270 ;; hash
 271
 272 (define-public (hash-table->alist t)
 273   (hash-fold (lambda (k v acc) (acons  k v  acc))
 274              '() t))
 275
 276 ;; todo: code dup with C++.
 277 (define-safe-public (alist->hash-table lst)
 278   "Convert alist to table"
 279   (let ((m (make-hash-table (length lst))))
 280     (map (lambda (k-v) (hashq-set! m (car k-v) (cdr k-v))) lst)
 281     m))
 282
 283 ;;;;;;;;;;;;;;;;
 284 ;; list
 285
 286 (define (functional-or . rest)
 287   (if (pair? rest)
 288       (or (car rest)
 289            (apply functional-and (cdr rest)))
 290       #f))
 291
 292 (define (functional-and . rest)
 293   (if (pair? rest)
 294       (and (car rest)
 295            (apply functional-and (cdr rest)))
 296       #t))
 297
 298 (define (split-list lst n)
 299   "Split LST in N equal sized parts"
 300
 301   (define (helper todo acc-vector k)
 302     (if (null? todo)
 303         acc-vector
 304         (begin
 305           (if (< k 0)
 306               (set! k (+ n k)))
 307
 308           (vector-set! acc-vector k (cons (car todo) (vector-ref acc-vector k)))
 309           (helper (cdr todo) acc-vector (1- k)))))
 310
 311   (helper lst (make-vector n '()) (1- n)))
 312
 313 (define (list-element-index lst x)
 314   (define (helper todo k)
 315     (cond
 316      ((null? todo) #f)
 317      ((equal? (car todo) x) k)
 318      (else
 319       (helper (cdr todo) (1+ k)))))
 320
 321   (helper lst 0))
 322
 323 (define-public (count-list lst)
 324   "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... )  "
 325
 326   (define (helper l acc count)
 327     (if (pair? l)
 328         (helper (cdr l) (cons (cons (car l) count) acc) (1+ count))
 329         acc))
 330
 331
 332   (reverse (helper lst '() 1)))
 333
 334 (define-public (list-join lst intermediate)
 335   "put INTERMEDIATE  between all elts of LST."
 336
 337   (fold-right
 338    (lambda (elem prev)
 339             (if (pair? prev)
 340                 (cons  elem (cons intermediate prev))
 341                 (list elem)))
 342           '() lst))
 343
 344 (define-public (filtered-map proc lst)
 345   (filter
 346    (lambda (x) x)
 347    (map proc lst)))
 348
 349
 350 (define (flatten-list lst)
 351   "Unnest LST"
 352   (if (null? lst)
 353       '()
 354       (if (pair? (car lst))
 355           (append (flatten-list (car lst)) (flatten-list  (cdr lst)))
 356           (cons (car lst) (flatten-list (cdr lst))))))
 357
 358 (define (list-minus a b)
 359   "Return list of elements in A that are not in B."
 360   (lset-difference eq? a b))
 361
 362 (define-public (uniq-list lst)
 363   "Uniq LST, assuming that it is sorted. Uses equal? for comparisons."
 364
 365   (reverse!
 366    (fold (lambda (x acc)
 367            (if (null? acc)
 368                (list x)
 369                (if (equal? x (car acc))
 370                    acc
 371                    (cons x acc))))
 372          '() lst) '()))
 373
 374 (define (split-at-predicate pred lst)
 375   "Split LST into two lists at the first element that returns #f for
 376   (PRED previous_element element). Return the two parts as a pair.
 377   Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
 378   (if (null? lst)
 379       (list lst)
 380       (let ((i (list-index pred (cdr lst) lst)))
 381         (if i
 382             (cons (take lst (1+ i)) (drop lst (1+ i)))
 383             (list lst)))))
 384
 385 (define-public (split-list-by-separator lst pred)
 386   "Split LST at each element that satisfies PRED, and return the parts
 387   (with the separators removed) as a list of lists. Example:
 388   (split-list-by-separator '(a 0 b c 1 d) number?) ==> ((a) (b c) (d))"
 389   (let loop ((result '()) (lst lst))
 390     (if (and lst (not (null? lst)))
 391         (loop
 392           (append result
 393                   (list (take-while (lambda (x) (not (pred x))) lst)))
 394           (let ((tail (find-tail pred lst)))
 395             (if tail (cdr tail) #f)))
 396        result)))
 397
 398 (define-public (offset-add a b)
 399   (cons (+ (car a) (car b))
 400         (+ (cdr a) (cdr b))))
 401
 402 (define-public (offset-flip-y o)
 403   (cons (car o) (- (cdr o))))
 404
 405 (define-public (offset-scale o scale)
 406   (cons (* (car o) scale)
 407         (* (cdr o) scale)))
 408
 409 (define-public (ly:list->offsets accum coords)
 410   (if (null? coords)
 411       accum
 412       (cons (cons (car coords) (cadr coords))
 413             (ly:list->offsets accum (cddr coords)))))
 414
 415 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 416 ;; numbers
 417
 418 (if (not (defined? 'nan?)) ;; guile 1.6 compat
 419     (define-public (nan? x) (not (or (< 0.0 x)
 420                                      (> 0.0 x)
 421                                      (= 0.0 x)))))
 422
 423 (if (not (defined? 'inf?))
 424     (define-public (inf? x) (= (/ 1.0 x) 0.0)))
 425
 426 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 427 ;; intervals
 428
 429 (define-public empty-interval '(+inf.0 . -inf.0))
 430
 431 (define-public (symmetric-interval expr)
 432   (cons (- expr) expr))
 433
 434 (define-public (interval-length x)
 435   "Length of the number-pair X, when an interval"
 436   (max 0 (- (cdr x) (car x))))
 437
 438 (define-public (ordered-cons a b)
 439   (cons (min a b)
 440         (max a b)))
 441
 442 (define-public (interval-bound interval dir)
 443   ((if (= dir RIGHT) cdr car) interval))
 444
 445 (define-public (interval-index interval dir)
 446   "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)"
 447
 448   (* (+  (interval-start interval) (interval-end interval)
 449          (* dir (- (interval-end interval) (interval-start interval))))
 450      0.5))
 451
 452 (define-public (interval-center x)
 453   "Center the number-pair X, when an interval"
 454   (if (interval-empty? x)
 455       0.0
 456       (/ (+ (car x) (cdr x)) 2)))
 457
 458 (define-public interval-start car)
 459
 460 (define-public interval-end cdr)
 461
 462 (define-public (interval-translate iv amount)
 463   (cons (+ amount (car iv))
 464         (+ amount (cdr iv))))
 465
 466 (define (other-axis a)
 467   (remainder (+ a 1) 2))
 468
 469 (define-public (interval-widen iv amount)
 470    (cons (- (car iv) amount)
 471          (+ (cdr iv) amount)))
 472
 473 (define-public (interval-empty? iv)
 474    (> (car iv) (cdr iv)))
 475
 476 (define-public (interval-union i1 i2)
 477    (cons (min (car i1) (car i2))
 478          (max (cdr i1) (cdr i2))))
 479
 480 (define-public (interval-intersection i1 i2)
 481    (cons (max (car i1) (car i2))
 482          (min (cdr i1) (cdr i2))))
 483
 484 (define-public (interval-sane? i)
 485   (not (or  (nan? (car i))
 486             (inf? (car i))
 487             (nan? (cdr i))
 488             (inf? (cdr i))
 489             (> (car i) (cdr i)))))
 490
 491 (define-public (add-point interval p)
 492   (cons (min (interval-start interval) p)
 493         (max (interval-end interval) p)))
 494
 495 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 496 ;; string
 497
 498 (define-public (string-endswith s suffix)
 499   (equal? suffix (substring s
 500                             (max 0 (- (string-length s) (string-length suffix)))
 501                             (string-length s))))
 502
 503 (define-public (string-startswith s prefix)
 504   (equal? prefix (substring s 0 (min (string-length s) (string-length prefix)))))
 505
 506 (define-public (string-encode-integer i)
 507   (cond
 508    ((= i  0) "o")
 509    ((< i 0)   (string-append "n" (string-encode-integer (- i))))
 510    (else (string-append
 511           (make-string 1 (integer->char (+ 65 (modulo i 26))))
 512           (string-encode-integer (quotient i 26))))))
 513
 514 (define (number->octal-string x)
 515   (let* ((n (inexact->exact x))
 516          (n64 (quotient n 64))
 517          (n8 (quotient (- n (* n64 64)) 8)))
 518     (string-append
 519      (number->string n64)
 520      (number->string n8)
 521      (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
 522
 523 (define-public (ly:inexact->string x radix)
 524   (let ((n (inexact->exact x)))
 525     (number->string n radix)))
 526
 527 (define-public (ly:number-pair->string c)
 528   (string-append (ly:number->string (car c)) " "
 529                  (ly:number->string (cdr c))))
 530
 531 (define-public (dir-basename file . rest)
 532   "Strip suffixes in REST, but leave directory component for FILE."
 533   (define (inverse-basename x y) (basename y x))
 534   (simple-format #f "~a/~a" (dirname file)
 535                  (fold inverse-basename file rest)))
 536
 537 (define-public (write-me message x)
 538   "Return X.  Display MESSAGE and write X.  Handy for debugging,
 539 possibly turned off."
 540   (display message) (write x) (newline) x)
 541 ;;  x)
 542
 543 (define-public (stderr string . rest)
 544   (apply format (cons (current-error-port) (cons string rest)))
 545   (force-output (current-error-port)))
 546
 547 (define-public (debugf string . rest)
 548   (if #f
 549       (apply stderr (cons string rest))))
 550
 551 (define (index-cell cell dir)
 552   (if (equal? dir 1)
 553       (cdr cell)
 554       (car cell)))
 555
 556 (define (cons-map f x)
 557   "map F to contents of X"
 558   (cons (f (car x)) (f (cdr x))))
 559
 560 (define-public (list-insert-separator lst between)
 561   "Create new list, inserting BETWEEN between elements of LIST"
 562   (define (conc x y )
 563     (if (eq? y #f)
 564         (list x)
 565         (cons x  (cons between y))))
 566   (fold-right conc #f lst))
 567
 568 (define-public (string-regexp-substitute a b str)
 569   (regexp-substitute/global #f a str 'pre b 'post))
 570
 571 (define (regexp-split str regex)
 572   (define matches '())
 573   (define end-of-prev-match 0)
 574   (define (notice match)
 575
 576     (set! matches (cons (substring (match:string match)
 577                                    end-of-prev-match
 578                                    (match:start match))
 579                         matches))
 580     (set! end-of-prev-match (match:end match)))
 581
 582   (regexp-substitute/global #f regex str notice 'post)
 583
 584   (if (< end-of-prev-match (string-length str))
 585       (set!
 586        matches
 587        (cons (substring str end-of-prev-match (string-length str)) matches)))
 588
 589    (reverse matches))
 590
 591 ;;;;;;;;;;;;;;;;
 592 ;; other
 593
 594 (define (sign x)
 595   (if (= x 0)
 596       0
 597       (if (< x 0) -1 1)))
 598
 599 (define-public (binary-search start end getter target-val)
 600   (_i "Find the index between @var{start} and @var{end} (an integer)
 601 which will produce the closest match to @var{target-val} when
 602 applied to function @var{getter}.")
 603   (if (<= end start)
 604       start
 605       (let* ((compare (quotient (+ start end) 2))
 606              (get-val (getter compare)))
 607         (cond
 608          ((< target-val get-val)
 609           (set! end (1- compare)))
 610          ((< get-val target-val)
 611           (set! start (1+ compare))))
 612         (binary-search start end getter target-val))))
 613
 614 (define-public (car< a b)
 615   (< (car a) (car b)))
 616
 617 (define-public (symbol<? lst r)
 618   (string<? (symbol->string lst) (symbol->string r)))
 619
 620 (define-public (symbol-key<? lst r)
 621   (string<? (symbol->string (car lst)) (symbol->string (car r))))
 622
 623 ;;
 624 ;; don't confuse users with #<procedure .. > syntax.
 625 ;;
 626 (define-public (scm->string val)
 627   (if (and (procedure? val)
 628            (symbol? (procedure-name val)))
 629       (symbol->string (procedure-name val))
 630       (string-append
 631        (if (self-evaluating? val)
 632            (if (string? val)
 633                "\""
 634                "")
 635            "'")
 636        (call-with-output-string (lambda (port) (display val port)))
 637        (if (string? val)
 638            "\""
 639            ""))))
 640
 641 (define-public (!= lst r)
 642   (not (= lst r)))
 643
 644 (define-public lily-unit->bigpoint-factor
 645   (cond
 646    ((equal? (ly:unit) "mm") (/ 72.0 25.4))
 647    ((equal? (ly:unit) "pt") (/ 72.0 72.27))
 648    (else (ly:error (_ "unknown unit: ~S") (ly:unit)))))
 649
 650 (define-public lily-unit->mm-factor
 651   (* 25.4 (/ lily-unit->bigpoint-factor 72)))
 652
 653 ;;; FONT may be font smob, or pango font string...
 654 (define-public (font-name-style font)
 655   ;; FIXME: ughr, barf: feta-alphabet is actually emmentaler
 656   (if (and (string? font)
 657            (string-prefix? "feta-alphabet" font))
 658       (string-append "emmentaler"
 659                      "-"
 660                      (substring font
 661                                 (string-length "feta-alphabet")
 662                                 (string-length font)))
 663       (let* ((font-name (ly:font-name font))
 664              (full-name (if font-name font-name (ly:font-file-name font))))
 665         (if (string-prefix? "Aybabtu" full-name)
 666             "aybabtu"
 667             (string-downcase full-name)))))
 668
 669 (define-public (modified-font-metric-font-scaling font)
 670   (let* ((designsize (ly:font-design-size font))
 671          (magnification (* (ly:font-magnification font)))
 672          (scaling (* magnification designsize)))
 673     (debugf "scaling:~S\n" scaling)
 674     (debugf "magnification:~S\n" magnification)
 675     (debugf "design:~S\n" designsize)
 676     scaling))
 677
 678 (define-public (version-not-seen-message input-file-name)
 679   (ly:message
 680    "~a:0: ~a ~a"
 681     input-file-name
 682     (_ "warning:")
 683     (format #f
 684             (_ "no \\version statement found, please add~afor future compatibility")
 685             (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
 686
 687 (define-public (old-relative-not-used-message input-file-name)
 688   (ly:message
 689    "~a:0: ~a ~a"
 690     input-file-name
 691     (_ "warning:")
 692     (_ "old relative compatibility not used")))