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