--- /dev/null
+; Features:\r
+;\r
+; -> Counts number of notes between last | and point. Adds durations of\r
+; each note up, and returns result.\r
+;\r
+; -> Works well on notes and chords.\r
+;\r
+; -> Ignores most keywords, like \override\r
+;\r
+; -> Is aware of certain keywords which often contain parameters that\r
+; look like notes, but should not be counted.\r
+; | a \key b \minor c % b is not counted, but a and c are.\r
+;\r
+; -> Ignores Scheme expressions, which start with #\r
+;\r
+; -> Doesn't ignore the \times keyword. Intelligently handles triplets.\r
+; \r
+;\r
+; Caveats:\r
+;\r
+; -> Doesn't work on regions that aren't preceded by a |. This is because such\r
+; notes are only delimited by a {, and what-beat can't distinguish a { that\r
+; opens a set of notes from an internal { (say from a triplet)\r
+;\r
+; -> Doesn't work with << >> expressions or nested {} expressions (unless\r
+; {} is part of a keyword like \times)\r
+;\r
+; -> Keywords abutted against a note are not visible to what-beat, and \r
+; can therefore surreptitiosly sneak fake notes into what-beat.\r
+; | c\glissando f <- BAD: the f gets counted, but shouldn't\r
+; | c \glissando f <- GOOD: the f gets ignored\r
+;\r
+; -> Does not look outside notes context. Derivation rules don't work:\r
+; str = \notes { a8 b c d }\r
+; \score { \notes { | e4 %{ gets counted }% \str %{gets ignored}%\r
+;\r
+; -> Does not handle repeats.\r
+;\r
+\r
+; Recognizes pitch & octave\r
+(setq pitch-regex "\\([a-z]+[,']*\\|<[^>]*>\\)\\(=[,']*\\)?")\r
+; Recognizes duration\r
+(setq duration-regex "[ \t\n]*\\(\\(\\(128\\|6?4\\|3?2\\|16?\\|8\\)\\([.]*\\)\\)\\([ \t]*[*][ \t]*\\([0-9]+\\)\\(/\\([1-9][0-9]*\\)\\)?\\)?\\)")\r
+\r
+; These keywords precede notes that should not be counted during beats\r
+(setq Parm-Keywords '("key" "clef" "appoggiatura" "acciaccatura" "grace"\r
+ "override" "revert" "glissando"))\r
+\r
+\r
+(defun extract-match (string match-num)\r
+ (if (null (match-beginning match-num))\r
+ nil\r
+ (substring string (match-beginning match-num) (match-end match-num))))\r
+\r
+\r
+(defun add-fractions (f1 f2)\r
+ "Adds two fractions, both are (numerator denominator)"\r
+ (set 'result (list (+ (* (car f1) (cadr f2)) (* (car f2) (cadr f1)))\r
+ (* (cadr f1) (cadr f2))))\r
+ (set 'result (reduce-fraction result 2))\r
+ (set 'result (reduce-fraction result 3))\r
+ (set 'result (reduce-fraction result 5))\r
+ (set 'result (reduce-fraction result 7))\r
+)\r
+\r
+\r
+(defun reduce-fraction (f divisor)\r
+ "Eliminates divisor from fraction if present"\r
+ (while (and (= 0 (% (car result) divisor))\r
+ (= 0 (% (cadr result) divisor))\r
+ (< 1 (cadr result))\r
+ (< 0 (car result)))\r
+ (set 'result (list (/ (car result) divisor) (/ (cadr result) divisor))))\r
+ result\r
+)\r
+\r
+\r
+(defun parse-duration (duration)\r
+ "Returns a duration string parsed as '(numerator denominator)"\r
+ (string-match duration-regex duration)\r
+ (let ((result (list 1 (string-to-int (extract-match duration 2))))\r
+ (dots (extract-match duration 4))\r
+ (numerator (or (extract-match duration 6) "1"))\r
+ (denominator (or (extract-match duration 8) "1")))\r
+ (if (and (not (null dots)) (< 0 (string-width dots)))\r
+ (dotimes (dummy (string-width dots))\r
+ (set 'result (list (1+ (* 2 (car result))) (* 2 (cadr result))))))\r
+ (list (* (string-to-int numerator) (car result))\r
+ (* (string-to-int denominator) (cadr result)))\r
+))\r
+\r
+(defun walk-note-duration ()\r
+"Returns duration of next note, moving point past note.\r
+If point is not before a note, returns nil\r
+If next note has no duration, returns t"\r
+ (if (not (looking-at pitch-regex))\r
+ nil\r
+ (progn\r
+ (goto-char (match-end 0))\r
+ (if (not (looking-at duration-regex))\r
+ t\r
+ (progn\r
+ (goto-char (match-end 0))\r
+ (parse-duration (match-string 0)))))))\r
+\r
+; returns nil if not at a comment\r
+(defun skip-comment ()\r
+ (if (not (char-equal ?\% (following-char)))\r
+ nil\r
+ (progn\r
+ (forward-char)\r
+ (if (char-equal ?\{ (following-char))\r
+ (re-search-forward "}%" nil t)\r
+ (progn\r
+ (skip-chars-forward "^\n")\r
+ (forward-char)))\r
+ t\r
+)))\r
+\r
+; returns nil if not at a quotation\r
+(defun skip-quotation ()\r
+ (if (not (char-equal ?\" (following-char)))\r
+ nil\r
+ (progn\r
+ (forward-char)\r
+ (skip-chars-forward "^\"")\r
+ (forward-char)\r
+ t\r
+)))\r
+\r
+; returns nil if not at a sexp\r
+(defun skip-sexp ()\r
+ (interactive)\r
+ (if (not (char-equal ?\# (following-char)))\r
+ nil\r
+ (progn\r
+ (forward-char)\r
+ (if (char-equal ?\' (following-char))\r
+ (forward-char))\r
+ (if (not (char-equal ?\( (following-char)))\r
+ (skip-chars-forward "^ \t\n")\r
+ (progn\r
+ (let ((paren 1))\r
+ (while (< 0 paren)\r
+ (forward-char)\r
+ (cond ((char-equal ?\( (following-char))\r
+ (setq paren (1+ paren)))\r
+ ((char-equal ?\) (following-char))\r
+ (setq paren (1- paren)))))\r
+ (forward-char)\r
+ t\r
+))))))\r
+\r
+(defun goto-note-begin ()\r
+ (interactive)\r
+ ; skip anything that is not ws. And skip any comments or quotations\r
+ (while (or (< 0 (skip-chars-forward "^ \t\n~%#\""))\r
+ (skip-comment)\r
+ (skip-quotation)\r
+ (skip-sexp)))\r
+ ; Now skip anything that isn't alphanum or \. And skip comments or quotations\r
+ (while (or (< 0 (skip-chars-forward "^A-Za-z<%}#=\""))\r
+ (skip-comment)\r
+ (skip-quotation)\r
+ (skip-sexp)))\r
+ ; (skip-chars-forward "^\\") Why doesn't this work?!!\r
+ (if (char-equal ?\\ (preceding-char))\r
+ (backward-char))\r
+)\r
+\r
+\r
+(defun skip-good-keywords ()\r
+ (if (looking-at "\\\\\\([a-z]*\\)")\r
+ (progn\r
+ (goto-char (match-end 0))\r
+ (if (member (match-string 1) Parm-Keywords)\r
+ (progn\r
+ (if (looking-at "[ \t\n]*\\([a-z0-9_]+\\|{[^}]*}\\)")\r
+ (goto-char (match-end 0))\r
+ (error "Improper regex match:")\r
+ (error "Unknown text: %s")\r
+))))))\r
+\r
+(defun get-beat ()\r
+ (save-excursion\r
+ (save-restriction\r
+ (let* ((end (point))\r
+ (measure-start (or (re-search-backward "\|" 0 t) -1))\r
+ (last-dur (or (re-search-backward duration-regex 0 t) -1))\r
+ (duration (if (= -1 last-dur) 0 (parse-duration (match-string 0))))\r
+ (result '(0 1))) ; 0 in fraction form\r
+ (if (= measure-start -1)\r
+ (error "No | before point")\r
+ (progn\r
+ (goto-char (1+ measure-start))\r
+ (goto-note-begin)\r
+ (while (< (point) end)\r
+ (set 'new-duration (walk-note-duration))\r
+ (if (null new-duration)\r
+ (if (not (looking-at "\\\\times[ \t]*\\([1-9]*\\)/\\([1-9]*\\)[ \t\n]*{"))\r
+ (skip-good-keywords)\r
+\r
+ ; handle \times specially\r
+ (let ((numerator (string-to-int (match-string 1)))\r
+ (denominator (string-to-int (match-string 2))))\r
+ (goto-char (match-end 0))\r
+ (goto-note-begin)\r
+ (while (and (not (looking-at "}"))\r
+ (< (point) end))\r
+ (set 'new-duration (walk-note-duration))\r
+ (if (null new-duration)\r
+ (if (looking-at "\\\\[a-z]*[ \t]*[a-z]*")\r
+ (goto-char (match-end 0))\r
+ (error "Unknown text: %S %s" result(buffer-substring (point) end))))\r
+ (if (not (eq new-duration t))\r
+ (set 'duration new-duration))\r
+ (set 'result (add-fractions result\r
+ (list (* numerator (car duration))\r
+ (* denominator (cadr duration)))))\r
+ (goto-note-begin))\r
+ (if (< (point) end)\r
+ (forward-char 1)))) ; skip }\r
+\r
+ (if (not (eq new-duration t))\r
+ (set 'duration new-duration))\r
+ (set 'result (add-fractions result duration)))\r
+ (goto-note-begin))\r
+\r
+ result\r
+))))))\r
+\r
+(defun LilyPond-what-beat ()\r
+ "Returns how much of a measure lies between last measaure '|' and point.\r
+Recognizes chords, and triples."\r
+ (interactive)\r
+ (let ((beat (get-beat)))\r
+ (message "Beat: %d/%d" (car beat) (cadr beat)))\r
+)\r
+\r
+(defun LilyPond-electric-bar ()\r
+ "Indicate the number of beats in last measure when a | is inserted"\r
+ (interactive)\r
+ (self-insert-command 1)\r
+ (save-excursion\r
+ (save-restriction\r
+ (backward-char)\r
+ (LilyPond-what-beat)\r
+ (forward-char)\r
+)))\r
+\r
+\r
projects / lilypond.git / commitdiff