]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/translation-functions.scm
Issue 3983: Avoid define-public and define*-public with curried definitions
[lilypond.git] / scm / translation-functions.scm
index bc988ebd5a79e5854806b65216727c5a596ec43b..3e65016edb9b391225afe2536b97f4ad61e66c88 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; (c) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; (c) 1998--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -38,33 +38,54 @@ way the transposition number is displayed."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; metronome marks
 
-(define-public (format-metronome-markup event context)
-  (let ((hide-note (ly:context-property context 'tempoHideNote #f))
-        (text (ly:event-property event 'text))
-        (dur (ly:event-property event 'tempo-unit))
-        (count (ly:event-property event 'metronome-count)))
-
-    (metronome-markup text dur count hide-note)))
-
-(define-public (metronome-markup text dur count hide-note)
-  (let* ((note-mark (if (and (not hide-note) (ly:duration? dur))
-                        (make-smaller-markup
-                         (make-note-by-number-markup (ly:duration-log dur)
-                                                     (ly:duration-dot-count dur)
-                                                     1))
-                        #f))
+;; We give 'styled-metronome-markup' an optional argument, 'glyph-font', to
+;; prepare using other fonts than 'fetaMusic.
+;; Currently it ensures that the default-fonts are used by the
+;; markup-command 'note-by-number' in 'metronome-markup' (see below).
+(define*
+  ((styled-metronome-markup #:optional (glyph-font 'default))
+                            event context)
+   (let ((hide-note (ly:context-property context 'tempoHideNote #f))
+         (text (ly:event-property event 'text))
+         (dur (ly:event-property event 'tempo-unit))
+         (count (ly:event-property event 'metronome-count)))
+
+   (metronome-markup glyph-font text dur count hide-note)))
+(export styled-metronome-markup)
+
+(define-public format-metronome-markup
+  (styled-metronome-markup))
+
+(define (metronome-markup glyph-font text dur count hide-note)
+  (let* ((note-mark
+            (if (and (not hide-note) (ly:duration? dur))
+                (make-smaller-markup
+                   ;; We insert the (default)-font for flag-glyphs and
+                   ;; note-head-glyphs to prepare the possibility to use
+                   ;; other fonts and to make possible using
+                   ;; \override MetronomeMark #'font-name = #<font-name>
+                   ;; without affecting the note/flag-glyphs.
+                   (make-override-markup (cons 'font-name glyph-font)
+                    (make-note-by-number-markup
+                        (ly:duration-log dur)
+                        (ly:duration-dot-count dur)
+                        UP)))
+                      #f))
          (count-markup (cond ((number? count)
                               (if (> count 0)
-                                  (make-simple-markup (number->string count))
+                                  (make-simple-markup
+                                          (number->string count))
                                   #f))
                              ((pair? count)
                               (make-concat-markup
                                (list
-                                (make-simple-markup (number->string (car count)))
+                                (make-simple-markup
+                                        (number->string (car count)))
                                 (make-simple-markup " ")
                                 (make-simple-markup "–")
                                 (make-simple-markup " ")
-                                (make-simple-markup (number->string (cdr count))))))
+                                (make-simple-markup
+                                        (number->string (cdr count))))))
                              (else #f)))
          (note-markup (if (and (not hide-note) count-markup)
                           (make-concat-markup
@@ -321,14 +342,14 @@ along with @var{minimum-fret}, @var{maximum-stretch}, and
 if no fingering is present."
       (let* ((articulations (ly:event-property ev 'articulations))
              (finger-found #f))
-        (map (lambda (art)
-               (let* ((num (ly:event-property art 'digit)))
-
-                 (if (and (ly:in-event-class? art 'fingering-event)
-                          (number? num)
-                          (> num 0))
-                     (set! finger-found num))))
-             articulations)
+        (for-each (lambda (art)
+                    (let* ((num (ly:event-property art 'digit)))
+
+                      (if (and (ly:in-event-class? art 'fingering-event)
+                               (number? num)
+                               (> num 0))
+                          (set! finger-found num))))
+                  articulations)
         finger-found))
 
     (define (delete-free-string string)
@@ -464,9 +485,11 @@ the current tuning?"
                (if fit-string
                    (set-fret! pitch-entry fit-string finger)
                    (begin
-                     (ly:warning (_ "No string for pitch ~a (given frets ~a)")
-                                 pitch
-                                 specified-frets)
+                     (ly:event-warning
+                      (list-ref notes (cdr pitch-entry))
+                      (_ "No string for pitch ~a (given frets ~a)")
+                      pitch
+                      specified-frets)
                      (kill-note! string-fret-fingers
                                  (cdr pitch-entry)))))))
        (sort pitch-alist (lambda (pitch-entry-a pitch-entry-b)
@@ -580,7 +603,7 @@ only ~a fret labels provided")
   (make-vcenter-markup
    (format #f "~a" fret-number)))
 
-;; The 5-string banjo has got a extra string, the fifth (duh), which
+;; The 5-string banjo has got an extra string, the fifth (duh), which
 ;; starts at the fifth fret on the neck.  Frets on the fifth string
 ;; are referred to relative to the other frets:
 ;;   the "first fret" on the fifth string is really the sixth fret
@@ -612,16 +635,19 @@ only ~a fret labels provided")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; bar numbers
 
-(define-public ((every-nth-bar-number-visible n) barnum mp)
+(define ((every-nth-bar-number-visible n) barnum mp)
   (= 0 (modulo barnum n)))
+(export every-nth-bar-number-visible)
 
-(define-public ((modulo-bar-number-visible n m) barnum mp)
+(define ((modulo-bar-number-visible n m) barnum mp)
   (and (> barnum 1) (= m (modulo barnum n))))
+(export modulo-bar-number-visible)
 
-(define-public ((set-bar-number-visibility n) tr)
+(define ((set-bar-number-visibility n) tr)
   (let ((bn (ly:context-property tr 'currentBarNumber)))
     (ly:context-set-property! tr 'barNumberVisibility
                               (modulo-bar-number-visible n (modulo bn n)))))
+(export set-bar-number-visibility)
 
 (define-public (first-bar-number-invisible barnum mp)
   (> barnum 1))
@@ -666,8 +692,9 @@ only ~a fret labels provided")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; percent repeat counters
 
-(define-public ((every-nth-repeat-count-visible n) count context)
+(define ((every-nth-repeat-count-visible n) count context)
   (= 0 (modulo count n)))
+(export every-nth-repeat-count-visible)
 
 (define-public (all-repeat-counts-visible count context) #t)