]> git.donarmstrong.com Git - lilypond.git/blob - elisp/lilypond-what-beat.el
better version check; handle fooX.Y
[lilypond.git] / elisp / lilypond-what-beat.el
1 ; Features:\r
2 ;\r
3 ; -> Counts number of notes between last | and point. Adds durations of\r
4 ; each note up, and returns result.\r
5 ;\r
6 ; -> Works well on notes and chords.\r
7 ;\r
8 ; -> Ignores most keywords, like \override\r
9 ;\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
13 ;\r
14 ; -> Ignores Scheme expressions, which start with #\r
15 ;\r
16 ; -> Doesn't ignore the \times keyword. Intelligently handles triplets.\r
17\r
18 ;\r
19 ; Caveats:\r
20 ;\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
24 ;\r
25 ; -> Doesn't work with << >>  expressions or nested {} expressions (unless\r
26 ; {} is part of a keyword like \times)\r
27 ;\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
32 ;\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
36 ;\r
37 ; -> Does not handle repeats.\r
38 ;\r
39 ; -> Ignores \bar commands (and does not get confused by a | inside a \bar)\r
40 ;\r
41 \r
42 ; Recognizes pitch & octave\r
43 (setq pitch-regex "\\([a-z]+[,']*\\|<[^>]*>\\)\\(=[,']*\\)?")\r
44 ; Recognizes duration\r
45 (setq duration-regex "[ \t\n]*\\(\\(\\(128\\|6?4\\|3?2\\|16?\\|8\\)\\([.]*\\)\\)\\([ \t]*[*][ \t]*\\([0-9]+\\)\\(/\\([1-9][0-9]*\\)\\)?\\)?\\)")\r
46 \r
47 ; These keywords precede notes that should not be counted during beats\r
48 (setq Parm-Keywords '("key" "clef" "appoggiatura" "acciaccatura" "grace"\r
49                       "override" "revert" "glissando"))\r
50 \r
51 \r
52 (defun extract-match (string match-num)\r
53   (if (null (match-beginning match-num))\r
54       nil\r
55     (substring string (match-beginning match-num) (match-end match-num))))\r
56 \r
57 \r
58 (defun add-fractions (f1 f2)\r
59   "Adds two fractions, both are (numerator denominator)"\r
60   (set 'result (list (+ (* (car f1) (cadr f2)) (* (car f2) (cadr f1)))\r
61                      (* (cadr f1) (cadr f2))))\r
62   (set 'result (reduce-fraction result 2))\r
63   (set 'result (reduce-fraction result 3))\r
64   (set 'result (reduce-fraction result 5))\r
65   (set 'result (reduce-fraction result 7))\r
66 )\r
67 \r
68 \r
69 (defun reduce-fraction (f divisor)\r
70   "Eliminates divisor from fraction if present"\r
71   (while (and (= 0 (% (car result) divisor))\r
72               (= 0 (% (cadr result) divisor))\r
73               (< 1 (cadr result))\r
74               (< 0 (car result)))\r
75     (set 'result (list (/ (car result) divisor) (/ (cadr result) divisor))))\r
76   result\r
77 )\r
78 \r
79 \r
80 (defun parse-duration (duration)\r
81   "Returns a duration string parsed as '(numerator denominator)"\r
82   (string-match duration-regex duration)\r
83   (let ((result (list 1 (string-to-int (extract-match duration 2))))\r
84         (dots (extract-match duration 4))\r
85         (numerator (or (extract-match duration 6) "1"))\r
86         (denominator (or (extract-match duration 8) "1")))\r
87     (if (and (not (null dots)) (< 0 (string-width dots)))\r
88         (dotimes (dummy (string-width dots))\r
89           (set 'result (list (1+ (* 2 (car result))) (* 2 (cadr result))))))\r
90     (list (* (string-to-int numerator) (car result))\r
91           (* (string-to-int denominator) (cadr result)))\r
92 ))\r
93 \r
94 (defun walk-note-duration ()\r
95 "Returns duration of next note, moving point past note.\r
96 If point is not before a note, returns nil\r
97 If next note has no duration, returns t"\r
98   (if (not (looking-at pitch-regex))\r
99       nil\r
100     (progn\r
101       (goto-char (match-end 0))\r
102       (if (not (looking-at duration-regex))\r
103           t\r
104         (progn\r
105           (goto-char (match-end 0))\r
106           (parse-duration (match-string 0)))))))\r
107 \r
108 ; returns nil if not at a comment\r
109 (defun skip-comment ()\r
110   (if (not (char-equal ?\% (following-char)))\r
111       nil\r
112     (progn\r
113       (forward-char)\r
114       (if (char-equal ?\{ (following-char))\r
115           (re-search-forward "}%" nil t)\r
116         (progn\r
117           (skip-chars-forward "^\n")\r
118           (forward-char)))\r
119       t\r
120 )))\r
121 \r
122 ; returns nil if not at a quotation\r
123 (defun skip-quotation ()\r
124   (if (not (char-equal ?\" (following-char)))\r
125       nil\r
126     (progn\r
127       (forward-char)\r
128       (skip-chars-forward "^\"")\r
129       (forward-char)\r
130       t\r
131 )))\r
132 \r
133 ; returns nil if not at a sexp\r
134 (defun skip-sexp ()\r
135   (interactive)\r
136   (if (not (char-equal ?\# (following-char)))\r
137       nil\r
138     (progn\r
139       (forward-char)\r
140       (if (char-equal ?\' (following-char))\r
141           (forward-char))\r
142       (if (not (char-equal ?\( (following-char)))\r
143           (skip-chars-forward "^ \t\n")\r
144         (progn\r
145           (let ((paren 1))\r
146             (while (< 0 paren)\r
147               (forward-char)\r
148               (cond ((char-equal ?\( (following-char))\r
149                      (setq paren (1+ paren)))\r
150                     ((char-equal ?\) (following-char))\r
151                      (setq paren (1- paren)))))\r
152             (forward-char)\r
153             t\r
154 ))))))\r
155 \r
156 (defun goto-note-begin ()\r
157   (interactive)\r
158   ; skip anything that is not ws. And skip any comments or quotations\r
159   (while (or (< 0 (skip-chars-forward "^ \t\n~%#\""))\r
160              (skip-comment)\r
161              (skip-quotation)\r
162              (skip-sexp)))\r
163   ; Now skip anything that isn't alphanum or \. And skip comments or quotations\r
164   (while (or (< 0 (skip-chars-forward "^A-Za-z<%}#=\""))\r
165              (skip-comment)\r
166              (skip-quotation)\r
167              (skip-sexp)))\r
168   ; (skip-chars-forward "^\\") Why doesn't this work?!!\r
169   (if (char-equal ?\\ (preceding-char))\r
170       (backward-char))\r
171 )\r
172 \r
173 \r
174 (defun skip-good-keywords ()\r
175   (if (looking-at "\\\\\\([a-z]*\\)")\r
176       (progn\r
177         (goto-char (match-end 0))\r
178         (if (member (match-string 1) Parm-Keywords)\r
179             (progn\r
180               (if (looking-at "[ \t\n]*?\\([a-z0-9_]+\\|{[^}]*}\\|\"[^\"]*\"\\)")\r
181                   (goto-char (match-end 0))\r
182                 (error "Improper regex match:")\r
183                 (error "Unknown text: %s")\r
184 ))))))\r
185 \r
186 (defun find-measure-start ()\r
187   (let ((start (re-search-backward "\|" 0 t)))\r
188     (if (null start)\r
189         -1\r
190       (if (looking-at "[^ \n\t]*\"")\r
191           (find-measure-start)\r
192         (point)\r
193 ))))\r
194 \r
195 (defun get-beat ()\r
196   (save-excursion\r
197     (save-restriction\r
198       (let* ((end (point))\r
199              (measure-start (find-measure-start))\r
200              (last-dur (or (re-search-backward duration-regex 0 t) -1))\r
201              (duration (if (= -1 last-dur) 0 (parse-duration (match-string 0))))\r
202              (result '(0 1)))           ; 0 in fraction form\r
203         (if (= measure-start -1)\r
204             (error "No | before point")\r
205           (progn\r
206             (goto-char (1+ measure-start))\r
207             (goto-note-begin)\r
208             (while (< (point) end)\r
209               (set 'new-duration (walk-note-duration))\r
210               (if (null new-duration)\r
211                   (if (not (looking-at "\\\\times[ \t]*\\([1-9]*\\)/\\([1-9]*\\)[ \t\n]*{"))\r
212                       (skip-good-keywords)\r
213 \r
214                                         ; handle \times specially\r
215                     (let ((numerator (string-to-int (match-string 1)))\r
216                           (denominator (string-to-int (match-string 2))))\r
217                       (goto-char (match-end 0))\r
218                       (goto-note-begin)\r
219                       (while (and (not (looking-at "}"))\r
220                                   (< (point) end))\r
221                         (set 'new-duration (walk-note-duration))\r
222                         (if (null new-duration)\r
223                             (if (looking-at "\\\\[a-z]*[ \t]*[a-z]*")\r
224                                 (goto-char (match-end 0))\r
225                               (error "Unknown text: %S %s" result(buffer-substring (point) end))))\r
226                         (if (not (eq new-duration t))\r
227                             (set 'duration new-duration))\r
228                         (set 'result (add-fractions result\r
229                                                     (list (* numerator (car duration))\r
230                                                           (* denominator (cadr duration)))))\r
231                         (goto-note-begin))\r
232                       (if (< (point) end)\r
233                           (forward-char 1)))) ; skip }\r
234 \r
235                 (if (not (eq new-duration t))\r
236                     (set 'duration new-duration))\r
237                 (set 'result (add-fractions result duration)))\r
238               (goto-note-begin))\r
239 \r
240             result\r
241 ))))))\r
242 \r
243 (defun LilyPond-what-beat ()\r
244   "Returns how much of a measure lies between last measaure '|' and point.\r
245 Recognizes chords, and triples."\r
246   (interactive)\r
247   (let ((beat (get-beat)))\r
248     (message "Beat: %d/%d" (car beat) (cadr beat)))\r
249 )\r
250 \r
251 (defun LilyPond-electric-bar ()\r
252   "Indicate the number of beats in last measure when a | is inserted"\r
253   (interactive)\r
254   (self-insert-command 1)\r
255   (save-excursion\r
256     (save-restriction\r
257       (backward-char)\r
258       (LilyPond-what-beat)\r
259       (forward-char)\r
260 )))\r
261 \r
262 \r