3 ; -> Counts number of notes between last | and point. Adds durations of
4 ; each note up, and returns result.
6 ; -> Works well on notes and chords.
8 ; -> Ignores most keywords, like \override
10 ; -> Is aware of certain keywords which often contain parameters that
11 ; look like notes, but should not be counted.
12 ; | a \key b \minor c % b is not counted, but a and c are.
14 ; -> Ignores Scheme expressions, which start with #
16 ; -> Doesn't ignore the \times keyword. Intelligently handles triplets.
21 ; -> Doesn't work on regions that aren't preceded by a |. This is because such
22 ; notes are only delimited by a {, and what-beat can't distinguish a { that
23 ; opens a set of notes from an internal { (say from a triplet)
25 ; -> Doesn't work with << >> expressions or nested {} expressions (unless
26 ; {} is part of a keyword like \times)
28 ; -> Keywords abutted against a note are not visible to what-beat, and
29 ; can therefore surreptitiosly sneak fake notes into what-beat.
30 ; | c\glissando f <- BAD: the f gets counted, but shouldn't
31 ; | c \glissando f <- GOOD: the f gets ignored
33 ; -> Does not look outside notes context. Derivation rules don't work:
34 ; str = \notes { a8 b c d }
35 ; \score { \notes { | e4 %{ gets counted }% \str %{gets ignored}%
37 ; -> Does not handle repeats.
39 ; -> Ignores \bar commands (and does not get confused by a | inside a \bar)
42 ; Recognizes pitch & octave
43 (setq pitch-regex "\\([a-z]+[,']*\\|<[^>]*>\\)\\(=[,']*\\)?")
45 (setq duration-regex "[ \t\n]*\\(\\(\\(128\\|6?4\\|3?2\\|16?\\|8\\)\\([.]*\\)\\)\\([ \t]*[*][ \t]*\\([0-9]+\\)\\(/\\([1-9][0-9]*\\)\\)?\\)?\\)")
47 ; These keywords precede notes that should not be counted during beats
48 (setq Parm-Keywords '("key" "clef" "appoggiatura" "acciaccatura" "grace"
49 "override" "revert" "glissando"))
52 (defun extract-match (string match-num)
53 (if (null (match-beginning match-num))
55 (substring string (match-beginning match-num) (match-end match-num))))
58 (defun add-fractions (f1 f2)
59 "Adds two fractions, both are (numerator denominator)"
60 (setq result (list (+ (* (car f1) (cadr f2)) (* (car f2) (cadr f1)))
61 (* (cadr f1) (cadr f2))))
62 (setq result (reduce-fraction result 2))
63 (setq result (reduce-fraction result 3))
64 (setq result (reduce-fraction result 5))
65 (setq result (reduce-fraction result 7))
69 (defun reduce-fraction (f divisor)
70 "Eliminates divisor from fraction if present"
71 (while (and (= 0 (% (car result) divisor))
72 (= 0 (% (cadr result) divisor))
75 (setq result (list (/ (car result) divisor) (/ (cadr result) divisor))))
80 (defun parse-duration (duration)
81 "Returns a duration string parsed as '(numerator denominator)"
82 (string-match duration-regex duration)
83 (let ((result (list 1 (string-to-int (extract-match duration 2))))
84 (dots (extract-match duration 4))
85 (numerator (or (extract-match duration 6) "1"))
86 (denominator (or (extract-match duration 8) "1")))
87 (if (and (not (null dots)) (< 0 (string-width dots)))
88 (dotimes (dummy (string-width dots))
89 (setq result (list (1+ (* 2 (car result))) (* 2 (cadr result))))))
90 (list (* (string-to-int numerator) (car result))
91 (* (string-to-int denominator) (cadr result)))
94 (defun walk-note-duration ()
95 "Returns duration of next note, moving point past note.
96 If point is not before a note, returns nil
97 If next note has no duration, returns t"
98 (let ((have-pitch (looking-at pitch-regex)))
99 (if have-pitch (goto-char (match-end 0)))
100 (if (not (looking-at duration-regex))
102 (goto-char (match-end 0))
103 (parse-duration (match-string 0)))))
105 ; returns nil if not at a comment
106 (defun skip-comment ()
107 (if (not (char-equal ?\% (following-char)))
111 (if (char-equal ?\{ (following-char))
112 (re-search-forward "}%" nil t)
114 (skip-chars-forward "^\n")
119 ; returns nil if not at a quotation
120 (defun skip-quotation ()
121 (if (not (char-equal ?\" (following-char)))
125 (skip-chars-forward "^\"")
130 ; returns nil if not at a sexp
133 (if (not (char-equal ?\# (following-char)))
137 (if (char-equal ?\' (following-char))
139 (if (not (char-equal ?\( (following-char)))
140 (skip-chars-forward "^ \t\n")
145 (cond ((char-equal ?\( (following-char))
146 (setq paren (1+ paren)))
147 ((char-equal ?\) (following-char))
148 (setq paren (1- paren)))))
153 (defun goto-note-begin ()
155 ; skip anything that is not ws. And skip any comments or quotations
156 (while (or (< 0 (skip-chars-forward "^ \t\n~%#\""))
160 ; Now skip anything that isn't alphanum or \. And skip comments or quotations
161 (while (or (< 0 (skip-chars-forward "^A-Za-z1-9<%}#=\""))
165 ; (skip-chars-forward "^\\") Why doesn't this work?!!
166 (if (char-equal ?\\ (preceding-char))
171 (defun skip-good-keywords ()
172 (if (looking-at "\\\\\\([a-z]*\\)")
174 (goto-char (match-end 0))
175 (if (member (match-string 1) Parm-Keywords)
177 (if (looking-at "[ \t\n]*?\\([a-z0-9_]+\\|{[^}]*}\\|\"[^\"]*\"\\)")
178 (goto-char (match-end 0))
179 (error "Improper regex match:")
180 (error "Unknown text: %s")
183 (defun find-measure-start ()
184 (let ((start (re-search-backward "\|" 0 t)))
187 (if (looking-at "[^ \n\t]*\"")
196 (measure-start (find-measure-start))
197 (last-dur (or (re-search-backward duration-regex 0 t) -1))
198 (duration (if (= -1 last-dur) 0 (parse-duration (match-string 0))))
199 (result '(0 1))) ; 0 in fraction form
200 (if (= measure-start -1)
201 (message "No | before point")
202 (goto-char (1+ measure-start))
204 (while (< (point) end)
205 (let ((new-duration (walk-note-duration)))
206 (if (null new-duration)
208 (concat "\\\\t\\(?:\\(imes\\)\\|uplet\\)[ \t]*\\([0-9]+\\)/\\([0-9]+\\)\\(?:[ \t\n]"
209 duration-regex "\\)?[ \t\n]*{")))
212 ; handle \times/\tuplet specially
213 (let* ((times-p (match-beginning 1))
214 (numerator (string-to-int (match-string (if times-p 2 3))))
215 (denominator (string-to-int (match-string (if times-p 3 2)))))
216 (goto-char (match-end 0))
218 (while (and (not (looking-at "}"))
220 (setq new-duration (walk-note-duration))
221 (if (null new-duration)
222 (if (looking-at "\\\\[a-z]*[ \t]*[a-z]*")
223 (goto-char (match-end 0))
224 (error "Unknown text: %S %s" result(buffer-substring (point) end))))
225 (if (not (eq new-duration t))
226 (setq duration new-duration))
227 (setq result (add-fractions result
228 (list (* numerator (car duration))
229 (* denominator (cadr duration)))))
232 (forward-char 1)))) ; skip }
234 (if (not (eq new-duration t))
235 (setq duration new-duration))
236 (setq result (add-fractions result duration)))
241 (defun LilyPond-what-beat ()
242 "Returns how much of a measure lies between last measaure '|' and point.
243 Recognizes chords, and triples."
245 (let ((beat (get-beat)))
246 (message "Beat: %d/%d" (car beat) (cadr beat)))
249 (defun LilyPond-electric-bar ()
250 "Indicate the number of beats in last measure when a | is inserted"
252 (self-insert-command 1)