--- /dev/null
+;; $RCSfile: lyqi-base.el,v $
+;; $Revision: 1.5 $
+;; $Date: 2003/09/27 16:59:27 $
+;; $Author: nicolas $
+;;;
+;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
+;;; for quick note insertion while editing GNU LilyPond music scores.
+;;;
+;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; See http://nicolas.sceaux.free.fr/lilypond/
+;;;
+
+(eval-when-compile (require 'cl))
+(require 'eieio)
+
+;;;;;;;;;;;;;;;;
+
+(defconst mudela-translation-table
+ '((pitch . ((nederlands . ["c" "d" "e" "f" "g" "a" "b"])
+ (english . ["c" "d" "e" "f" "g" "a" "b"])
+ (deutsch . ["c" "d" "e" "f" "g" "a" "h"])
+ (norsk . ["c" "d" "e" "f" "g" "a" "h"])
+ (svenska . ["c" "d" "e" "f" "g" "a" "h"])
+ (italiano . ["do" "re" "mi" "fa" "sol" "la" "si"])
+ (catalan . ["do" "re" "mi" "fa" "sol" "la" "si"])
+ (espanol . ["do" "re" "mi" "fa" "sol" "la" "si"])))
+ (accidental . ((nederlands . ["eses" "es" "" "is" "isis"])
+ (english . ["ff" "f" "" "s" "ss"])
+ (deutsch . ["eses" "es" "" "is" "isis"])
+ (norsk . ["essess" "ess" "" "iss" "ississ"])
+ (svenska . ["essess" "ess" "" "iss" "ississ"])
+ (italiano . ["bb" "b" "" "d" "dd"])
+ (catalan . ["bb" "b" "" "d" "dd"])
+ (espanol . ["bb" "b" "" "s" "ss"])))
+ (replacements . ((nederlands . (("eeses" "eses") ("ees" "es")
+ ("aeses" "ases") ("aes" "as")))
+ (deutsch . (("hes" "b") ;("heses" "bes")
+ ("eeses" "eses") ("ees" "es")
+ ("aeses" "ases") ("aes" "as")))
+ (norsk . (("eessess" "essess") ("eess" "ess")
+ ("hess" "b") ("hessess" "bess")))
+ (svenska . (("eessess" "essess") ("eess" "ess")
+ ("aessess" "assess") ("aess" "ass")
+ ("hess" "b") ("hessess" "bess")))))
+ (rest . "r")
+ (skip . "s")
+ (octave-up . ?')
+ (octave-down . ?,)
+ (dot . ?.)
+ (reminder-accidental . ?!)
+ (cautionary-accidental . ??)))
+
+(defclass mudela-editing-state ()
+ ((translation-table :initarg :translation-table
+ :initform nil
+ :documentation "A mudela string or character <---> internal value translation table.")
+ (language :initarg :language
+ :initform nederlands
+ :documentation "Current output language")
+ (relative-octave :initarg :relative-octave
+ :initform nil
+ :documentation "Current octave mode. relative if non-nil, absolute otherwise.")
+ (force-duration :initarg :force-duration
+ :initform t
+ :documentation "Current duration output mode. always present if non-nil, ellipsed otherwise")
+ (pitch-dict :initarg :pitch-dict
+ :initform nil
+ :documentation "A mudela<->internal values dictionnnary for pitches and alterations")
+ (alterations :initarg :alterations
+ :initform [2 2 2 2 2 2 2]
+ :documenation "Last alteration for each note."))
+ "The current editing state : octave mode, language, etc.")
+
+;; (defmethod init-state ((editing-state mudela-editing-state) &optional lang)
+;; "Initialize `editing-state' pitch-dict due to `lang',
+;; and `translation-table' to `mudela-translation-table'."
+;; (setf (slot-value editing-state 'translation-table) mudela-translation-table)
+;; (with-slots (language) editing-state
+;; (set-language editing-state (or lang language)))
+;; editing-state)
+
+(defmethod get-translation ((editing-state mudela-editing-state) key)
+ "Return the value corresponding to `key' in `translation-table'"
+ (with-slots (translation-table) editing-state
+ (cdr (assoc key translation-table))))
+
+(defmethod get-pitch ((editing-state mudela-editing-state) pitch-string)
+ "Return a (pitch . alteration) pair corresponding to `pitch-string' in `pitch-dict' (if any)"
+ (with-slots (pitch-dict) editing-state
+ (car (rassoc pitch-string pitch-dict))))
+
+(defmethod get-pitch-string ((editing-state mudela-editing-state) pitch alteration)
+ "Return the mudela pitch string corresponding to the (`pitch' . `alteration') pair
+in `pitch-dict' (if any)"
+ (with-slots (pitch-dict) editing-state
+ (cdr (assoc (cons pitch alteration) pitch-dict))))
+
+(defmethod set-language ((editing-state mudela-editing-state) lang)
+ "Set the editing-state object's language and update its pitch-dict accordingly."
+ (labels ((get-translation2 (key)
+ (cdr (assoc lang (get-translation editing-state key)))))
+ (setf (slot-value editing-state 'language) (if (stringp lang) (intern lang) lang))
+ (setf (slot-value editing-state 'pitch-dict)
+ (let (dict)
+ (dotimes (pitch 7 (nreverse dict))
+ (dotimes (alter 5 dict)
+ (setq dict
+ (cons (cons (cons pitch alter)
+ (let ((note (concat (aref (get-translation2 'pitch) pitch)
+ (aref (get-translation2 'accidental) alter))))
+ (or (cadr (assoc note (get-translation2 'replacements)))
+ note)))
+ dict))))))
+ lang))
+
+;;;;;;;;;;;;;;;
+
+(defclass mudela-note-state ()
+ ((pitch :initarg :pitch
+ :initform 0
+ :documentation "Previous note pitch")
+ (octave :initarg :octave
+ :initform 1
+ :documentation "Previous note octave")
+ (duration :initarg :duration
+ :initform 3
+ :documentation "Previous music token duration")
+ (dots :initarg :dots
+ :initform 0
+ :documentation "Previous music token dot number"))
+ "Describe the current note state : current octave, duration, etc.")
+
+;;;;;;;;;;;;;;;;
+
+(defclass mudela-word ()
+ ((editing-state :allocation :class
+ :documentation "The current editing state (language, relative/absolute octaves, etc),
+used to generate mudela strings"))
+ "Base class for mudela words: notes, rests, skips, etc.")
+
+(defmethod mudela-string ((word mudela-word) &optional note-state)
+ "(return an empty string. should be reimplemented by derived classes)"
+ "")
+
+(defmethod set-alteration-up ((word mudela-word))
+ "Increase, if possible, the word alteration."
+ nil)
+
+(defmethod set-alteration-down ((word mudela-word))
+ "Decrease, if possible, the word alteration."
+ nil)
+
+(defmethod set-alteration-natural ((word mudela-word))
+ "Set, if possible, the word alteration to natural."
+ nil)
+
+(defmethod set-octave-up ((word mudela-word))
+ "Increase the word's octave."
+ nil)
+
+(defmethod set-octave-down ((word mudela-word))
+ "Decrease the word's octave."
+ nil)
+
+(defmethod set-octave-zero ((word mudela-word))
+ "Set the note octave to zero."
+ nil)
+
+(defmethod set-duration ((word mudela-word) duration)
+ "Set the word's duration."
+ duration)
+
+(defmethod set-dots ((word mudela-word))
+ "Increase, modulo 5, the word's dot number."
+ nil)
+
+(defmethod set-reminder-alt ((word mudela-word))
+ "Change reminder alteration state for word."
+ nil)
+
+(defmethod set-cautionary-alt ((word mudela-word))
+ "Change cautionary alteration state for word."
+ nil)
+
+(defmethod transpose ((word mudela-word) note-diff exact-pitch-diff &optional note-state)
+ "Transpose `word'."
+ word)
+
+(defclass mudela-word-duration (mudela-word)
+ ((duration :initarg :duration
+ :initform 3 ; 2^(3 - 1) = 4 ==> quater note
+ :documentation "duration, from 1 to 8. real-duration = 2^(duration - 1)")
+ (dots :initarg :dots
+ :initform 0 ; no dot
+ :documentation "dots, from 0 (no dot) to N>0 (N dots)"))
+ "A mudela word that have a duration information.")
+
+(defmethod set-duration ((word mudela-word-duration) duration)
+ "Set the word's duration."
+ (setf (slot-value word 'dots) 0)
+ (setf (slot-value word 'duration) duration))
+
+(defmethod set-dots ((word mudela-word-duration))
+ "Increase, modulo 5, the word's dot number."
+ (setf (slot-value word 'dots)
+ (mod (1+ (slot-value word 'dots)) 5)))
+
+(defmethod update-note-state ((word mudela-word-duration) note-state)
+ "Update the current `note-state' thanks to the given music `word': duration and dots."
+ (with-slots (duration dots) word
+ (setf (slot-value note-state 'duration) duration)
+ (setf (slot-value note-state 'dots) dots))
+ note-state)
+
+(defmethod mudela-duration ((word mudela-word-duration) &optional note-state)
+ "Return the mudela duration string for `word'. If `editing-state'
+indicates that duration is facultative, and `note-state' duration
+and dots are the same that `word' duration and dots, the string is empty."
+ (with-slots (duration dots editing-state) word
+ (if (and (not (slot-value editing-state 'force-duration))
+ note-state
+ (= duration (slot-value note-state 'duration))
+ (= dots (slot-value note-state 'dots)))
+ ;; same duration and dots, and user permit duration ellipse
+ ""
+ (format "%d%s"
+ (expt 2 (1- duration))
+ (make-string dots (get-translation editing-state 'dot))))))
+
+(defclass mudela-note (mudela-word-duration)
+ ((pitch :initarg :pitch
+ :initform 0 ; do / c
+ :documentation "note pitch, from 0 (do / c) to 6 (si / b)")
+ (alteration :initarg :alteration
+ :initform 2 ; becarre / natural
+ :documentation "note alteration, from 0 (bb) to 4 (##)")
+ (octave :initarg :octave
+ :initform 1
+ :documentation "note octave, 0 being the octave starting with the do / c
+which is in the 2nd interline in bass clef (4th line F clef)")
+ (reminder-accidental :initarg :reminder-accidental
+ :initform nil
+ :documentation "if non-nil, force a reminder accidental")
+ (cautionary-accidental :initarg :cautionary-accidental
+ :initform nil
+ :documentation "if non-nil and reminder-accidental is nil,
+indicate a cautionary accidental"))
+ "Note : duration and pitch")
+
+(defmethod set-alteration-natural ((note mudela-note))
+ "Set notes's alteration to natural"
+ ;; we update the alterations table in the current editing state
+ (aset (slot-value (slot-value note 'editing-state) 'alterations)
+ (slot-value note 'pitch)
+ 2)
+ ;; reset reminder and cautionary slots
+ (setf (slot-value note 'cautionary-accidental) nil)
+ (setf (slot-value note 'reminder-accidental) nil)
+ (setf (slot-value note 'alteration) 2))
+
+(defmethod set-alteration-up ((note mudela-note))
+ "Increase, if possible, the note alteration."
+ (with-slots (alteration) note
+ (when (< alteration 4)
+ ;; we update the alterations table in the current editing state
+ (aset (slot-value (slot-value note 'editing-state) 'alterations)
+ (slot-value note 'pitch)
+ (1+ alteration))
+ ;; reset reminder and cautionary slots
+ (setf (slot-value note 'cautionary-accidental) nil)
+ (setf (slot-value note 'reminder-accidental) nil)
+ (setf (slot-value note 'alteration) (1+ alteration)))))
+
+(defmethod set-alteration-down ((note mudela-note))
+ "Decrease, if possible, the note alteration."
+ (with-slots (alteration) note
+ (when (> alteration 0)
+ ;; we update the alterations table in the current editing state
+ (aset (slot-value (slot-value note 'editing-state) 'alterations)
+ (slot-value note 'pitch)
+ (1- alteration))
+ ;; reset reminder and cautionary slots
+ (setf (slot-value note 'cautionary-accidental) nil)
+ (setf (slot-value note 'reminder-accidental) nil)
+ (setf (slot-value note 'alteration) (1- alteration)))))
+
+(defmethod set-octave-up ((note mudela-note))
+ "Increase the note's octave."
+ (with-slots (octave) note
+ (when (< octave 4)
+ (setf (slot-value note 'octave) (1+ octave)))))
+
+(defmethod set-octave-down ((note mudela-note))
+ "Decrease the note's octave."
+ (with-slots (octave) note
+ (when (> octave -3)
+ (setf (slot-value note 'octave) (1- octave)))))
+
+(defmethod set-octave-zero ((note mudela-note))
+ "Set the note octave to zero."
+ (setf (slot-value note 'octave) 0))
+
+(defmethod set-reminder-alt ((note mudela-note))
+ "Change reminder alteration state for note."
+ (with-slots (reminder-accidental) note
+ (setf (slot-value note 'reminder-accidental) (not reminder-accidental))))
+
+(defmethod set-cautionary-alt ((note mudela-note))
+ "Change cautionary alteration state for note."
+ (with-slots (cautionary-accidental) note
+ (unless cautionary-accidental
+ (setf (slot-value note 'reminder-accidental) nil))
+ (setf (slot-value note 'cautionary-accidental) (not cautionary-accidental))))
+
+(defmethod update-note-state ((note mudela-note) note-state)
+ "Update the current `note-state' thanks to the given `note': duration, dots, pitch and octave."
+ (call-next-method)
+ (with-slots (pitch octave) note
+ (setf (slot-value note-state 'pitch) pitch)
+ (setf (slot-value note-state 'octave) octave))
+ note-state)
+
+(defmethod mudela-string ((note mudela-note) &optional note-state)
+ "Return the mudela string for `note', depending on the context
+given by `editing-state' and `note-state': pitch, accidental, octave,
+duration (with dots), reminder or cautionary accidental."
+ (format "%s%s%s%s"
+ (mudela-pitch note)
+ (mudela-octave note note-state)
+ (mudela-chromatic note)
+ (mudela-duration note note-state)))
+
+(defmethod mudela-pitch ((note mudela-note))
+ "Return the mudela pitch (with alteration) string for `note'"
+ (with-slots (pitch alteration editing-state) note
+ (get-pitch-string editing-state pitch alteration)))
+
+(defmethod mudela-octave ((note mudela-note) &optional note-state)
+ "Return the mudela octave string for `note'. In case of relative octave mode,
+`note-state' is mandatory."
+ (with-slots (pitch octave editing-state) note
+ (if (slot-value editing-state 'relative-octave)
+ ;; relative octave
+ (when note-state
+ (let ((abspitch1 (+ (* 7 (slot-value note-state 'octave))
+ (slot-value note-state 'pitch)))
+ (abspitch2 (+ (* 7 octave) pitch)))
+ (if (< (abs (- abspitch1 abspitch2)) 4)
+ "" ; same relative octave
+ (if (> abspitch1 abspitch2)
+ (make-string (+ (/ (- abspitch1 abspitch2 4) 7) 1)
+ (get-translation editing-state 'octave-down))
+ (make-string (+ (/ (- abspitch2 abspitch1 4) 7) 1)
+ (get-translation editing-state 'octave-up))))))
+ ;; absolute octave
+ (if (> octave 0)
+ (make-string octave (get-translation editing-state 'octave-up))
+ (make-string (* -1 octave) (get-translation editing-state 'octave-down))))))
+
+(defmethod mudela-chromatic ((note mudela-note))
+ "Return the mudela chromatic information string for `note'."
+ (with-slots (reminder-accidental cautionary-accidental editing-state) note
+ (cond (reminder-accidental
+ (char-to-string (get-translation editing-state 'reminder-accidental)))
+ (cautionary-accidental
+ (char-to-string (get-translation editing-state 'cautionary-accidental)))
+ (t ""))))
+
+(defmethod midi-pitch ((note mudela-note))
+ "Return `note''s midi pitch, from 0 to 127."
+ (with-slots (pitch alteration octave) note
+ (+ (aref [0 2 4 5 7 9 11] pitch)
+ (- alteration 2)
+ (* octave 12)
+ 48)))
+
+(defmethod transpose ((note mudela-note) note-diff exact-pitch-diff)
+ "Transpose `note'. Ex: (transpose [do] -5 -9) -> [mib,]"
+ (with-slots (pitch octave alteration) note
+ (let ((newnote (copy-sequence note)))
+ ;; pitch
+ (setf (slot-value newnote 'pitch) (mod (+ pitch note-diff) 7))
+ ;; octave
+ (cond ((< (+ pitch note-diff) 0)
+ (setf (slot-value newnote 'octave)
+ (+ octave (/ (+ pitch note-diff -6) 7))))
+ ((> (+ pitch note-diff) 6)
+ (setf (slot-value newnote 'octave)
+ (+ octave (/ (+ pitch note-diff) 7)))))
+ ;; alteration
+ (setf (slot-value newnote 'alteration)
+ (min (max (+ (- exact-pitch-diff (- (midi-pitch newnote) (midi-pitch note)))
+ alteration)
+ 0)
+ 4))
+ newnote)))
+
+
+(defclass mudela-rest (mudela-word-duration)
+ nil
+ "Rest.")
+
+(defmethod mudela-string ((rest mudela-rest) &optional note-state)
+ "Return the mudela string for `rest'."
+ (with-slots (editing-state) rest
+ (format "%s%s"
+ (get-translation editing-state 'rest)
+ (mudela-duration rest note-state))))
+
+(defclass mudela-skip (mudela-word-duration)
+ nil
+ "Skip.")
+
+(defmethod mudela-string ((skip mudela-skip) &optional note-state)
+ "Return the mudela string for `skip'."
+ (with-slots (editing-state) skip
+ (format "%s%s"
+ (get-translation editing-state 'skip)
+ (mudela-duration skip note-state))))
+
+(defclass mudela-verbatim (mudela-word)
+ ((text :initarg :text
+ :initform ""
+ :documentation "Verbatim mudela text, storing not recognized mudela words"))
+ "Not recognized text")
+
+(defmethod update-note-state ((verbatim mudela-verbatim) note-state)
+ "(do nothing)"
+ note-state)
+
+(defmethod mudela-string ((verbatim mudela-verbatim) &optional note-state)
+ "Return the verbatim mudela string contained in this object"
+ (with-slots (text) verbatim
+ text))
+
+(provide 'lyqi-base)
--- /dev/null
+;; $RCSfile: lyqi-editor.el,v $
+;; $Revision: 1.6 $
+;; $Date: 2004/03/14 15:15:54 $
+;; $Author: nicolas $
+;;;
+;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
+;;; for quick note insertion while editing GNU LilyPond music scores.
+;;;
+;;; (c) 2003 copyright Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; See http://nicolas.sceaux.free.fr/lilypond/
+;;;
+
+(eval-when-compile (require 'cl))
+(require 'eieio)
+(require 'lyqi-base)
+(require 'lyqi-parser)
+
+(unless (fboundp 'object-of-class-p)
+ (defun object-of-class-p (obj class)
+ (obj-of-class-p obj class)))
+
+(defun lyqi-just-one-space ()
+ "Invoke `just-one-space', unless point is at the beginning of a line."
+ (unless (bolp)
+ (just-one-space)))
+
+(defclass mudela-editor ()
+ ((editing-state :initarg :editing-state
+ :documentation "The current editing state (language, relative/absolute octaves, etc),
+used to generate mudela regexps")
+ (parser :initarg :parser
+ :documentation "A mudela-parser instance used to read buffer.")
+ (note-state :initarg :note-state
+ :documentation "Current note state."))
+ "A mudela parser: basic mudela edition, such as insert/deleting/updating notes.")
+
+(defmethod point-note-state ((editor mudela-editor))
+ "Return a note state deduced thanks to words preceding point."
+ (with-slots (parser note-state) editor
+ (let* ((fake-note-state (make-instance 'mudela-note-state :duration nil :dots 0))
+ (prev-duration-word ;; the previous word with explicit duration
+ (save-excursion
+ (do ((word-descr (get-word parser fake-note-state t)
+ (get-word parser fake-note-state t)))
+ ((or (null (car word-descr))
+ (<= (point) (point-min))))
+ (when (and (object-of-class-p (car word-descr) 'mudela-word-duration)
+ (slot-value (car word-descr) 'duration))
+ (return (car word-descr)))
+ (goto-char (cadr word-descr)))))
+ (duration ;; duration of that duration word
+ (if prev-duration-word
+ (slot-value prev-duration-word 'duration)
+ (slot-value note-state 'duration)))
+ (dots ;; number of dots in that duration word
+ (if prev-duration-word
+ (slot-value prev-duration-word 'dots)
+ (slot-value note-state 'dots)))
+ (prev-note ;; the previous note
+ (save-excursion
+ (do ((word-descr (get-word parser note-state t)
+ (get-word parser note-state t)))
+ ((or (null (car word-descr))
+ (<= (point) (point-min))))
+ (when (mudela-note-p (car word-descr))
+ (return (car word-descr)))
+ (goto-char (cadr word-descr)))))
+ (pitch ;; the pitch of that note
+ (if prev-note
+ (slot-value prev-note 'pitch)
+ (slot-value note-state 'pitch)))
+ (octave ;; the octave of that note
+ (if (and prev-note (not (slot-value (slot-value parser 'editing-state)
+ 'relative-octave)))
+ (slot-value prev-note 'octave)
+ (slot-value note-state 'octave))))
+ (make-instance 'mudela-note-state
+ :pitch pitch
+ :octave octave
+ :duration duration
+ :dots dots))))
+
+(defmethod delete-word ((editor mudela-editor) &optional (backward t))
+ "Delete the first recognized word after (if `backward' is nil)
+or before (otherwise) point (if any)."
+ (with-slots (parser note-state) editor
+ (destructuring-bind (word beginning end) (get-word parser note-state t)
+ (when word
+ (delete-region beginning end)
+ (goto-char beginning)
+ (lyqi-just-one-space)
+ (backward-char)))))
+
+(defmethod make-note ((editor mudela-editor) pitch)
+ "Make a new note, of pitch `pitch', which octave and duration are taken
+from `editor''s note-state slot, and alteration taken from editing-state alterations
+slot."
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ (with-slots (note-state editing-state) editor
+ (with-slots ((pitch0 pitch) (octave0 octave) (duration0 duration) (dots0 dots)) note-state
+ (make-instance 'mudela-note :pitch pitch
+ :alteration (aref (slot-value editing-state 'alterations) pitch)
+ :duration duration0 :dots dots0
+ :octave (cond ((> (- pitch pitch0) 3) (1- octave0))
+ ((> (- pitch0 pitch) 3) (1+ octave0))
+ (t octave0))))))
+
+(defmethod make-rest ((editor mudela-editor))
+ "Make a new rest, which duration is taken from `editor''s note-state slot."
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ (with-slots (note-state) editor
+ (with-slots ((duration0 duration) (dots0 dots)) note-state
+ (make-instance 'mudela-rest :duration duration0 :dots dots0))))
+
+(defmethod make-skip ((editor mudela-editor))
+ "Make a new rest, which duration is taken from `editor''s note-state slot."
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ (with-slots (note-state) editor
+ (with-slots ((duration0 duration) (dots0 dots)) note-state
+ (make-instance 'mudela-skip :duration duration0 :dots dots0))))
+
+(defmethod word-insert ((editor mudela-editor) word)
+ "Insert the word's mudela string at current point, and updates
+editor's note-state."
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ (with-slots (note-state) editor
+ (lyqi-just-one-space)
+ (insert (mudela-string word note-state))
+ (lyqi-just-one-space)
+ (indent-for-tab-command) ;; TODO: be softer.
+ word))
+
+(defmethod search-word ((editor mudela-editor) &optional backward)
+ "Return a (word note-state beginning end) list, `word' being a
+mudela-word representation of the first word after (if `backward is nil)
+or before (otherwise) point, `note-state' the note-state deduced before that
+word, `beginning' and `end' being the beginning and end position of the word."
+ (with-slots (parser note-state) editor
+ (destructuring-bind (tmpword beginning end) (get-word parser note-state backward)
+ (cond (tmpword
+ (goto-char beginning)
+ (let ((new-note-state (point-note-state editor)))
+ (list (parse-string parser
+ (buffer-substring-no-properties beginning end)
+ new-note-state)
+ new-note-state
+ beginning
+ end)))
+ (t (list nil nil 0 0))))))
+
+(defmacro with-word-update (editor word-symbol &rest body)
+ "Read last word / update / delete / re-write word facility.
+The word preceding point will be read by `editor', and will
+be modified in `body', by refereing it as `word-symbol' (a
+non quoted symbol). Then, word will be deleted in the buffer,
+and a new string, reflecting changes appareing in `body',
+will be inserted."
+ (let ((beginning (gensym))
+ (end (gensym))
+ (note-state-at-point (gensym)))
+ `(destructuring-bind (,word-symbol ,note-state-at-point ,beginning ,end) (search-word ,editor t)
+ (when ,word-symbol
+ ,@body
+ (goto-char ,beginning)
+ (delete-region ,beginning ,end)
+ (word-insert ,editor ,word-symbol)
+ ,word-symbol))))
+
+(defmethod transpose-region ((editor mudela-editor) note-diff exact-pitch-diff beginning end)
+ "Transpose notes in current region."
+ (with-slots (parser note-state) editor
+ (goto-char beginning)
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ (let ((word-list (parse-region parser beginning end)))
+ (delete-region beginning end)
+ (dolist (word word-list)
+ (let ((transp-word (transpose word note-diff exact-pitch-diff)))
+ (word-insert editor transp-word))))))
+
+(defmethod change-octave-mode-region ((editor mudela-editor) beginning end)
+ "Switch octave mode for notes included between `beginning' and `end'"
+ (with-slots (parser note-state editing-state) editor
+ (goto-char beginning)
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ (let ((word-list (parse-region parser beginning end)))
+ (delete-region beginning end)
+ ;; we switch editing-state's octave mode
+ (setf (slot-value editing-state 'relative-octave)
+ (not (slot-value editing-state 'relative-octave)))
+ (dolist (word word-list)
+ (word-insert editor word)))))
+
+(defmethod change-language-region ((editor mudela-editor) from-lang to-lang beginning end)
+ "Change language for notes included between `beginning' and `end',
+from `from-lang' to `to-lang' (two symbols)."
+ (with-slots (parser note-state editing-state) editor
+ (goto-char beginning)
+ (setf (slot-value editor 'note-state) (point-note-state editor))
+ ;; first, read the region with from-lang language
+ (when (not (equal (slot-value editing-state 'language) from-lang))
+ (set-language editing-state from-lang)
+ (update-regexp parser))
+ (let ((word-list (parse-region parser beginning end)))
+ (delete-region beginning end)
+ ;; then, we change language from writing
+ (set-language editing-state to-lang)
+ (update-regexp parser)
+ (dolist (word word-list)
+ (word-insert editor word)))))
+
+(provide 'lyqi-editor)
--- /dev/null
+;; $RCSfile: lyqi-midi.el,v $
+;; $Revision: 1.7 $
+;; $Date: 2004/03/14 15:16:05 $
+;; $Author: nicolas $
+;;;
+;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
+;;; for quick note insertion while editing GNU LilyPond music scores.
+;;;
+;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; See http://nicolas.sceaux.free.fr/lilypond/
+;;;
+
+(require 'eieio)
+(require 'lyqi-base)
+
+(defcustom lyqi-midi-demon-command "timidity -iA -B2,8 -Os -EFreverb=0"
+ "Command used to start the midi demon."
+ :group 'lyqi
+ :type 'string)
+
+(defcustom lyqi-midi-keyboard-command "mymidikbd"
+ "Command used to start the midi keyboard process."
+ :group 'lyqi
+ :type 'string)
+
+(defcustom lyqi-midi-enabled-default nil
+ "Automatically launch midi?"
+ :group 'lyqi
+ :type 'boolean)
+
+(defcustom lyqi-midi-external-timidity-port 128
+ "ALSA port of external timidity server."
+ :group 'lyqi
+ :type 'integer)
+
+(defcustom lyqi-midi-use-external-timidity-server nil
+ "If true, don't start a new timidity server, but use an existing
+one, which port is `lyqi-midi-external-timidity-port'."
+ :group 'lyqi
+ :type 'boolean)
+
+(defvar lyqi-midi-tempo 80
+ "Tempo used for play back (quaters per minute).")
+
+(defvar lyqi-midi-manually-off nil
+ "Tells if user has previously switched off midi")
+
+(defvar lyqi-midi-timidity nil
+ "The timidity demon process.")
+
+(defvar lyqi-midi-keyboard nil
+ "The midi keyboard process.")
+
+(defvar lyqi-midi-on nil
+ "Say if midi processes are running")
+
+(defun lyqi-midi-set-timidity-alsa-port (port)
+ "When using an external timidity demon, set its ALSA sequencer port."
+ (interactive "nTimidity ALSA port: ")
+ (setf lyqi-midi-external-timidity-port port)
+ (when lyqi-midi-timidity
+ (setf (slot-value lyqi-midi-timidity 'seqport) port)))
+
+(defun lyqi-midi-timidity-start ()
+ (process-start lyqi-midi-timidity)
+ (mapcar (lambda (client)
+ (setf (slot-value client 'server-port)
+ (slot-value lyqi-midi-timidity 'seqport)))
+ (list lyqi-midi-keyboard)))
+ ;;(list lyqi-midi-keyboard lyqi-midi-rumor)))
+
+(defun lyqi-midi-start ()
+ "Starts the timidity process with ALSA interface
+and the keyboard process."
+ (unless lyqi-midi-on
+ (lyqi-midi-timidity-start)
+ (process-start lyqi-midi-keyboard))
+ (setq lyqi-midi-on (and (process-runningp lyqi-midi-timidity)
+ (process-runningp lyqi-midi-keyboard))))
+
+(defun lyqi-midi-stop ()
+ "Stops timidity and keyboard processes."
+ (process-stop lyqi-midi-timidity)
+ (process-stop lyqi-midi-keyboard)
+ (setq lyqi-midi-on nil))
+
+(defmethod play-note ((note mudela-note) &optional short)
+ "Play the given note, by sending its pitch and length (in sec)
+to the midi keyboard process."
+ (when (process-runningp lyqi-midi-keyboard)
+ (with-slots (duration dots) note
+ (process-send-string
+ (process-name (slot-value lyqi-midi-keyboard 'process))
+ (format "%d %f\n"
+ (midi-pitch note)
+ (if short
+ -1.0
+ (* (expt 2.0 (- 3 duration))
+ (do ((i 0 (1+ i))
+ (sum 0.0 (+ sum (expt 2.0 (- i)))))
+ ((> i dots) sum))
+ (/ 60.0 (* 1.0 lyqi-midi-tempo)))))))))
+
+(defmethod play-note ((word mudela-word-duration) &optional short)
+ "Play the given note, by sending its pitch and length (in sec)
+to the midi keyboard process."
+ (when (process-runningp lyqi-midi-keyboard)
+ (with-slots (duration dots) word
+ (process-send-string (process-name (slot-value lyqi-midi-keyboard 'process))
+ (format "%d %f\n"
+ -1
+ (* (expt 2.0 (- 3 duration))
+ (do ((i 0 (1+ i))
+ (sum 0.0 (+ sum (expt 2.0 (- i)))))
+ ((> i dots) sum))
+ (/ 60.0 (* 1.0 lyqi-midi-tempo))))))))
+
+(defmethod play-note ((word mudela-word) &optional short)
+ "Play the given note, by sending its pitch and length (in sec)
+to the midi keyboard process."
+ nil)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defclass midi-process ()
+ ((command :initarg :command
+ :initform nil
+ :documentation "process start command")
+ (args :initarg :args
+ :initform nil
+ :documentation "process command arguments")
+ (name :initarg :name
+ :initform nil
+ :documentation "process name")
+ (process :initform nil
+ :documentation "process object")))
+(defmethod process-runningp ((process midi-process))
+ "Return t if the process is running, nil otherwise."
+ (with-slots ((proc process)) process
+ (and proc (eq (process-status proc) 'run))))
+(defmethod process-start ((process midi-process))
+ "Start the process"
+ (unless (process-runningp process)
+ (with-slots (name command args) process
+ (setf (slot-value process 'process)
+ (apply 'start-process name name (append (split-string command " ")
+ args))))))
+(defmethod process-stop ((process midi-process))
+ "Stop the process"
+ (when (process-runningp process)
+ (with-slots ((proc process)) process
+ (delete-process (process-name proc)))))
+
+(defclass timidity-server (midi-process)
+ ((seqport :initform nil
+ :documentation "Timidity ALSA sequencer port")))
+(defmethod process-start :AFTER ((timidity timidity-server))
+ "Grep the sequencer port."
+ ;; we have to wait a bit before reading timidity's output
+ (sleep-for 1)
+ (let ((port
+ (with-current-buffer (buffer-name (process-buffer (slot-value timidity 'process)))
+ (goto-char (point-max))
+ (if (re-search-backward "Opening sequencer port: \\([0-9]+\\):" nil t)
+ (buffer-substring (match-beginning 1)
+ (match-end 1))))))
+ (when port
+ (setf (slot-value timidity 'seqport) (string-to-int port)))))
+
+(defclass external-timidity-server (midi-process)
+ ((seqport ;:initform lyqi-midi-external-timidity-port
+ :documentation "External timidity ALSA sequencer port")))
+(defmethod process-runningp ((timidity external-timidity-server))
+ t)
+(defmethod process-start ((timidity external-timidity-server))
+ t)
+(defmethod process-stop ((timidity external-timidity-server))
+ t)
+
+
+(defclass timidity-client (midi-process)
+ ((server-port :initform nil
+ :documentation "The timidity server ALSA port")))
+
+(defclass mymidikbd (timidity-client) nil)
+(defmethod process-start :BEFORE ((kbd mymidikbd))
+ "Update command argument list before execution."
+ (setf (slot-value kbd 'args)
+ (list (number-to-string (slot-value kbd 'server-port)))))
+
+(provide 'lyqi-midi)
+
--- /dev/null
+;; $RCSfile: lyqi-mode.el,v $
+;; $Revision: 1.9 $
+;; $Date: 2004/03/14 15:14:55 $
+;; $Author: nicolas $
+;;;
+;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
+;;; for quick note insertion while editing GNU LilyPond music scores.
+;;;
+;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; See http://nicolas.sceaux.free.fr/lilypond/
+;;;
+
+(defgroup lyqi nil
+ "LilyPond quick insert mode."
+ :prefix "lyqi-"
+ :group 'applications)
+
+(eval-when-compile (require 'cl))
+(require 'lyqi-base)
+(require 'lyqi-parser)
+(require 'lyqi-editor)
+(require 'lyqi-midi)
+(require 'lyqi-rumor)
+
+(defconst lyqi-version "0.2.5")
+
+(defconst lyqi-languages
+ '(nederlands english deutsch norsk svenska italiano catalan espanol)
+ "Possible languages for writing LilyPond note names.")
+
+(defcustom lyqi-self-inserting-keys "()<>~{}|[] "
+ "Self inserting keys in lyqi-mode-map."
+ :group 'lyqi
+ :type 'string)
+
+(defcustom lyqi-self-inserting-+-char-keys "-_^\\"
+ "Self inserting keys, after which the user is asked an extra char to insert."
+ :group 'lyqi
+ :type 'string)
+
+(defcustom lyqi-self-inserting-+-string-keys
+ '((?- "\C-c-") (?_ "\C-c_") (?^ "\C-c^") (?\\ "\C-c\\") (?# "#") (?\" "\"" "\""))
+ "Self inserting keys, after which the user is asked an extra string to insert."
+ :group 'lyqi)
+
+(defcustom lyqi-force-duration t
+ "Force duration to appear when inserting a note"
+ :group 'lyqi
+ :type 'boolean)
+
+(defcustom lyqi-relative-octave-default nil
+ "Relative or absolute octave in lilypond insert mode by default?"
+ :group 'lyqi
+ :type 'boolean)
+
+(defcustom lyqi-default-language 'nederlands
+ "The default language for writing LilyPond note names."
+ :group 'lyqi
+ :options lyqi-languages
+ :type 'symbol)
+
+(defvar lyqi-editing-state nil
+ "The current editing state: language, octave mode, etc.")
+
+(defvar lyqi-mudela-editor nil
+ "A mudela editor.")
+
+(defvar lyqi-mudela-parser nil
+ "A rudimentary mudela parser")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; lilypond-quick-insert-mode interactive functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro with-GNUEmacs (&rest body)
+ (if (string-match "GNU Emacs" (version)) `(progn ,@body)))
+
+(defmacro with-XEmacs (&rest body)
+ (if (string-match "XEmacs" (version)) `(progn ,@body)))
+
+(with-XEmacs
+ (defun my-get-key (fn)
+ "Returns the key (a string) binded to `fn'"
+ (let ((keys (where-is-internal fn nil t)))
+ (and keys (my-join (mapcar (lambda (key)
+ (if (consp key)
+ (format "%s-%s"
+ (upcase (substring (symbol-name (car key)) 0 1))
+ (symbol-name (cadr key)))
+ (symbol-name key)))
+ (append keys nil)) " ")))))
+(with-GNUEmacs
+ (defun my-get-key (fn)
+ "Returns the key (a string) binded to `fn'"
+ (let ((keys (where-is-internal fn nil t)))
+ (and keys (my-join (mapcar (lambda (key) (if (and (<= 1 key) (<= key 26))
+ (format "C-%c" (+ 96 key))
+ (char-to-string key)))
+ keys) " ")))))
+
+(defun lyqi-display-state ()
+ "Display current state (language used, octave mode) and help commands in the minibuffer."
+ (message "lyqi-%s [%s,%s pitches,midi %s] Press %s to quit, %s for help."
+ lyqi-version
+ (slot-value lyqi-editing-state 'language)
+ (if (slot-value lyqi-editing-state 'relative-octave) "relative" "absolute")
+ (if lyqi-midi-on "on" "off")
+ (my-get-key 'lyqi-quit)
+ (my-get-key 'lyqi-help)))
+
+;; (defmacro with-lyqi-interactive (&rest body)
+;; "Utility to make a lyqi interactive command, with message display at the end."
+;; `(progn
+;; (interactive)
+;; ,@body
+;; (lyqi-display-state)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; note, rest, skips insertion
+
+(defun lyqi-insert-note (pitch)
+ "Insert a new mudela note of pitch `pitch'."
+ (let ((note (make-note lyqi-mudela-editor pitch)))
+ (word-insert lyqi-mudela-editor note)
+ (when lyqi-midi-on
+ (play-note note t))
+ (lyqi-display-state)))
+
+(defun lyqi-insert-note-do ()
+ "Insert a new do / c note at point."
+ (interactive)
+ (lyqi-insert-note 0))
+
+(defun lyqi-insert-note-re ()
+ "Insert a new re / d note at point."
+ (interactive)
+ (lyqi-insert-note 1))
+
+(defun lyqi-insert-note-mi ()
+ "Insert a new mi / e note at point."
+ (interactive)
+ (lyqi-insert-note 2))
+
+(defun lyqi-insert-note-fa ()
+ "Insert a new fa / f note at point."
+ (interactive)
+ (lyqi-insert-note 3))
+
+(defun lyqi-insert-note-sol ()
+ "Insert a new sol / g note at point."
+ (interactive)
+ (lyqi-insert-note 4))
+
+(defun lyqi-insert-note-la ()
+ "Insert a new la / a note at point."
+ (interactive)
+ (lyqi-insert-note 5))
+
+(defun lyqi-insert-note-si ()
+ "Insert a new si / b note at point."
+ (interactive)
+ (lyqi-insert-note 6))
+
+(defun lyqi-insert-rest ()
+ "Insert a rest at point."
+ (interactive)
+ (word-insert lyqi-mudela-editor (make-rest lyqi-mudela-editor))
+ (lyqi-display-state))
+
+(defun lyqi-insert-skip ()
+ "Insert a skip at point."
+ (interactive)
+ (word-insert lyqi-mudela-editor (make-skip lyqi-mudela-editor))
+ (lyqi-display-state))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; note, rest, skips update
+
+;; (defun lyqi-change-duration (duration)
+;; "Change the last word duration, if any, and if possible."
+;; (with-word-update lyqi-mudela-editor the-word
+;; (set-duration the-word duration)))
+(defun lyqi-change-duration (duration)
+ "Change the last word duration, if any, and if possible."
+ (with-word-update lyqi-mudela-editor the-word
+ (set-duration the-word duration)))
+
+(defun lyqi-change-duration-1 ()
+ "Change the previous word duration to 1."
+ (interactive)
+ (lyqi-change-duration 1)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-2 ()
+ "Change the previous word duration to 2."
+ (interactive)
+ (lyqi-change-duration 2)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-4 ()
+ "Change the previous word duration to 4."
+ (interactive)
+ (lyqi-change-duration 3)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-8 ()
+ "Change the previous word duration to 8."
+ (interactive)
+ (lyqi-change-duration 4)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-16 ()
+ "Change the previous word duration to 16."
+ (interactive)
+ (lyqi-change-duration 5)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-32 ()
+ "Change the previous word duration to 32."
+ (interactive)
+ (lyqi-change-duration 6)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-64 ()
+ "Change the previous word duration to 64."
+ (interactive)
+ (lyqi-change-duration 7)
+ (lyqi-display-state))
+
+(defun lyqi-change-duration-128 ()
+ "Change the previous word duration to 128."
+ (interactive)
+ (lyqi-change-duration 8)
+ (lyqi-display-state))
+
+(defun lyqi-change-dots ()
+ "Increase modulo 5 the previous word dot number."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-word
+ (set-dots the-word))
+ (lyqi-display-state))
+
+(defun lyqi-change-alteration-up ()
+ "Increase, if possible, the last note alteration."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-alteration-up the-note)
+ (when lyqi-midi-on
+ (play-note the-note t)))
+ (lyqi-display-state))
+
+(defun lyqi-change-alteration-down ()
+ "Decrease, if possible, the last note alteration."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-alteration-down the-note)
+ (when lyqi-midi-on
+ (play-note the-note t)))
+ (lyqi-display-state))
+
+(defun lyqi-change-alteration-natural ()
+ "Set, if possible, the last note alteration to natural."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-alteration-natural the-note)
+ (when lyqi-midi-on
+ (play-note the-note t)))
+ (lyqi-display-state))
+
+(defun lyqi-change-octave-up ()
+ "Increase the last note octave."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-octave-up the-note)
+ (when lyqi-midi-on
+ (play-note the-note t)))
+ (lyqi-display-state))
+
+(defun lyqi-change-octave-down ()
+ "Decrease the last note octave."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-octave-down the-note)
+ (when lyqi-midi-on
+ (play-note the-note t)))
+ (lyqi-display-state))
+
+(defun lyqi-change-octave-zero ()
+ "Set the last note octave to zero."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-octave-zero the-note)
+ (when lyqi-midi-on
+ (play-note the-note t)))
+ (lyqi-display-state))
+
+(defun lyqi-change-reminder-alt ()
+ "Change the last note's reminder alteration state."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-reminder-alt the-note))
+ (lyqi-display-state))
+
+(defun lyqi-change-cautionary-alt ()
+ "Change the last note's cautionary alteration state."
+ (interactive)
+ (with-word-update lyqi-mudela-editor the-note
+ (set-cautionary-alt the-note))
+ (lyqi-display-state))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+
+(with-XEmacs
+ (defun my-read-char-exclusive (prompt)
+ (let ((event (next-event nil prompt)))
+ (while (not (key-press-event-p event))
+ (next-event event prompt))
+ (event-to-character event))))
+(with-GNUEmacs
+ (defun my-read-char-exclusive (prompt)
+ (read-char-exclusive prompt)))
+
+(defun lyqi-insert-tuplet ()
+ "Interactively inserts a \\times x/y {"
+ (interactive)
+ (let ((x ""))
+ (lyqi-just-one-space)
+ (insert "\\times ")
+ (while (not (and (string< x "9") (string< "0" x)))
+ (setq x (char-to-string (my-read-char-exclusive
+ "Insert a number for the numerator (\"x/\")"))))
+ (insert (format "%s/" x)) (setq x "/")
+ (while (not (and (string< x "9") (string< "0" x)))
+ (setq x (char-to-string (my-read-char-exclusive
+ "Insert a number for the denominator (\"/y\")"))))
+ (insert (format "%s { " x)))
+ (lyqi-display-state))
+
+(defun lyqi-word-forward ()
+ "Move to the following mudela word end, if any, otherwise to the end of the
+following text word."
+ (interactive)
+ (unless (re-search-forward (slot-value lyqi-mudela-parser 'regexp) nil t)
+ (forward-word 1))
+ (lyqi-display-state))
+
+(defun lyqi-word-backward ()
+ "Move to the previous mudela word beginning, if any, otherwise to the beginning of the
+previous text word."
+ (interactive)
+ (unless (re-search-backward (slot-value lyqi-mudela-parser 'regexp) nil t)
+ (backward-word 1))
+ (lyqi-display-state))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+
+(defun my-next (elt seq)
+ "Returns the element following `elt' in `seq'.
+If it is the last, returns the first element of the sequence."
+ (let ((nexts (cdr (member elt seq))))
+ (if (consp nexts)
+ (car nexts)
+ (car seq))))
+
+(defun lyqi-switch-language ()
+ "Select the next mudela language in `lyqi-languages'."
+ (interactive)
+ (setf lyqi-default-language
+ (my-next (slot-value lyqi-editing-state 'language) lyqi-languages))
+ (set-language lyqi-editing-state lyqi-default-language)
+ (update-regexp lyqi-mudela-parser)
+ (lyqi-display-state))
+
+(defun lyqi-switch-octave-mode ()
+ "Switch between relative and absolute octave modes."
+ (interactive)
+ (setf (slot-value lyqi-editing-state 'relative-octave)
+ (not (slot-value lyqi-editing-state 'relative-octave)))
+ (lyqi-display-state))
+
+(defun my-center-string (str len)
+ "Makes a centered string from `str', of length `len'"
+ (let* ((inner-str (if (< (length str) len)
+ str
+ (substring str 0 len)))
+ (right-space (/ (- len (length inner-str)) 2))
+ (left-space (- len right-space (length inner-str))))
+ (format "%s%s%s"
+ (make-string left-space (string-to-char " "))
+ inner-str
+ (make-string right-space (string-to-char " ")))))
+
+(defun lyqi-help ()
+ "Display a help message in a dedicated buffer."
+ (interactive)
+ (describe-mode)
+;; (with-output-to-temp-buffer "*Help*"
+;; (princ "LilyPond quick insert mode
+;; Note entry:
+;; | | | | | | | | | | | | |
+;; | | | | | | | | | | | | |
+;; | |_| |_| | |_| |_| |_| |
+;; | | | | | | | |
+;; |___|___|___|___|___|___|___|\n")
+
+;; (princ (format "pitch keys: %s \n\n"
+;; (my-join (mapcar (lambda (fn)
+;; (my-center-string (format "`%s'" (my-get-key fn)) 3))
+;; '(lyqi-insert-note-do
+;; lyqi-insert-note-re
+;; lyqi-insert-note-mi
+;; lyqi-insert-note-fa
+;; lyqi-insert-note-sol
+;; lyqi-insert-note-la
+;; lyqi-insert-note-si)) " ")))
+;; (princ (format "duration keys: %s\n"
+;; (my-join (mapcar (lambda (fn)
+;; (my-center-string (format "`%s'" (my-get-key fn)) 3))
+;; '(lyqi-change-duration-1
+;; lyqi-change-duration-2
+;; lyqi-change-duration-4
+;; lyqi-change-duration-8
+;; lyqi-change-duration-16
+;; lyqi-change-duration-32
+;; lyqi-change-duration-64
+;; lyqi-change-duration-128)) " ")))
+;; (princ (format " %s\n"
+;; (my-join (mapcar (lambda (num)
+;; (my-center-string
+;; (int-to-string (expt 2 (- num 1))) 3))
+;; '(1 2 3 4 5 6 7 8)) "|")))
+;; (princ (format "alteration: `%s' flat
+;; `%s' sharp\n
+;; `%s' force reminder alteration\n
+;; `%s' force cautionary alteration\n"
+;; (my-get-key 'lyqi-change-alteration-down)
+;; (my-get-key 'lyqi-change-alteration-up)
+;; (my-get-key 'lyqi-change-reminder-alt)
+;; (my-get-key 'lyqi-change-cautionary-alt)))
+;; (princ (format "dot key: `%s'\n" (my-get-key 'lyqi-change-dots)))
+;; (princ (format "octave keys: `%s' down
+;; `%s' up\n"
+;; (my-get-key 'lyqi-change-octave-down)
+;; (my-get-key 'lyqi-change-octave-up)))
+;; (princ (format "rests: `%s'\n" (my-get-key 'lyqi-insert-rest)))
+;; (princ (format "skips: `%s'\n" (my-get-key 'lyqi-insert-skip)))
+;; (princ (format "tuplets: `%s'\n" (my-get-key 'lyqi-insert-tuplet)))
+;; (princ (format "self inserting keys: `%s'\n" (my-join (split-string lyqi-self-inserting-keys "") "' `")))
+;; (princ "\nOther bindings:\n")
+;; (princ (format "absolute/relative octave switch: `%s'\n"
+;; (my-get-key 'lyqi-switch-octave-mode)))
+;; (princ (format "language switch: `%s'\n" (my-get-key 'lyqi-switch-language)))
+;; (princ (format "help: `%s'\n" (my-get-key 'lyqi-help)))
+;; (princ (format "Midi note playing start/stop: `%s'\n"
+;; (my-get-key 'lyqi-midi-start-stop)))
+;; (princ (format "back to LilyPond-mode: `%s'\n" (my-get-key 'lyqi-quit)))
+;; (princ (format "Transpose region: `%s'\n" (my-get-key 'lyqi-transpose-region)))
+ (lyqi-display-state))
+
+(defun lyqi-quit ()
+ "Quit lilypond-quick-insert-mode, back to LilyPond-mode"
+ (interactive)
+ (LilyPond-mode))
+
+(defun lyqi-relative-to-absolute-region ()
+ "Rewrite region with absolute octave mode instead of relative octave mode.
+An octave transposition may be required afterward."
+ (interactive)
+ (when (not (slot-value lyqi-editing-state 'relative-octave))
+ (lyqi-switch-octave-mode))
+ (change-octave-mode-region lyqi-mudela-editor (region-beginning) (region-end))
+ (lyqi-display-state))
+
+(defun lyqi-absolute-to-relative-region ()
+ "Rewrite region with relative octave mode instead of absolute octave mode."
+ (interactive)
+ (when (slot-value lyqi-editing-state 'relative-octave)
+ (lyqi-switch-octave-mode))
+ (change-octave-mode-region lyqi-mudela-editor (region-beginning) (region-end))
+ (lyqi-display-state))
+
+(defun lyqi-transpose-region-aux (from-note to-note)
+ "Transpose the current region, the interval being defined by `from-note'
+and `to-note', two mudela-notes."
+ (when to-note
+ (let ((note-diff (+ (- (slot-value to-note 'pitch)
+ (slot-value from-note 'pitch))
+ (* 7 (- (slot-value to-note 'octave)
+ (slot-value from-note 'octave)))))
+ (exact-pitch-diff (- (midi-pitch to-note) (midi-pitch from-note))))
+ (transpose-region lyqi-mudela-editor note-diff exact-pitch-diff (region-beginning) (region-end)))))
+
+(defun lyqi-transpose-region (to-note-str)
+ "Interactively transpose the current region. The user is asked the transposition interval,
+starting from c/do."
+ (interactive "sTranspose to: ")
+ (let ((from-note (make-instance 'mudela-note :pitch 0 :octave 0))
+ (to-note (parse-string lyqi-mudela-parser to-note-str (make-instance 'mudela-note-state :octave 0))))
+ (lyqi-transpose-region-aux from-note to-note)))
+
+;;; by Reuben Thomas <rrt@sc3d.org>
+(defun lyqi-transpose-interval-region (trans)
+ "Interactively transpose the current region. The user is asked the transposition interval in tones."
+ (interactive "sTranspose by interval (tones[+]|[-]) : ")
+ (let* ((interval (string-to-int trans))
+ (adj (substring trans -1))
+ (alt (cond ((equal adj "+") 3)
+ ((equal adj "-") 1)
+ (t 2)))
+ (oct (/ interval 7))
+ (tone (% interval 7)))
+ (when (< tone 0)
+ (setq tone (+ tone 7))
+ (setq oct (- oct 1)))
+ (let ((from-note (make-instance 'mudela-note :pitch 0 :octave 0))
+ (to-note (make-instance 'mudela-note :pitch tone :octave oct :alteration alt)))
+ (lyqi-transpose-region-aux from-note to-note)))
+ (lyqi-display-state))
+
+(defun lyqi-play-back-region ()
+ "If midi is on, play back notes in region."
+ (interactive)
+ (when (process-runningp lyqi-midi-keyboard)
+ (mapcar 'play-note (parse-region lyqi-mudela-parser (region-beginning) (region-end)))))
+
+(defun lyqi-change-language-region ()
+ "Change note language in region. The user is asked for source and destination languages."
+ (interactive)
+ (let* ((current-lang (slot-value lyqi-editing-state 'language))
+ (next-lang (my-next current-lang lyqi-languages))
+ (lang-collection (mapcar (lambda (lang) (list (symbol-name lang))) lyqi-languages))
+ (from-lang (intern (completing-read (format "Change from language [%s]: " current-lang)
+ lang-collection nil t nil nil (symbol-name current-lang))))
+ (to-lang (intern (completing-read (format "Change from language %s to [%s]: " from-lang next-lang)
+ lang-collection nil t nil nil (symbol-name next-lang)))))
+ (change-language-region lyqi-mudela-editor from-lang to-lang (region-beginning) (region-end)))
+ (lyqi-display-state))
+
+;; (defun lyqi-self-insert-plus-char (char))
+;; (defun lyqi-self-insert-plus-string (char) &optional ending)
+
+;;; Rumor
+
+(defun lyqi-rumor-session-stop ()
+ "Stop a running rumor session."
+ (interactive)
+ (process-stop lyqi-rumor-process)
+ (define-key lyqi-mode-map " " 'self-insert-command))
+
+(defun lyqi-rumor-session-start ()
+ "Start a rumor session. Press SPC to stop the session"
+ (interactive)
+ (define-key lyqi-mode-map " " 'lyqi-rumor-session-stop)
+ (process-start lyqi-rumor-process))
+
+(defun lyqi-rumor-set-legato ()
+ "Change rumor's legato parameter."
+ (interactive)
+ (let ((legato (with-slots (legato) lyqi-rumor-process
+ (setf (slot-value lyqi-rumor-process 'legato)
+ (not legato)))))
+ (message "rumor: legato mode set %s for next session." (if legato "on" "off"))
+ legato))
+
+(defun lyqi-rumor-set-no-dots ()
+ "Change rumor's no-dots parameter."
+ (interactive)
+ (let ((no-dots (with-slots (no-dots) lyqi-rumor-process
+ (setf (slot-value lyqi-rumor-process 'no-dots)
+ (not no-dots)))))
+ (message "rumor: dots %sshown in next session." (if no-dots "not " ""))
+ no-dots))
+
+(defun lyqi-rumor-set-flat ()
+ "Change rumor's flat parameter."
+ (interactive)
+ (let ((flat (with-slots (flat) lyqi-rumor-process
+ (setf (slot-value lyqi-rumor-process 'flat)
+ (not flat)))))
+ (message "rumor: flat mode set %s for next session." (if flat "on" "off"))
+ flat))
+
+(defun lyqi-rumor-set-grain (grain-str)
+ "Set rumor's grain."
+ (interactive "sRumor's new grain: ")
+ (let ((grain (setf (slot-value lyqi-rumor-process 'grain)
+ (string-to-number grain-str))))
+ (message "rumor: grain set to %d for next session" grain)
+ grain))
+
+(defun lyqi-rumor-set-tempo (tempo-str)
+ "Set rumor's tempo."
+ (interactive "sRumor's new tempo: ")
+ (let ((tempo (setf (slot-value lyqi-rumor-process 'tempo)
+ (string-to-number tempo-str))))
+ (message "rumor: tempo set to %d for next session" tempo)
+ tempo))
+
+(defun lyqi-rumor-set-alsa-port (alsa-port-str)
+ "Set rumor's alsa-port."
+ (interactive "sRumor's new alsa port: ")
+ (let ((port (setf (slot-value lyqi-rumor-process 'port)
+ (string-to-number alsa-port-str))))
+ (message "rumor: alsa port set to %d for next session" port)
+ port))
+
+(defun lyqi-rumor-set-meter (meter)
+ "Set rumor's meter."
+ (interactive "sRumor's new meter: ")
+ (setf (slot-value lyqi-rumor-process 'meter)
+ meter)
+ (message "rumor: meter set to %s for next session" meter)
+ meter)
+
+(defun lyqi-rumor-set-key (key)
+ "Set rumor's key."
+ (interactive "sRumor's new key (in dutsch): ")
+ (setf (slot-value lyqi-rumor-process 'key)
+ key)
+ (message "rumor: key set to %s for next session" key)
+ key)
+
+;;; Midi play back
+
+(defun lyqi-midi-start-stop ()
+ "Start or stop midi playing."
+ (interactive)
+ (if lyqi-midi-on
+ (lyqi-midi-stop)
+ (lyqi-midi-start))
+ (setq lyqi-midi-manually-off (not lyqi-midi-on))
+ (lyqi-display-state))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; lyqi-mode definition
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro lyqi-make-self-insert-+-char (key)
+ "Define a self-insert-<char>-+-char function, and "
+ (let ((fn-symb (intern (format "lyqi-%s-self-insert-+-char" key))))
+ `(progn
+ (defun ,fn-symb ()
+ ,(format "Insert the character %s and ask the user an extra character to insert." key)
+ (interactive)
+ (insert ,key)
+ (insert (char-to-string (my-read-char-exclusive "Following character: "))))
+ (define-key lyqi-mode-map ,key ',fn-symb))))
+
+(defmacro lyqi-make-self-insert-+-string (char key &optional end-string)
+ "Define a self-insert-<char>-+-char function, and "
+ (let ((fn-symb (intern (format "lyqi-%s-self-insert-+-string" (char-to-string char)))))
+ `(progn
+ (defun ,fn-symb ()
+ ,(format "Insert the character %c and ask the user an extra character to insert." char)
+ (interactive)
+ (insert ,(char-to-string char))
+ (insert (read-string "Following string: "))
+ ,(if end-string `(insert ,end-string)))
+ (define-key lyqi-mode-map ,key ',fn-symb))))
+
+(define-derived-mode lyqi-mode
+ LilyPond-mode "lyqi"
+ "Major mode for LilyPond quick note insert.
+\\{lyqi-mode-map}"
+ (make-local-variable 'lyqi-editing-state)
+ (make-local-variable 'lyqi-mudela-parser)
+ (make-local-variable 'lyqi-mudela-editor)
+
+ (setq lyqi-editing-state (make-instance 'mudela-editing-state
+ :translation-table mudela-translation-table
+ :relative-octave lyqi-relative-octave-default
+ :force-duration lyqi-force-duration))
+ (set-language lyqi-editing-state lyqi-default-language)
+ (setq lyqi-mudela-parser (make-mudela-parser lyqi-editing-state))
+ (setq lyqi-mudela-editor (make-instance 'mudela-editor
+ :editing-state lyqi-editing-state
+ :parser lyqi-mudela-parser
+ :note-state (make-instance 'mudela-note-state)))
+ ;; I don't know how to directly set a class slot !
+ ;; Is that a feature or a bug ? when I set a class allocated slot
+ ;; of a mother class instance, the slot is not also updated in child
+ ;; class instances...
+ (let ((c (make-instance 'mudela-note))
+ (r (make-instance 'mudela-rest))
+ (s (make-instance 'mudela-skip)))
+ (setf (slot-value c 'editing-state) lyqi-editing-state)
+ (setf (slot-value r 'editing-state) lyqi-editing-state)
+ (setf (slot-value s 'editing-state) lyqi-editing-state))
+
+ ;; midi start
+ (unless lyqi-midi-timidity
+ (cond (lyqi-midi-use-external-timidity-server
+ (setq lyqi-midi-timidity (make-instance 'external-timidity-server))
+ (setf (slot-value lyqi-midi-timidity 'seqport) lyqi-midi-external-timidity-port))
+ (t
+ (setq lyqi-midi-timidity (make-instance 'timidity-server
+ :command lyqi-midi-demon-command
+ :name "timidity")))))
+ (unless lyqi-midi-keyboard
+ (setq lyqi-midi-keyboard (make-instance 'mymidikbd
+ :command lyqi-midi-keyboard-command
+ :name "mymidikbd")))
+ (unless lyqi-rumor-process
+ (setq lyqi-rumor-process (make-instance 'rumor
+ :command lyqi-rumor-command
+ :name "rumor"
+ :grain lyqi-rumor-default-grain
+ :tempo lyqi-rumor-default-tempo
+ :legato lyqi-rumor-default-legato
+ :no-dots lyqi-rumor-default-no-dots
+ :flat lyqi-rumor-default-flat
+ :strip lyqi-rumor-default-strip
+ :meter lyqi-rumor-default-meter
+ :key lyqi-rumor-default-key
+ :alsa-port lyqi-rumor-default-alsa-port)))
+ (when (and (not lyqi-midi-manually-off)
+ lyqi-midi-enabled-default)
+ (lyqi-midi-start)))
+
+;; makes all the printing characters undefined.
+(suppress-keymap lyqi-mode-map t)
+;; rests and skips
+(define-key lyqi-mode-map "r" 'lyqi-insert-rest)
+(define-key lyqi-mode-map "s" 'lyqi-insert-skip)
+;; pitches : do re mi fa sol la si
+(define-key lyqi-mode-map "d" 'lyqi-insert-note-do)
+(define-key lyqi-mode-map "f" 'lyqi-insert-note-re)
+(define-key lyqi-mode-map "g" 'lyqi-insert-note-mi)
+(define-key lyqi-mode-map "h" 'lyqi-insert-note-fa)
+(define-key lyqi-mode-map "j" 'lyqi-insert-note-sol)
+(define-key lyqi-mode-map "k" 'lyqi-insert-note-la)
+(define-key lyqi-mode-map "l" 'lyqi-insert-note-si)
+;; alterations
+(define-key lyqi-mode-map "i" 'lyqi-change-alteration-up)
+(define-key lyqi-mode-map "e" 'lyqi-change-alteration-down)
+(define-key lyqi-mode-map "n" 'lyqi-change-alteration-natural)
+(define-key lyqi-mode-map "!" 'lyqi-change-reminder-alt)
+(define-key lyqi-mode-map "?" 'lyqi-change-cautionary-alt)
+;; octave
+(define-key lyqi-mode-map "'" 'lyqi-change-octave-up)
+(define-key lyqi-mode-map "," 'lyqi-change-octave-down)
+(define-key lyqi-mode-map "=" 'lyqi-change-octave-zero)
+;; durations: 1 2 4 8 16 32 64 128
+(define-key lyqi-mode-map "1" 'lyqi-change-duration-1)
+(define-key lyqi-mode-map "2" 'lyqi-change-duration-2)
+(define-key lyqi-mode-map "4" 'lyqi-change-duration-4)
+(define-key lyqi-mode-map "8" 'lyqi-change-duration-8)
+(define-key lyqi-mode-map "7" 'lyqi-change-duration-16)
+(define-key lyqi-mode-map "5" 'lyqi-change-duration-32)
+(define-key lyqi-mode-map "0" 'lyqi-change-duration-64)
+(define-key lyqi-mode-map "9" 'lyqi-change-duration-128)
+;; dots
+(define-key lyqi-mode-map "." 'lyqi-change-dots)
+;; tuplets
+(define-key lyqi-mode-map "\C-ct" 'lyqi-insert-tuplet)
+;; other bindings
+(define-key lyqi-mode-map "\C-co" 'lyqi-switch-octave-mode)
+(define-key lyqi-mode-map "\C-c\C-l" 'lyqi-switch-language)
+(define-key lyqi-mode-map "\C-cq" 'lyqi-quit) ; back to LilyPond-mode
+(define-key lyqi-mode-map "\C-ch" 'lyqi-help)
+(define-key lyqi-mode-map "\M-b" 'lyqi-word-backward)
+(define-key lyqi-mode-map "\M-f" 'lyqi-word-forward)
+(define-key lyqi-mode-map "\C-c\C-t" 'lyqi-transpose-region)
+(define-key lyqi-mode-map "\C-cm" 'lyqi-midi-start-stop)
+(define-key lyqi-mode-map "\C-cp" 'lyqi-play-back-region)
+;; prefix key for rumor commands
+(define-prefix-command 'ctl-c-p)
+(define-key lyqi-mode-map "\C-cr" ctl-c-p)
+(define-key lyqi-mode-map "\C-crs" 'lyqi-rumor-session-start)
+(define-key lyqi-mode-map "\C-crg" 'lyqi-rumor-set-grain)
+(define-key lyqi-mode-map "\C-crt" 'lyqi-rumor-set-tempo)
+(define-key lyqi-mode-map "\C-crl" 'lyqi-rumor-set-legato)
+(define-key lyqi-mode-map "\C-crd" 'lyqi-rumor-set-no-dots)
+(define-key lyqi-mode-map "\C-crf" 'lyqi-rumor-set-flat)
+(define-key lyqi-mode-map "\C-crm" 'lyqi-rumor-set-meter)
+(define-key lyqi-mode-map "\C-crk" 'lyqi-rumor-set-key)
+(define-key lyqi-mode-map "\C-crp" 'lyqi-rumor-set-alsa-port)
+;; self inserting keys
+(dolist (key (split-string lyqi-self-inserting-keys ""))
+ (define-key lyqi-mode-map key 'self-insert-command))
+(dolist (key (split-string lyqi-self-inserting-+-char-keys ""))
+ (eval `(lyqi-make-self-insert-+-char ,key)))
+(dolist (key-descr lyqi-self-inserting-+-string-keys)
+ (eval `(lyqi-make-self-insert-+-string ,@key-descr)))
--- /dev/null
+;; $RCSfile: lyqi-parser.el,v $
+;; $Revision: 1.5 $
+;; $Date: 2003/09/27 16:33:49 $
+;; $Author: nicolas $
+;;;
+;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
+;;; for quick note insertion while editing GNU LilyPond music scores.
+;;;
+;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; See http://nicolas.sceaux.free.fr/lilypond/
+;;;
+
+(eval-when-compile (require 'cl))
+(require 'eieio)
+(require 'lyqi-base)
+
+;;;;;; few string utilities ;;;;;;;;;;
+
+;; for XEmacs21 compatibility
+(if (not (fboundp 'match-string-no-properties))
+ (defalias 'match-string-no-properties 'match-string))
+
+(defun my-join (string-list joiner)
+ "Returns a concatenation of all string-list elements, with joiner between elements"
+ (apply 'concat
+ (car string-list)
+ (mapcar (lambda (str) (concat joiner str))
+ (cdr string-list))))
+
+(defun my-sort-string-by-length (string-list)
+ "Sort the given string list by decreasing string length."
+ (nreverse
+ (sort string-list
+ (lambda (str1 str2)
+ (or (< (length str1) (length str2))
+ (and (= (length str1) (length str2))
+ (string< str1 str2)))))))
+
+(defun my-char-to-restring (char)
+ (concat (if (member char '(?. ?* ?+ ??)) "\\" "")
+ (char-to-string char)))
+
+;;;;;; parser classes ;;;;;;;;;
+
+(defclass base-parser ()
+ ((regexp :initarg :regexp
+ :documentation "A regular expression associated with the parser"))
+ "base class for parsers")
+
+(defmethod update-regexp ((parser base-parser))
+ "(do nothing) Return the parser's regexp"
+ (slot-value parser 'regexp))
+
+(defclass syllab-parser (base-parser)
+ nil
+ "A syllab parser, ie a specialized word component parser.")
+
+(defclass word-parser (base-parser)
+ ((regexp-not-before :initarg :not-before
+ :initform nil
+ :documentation "A regexp describing what should not be found after the words
+that the parser recognize.")
+ (regexp-not-after :initarg :not-after
+ :initform nil
+ :documentation "A regexp describing what should not be found before the words
+that the parser recognize.")
+ (syllab-parsers :initarg :syllab-parsers
+ :initform nil
+ :documentation "A list of (syllab-parser . facultative) pair, where `syllab-parser'
+is a syllab-parser object, and facultative says if the syylab if facultative in the word.")
+ (word-class :initarg :word-class
+ :type symbol
+ :documentation "The class name of the recognized words."))
+ "A word parser, which aims at building a given type of objects when parsing a recognized word.
+A word is composed of syllabs, and thus a word-parser is composed of syllab-parsers.")
+
+(defmethod update-regexp ((parser word-parser))
+ "Update the parser's regexp thanks to its syllabe-parsers regexps.
+Return the new regexp."
+ (with-slots (syllab-parsers) parser
+ (setf (slot-value parser 'regexp)
+ (apply 'concat "\\b" (mapcar (lambda (sylparser)
+ (format (if (cdr sylparser) "\\(%s\\)?" "%s")
+ (update-regexp (car sylparser))))
+ syllab-parsers)))))
+
+(defclass text-parser (base-parser)
+ ((word-parsers :initarg :word-parsers
+ :initform nil
+ :documentation "List of word-parser objects used to parse a text. Order matters.")
+ (class-unknown :initarg :class-unknown
+ :type symbol
+ :documentation "Class name used to store not recognized text.")
+ (slot-unknown :initarg :slot-unknown
+ :type symbol
+ :documentation "Slot name of class-unknown where the not recognized text will be stored"))
+ "A text parser, which aims at building an object list, each object being built when a word is recognized.
+A text is composed of words, and thus a text-parser is composed of word-parsers. When a piece of text is not
+recognized by word-parsers, it is stored in the slot `slot-unknown' of an object of class `class-unknown'.")
+
+(defmethod update-regexp ((parser text-parser))
+ "Update the text-parser's regexp thanks to its word-parsers regexps.
+Return the new regexp."
+ (with-slots (word-parsers) parser
+ (setf (slot-value parser 'regexp)
+ (format "\\(%s\\)" (my-join (mapcar (lambda (word-parser)
+ (format "\\(%s\\)" (update-regexp word-parser)))
+ word-parsers)
+ "\\|")))))
+
+;;;;;;;; mudela parser ;;;;;;;;;;;;;
+;; no multiple inheritance with eieio... can not define a base class that has an editing-state slot
+
+(defclass mudela-syllab-parser (syllab-parser)
+ ((editing-state :initarg :editing-state
+ :documentation "The current editing state (language, relative/absolute octaves, etc),
+used to generate mudela regexps"))
+ "A syllab parser specialized for mudela.")
+
+(defmethod parse-string ((parser mudela-syllab-parser) mudela-str note-state)
+ "do nothing"
+ nil)
+
+(defclass duration-parser (mudela-syllab-parser)
+ nil
+ "A duration and dots parser.")
+
+(defmethod init-parser ((parser duration-parser) editing-state)
+ "Init the parser regexp"
+ (setf (slot-value parser 'editing-state) editing-state)
+ (setf (slot-value parser 'regexp)
+ (format "\\(%s\\)\\(%s*\\)"
+ (my-join (my-sort-string-by-length
+ (mapcar 'int-to-string
+ (mapcar (lambda (n) (expt 2 (- n 1)))
+ '(1 2 3 4 5 6 7 8))))
+ "\\|")
+ (my-char-to-restring (get-translation editing-state 'dot))))
+ parser)
+
+(defmethod parse-string ((parser duration-parser) mudela-str note-state)
+ "If `parser' regexp matches `mudela-str', return slot initialization description,
+ie (:duration N :dots P), with N and P read from `mudela-str'. Otherwise, a default definition
+is generated thanks to `note-state'."
+ (with-slots (regexp) parser
+ (if (string-match regexp mudela-str)
+ (list :duration (round (1+ (log (string-to-number (match-string-no-properties 1 mudela-str)) 2)))
+ :dots (length (match-string-no-properties 2 mudela-str)))
+ (with-slots (duration dots) note-state
+ (list :duration duration :dots dots)))))
+
+(defclass pitch-parser (mudela-syllab-parser)
+ nil
+ "A pitch, alteration and octave parser.")
+
+(defmethod update-regexp ((parser pitch-parser))
+ "Update the parser's regexp and return it"
+ (with-slots (editing-state) parser
+ (setf (slot-value parser 'regexp)
+ (format "\\(%s\\)\\(%s+\\|%s+\\)?"
+ (my-join (my-sort-string-by-length (mapcar 'cdr (slot-value editing-state 'pitch-dict)))
+ "\\|")
+ (my-char-to-restring (get-translation editing-state 'octave-down))
+ (my-char-to-restring (get-translation editing-state 'octave-up))))))
+
+(defmethod init-parser ((parser pitch-parser) editing-state)
+ "Init the parser regexp"
+ (setf (slot-value parser 'editing-state) editing-state)
+ (update-regexp parser)
+ parser)
+
+(defmethod parse-string ((parser pitch-parser) mudela-str note-state)
+ "If `parser' regexp matches `mudela-str', return slot initialization description,
+ie (:pitch N :alteration P :octave Q), with N, P and Q read from `mudela-str'."
+ (with-slots (regexp editing-state) parser
+ (when (string-match regexp mudela-str)
+ (let* ((pitch-alter (get-pitch editing-state (match-string-no-properties 1 mudela-str)))
+ (pitch (car pitch-alter))
+ (alter (cdr pitch-alter)))
+ (list :pitch pitch
+ :alteration alter
+ :octave (+ 0
+ (if (slot-value editing-state 'relative-octave)
+ (+ (slot-value note-state 'octave)
+ (cond ((> (- pitch (slot-value note-state 'pitch)) 3) -1)
+ ((> (- (slot-value note-state 'pitch) pitch) 3) 1)
+ (t 0)))
+ 0)
+ (if (match-string-no-properties 2 mudela-str)
+ (* (if (string= (char-to-string (get-translation editing-state 'octave-down))
+ (substring (match-string-no-properties 2 mudela-str) 0 1))
+ -1
+ 1)
+ (length (match-string-no-properties 2 mudela-str)))
+ 0)))))))
+
+(defclass chromatic-parser (mudela-syllab-parser)
+ nil
+ "A chromatic information parser.")
+
+(defmethod init-parser ((parser chromatic-parser) editing-state)
+ "Init the parser regexp"
+ (setf (slot-value parser 'editing-state) editing-state)
+ (setf (slot-value parser 'regexp)
+ (format "\\(%s\\|%s\\)"
+ (my-char-to-restring (get-translation editing-state 'reminder-accidental))
+ (my-char-to-restring (get-translation editing-state 'cautionary-accidental))))
+ parser)
+
+(defmethod parse-string ((parser chromatic-parser) mudela-str note-state)
+ "If `parser' regexp matches `mudela-str', return slot initialization description,
+ie (:reminder-accidental N :cautionary-accidental P, with N and P read from `mudela-str'."
+ (with-slots (regexp editing-state) parser
+ (if (string-match regexp mudela-str)
+ (list :reminder-accidental (string= (char-to-string (get-translation editing-state 'reminder-accidental))
+ (substring (match-string-no-properties 0 mudela-str) 0 1))
+ :cautionary-accidental (string= (char-to-string (get-translation editing-state 'cautionary-accidental))
+ (substring (match-string-no-properties 0 mudela-str) 0 1)))
+ (list :reminder-accidental nil :cautionary-accidental nil))))
+
+(defclass r-parser (mudela-syllab-parser)
+ nil
+ "A r (rest) parser.")
+
+(defmethod init-parser ((parser r-parser) editing-state)
+ "Init the parser regexp"
+ (setf (slot-value parser 'editing-state) editing-state)
+ (setf (slot-value parser 'regexp)
+ (format "\\(%s\\|%s\\)"
+ (get-translation editing-state 'rest)
+ (upcase (get-translation editing-state 'rest))))
+ parser)
+
+(defclass s-parser (mudela-syllab-parser)
+ ((editing-state :initarg :editing-state
+ :documentation "The current editing state (language, relative/absolute octaves, etc),
+used to generate mudela regexps"))
+ "A s (skip) parser.")
+
+(defmethod init-parser ((parser s-parser) editing-state)
+ "Init the parser regexp"
+ (setf (slot-value parser 'editing-state) editing-state)
+ (setf (slot-value parser 'regexp) (get-translation editing-state 'skip))
+ parser)
+
+(defclass mudela-word-parser (word-parser)
+ ((editing-state :initarg :editing-state
+ :documentation "The current editing state (language, relative/absolute octaves, etc),
+used to generate mudela regexps"))
+ "A specialized mudella word parser.")
+
+(defmethod init-parser ((parser mudela-word-parser) editing-state)
+ "Init the parser regexp"
+ (setf (slot-value parser 'editing-state) editing-state)
+ (with-slots (syllab-parsers) parser
+ (dolist (sylparser syllab-parsers)
+ (init-parser (car sylparser) editing-state)))
+ (update-regexp parser)
+ parser)
+
+(defmethod parse-string ((parser mudela-word-parser) mudela-str note-state &optional before after)
+ "If the parser regexp matches `mudela-str' exactly and if `regexp-not-after' and
+`regexp-not-before' do not match the strings `before' or `after', return an instance
+of `word-class' by parsing `mudela-str'."
+ (with-slots (word-class syllab-parsers regexp regexp-not-after regexp-not-before) parser
+ (when (and (string-match regexp mudela-str)
+ (string= (match-string-no-properties 0 mudela-str) mudela-str)
+ (not (and before (string-match regexp-not-after before)))
+ (not (and after (string-match regexp-not-before after))))
+ (apply 'make-instance word-class (apply 'append
+ (remove-if 'null (mapcar (lambda (syl-parser)
+ (parse-string (car syl-parser) mudela-str note-state))
+ syllab-parsers)))))))
+
+(defclass mudela-parser (text-parser)
+ ((editing-state :initarg :editing-state
+ :documentation "The current editing state (language, relative/absolute octaves, etc),
+used to generate mudela regexps"))
+ "A simple mudela parser, that can read notes, rests and skips")
+
+(defmethod init-parser ((parser mudela-parser) editing-state)
+ "Initialize `parser' : editing-state, syllab and word parsers, etc."
+ (setf (slot-value parser 'editing-state) editing-state)
+ (with-slots (word-parsers) parser
+ (dolist (word-pars word-parsers)
+ (init-parser word-pars editing-state)))
+ (update-regexp parser)
+ parser)
+
+(defmethod parse-string ((parser mudela-parser) mudela-str note-state &optional before after)
+ "If `mudela-str' is exactly recognized as a known word, return an object
+corresponding to that word. Otherwise, return nil."
+ (with-slots (word-parsers) parser
+ (do* ((wparsers word-parsers (cdr wparsers))
+ (wparser (car wparsers) (car wparsers))
+ obj)
+ ((or obj (not wparser)) obj)
+ (setq obj (parse-string wparser mudela-str note-state before after)))))
+
+(defmethod get-word ((parser mudela-parser) note-state &optional backward limit)
+ "Return a (word beginning end) list, `word' being the first mudela-word
+found after (if `backward' is nil) or before (otherwise) point, `beginning' and
+`end' being its beginning and end points. If no such word is found,
+ (nil beginning end) is returned, `beginning' and `end' being the parsed region.
+The position is preserved."
+ (save-excursion
+ (with-slots (regexp) parser
+ (let (word
+ (beginning (and (not backward) (point)))
+ (end (and backward (point))))
+ (while (and (not word)
+ (if backward
+ (re-search-backward regexp limit t)
+ (re-search-forward regexp limit t)))
+ (let* ((b (match-beginning 0))
+ (e (match-end 0))
+ (point-before (and (> b (point-min)) (1- b)))
+ (point-after (and (< e (point-max)) e))
+ (str-before (and point-before (buffer-substring-no-properties point-before (1+ point-before))))
+ (str-after (and point-after (buffer-substring-no-properties point-after (1+ point-after))))
+ (token (parse-string parser (match-string-no-properties 0) note-state str-before str-after)))
+ (if token
+ (setq word token
+ beginning b
+ end e)
+ (goto-char (if backward (1- e) (1+ b))))))
+ (list word
+ (if backward (or beginning limit) beginning)
+ (if backward end (or end limit)))))))
+
+(defmethod parse-region ((parser mudela-parser) beginning end)
+ "Return an object list describing what as been read by `parser' in the
+region delimited by `beginning' and `end'."
+ (with-slots (class-unknown slot-unknown) parser
+ (labels ((make-verbatim (text)
+ (let ((obj (make-instance class-unknown)))
+ (setf (slot-value obj slot-unknown) text)
+ obj)))
+ (save-excursion
+ (let ((start-verb beginning)
+ tokens
+ (note-state (make-instance 'mudela-note-state)))
+ (goto-char beginning)
+ (do ((word-descr (get-word parser note-state nil end)
+ (get-word parser note-state nil end)))
+ ((or (null (car word-descr)) (>= (point) end)))
+ ;; first, we push verbatim text in tokens
+ (push (make-verbatim (buffer-substring-no-properties start-verb (cadr word-descr))) tokens)
+ ;; then, the recognized word
+ (push (car word-descr) tokens)
+ ;; finally, update position
+ (goto-char (caddr word-descr))
+ (setq start-verb (point))
+ (setf note-state (update-note-state (car word-descr) note-state)))
+ ;; remaining verbatim text
+ (when (< start-verb end)
+ (push (make-verbatim (buffer-substring-no-properties start-verb end)) tokens))
+ (nreverse tokens))))))
+
+
+(defun make-mudela-parser (editing-state)
+ "Build and initialize a simple mudela parser."
+ (let* (;; syllab-parsers
+ (duration-pars (make-instance 'duration-parser))
+ (pitch-pars (make-instance 'pitch-parser))
+ (chromatic-pars (make-instance 'chromatic-parser))
+ (r-pars (make-instance 'r-parser))
+ (s-pars (make-instance 's-parser))
+ ;; word-parsers
+ (note-pars (make-instance 'mudela-word-parser
+ :not-before "[a-zA-Z]"
+ :not-after "[a-zA-Z\\\\]"
+ :word-class 'mudela-note
+ :syllab-parsers (list (cons pitch-pars nil)
+ (cons chromatic-pars t)
+ (cons duration-pars t))))
+ (rest-pars (make-instance 'mudela-word-parser
+ :not-before "[a-zA-Z]"
+ :not-after "[a-zA-Z\\\\]"
+ :word-class 'mudela-rest
+ :syllab-parsers (list (cons r-pars nil)
+ (cons duration-pars t))))
+ (skip-pars (make-instance 'mudela-word-parser
+ :not-before "[a-zA-Z]"
+ :not-after "[a-zA-Z\\\\]"
+ :word-class 'mudela-skip
+ :syllab-parsers (list (cons s-pars nil)
+ (cons duration-pars t))))
+ ;; text-parser
+ (mudela-pars (make-instance 'mudela-parser
+ :class-unknown 'mudela-verbatim
+ :slot-unknown 'text
+ :word-parsers (list note-pars
+ rest-pars
+ skip-pars))))
+ (init-parser mudela-pars editing-state)
+ mudela-pars))
+
+(provide 'lyqi-parser)
--- /dev/null
+;; $RCSfile: lyqi-rumor.el,v $
+;; $Revision: 1.2 $
+;; $Date: 2004/03/14 15:15:24 $
+;; $Author: nicolas $
+;;;
+;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
+;;; for quick note insertion while editing GNU LilyPond music scores.
+;;;
+;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
+;;; See http://nicolas.sceaux.free.fr/lilypond/
+;;;
+
+(require 'eieio)
+(require 'lyqi-base)
+(require 'lyqi-midi)
+
+(defcustom lyqi-rumor-command "rumor"
+ "Command used to start the rumor process."
+ :group 'lyqi
+ :type 'string)
+
+;;; rumor options
+(defcustom lyqi-rumor-default-grain 16
+ "Set minimum time resolution to the NUMth note. Only powers of two are valid, from 1 up to 128."
+ :group 'lyqi
+ :type 'number)
+
+(defcustom lyqi-rumor-default-tempo 80
+ "Metronome speed in beats per minute."
+ :group 'lyqi
+ :type 'number)
+
+(defcustom lyqi-rumor-default-legato nil
+ "If true, ignore any rests between notes."
+ :group 'lyqi
+ :type 'boolean)
+
+(defcustom lyqi-rumor-default-no-dots nil
+ "If true, do not use dotted notes."
+ :group 'lyqi
+ :type 'boolean)
+
+(defcustom lyqi-rumor-default-flat nil
+ "If true, output only pitches as you play, no lengths."
+ :group 'lyqi
+ :type 'boolean)
+
+(defcustom lyqi-rumor-default-strip t
+ "If true, strip leading and trailing rests from output."
+ :group 'lyqi
+ :type 'boolean)
+
+;; the two following are obiously score-dependant, not really
+;; custom vars. However, with defcustom, they can be set thanks
+;; to set-variable.
+(defcustom lyqi-rumor-default-meter "4/4"
+ "P/Q. Set time signature. Bar will have P beats of duration of the Qth note. Q must be a power of two."
+ :group 'lyqi
+ :type 'string)
+
+(defcustom lyqi-rumor-default-key "c"
+ "Set base note of current scale.
+Valid values for KEY are ces, c, cis, des, .... Double sharps/flats are not allowed.
+Note that KEY has to be given using note language `nederlands'."
+ :group 'lyqi
+ :type 'string)
+
+(defcustom lyqi-rumor-default-alsa-port 64
+ "rumor ALSA port"
+ :group 'lyqi
+ :type 'number)
+
+(defvar lyqi-rumor-process nil
+ "The rumor process.")
+
+(defclass rumor (midi-process)
+ ((grain :initarg :grain)
+ (tempo :initarg :tempo)
+ (legato :initarg :legato)
+ (no-dots :initarg :no-dots)
+ (flat :initarg :flat)
+ (strip :initarg :strip)
+ (meter :initarg :meter)
+ (key :initarg :key)
+ (port :initarg :alsa-port)))
+
+(defmethod process-start :BEFORE ((rumor rumor))
+ "Start a rumor recording session"
+ (with-slots (grain tempo legato no-dots flat strip meter key port) rumor
+ (setf (slot-value rumor 'args)
+ (list "2>/dev/null"
+ (format "--meter=%s" meter)
+ (format "--tempo=%d" tempo)
+ (format "--grain=%d" grain)
+ (format "--key=%s" key)
+ (format "--alsa=%d:0,%d:0" port port)))
+ (when legato
+ (push "--legato" (slot-value rumor 'args)))
+ (when no-dots
+ (push "--no-dots" (slot-value rumor 'args)))
+ (when flat
+ (push "--flat" (slot-value rumor 'args)))
+ (when strip
+ (push "--strip" (slot-value rumor 'args)))
+ (push (format "--lang=%s" (case (slot-value lyqi-editing-state 'language)
+ (nederlands "ne")
+ (english "en-short")
+ (deutsch "de")
+ (norsk "no")
+ (svenska "sv")
+ (italiano "it")
+ (catalan "ca")
+ (espanol"es")))
+ (slot-value rumor 'args))
+ (when (slot-value lyqi-editing-state 'force-duration)
+ (push "--explicit-duration" (slot-value rumor 'args)))
+ (unless (slot-value lyqi-editing-state 'relative-octave)
+ (push "--absolute-pitches" (slot-value rumor 'args)))
+ (push "--no-chords" (slot-value rumor 'args))
+ (setf (slot-value rumor 'args) (nreverse (slot-value rumor 'args)))))
+
+(defmethod process-start :AFTER ((rumor rumor))
+ (set-process-filter (slot-value rumor 'process) 'rumor-filter))
+
+(defun rumor-filter (process output)
+ "Process Filter Function for rumor.
+ Just insert rumor output in current buffer."
+ (insert output)
+ (accept-process-output process 0.3 0))
+
+(provide 'lyqi-rumor)
+
--- /dev/null
+\documentclass{article}
+\usepackage{fancyhdr}
+\usepackage[pdftex]{graphicx}
+\usepackage[bf]{caption2}
+\newenvironment{narrow}[2]{%
+ \begin{list}{}{%
+ \setlength{\topsep}{0pt}%
+ \setlength{\leftmargin}{#1}%
+ \setlength{\rightmargin}{#2}%
+ \setlength{\listparindent}{\parindent}%
+ \setlength{\itemindent}{\parindent}%
+ \setlength{\parsep}{\parskip}}%
+ \item[]}{\end{list}}
+\renewcommand{\textfraction}{0.15}
+\renewcommand{\topfraction}{0.85}
+\renewcommand{\bottomfraction}{0.65}
+\renewcommand{\floatpagefraction}{0.60}
+\pagestyle{fancy}
+\author{AUTHOR}
+\title{TITLE}
+\begin{document}
+%\maketitle
+
+%\figure~\ref{fig:fasta3_search} on
+%page~\pageref{fig:fasta3_search} for {\tt fasta3} and in
+%figure~\ref{fig:blastp_search} on page~\pageref{fig:blastp_search} for
+%{\tt blastp}.
+
+%\begin{figure}[htbp]
+%\centering
+%\includegraphics[width=1\textwidth]{blastp_image.jpg}
+%\caption{{\tt blastp}}
+%\label{fig:blastp_search}
+%\end{figure}
+
+%\begin{table}[htbp]
+%\footnotesize
+%\begin{narrow}{-1in}{-1in}
+%\centering
+%\begin{tabular}{c c c c c c}
+%%IL7R$\alpha$ & {\it Homo sapiens} & P16871 & $2.6\cdot10^{-155}$ & $10^{-143}$ & $1.5\cdot10^{-181}$\\
+%\end{tabular}
+%\end{narrow}
+%\caption{Common Hits with Expect Values $< 10^{-10}$}
+%\label{tab:commonhits}
+%\end{table}
+
+
+
+
+
+
+\end{document}
\ No newline at end of file
./tex:
latex
+.svn
./tex/latex:
exam.cls
+.svn
+
+./tex/latex/.svn:
+empty-file
+entries
+format
+prop-base
+props
+README.txt
+text-base
+tmp
+wcprops
+
+./tex/latex/.svn/prop-base:
+
+./tex/latex/.svn/props:
+
+./tex/latex/.svn/text-base:
+exam.cls.svn-base
+
+./tex/latex/.svn/tmp:
+prop-base
+props
+text-base
+wcprops
+
+./tex/latex/.svn/tmp/prop-base:
+
+./tex/latex/.svn/tmp/props:
+
+./tex/latex/.svn/tmp/text-base:
+
+./tex/latex/.svn/tmp/wcprops:
+
+./tex/latex/.svn/wcprops:
+
+./tex/.svn:
+empty-file
+entries
+format
+prop-base
+props
+README.txt
+text-base
+tmp
+wcprops
+
+./tex/.svn/prop-base:
+
+./tex/.svn/props:
+
+./tex/.svn/text-base:
+
+./tex/.svn/tmp:
+prop-base
+props
+text-base
+wcprops
+
+./tex/.svn/tmp/prop-base:
+
+./tex/.svn/tmp/props:
+
+./tex/.svn/tmp/text-base:
+
+./tex/.svn/tmp/wcprops:
+
+./tex/.svn/wcprops:
projects / lib.git / commitdiff