From: Don Armstrong Date: Sat, 19 Sep 2009 00:17:10 +0000 (+0000) Subject: delete lyqi and add glusterfs-mode X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=101b8dfead47d4b722b9daee4c2ac10d282c2ea6;p=lib.git delete lyqi and add glusterfs-mode --- diff --git a/emacs_el/glusterfs-mode.el b/emacs_el/glusterfs-mode.el new file mode 100644 index 0000000..fdad286 --- /dev/null +++ b/emacs_el/glusterfs-mode.el @@ -0,0 +1,112 @@ +;;; Copyright (C) 2007, 2008 Z RESEARCH Inc. +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +;;; + +(defvar glusterfs-mode-hook nil) + +;; (defvar glusterfs-mode-map +;; (let ((glusterfs-mode-map (make-keymap))) +;; (define-key glusterfs-mode-map "\C-j" 'newline-and-indent) +;; glusterfs-mode-map) +;; "Keymap for WPDL major mode") + +(add-to-list 'auto-mode-alist '("\\.vol\\'" . glusterfs-mode)) + +(defconst glusterfs-font-lock-keywords-1 + (list + ; "cluster/{unify,afr,stripe}" + ; "performance/{io-cache,io-threads,write-behind,read-ahead,stat-prefetch}" + ; "protocol/{client/server}" + ; "features/{trash,posix-locks,fixed-id,filter}" + ; "stroage/posix" + ; "encryption/rot-13" + ; "debug/trace" + '("\\<\\(cluster/\\(unify\\|afr\\|stripe\\)\\|\\performance/\\(io-\\(cache\\|threads\\)\\|write-behind\\|read-ahead\\|stat-prefetch\\|booster\\)\\|protocol/\\(server\\|client\\)\\|features/\\(trash\\|posix-locks\\|fixed-id\\|path-converter\\|filter\\)\\|storage/\\(posix\\|bdb\\)\\|encryption/rot-13\\|debug/trace\\)\\>" . font-lock-keyword-face)) +"Additional Keywords to highlight in GlusterFS mode.") + +(defconst glusterfs-font-lock-keywords-2 + (append glusterfs-font-lock-keywords-1 + (list + ; "replicate" "namespace" "scheduler" "remote-subvolume" "remote-host" + ; "auth.addr" "block-size" "remote-port" "listen-port" "transport-type" + ; "limits.min-free-disk" "directory" + ; TODO: add all the keys here. + '("\\<\\(inode-lru-limit\\|replicate\\|namespace\\|scheduler\\|username\\|password\\|allow\\|reject\\|block-size\\|listen-port\\|transport-type\\|directory\\|page-size\\|page-count\\|aggregate-size\\|non-blocking-io\\|client-volume-filename\\|bind-address\\|self-heal\\|read-only-subvolumes\\|read-subvolume\\|thread-count\\|cache-size\\|window-size\\|force-revalidate-timeout\\|priority\\|include\\|exclude\\|remote-\\(host\\|subvolume\\|port\\)\\|auth.\\(addr\\|login\\)\\|limits.\\(min-disk-free\\|transaction-size\\|ib-verbs-\\(work-request-\\(send-\\|recv-\\(count\\|size\\)\\)\\|port\\|mtu\\|device-name\\)\\)\\)\ \\>" . font-lock-constant-face))) + "option keys in GlusterFS mode.") + +(defconst glusterfs-font-lock-keywords-3 + (append glusterfs-font-lock-keywords-2 + (list + ; "option" "volume" "end-volume" "subvolumes" "type" + '("\\<\\(option\ \\|volume\ \\|subvolumes\ \\|type\ \\|end-volume\\)\\>" . font-lock-builtin-face))) + ;'((regexp-opt (" option " "^volume " "^end-volume" "subvolumes " " type ") t) . font-lock-builtin-face)) + "Minimal highlighting expressions for GlusterFS mode.") + + +(defvar glusterfs-font-lock-keywords glusterfs-font-lock-keywords-3 + "Default highlighting expressions for GlusterFS mode.") + +(defvar glusterfs-mode-syntax-table + (let ((glusterfs-mode-syntax-table (make-syntax-table))) + (modify-syntax-entry ?\# "<" glusterfs-mode-syntax-table) + (modify-syntax-entry ?* ". 23" glusterfs-mode-syntax-table) + (modify-syntax-entry ?\n ">#" glusterfs-mode-syntax-table) + glusterfs-mode-syntax-table) + "Syntax table for glusterfs-mode") + +;; TODO: add an indentation table + +(defun glusterfs-indent-line () + "Indent current line as GlusterFS code" + (interactive) + (beginning-of-line) + (if (bobp) + (indent-line-to 0) ; First line is always non-indented + (let ((not-indented t) cur-indent) + (if (looking-at "^[ \t]*volume\ ") + (progn + (save-excursion + (forward-line -1) + (setq not-indented nil) + (setq cur-indent 0)))) + (if (looking-at "^[ \t]*end-volume") + (progn + (save-excursion + (forward-line -1) + (setq cur-indent 0)) + (if (< cur-indent 0) ; We can't indent past the left margin + (setq cur-indent 0))) + (save-excursion + (while not-indented ; Iterate backwards until we find an indentation hint + (progn + (setq cur-indent 4) ; Do the actual indenting + (setq not-indented nil))))) + (if cur-indent + (indent-line-to cur-indent) + (indent-line-to 0))))) + +(defun glusterfs-mode () + (interactive) + (kill-all-local-variables) + ;; (use-local-map glusterfs-mode-map) + (set-syntax-table glusterfs-mode-syntax-table) + (set (make-local-variable 'indent-line-function) 'glusterfs-indent-line) + (set (make-local-variable 'font-lock-defaults) '(glusterfs-font-lock-keywords)) + (setq major-mode 'glusterfs-mode) + (setq mode-name "GlusterFS") + (run-hooks 'glusterfs-mode-hook)) + +(provide 'glusterfs-mode) diff --git a/emacs_el/lyqi-base.el b/emacs_el/lyqi-base.el deleted file mode 100644 index c060d48..0000000 --- a/emacs_el/lyqi-base.el +++ /dev/null @@ -1,436 +0,0 @@ -;; $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 deleted file mode 100644 index d452536..0000000 --- a/emacs_el/lyqi-editor.el +++ /dev/null @@ -1,211 +0,0 @@ -;; $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 deleted file mode 100644 index e3e98e5..0000000 --- a/emacs_el/lyqi-midi.el +++ /dev/null @@ -1,191 +0,0 @@ -;; $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 deleted file mode 100644 index be68518..0000000 --- a/emacs_el/lyqi-mode.el +++ /dev/null @@ -1,786 +0,0 @@ -;; $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 deleted file mode 100644 index b9a017c..0000000 --- a/emacs_el/lyqi-parser.el +++ /dev/null @@ -1,399 +0,0 @@ -;; $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 deleted file mode 100644 index b687aaa..0000000 --- a/emacs_el/lyqi-rumor.el +++ /dev/null @@ -1,132 +0,0 @@ -;; $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) -