From d7770b36dec98e119032f6f191385846227dfa14 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Sun, 30 Oct 2005 05:21:32 +0000 Subject: [PATCH] update templates, add lyqi and update ls-R --- emacs_el/lyqi-base.el | 436 ++++++++++++++++++++ emacs_el/lyqi-editor.el | 211 ++++++++++ emacs_el/lyqi-midi.el | 191 +++++++++ emacs_el/lyqi-mode.el | 786 ++++++++++++++++++++++++++++++++++++ emacs_el/lyqi-parser.el | 399 ++++++++++++++++++ emacs_el/lyqi-rumor.el | 132 ++++++ templates/article_shell.tex | 53 +++ texmf/ls-R | 69 ++++ 8 files changed, 2277 insertions(+) create mode 100644 emacs_el/lyqi-base.el create mode 100644 emacs_el/lyqi-editor.el create mode 100644 emacs_el/lyqi-midi.el create mode 100644 emacs_el/lyqi-mode.el create mode 100644 emacs_el/lyqi-parser.el create mode 100644 emacs_el/lyqi-rumor.el create mode 100644 templates/article_shell.tex diff --git a/emacs_el/lyqi-base.el b/emacs_el/lyqi-base.el new file mode 100644 index 0000000..c060d48 --- /dev/null +++ b/emacs_el/lyqi-base.el @@ -0,0 +1,436 @@ +;; $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 +;;; 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) diff --git a/emacs_el/lyqi-editor.el b/emacs_el/lyqi-editor.el new file mode 100644 index 0000000..d452536 --- /dev/null +++ b/emacs_el/lyqi-editor.el @@ -0,0 +1,211 @@ +;; $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 +;;; 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) diff --git a/emacs_el/lyqi-midi.el b/emacs_el/lyqi-midi.el new file mode 100644 index 0000000..e3e98e5 --- /dev/null +++ b/emacs_el/lyqi-midi.el @@ -0,0 +1,191 @@ +;; $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 +;;; 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) + diff --git a/emacs_el/lyqi-mode.el b/emacs_el/lyqi-mode.el new file mode 100644 index 0000000..be68518 --- /dev/null +++ b/emacs_el/lyqi-mode.el @@ -0,0 +1,786 @@ +;; $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 +;;; 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 +(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 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 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))) diff --git a/emacs_el/lyqi-parser.el b/emacs_el/lyqi-parser.el new file mode 100644 index 0000000..b9a017c --- /dev/null +++ b/emacs_el/lyqi-parser.el @@ -0,0 +1,399 @@ +;; $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 +;;; 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) diff --git a/emacs_el/lyqi-rumor.el b/emacs_el/lyqi-rumor.el new file mode 100644 index 0000000..b687aaa --- /dev/null +++ b/emacs_el/lyqi-rumor.el @@ -0,0 +1,132 @@ +;; $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 +;;; 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) + diff --git a/templates/article_shell.tex b/templates/article_shell.tex new file mode 100644 index 0000000..b21c229 --- /dev/null +++ b/templates/article_shell.tex @@ -0,0 +1,53 @@ +\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 diff --git a/texmf/ls-R b/texmf/ls-R index 01d9791..0f81712 100644 --- a/texmf/ls-R +++ b/texmf/ls-R @@ -223,6 +223,75 @@ wcprops ./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: -- 2.39.2