3 ; -> Counts number of notes between last | and point. Adds durations of
\r
4 ; each note up, and returns result.
\r
6 ; -> Works well on notes and chords.
\r
8 ; -> Ignores most keywords, like \override
\r
10 ; -> Is aware of certain keywords which often contain parameters that
\r
11 ; look like notes, but should not be counted.
\r
12 ; | a \key b \minor c % b is not counted, but a and c are.
\r
14 ; -> Ignores Scheme expressions, which start with #
\r
16 ; -> Doesn't ignore the \times keyword. Intelligently handles triplets.
\r
21 ; -> Doesn't work on regions that aren't preceded by a |. This is because such
\r
22 ; notes are only delimited by a {, and what-beat can't distinguish a { that
\r
23 ; opens a set of notes from an internal { (say from a triplet)
\r
25 ; -> Doesn't work with << >> expressions or nested {} expressions (unless
\r
26 ; {} is part of a keyword like \times)
\r
28 ; -> Keywords abutted against a note are not visible to what-beat, and
\r
29 ; can therefore surreptitiosly sneak fake notes into what-beat.
\r
30 ; | c\glissando f <- BAD: the f gets counted, but shouldn't
\r
31 ; | c \glissando f <- GOOD: the f gets ignored
\r
33 ; -> Does not look outside notes context. Derivation rules don't work:
\r
34 ; str = \notes { a8 b c d }
\r
35 ; \score { \notes { | e4 %{ gets counted }% \str %{gets ignored}%
\r
37 ; -> Does not handle repeats.
\r
40 ; Recognizes pitch & octave
\r
41 (setq pitch-regex "\\([a-z]+[,']*\\|<[^>]*>\\)\\(=[,']*\\)?")
\r
42 ; Recognizes duration
\r
43 (setq duration-regex "[ \t\n]*\\(\\(\\(128\\|6?4\\|3?2\\|16?\\|8\\)\\([.]*\\)\\)\\([ \t]*[*][ \t]*\\([0-9]+\\)\\(/\\([1-9][0-9]*\\)\\)?\\)?\\)")
\r
45 ; These keywords precede notes that should not be counted during beats
\r
46 (setq Parm-Keywords '("key" "clef" "appoggiatura" "acciaccatura" "grace"
\r
47 "override" "revert" "glissando"))
\r
50 (defun extract-match (string match-num)
\r
51 (if (null (match-beginning match-num))
\r
53 (substring string (match-beginning match-num) (match-end match-num))))
\r
56 (defun add-fractions (f1 f2)
\r
57 "Adds two fractions, both are (numerator denominator)"
\r
58 (set 'result (list (+ (* (car f1) (cadr f2)) (* (car f2) (cadr f1)))
\r
59 (* (cadr f1) (cadr f2))))
\r
60 (set 'result (reduce-fraction result 2))
\r
61 (set 'result (reduce-fraction result 3))
\r
62 (set 'result (reduce-fraction result 5))
\r
63 (set 'result (reduce-fraction result 7))
\r
67 (defun reduce-fraction (f divisor)
\r
68 "Eliminates divisor from fraction if present"
\r
69 (while (and (= 0 (% (car result) divisor))
\r
70 (= 0 (% (cadr result) divisor))
\r
73 (set 'result (list (/ (car result) divisor) (/ (cadr result) divisor))))
\r
78 (defun parse-duration (duration)
\r
79 "Returns a duration string parsed as '(numerator denominator)"
\r
80 (string-match duration-regex duration)
\r
81 (let ((result (list 1 (string-to-int (extract-match duration 2))))
\r
82 (dots (extract-match duration 4))
\r
83 (numerator (or (extract-match duration 6) "1"))
\r
84 (denominator (or (extract-match duration 8) "1")))
\r
85 (if (and (not (null dots)) (< 0 (string-width dots)))
\r
86 (dotimes (dummy (string-width dots))
\r
87 (set 'result (list (1+ (* 2 (car result))) (* 2 (cadr result))))))
\r
88 (list (* (string-to-int numerator) (car result))
\r
89 (* (string-to-int denominator) (cadr result)))
\r
92 (defun walk-note-duration ()
\r
93 "Returns duration of next note, moving point past note.
\r
94 If point is not before a note, returns nil
\r
95 If next note has no duration, returns t"
\r
96 (if (not (looking-at pitch-regex))
\r
99 (goto-char (match-end 0))
\r
100 (if (not (looking-at duration-regex))
\r
103 (goto-char (match-end 0))
\r
104 (parse-duration (match-string 0)))))))
\r
106 ; returns nil if not at a comment
\r
107 (defun skip-comment ()
\r
108 (if (not (char-equal ?\% (following-char)))
\r
112 (if (char-equal ?\{ (following-char))
\r
113 (re-search-forward "}%" nil t)
\r
115 (skip-chars-forward "^\n")
\r
120 ; returns nil if not at a quotation
\r
121 (defun skip-quotation ()
\r
122 (if (not (char-equal ?\" (following-char)))
\r
126 (skip-chars-forward "^\"")
\r
131 ; returns nil if not at a sexp
\r
132 (defun skip-sexp ()
\r
134 (if (not (char-equal ?\# (following-char)))
\r
138 (if (char-equal ?\' (following-char))
\r
140 (if (not (char-equal ?\( (following-char)))
\r
141 (skip-chars-forward "^ \t\n")
\r
146 (cond ((char-equal ?\( (following-char))
\r
147 (setq paren (1+ paren)))
\r
148 ((char-equal ?\) (following-char))
\r
149 (setq paren (1- paren)))))
\r
154 (defun goto-note-begin ()
\r
156 ; skip anything that is not ws. And skip any comments or quotations
\r
157 (while (or (< 0 (skip-chars-forward "^ \t\n~%#\""))
\r
161 ; Now skip anything that isn't alphanum or \. And skip comments or quotations
\r
162 (while (or (< 0 (skip-chars-forward "^A-Za-z<%}#=\""))
\r
166 ; (skip-chars-forward "^\\") Why doesn't this work?!!
\r
167 (if (char-equal ?\\ (preceding-char))
\r
172 (defun skip-good-keywords ()
\r
173 (if (looking-at "\\\\\\([a-z]*\\)")
\r
175 (goto-char (match-end 0))
\r
176 (if (member (match-string 1) Parm-Keywords)
\r
178 (if (looking-at "[ \t\n]*\\([a-z0-9_]+\\|{[^}]*}\\)")
\r
179 (goto-char (match-end 0))
\r
180 (error "Improper regex match:")
\r
181 (error "Unknown text: %s")
\r
187 (let* ((end (point))
\r
188 (measure-start (or (re-search-backward "\|" 0 t) -1))
\r
189 (last-dur (or (re-search-backward duration-regex 0 t) -1))
\r
190 (duration (if (= -1 last-dur) 0 (parse-duration (match-string 0))))
\r
191 (result '(0 1))) ; 0 in fraction form
\r
192 (if (= measure-start -1)
\r
193 (error "No | before point")
\r
195 (goto-char (1+ measure-start))
\r
197 (while (< (point) end)
\r
198 (set 'new-duration (walk-note-duration))
\r
199 (if (null new-duration)
\r
200 (if (not (looking-at "\\\\times[ \t]*\\([1-9]*\\)/\\([1-9]*\\)[ \t\n]*{"))
\r
201 (skip-good-keywords)
\r
203 ; handle \times specially
\r
204 (let ((numerator (string-to-int (match-string 1)))
\r
205 (denominator (string-to-int (match-string 2))))
\r
206 (goto-char (match-end 0))
\r
208 (while (and (not (looking-at "}"))
\r
210 (set 'new-duration (walk-note-duration))
\r
211 (if (null new-duration)
\r
212 (if (looking-at "\\\\[a-z]*[ \t]*[a-z]*")
\r
213 (goto-char (match-end 0))
\r
214 (error "Unknown text: %S %s" result(buffer-substring (point) end))))
\r
215 (if (not (eq new-duration t))
\r
216 (set 'duration new-duration))
\r
217 (set 'result (add-fractions result
\r
218 (list (* numerator (car duration))
\r
219 (* denominator (cadr duration)))))
\r
221 (if (< (point) end)
\r
222 (forward-char 1)))) ; skip }
\r
224 (if (not (eq new-duration t))
\r
225 (set 'duration new-duration))
\r
226 (set 'result (add-fractions result duration)))
\r
232 (defun LilyPond-what-beat ()
\r
233 "Returns how much of a measure lies between last measaure '|' and point.
\r
234 Recognizes chords, and triples."
\r
236 (let ((beat (get-beat)))
\r
237 (message "Beat: %d/%d" (car beat) (cadr beat)))
\r
240 (defun LilyPond-electric-bar ()
\r
241 "Indicate the number of beats in last measure when a | is inserted"
\r
243 (self-insert-command 1)
\r
247 (LilyPond-what-beat)
\r