--- /dev/null
+;;; Copyright (C) 2007, 2008 Z RESEARCH Inc. <http://www.zresearch.com>\r
+;;; \r
+;;; This program is free software; you can redistribute it and/or modify\r
+;;; it under the terms of the GNU General Public License as published by\r
+;;; the Free Software Foundation; either version 2 of the License, or\r
+;;; (at your option) any later version.\r
+;;; \r
+;;; This program is distributed in the hope that it will be useful,\r
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
+;;; GNU General Public License for more details.\r
+;;; \r
+;;; You should have received a copy of the GNU General Public License\r
+;;; along with this program; if not, write to the Free Software\r
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.\r
+;;; \r
+\r
+(defvar glusterfs-mode-hook nil)\r
+\r
+;; (defvar glusterfs-mode-map\r
+;; (let ((glusterfs-mode-map (make-keymap)))\r
+;; (define-key glusterfs-mode-map "\C-j" 'newline-and-indent)\r
+;; glusterfs-mode-map)\r
+;; "Keymap for WPDL major mode")\r
+\r
+(add-to-list 'auto-mode-alist '("\\.vol\\'" . glusterfs-mode))\r
+\r
+(defconst glusterfs-font-lock-keywords-1\r
+ (list\r
+ ; "cluster/{unify,afr,stripe}" \r
+ ; "performance/{io-cache,io-threads,write-behind,read-ahead,stat-prefetch}"\r
+ ; "protocol/{client/server}"\r
+ ; "features/{trash,posix-locks,fixed-id,filter}"\r
+ ; "stroage/posix"\r
+ ; "encryption/rot-13"\r
+ ; "debug/trace"\r
+ '("\\<\\(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))\r
+"Additional Keywords to highlight in GlusterFS mode.")\r
+\r
+(defconst glusterfs-font-lock-keywords-2\r
+ (append glusterfs-font-lock-keywords-1\r
+ (list\r
+ ; "replicate" "namespace" "scheduler" "remote-subvolume" "remote-host" \r
+ ; "auth.addr" "block-size" "remote-port" "listen-port" "transport-type"\r
+ ; "limits.min-free-disk" "directory"\r
+ ; TODO: add all the keys here.\r
+ '("\\<\\(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)))\r
+ "option keys in GlusterFS mode.")\r
+\r
+(defconst glusterfs-font-lock-keywords-3\r
+ (append glusterfs-font-lock-keywords-2\r
+ (list\r
+ ; "option" "volume" "end-volume" "subvolumes" "type"\r
+ '("\\<\\(option\ \\|volume\ \\|subvolumes\ \\|type\ \\|end-volume\\)\\>" . font-lock-builtin-face)))\r
+ ;'((regexp-opt (" option " "^volume " "^end-volume" "subvolumes " " type ") t) . font-lock-builtin-face))\r
+ "Minimal highlighting expressions for GlusterFS mode.")\r
+\r
+\r
+(defvar glusterfs-font-lock-keywords glusterfs-font-lock-keywords-3\r
+ "Default highlighting expressions for GlusterFS mode.")\r
+\r
+(defvar glusterfs-mode-syntax-table\r
+ (let ((glusterfs-mode-syntax-table (make-syntax-table)))\r
+ (modify-syntax-entry ?\# "<" glusterfs-mode-syntax-table)\r
+ (modify-syntax-entry ?* ". 23" glusterfs-mode-syntax-table)\r
+ (modify-syntax-entry ?\n ">#" glusterfs-mode-syntax-table)\r
+ glusterfs-mode-syntax-table)\r
+ "Syntax table for glusterfs-mode")\r
+\r
+;; TODO: add an indentation table\r
+\r
+(defun glusterfs-indent-line ()\r
+ "Indent current line as GlusterFS code"\r
+ (interactive)\r
+ (beginning-of-line)\r
+ (if (bobp)\r
+ (indent-line-to 0) ; First line is always non-indented\r
+ (let ((not-indented t) cur-indent)\r
+ (if (looking-at "^[ \t]*volume\ ")\r
+ (progn\r
+ (save-excursion\r
+ (forward-line -1)\r
+ (setq not-indented nil)\r
+ (setq cur-indent 0))))\r
+ (if (looking-at "^[ \t]*end-volume")\r
+ (progn\r
+ (save-excursion\r
+ (forward-line -1)\r
+ (setq cur-indent 0))\r
+ (if (< cur-indent 0) ; We can't indent past the left margin\r
+ (setq cur-indent 0)))\r
+ (save-excursion\r
+ (while not-indented ; Iterate backwards until we find an indentation hint\r
+ (progn\r
+ (setq cur-indent 4) ; Do the actual indenting\r
+ (setq not-indented nil)))))\r
+ (if cur-indent\r
+ (indent-line-to cur-indent)\r
+ (indent-line-to 0)))))\r
+\r
+(defun glusterfs-mode ()\r
+ (interactive)\r
+ (kill-all-local-variables)\r
+ ;; (use-local-map glusterfs-mode-map)\r
+ (set-syntax-table glusterfs-mode-syntax-table)\r
+ (set (make-local-variable 'indent-line-function) 'glusterfs-indent-line) \r
+ (set (make-local-variable 'font-lock-defaults) '(glusterfs-font-lock-keywords))\r
+ (setq major-mode 'glusterfs-mode)\r
+ (setq mode-name "GlusterFS")\r
+ (run-hooks 'glusterfs-mode-hook))\r
+\r
+(provide 'glusterfs-mode)\r
+++ /dev/null
-;; $RCSfile: lyqi-base.el,v $
-;; $Revision: 1.5 $
-;; $Date: 2003/09/27 16:59:27 $
-;; $Author: nicolas $
-;;;
-;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
-;;; for quick note insertion while editing GNU LilyPond music scores.
-;;;
-;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
-;;; See http://nicolas.sceaux.free.fr/lilypond/
-;;;
-
-(eval-when-compile (require 'cl))
-(require 'eieio)
-
-;;;;;;;;;;;;;;;;
-
-(defconst mudela-translation-table
- '((pitch . ((nederlands . ["c" "d" "e" "f" "g" "a" "b"])
- (english . ["c" "d" "e" "f" "g" "a" "b"])
- (deutsch . ["c" "d" "e" "f" "g" "a" "h"])
- (norsk . ["c" "d" "e" "f" "g" "a" "h"])
- (svenska . ["c" "d" "e" "f" "g" "a" "h"])
- (italiano . ["do" "re" "mi" "fa" "sol" "la" "si"])
- (catalan . ["do" "re" "mi" "fa" "sol" "la" "si"])
- (espanol . ["do" "re" "mi" "fa" "sol" "la" "si"])))
- (accidental . ((nederlands . ["eses" "es" "" "is" "isis"])
- (english . ["ff" "f" "" "s" "ss"])
- (deutsch . ["eses" "es" "" "is" "isis"])
- (norsk . ["essess" "ess" "" "iss" "ississ"])
- (svenska . ["essess" "ess" "" "iss" "ississ"])
- (italiano . ["bb" "b" "" "d" "dd"])
- (catalan . ["bb" "b" "" "d" "dd"])
- (espanol . ["bb" "b" "" "s" "ss"])))
- (replacements . ((nederlands . (("eeses" "eses") ("ees" "es")
- ("aeses" "ases") ("aes" "as")))
- (deutsch . (("hes" "b") ;("heses" "bes")
- ("eeses" "eses") ("ees" "es")
- ("aeses" "ases") ("aes" "as")))
- (norsk . (("eessess" "essess") ("eess" "ess")
- ("hess" "b") ("hessess" "bess")))
- (svenska . (("eessess" "essess") ("eess" "ess")
- ("aessess" "assess") ("aess" "ass")
- ("hess" "b") ("hessess" "bess")))))
- (rest . "r")
- (skip . "s")
- (octave-up . ?')
- (octave-down . ?,)
- (dot . ?.)
- (reminder-accidental . ?!)
- (cautionary-accidental . ??)))
-
-(defclass mudela-editing-state ()
- ((translation-table :initarg :translation-table
- :initform nil
- :documentation "A mudela string or character <---> internal value translation table.")
- (language :initarg :language
- :initform nederlands
- :documentation "Current output language")
- (relative-octave :initarg :relative-octave
- :initform nil
- :documentation "Current octave mode. relative if non-nil, absolute otherwise.")
- (force-duration :initarg :force-duration
- :initform t
- :documentation "Current duration output mode. always present if non-nil, ellipsed otherwise")
- (pitch-dict :initarg :pitch-dict
- :initform nil
- :documentation "A mudela<->internal values dictionnnary for pitches and alterations")
- (alterations :initarg :alterations
- :initform [2 2 2 2 2 2 2]
- :documenation "Last alteration for each note."))
- "The current editing state : octave mode, language, etc.")
-
-;; (defmethod init-state ((editing-state mudela-editing-state) &optional lang)
-;; "Initialize `editing-state' pitch-dict due to `lang',
-;; and `translation-table' to `mudela-translation-table'."
-;; (setf (slot-value editing-state 'translation-table) mudela-translation-table)
-;; (with-slots (language) editing-state
-;; (set-language editing-state (or lang language)))
-;; editing-state)
-
-(defmethod get-translation ((editing-state mudela-editing-state) key)
- "Return the value corresponding to `key' in `translation-table'"
- (with-slots (translation-table) editing-state
- (cdr (assoc key translation-table))))
-
-(defmethod get-pitch ((editing-state mudela-editing-state) pitch-string)
- "Return a (pitch . alteration) pair corresponding to `pitch-string' in `pitch-dict' (if any)"
- (with-slots (pitch-dict) editing-state
- (car (rassoc pitch-string pitch-dict))))
-
-(defmethod get-pitch-string ((editing-state mudela-editing-state) pitch alteration)
- "Return the mudela pitch string corresponding to the (`pitch' . `alteration') pair
-in `pitch-dict' (if any)"
- (with-slots (pitch-dict) editing-state
- (cdr (assoc (cons pitch alteration) pitch-dict))))
-
-(defmethod set-language ((editing-state mudela-editing-state) lang)
- "Set the editing-state object's language and update its pitch-dict accordingly."
- (labels ((get-translation2 (key)
- (cdr (assoc lang (get-translation editing-state key)))))
- (setf (slot-value editing-state 'language) (if (stringp lang) (intern lang) lang))
- (setf (slot-value editing-state 'pitch-dict)
- (let (dict)
- (dotimes (pitch 7 (nreverse dict))
- (dotimes (alter 5 dict)
- (setq dict
- (cons (cons (cons pitch alter)
- (let ((note (concat (aref (get-translation2 'pitch) pitch)
- (aref (get-translation2 'accidental) alter))))
- (or (cadr (assoc note (get-translation2 'replacements)))
- note)))
- dict))))))
- lang))
-
-;;;;;;;;;;;;;;;
-
-(defclass mudela-note-state ()
- ((pitch :initarg :pitch
- :initform 0
- :documentation "Previous note pitch")
- (octave :initarg :octave
- :initform 1
- :documentation "Previous note octave")
- (duration :initarg :duration
- :initform 3
- :documentation "Previous music token duration")
- (dots :initarg :dots
- :initform 0
- :documentation "Previous music token dot number"))
- "Describe the current note state : current octave, duration, etc.")
-
-;;;;;;;;;;;;;;;;
-
-(defclass mudela-word ()
- ((editing-state :allocation :class
- :documentation "The current editing state (language, relative/absolute octaves, etc),
-used to generate mudela strings"))
- "Base class for mudela words: notes, rests, skips, etc.")
-
-(defmethod mudela-string ((word mudela-word) &optional note-state)
- "(return an empty string. should be reimplemented by derived classes)"
- "")
-
-(defmethod set-alteration-up ((word mudela-word))
- "Increase, if possible, the word alteration."
- nil)
-
-(defmethod set-alteration-down ((word mudela-word))
- "Decrease, if possible, the word alteration."
- nil)
-
-(defmethod set-alteration-natural ((word mudela-word))
- "Set, if possible, the word alteration to natural."
- nil)
-
-(defmethod set-octave-up ((word mudela-word))
- "Increase the word's octave."
- nil)
-
-(defmethod set-octave-down ((word mudela-word))
- "Decrease the word's octave."
- nil)
-
-(defmethod set-octave-zero ((word mudela-word))
- "Set the note octave to zero."
- nil)
-
-(defmethod set-duration ((word mudela-word) duration)
- "Set the word's duration."
- duration)
-
-(defmethod set-dots ((word mudela-word))
- "Increase, modulo 5, the word's dot number."
- nil)
-
-(defmethod set-reminder-alt ((word mudela-word))
- "Change reminder alteration state for word."
- nil)
-
-(defmethod set-cautionary-alt ((word mudela-word))
- "Change cautionary alteration state for word."
- nil)
-
-(defmethod transpose ((word mudela-word) note-diff exact-pitch-diff &optional note-state)
- "Transpose `word'."
- word)
-
-(defclass mudela-word-duration (mudela-word)
- ((duration :initarg :duration
- :initform 3 ; 2^(3 - 1) = 4 ==> quater note
- :documentation "duration, from 1 to 8. real-duration = 2^(duration - 1)")
- (dots :initarg :dots
- :initform 0 ; no dot
- :documentation "dots, from 0 (no dot) to N>0 (N dots)"))
- "A mudela word that have a duration information.")
-
-(defmethod set-duration ((word mudela-word-duration) duration)
- "Set the word's duration."
- (setf (slot-value word 'dots) 0)
- (setf (slot-value word 'duration) duration))
-
-(defmethod set-dots ((word mudela-word-duration))
- "Increase, modulo 5, the word's dot number."
- (setf (slot-value word 'dots)
- (mod (1+ (slot-value word 'dots)) 5)))
-
-(defmethod update-note-state ((word mudela-word-duration) note-state)
- "Update the current `note-state' thanks to the given music `word': duration and dots."
- (with-slots (duration dots) word
- (setf (slot-value note-state 'duration) duration)
- (setf (slot-value note-state 'dots) dots))
- note-state)
-
-(defmethod mudela-duration ((word mudela-word-duration) &optional note-state)
- "Return the mudela duration string for `word'. If `editing-state'
-indicates that duration is facultative, and `note-state' duration
-and dots are the same that `word' duration and dots, the string is empty."
- (with-slots (duration dots editing-state) word
- (if (and (not (slot-value editing-state 'force-duration))
- note-state
- (= duration (slot-value note-state 'duration))
- (= dots (slot-value note-state 'dots)))
- ;; same duration and dots, and user permit duration ellipse
- ""
- (format "%d%s"
- (expt 2 (1- duration))
- (make-string dots (get-translation editing-state 'dot))))))
-
-(defclass mudela-note (mudela-word-duration)
- ((pitch :initarg :pitch
- :initform 0 ; do / c
- :documentation "note pitch, from 0 (do / c) to 6 (si / b)")
- (alteration :initarg :alteration
- :initform 2 ; becarre / natural
- :documentation "note alteration, from 0 (bb) to 4 (##)")
- (octave :initarg :octave
- :initform 1
- :documentation "note octave, 0 being the octave starting with the do / c
-which is in the 2nd interline in bass clef (4th line F clef)")
- (reminder-accidental :initarg :reminder-accidental
- :initform nil
- :documentation "if non-nil, force a reminder accidental")
- (cautionary-accidental :initarg :cautionary-accidental
- :initform nil
- :documentation "if non-nil and reminder-accidental is nil,
-indicate a cautionary accidental"))
- "Note : duration and pitch")
-
-(defmethod set-alteration-natural ((note mudela-note))
- "Set notes's alteration to natural"
- ;; we update the alterations table in the current editing state
- (aset (slot-value (slot-value note 'editing-state) 'alterations)
- (slot-value note 'pitch)
- 2)
- ;; reset reminder and cautionary slots
- (setf (slot-value note 'cautionary-accidental) nil)
- (setf (slot-value note 'reminder-accidental) nil)
- (setf (slot-value note 'alteration) 2))
-
-(defmethod set-alteration-up ((note mudela-note))
- "Increase, if possible, the note alteration."
- (with-slots (alteration) note
- (when (< alteration 4)
- ;; we update the alterations table in the current editing state
- (aset (slot-value (slot-value note 'editing-state) 'alterations)
- (slot-value note 'pitch)
- (1+ alteration))
- ;; reset reminder and cautionary slots
- (setf (slot-value note 'cautionary-accidental) nil)
- (setf (slot-value note 'reminder-accidental) nil)
- (setf (slot-value note 'alteration) (1+ alteration)))))
-
-(defmethod set-alteration-down ((note mudela-note))
- "Decrease, if possible, the note alteration."
- (with-slots (alteration) note
- (when (> alteration 0)
- ;; we update the alterations table in the current editing state
- (aset (slot-value (slot-value note 'editing-state) 'alterations)
- (slot-value note 'pitch)
- (1- alteration))
- ;; reset reminder and cautionary slots
- (setf (slot-value note 'cautionary-accidental) nil)
- (setf (slot-value note 'reminder-accidental) nil)
- (setf (slot-value note 'alteration) (1- alteration)))))
-
-(defmethod set-octave-up ((note mudela-note))
- "Increase the note's octave."
- (with-slots (octave) note
- (when (< octave 4)
- (setf (slot-value note 'octave) (1+ octave)))))
-
-(defmethod set-octave-down ((note mudela-note))
- "Decrease the note's octave."
- (with-slots (octave) note
- (when (> octave -3)
- (setf (slot-value note 'octave) (1- octave)))))
-
-(defmethod set-octave-zero ((note mudela-note))
- "Set the note octave to zero."
- (setf (slot-value note 'octave) 0))
-
-(defmethod set-reminder-alt ((note mudela-note))
- "Change reminder alteration state for note."
- (with-slots (reminder-accidental) note
- (setf (slot-value note 'reminder-accidental) (not reminder-accidental))))
-
-(defmethod set-cautionary-alt ((note mudela-note))
- "Change cautionary alteration state for note."
- (with-slots (cautionary-accidental) note
- (unless cautionary-accidental
- (setf (slot-value note 'reminder-accidental) nil))
- (setf (slot-value note 'cautionary-accidental) (not cautionary-accidental))))
-
-(defmethod update-note-state ((note mudela-note) note-state)
- "Update the current `note-state' thanks to the given `note': duration, dots, pitch and octave."
- (call-next-method)
- (with-slots (pitch octave) note
- (setf (slot-value note-state 'pitch) pitch)
- (setf (slot-value note-state 'octave) octave))
- note-state)
-
-(defmethod mudela-string ((note mudela-note) &optional note-state)
- "Return the mudela string for `note', depending on the context
-given by `editing-state' and `note-state': pitch, accidental, octave,
-duration (with dots), reminder or cautionary accidental."
- (format "%s%s%s%s"
- (mudela-pitch note)
- (mudela-octave note note-state)
- (mudela-chromatic note)
- (mudela-duration note note-state)))
-
-(defmethod mudela-pitch ((note mudela-note))
- "Return the mudela pitch (with alteration) string for `note'"
- (with-slots (pitch alteration editing-state) note
- (get-pitch-string editing-state pitch alteration)))
-
-(defmethod mudela-octave ((note mudela-note) &optional note-state)
- "Return the mudela octave string for `note'. In case of relative octave mode,
-`note-state' is mandatory."
- (with-slots (pitch octave editing-state) note
- (if (slot-value editing-state 'relative-octave)
- ;; relative octave
- (when note-state
- (let ((abspitch1 (+ (* 7 (slot-value note-state 'octave))
- (slot-value note-state 'pitch)))
- (abspitch2 (+ (* 7 octave) pitch)))
- (if (< (abs (- abspitch1 abspitch2)) 4)
- "" ; same relative octave
- (if (> abspitch1 abspitch2)
- (make-string (+ (/ (- abspitch1 abspitch2 4) 7) 1)
- (get-translation editing-state 'octave-down))
- (make-string (+ (/ (- abspitch2 abspitch1 4) 7) 1)
- (get-translation editing-state 'octave-up))))))
- ;; absolute octave
- (if (> octave 0)
- (make-string octave (get-translation editing-state 'octave-up))
- (make-string (* -1 octave) (get-translation editing-state 'octave-down))))))
-
-(defmethod mudela-chromatic ((note mudela-note))
- "Return the mudela chromatic information string for `note'."
- (with-slots (reminder-accidental cautionary-accidental editing-state) note
- (cond (reminder-accidental
- (char-to-string (get-translation editing-state 'reminder-accidental)))
- (cautionary-accidental
- (char-to-string (get-translation editing-state 'cautionary-accidental)))
- (t ""))))
-
-(defmethod midi-pitch ((note mudela-note))
- "Return `note''s midi pitch, from 0 to 127."
- (with-slots (pitch alteration octave) note
- (+ (aref [0 2 4 5 7 9 11] pitch)
- (- alteration 2)
- (* octave 12)
- 48)))
-
-(defmethod transpose ((note mudela-note) note-diff exact-pitch-diff)
- "Transpose `note'. Ex: (transpose [do] -5 -9) -> [mib,]"
- (with-slots (pitch octave alteration) note
- (let ((newnote (copy-sequence note)))
- ;; pitch
- (setf (slot-value newnote 'pitch) (mod (+ pitch note-diff) 7))
- ;; octave
- (cond ((< (+ pitch note-diff) 0)
- (setf (slot-value newnote 'octave)
- (+ octave (/ (+ pitch note-diff -6) 7))))
- ((> (+ pitch note-diff) 6)
- (setf (slot-value newnote 'octave)
- (+ octave (/ (+ pitch note-diff) 7)))))
- ;; alteration
- (setf (slot-value newnote 'alteration)
- (min (max (+ (- exact-pitch-diff (- (midi-pitch newnote) (midi-pitch note)))
- alteration)
- 0)
- 4))
- newnote)))
-
-
-(defclass mudela-rest (mudela-word-duration)
- nil
- "Rest.")
-
-(defmethod mudela-string ((rest mudela-rest) &optional note-state)
- "Return the mudela string for `rest'."
- (with-slots (editing-state) rest
- (format "%s%s"
- (get-translation editing-state 'rest)
- (mudela-duration rest note-state))))
-
-(defclass mudela-skip (mudela-word-duration)
- nil
- "Skip.")
-
-(defmethod mudela-string ((skip mudela-skip) &optional note-state)
- "Return the mudela string for `skip'."
- (with-slots (editing-state) skip
- (format "%s%s"
- (get-translation editing-state 'skip)
- (mudela-duration skip note-state))))
-
-(defclass mudela-verbatim (mudela-word)
- ((text :initarg :text
- :initform ""
- :documentation "Verbatim mudela text, storing not recognized mudela words"))
- "Not recognized text")
-
-(defmethod update-note-state ((verbatim mudela-verbatim) note-state)
- "(do nothing)"
- note-state)
-
-(defmethod mudela-string ((verbatim mudela-verbatim) &optional note-state)
- "Return the verbatim mudela string contained in this object"
- (with-slots (text) verbatim
- text))
-
-(provide 'lyqi-base)
+++ /dev/null
-;; $RCSfile: lyqi-editor.el,v $
-;; $Revision: 1.6 $
-;; $Date: 2004/03/14 15:15:54 $
-;; $Author: nicolas $
-;;;
-;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
-;;; for quick note insertion while editing GNU LilyPond music scores.
-;;;
-;;; (c) 2003 copyright Nicolas Sceaux <nicolas.sceaux@free.fr>
-;;; See http://nicolas.sceaux.free.fr/lilypond/
-;;;
-
-(eval-when-compile (require 'cl))
-(require 'eieio)
-(require 'lyqi-base)
-(require 'lyqi-parser)
-
-(unless (fboundp 'object-of-class-p)
- (defun object-of-class-p (obj class)
- (obj-of-class-p obj class)))
-
-(defun lyqi-just-one-space ()
- "Invoke `just-one-space', unless point is at the beginning of a line."
- (unless (bolp)
- (just-one-space)))
-
-(defclass mudela-editor ()
- ((editing-state :initarg :editing-state
- :documentation "The current editing state (language, relative/absolute octaves, etc),
-used to generate mudela regexps")
- (parser :initarg :parser
- :documentation "A mudela-parser instance used to read buffer.")
- (note-state :initarg :note-state
- :documentation "Current note state."))
- "A mudela parser: basic mudela edition, such as insert/deleting/updating notes.")
-
-(defmethod point-note-state ((editor mudela-editor))
- "Return a note state deduced thanks to words preceding point."
- (with-slots (parser note-state) editor
- (let* ((fake-note-state (make-instance 'mudela-note-state :duration nil :dots 0))
- (prev-duration-word ;; the previous word with explicit duration
- (save-excursion
- (do ((word-descr (get-word parser fake-note-state t)
- (get-word parser fake-note-state t)))
- ((or (null (car word-descr))
- (<= (point) (point-min))))
- (when (and (object-of-class-p (car word-descr) 'mudela-word-duration)
- (slot-value (car word-descr) 'duration))
- (return (car word-descr)))
- (goto-char (cadr word-descr)))))
- (duration ;; duration of that duration word
- (if prev-duration-word
- (slot-value prev-duration-word 'duration)
- (slot-value note-state 'duration)))
- (dots ;; number of dots in that duration word
- (if prev-duration-word
- (slot-value prev-duration-word 'dots)
- (slot-value note-state 'dots)))
- (prev-note ;; the previous note
- (save-excursion
- (do ((word-descr (get-word parser note-state t)
- (get-word parser note-state t)))
- ((or (null (car word-descr))
- (<= (point) (point-min))))
- (when (mudela-note-p (car word-descr))
- (return (car word-descr)))
- (goto-char (cadr word-descr)))))
- (pitch ;; the pitch of that note
- (if prev-note
- (slot-value prev-note 'pitch)
- (slot-value note-state 'pitch)))
- (octave ;; the octave of that note
- (if (and prev-note (not (slot-value (slot-value parser 'editing-state)
- 'relative-octave)))
- (slot-value prev-note 'octave)
- (slot-value note-state 'octave))))
- (make-instance 'mudela-note-state
- :pitch pitch
- :octave octave
- :duration duration
- :dots dots))))
-
-(defmethod delete-word ((editor mudela-editor) &optional (backward t))
- "Delete the first recognized word after (if `backward' is nil)
-or before (otherwise) point (if any)."
- (with-slots (parser note-state) editor
- (destructuring-bind (word beginning end) (get-word parser note-state t)
- (when word
- (delete-region beginning end)
- (goto-char beginning)
- (lyqi-just-one-space)
- (backward-char)))))
-
-(defmethod make-note ((editor mudela-editor) pitch)
- "Make a new note, of pitch `pitch', which octave and duration are taken
-from `editor''s note-state slot, and alteration taken from editing-state alterations
-slot."
- (setf (slot-value editor 'note-state) (point-note-state editor))
- (with-slots (note-state editing-state) editor
- (with-slots ((pitch0 pitch) (octave0 octave) (duration0 duration) (dots0 dots)) note-state
- (make-instance 'mudela-note :pitch pitch
- :alteration (aref (slot-value editing-state 'alterations) pitch)
- :duration duration0 :dots dots0
- :octave (cond ((> (- pitch pitch0) 3) (1- octave0))
- ((> (- pitch0 pitch) 3) (1+ octave0))
- (t octave0))))))
-
-(defmethod make-rest ((editor mudela-editor))
- "Make a new rest, which duration is taken from `editor''s note-state slot."
- (setf (slot-value editor 'note-state) (point-note-state editor))
- (with-slots (note-state) editor
- (with-slots ((duration0 duration) (dots0 dots)) note-state
- (make-instance 'mudela-rest :duration duration0 :dots dots0))))
-
-(defmethod make-skip ((editor mudela-editor))
- "Make a new rest, which duration is taken from `editor''s note-state slot."
- (setf (slot-value editor 'note-state) (point-note-state editor))
- (with-slots (note-state) editor
- (with-slots ((duration0 duration) (dots0 dots)) note-state
- (make-instance 'mudela-skip :duration duration0 :dots dots0))))
-
-(defmethod word-insert ((editor mudela-editor) word)
- "Insert the word's mudela string at current point, and updates
-editor's note-state."
- (setf (slot-value editor 'note-state) (point-note-state editor))
- (with-slots (note-state) editor
- (lyqi-just-one-space)
- (insert (mudela-string word note-state))
- (lyqi-just-one-space)
- (indent-for-tab-command) ;; TODO: be softer.
- word))
-
-(defmethod search-word ((editor mudela-editor) &optional backward)
- "Return a (word note-state beginning end) list, `word' being a
-mudela-word representation of the first word after (if `backward is nil)
-or before (otherwise) point, `note-state' the note-state deduced before that
-word, `beginning' and `end' being the beginning and end position of the word."
- (with-slots (parser note-state) editor
- (destructuring-bind (tmpword beginning end) (get-word parser note-state backward)
- (cond (tmpword
- (goto-char beginning)
- (let ((new-note-state (point-note-state editor)))
- (list (parse-string parser
- (buffer-substring-no-properties beginning end)
- new-note-state)
- new-note-state
- beginning
- end)))
- (t (list nil nil 0 0))))))
-
-(defmacro with-word-update (editor word-symbol &rest body)
- "Read last word / update / delete / re-write word facility.
-The word preceding point will be read by `editor', and will
-be modified in `body', by refereing it as `word-symbol' (a
-non quoted symbol). Then, word will be deleted in the buffer,
-and a new string, reflecting changes appareing in `body',
-will be inserted."
- (let ((beginning (gensym))
- (end (gensym))
- (note-state-at-point (gensym)))
- `(destructuring-bind (,word-symbol ,note-state-at-point ,beginning ,end) (search-word ,editor t)
- (when ,word-symbol
- ,@body
- (goto-char ,beginning)
- (delete-region ,beginning ,end)
- (word-insert ,editor ,word-symbol)
- ,word-symbol))))
-
-(defmethod transpose-region ((editor mudela-editor) note-diff exact-pitch-diff beginning end)
- "Transpose notes in current region."
- (with-slots (parser note-state) editor
- (goto-char beginning)
- (setf (slot-value editor 'note-state) (point-note-state editor))
- (let ((word-list (parse-region parser beginning end)))
- (delete-region beginning end)
- (dolist (word word-list)
- (let ((transp-word (transpose word note-diff exact-pitch-diff)))
- (word-insert editor transp-word))))))
-
-(defmethod change-octave-mode-region ((editor mudela-editor) beginning end)
- "Switch octave mode for notes included between `beginning' and `end'"
- (with-slots (parser note-state editing-state) editor
- (goto-char beginning)
- (setf (slot-value editor 'note-state) (point-note-state editor))
- (let ((word-list (parse-region parser beginning end)))
- (delete-region beginning end)
- ;; we switch editing-state's octave mode
- (setf (slot-value editing-state 'relative-octave)
- (not (slot-value editing-state 'relative-octave)))
- (dolist (word word-list)
- (word-insert editor word)))))
-
-(defmethod change-language-region ((editor mudela-editor) from-lang to-lang beginning end)
- "Change language for notes included between `beginning' and `end',
-from `from-lang' to `to-lang' (two symbols)."
- (with-slots (parser note-state editing-state) editor
- (goto-char beginning)
- (setf (slot-value editor 'note-state) (point-note-state editor))
- ;; first, read the region with from-lang language
- (when (not (equal (slot-value editing-state 'language) from-lang))
- (set-language editing-state from-lang)
- (update-regexp parser))
- (let ((word-list (parse-region parser beginning end)))
- (delete-region beginning end)
- ;; then, we change language from writing
- (set-language editing-state to-lang)
- (update-regexp parser)
- (dolist (word word-list)
- (word-insert editor word)))))
-
-(provide 'lyqi-editor)
+++ /dev/null
-;; $RCSfile: lyqi-midi.el,v $
-;; $Revision: 1.7 $
-;; $Date: 2004/03/14 15:16:05 $
-;; $Author: nicolas $
-;;;
-;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
-;;; for quick note insertion while editing GNU LilyPond music scores.
-;;;
-;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
-;;; See http://nicolas.sceaux.free.fr/lilypond/
-;;;
-
-(require 'eieio)
-(require 'lyqi-base)
-
-(defcustom lyqi-midi-demon-command "timidity -iA -B2,8 -Os -EFreverb=0"
- "Command used to start the midi demon."
- :group 'lyqi
- :type 'string)
-
-(defcustom lyqi-midi-keyboard-command "mymidikbd"
- "Command used to start the midi keyboard process."
- :group 'lyqi
- :type 'string)
-
-(defcustom lyqi-midi-enabled-default nil
- "Automatically launch midi?"
- :group 'lyqi
- :type 'boolean)
-
-(defcustom lyqi-midi-external-timidity-port 128
- "ALSA port of external timidity server."
- :group 'lyqi
- :type 'integer)
-
-(defcustom lyqi-midi-use-external-timidity-server nil
- "If true, don't start a new timidity server, but use an existing
-one, which port is `lyqi-midi-external-timidity-port'."
- :group 'lyqi
- :type 'boolean)
-
-(defvar lyqi-midi-tempo 80
- "Tempo used for play back (quaters per minute).")
-
-(defvar lyqi-midi-manually-off nil
- "Tells if user has previously switched off midi")
-
-(defvar lyqi-midi-timidity nil
- "The timidity demon process.")
-
-(defvar lyqi-midi-keyboard nil
- "The midi keyboard process.")
-
-(defvar lyqi-midi-on nil
- "Say if midi processes are running")
-
-(defun lyqi-midi-set-timidity-alsa-port (port)
- "When using an external timidity demon, set its ALSA sequencer port."
- (interactive "nTimidity ALSA port: ")
- (setf lyqi-midi-external-timidity-port port)
- (when lyqi-midi-timidity
- (setf (slot-value lyqi-midi-timidity 'seqport) port)))
-
-(defun lyqi-midi-timidity-start ()
- (process-start lyqi-midi-timidity)
- (mapcar (lambda (client)
- (setf (slot-value client 'server-port)
- (slot-value lyqi-midi-timidity 'seqport)))
- (list lyqi-midi-keyboard)))
- ;;(list lyqi-midi-keyboard lyqi-midi-rumor)))
-
-(defun lyqi-midi-start ()
- "Starts the timidity process with ALSA interface
-and the keyboard process."
- (unless lyqi-midi-on
- (lyqi-midi-timidity-start)
- (process-start lyqi-midi-keyboard))
- (setq lyqi-midi-on (and (process-runningp lyqi-midi-timidity)
- (process-runningp lyqi-midi-keyboard))))
-
-(defun lyqi-midi-stop ()
- "Stops timidity and keyboard processes."
- (process-stop lyqi-midi-timidity)
- (process-stop lyqi-midi-keyboard)
- (setq lyqi-midi-on nil))
-
-(defmethod play-note ((note mudela-note) &optional short)
- "Play the given note, by sending its pitch and length (in sec)
-to the midi keyboard process."
- (when (process-runningp lyqi-midi-keyboard)
- (with-slots (duration dots) note
- (process-send-string
- (process-name (slot-value lyqi-midi-keyboard 'process))
- (format "%d %f\n"
- (midi-pitch note)
- (if short
- -1.0
- (* (expt 2.0 (- 3 duration))
- (do ((i 0 (1+ i))
- (sum 0.0 (+ sum (expt 2.0 (- i)))))
- ((> i dots) sum))
- (/ 60.0 (* 1.0 lyqi-midi-tempo)))))))))
-
-(defmethod play-note ((word mudela-word-duration) &optional short)
- "Play the given note, by sending its pitch and length (in sec)
-to the midi keyboard process."
- (when (process-runningp lyqi-midi-keyboard)
- (with-slots (duration dots) word
- (process-send-string (process-name (slot-value lyqi-midi-keyboard 'process))
- (format "%d %f\n"
- -1
- (* (expt 2.0 (- 3 duration))
- (do ((i 0 (1+ i))
- (sum 0.0 (+ sum (expt 2.0 (- i)))))
- ((> i dots) sum))
- (/ 60.0 (* 1.0 lyqi-midi-tempo))))))))
-
-(defmethod play-note ((word mudela-word) &optional short)
- "Play the given note, by sending its pitch and length (in sec)
-to the midi keyboard process."
- nil)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defclass midi-process ()
- ((command :initarg :command
- :initform nil
- :documentation "process start command")
- (args :initarg :args
- :initform nil
- :documentation "process command arguments")
- (name :initarg :name
- :initform nil
- :documentation "process name")
- (process :initform nil
- :documentation "process object")))
-(defmethod process-runningp ((process midi-process))
- "Return t if the process is running, nil otherwise."
- (with-slots ((proc process)) process
- (and proc (eq (process-status proc) 'run))))
-(defmethod process-start ((process midi-process))
- "Start the process"
- (unless (process-runningp process)
- (with-slots (name command args) process
- (setf (slot-value process 'process)
- (apply 'start-process name name (append (split-string command " ")
- args))))))
-(defmethod process-stop ((process midi-process))
- "Stop the process"
- (when (process-runningp process)
- (with-slots ((proc process)) process
- (delete-process (process-name proc)))))
-
-(defclass timidity-server (midi-process)
- ((seqport :initform nil
- :documentation "Timidity ALSA sequencer port")))
-(defmethod process-start :AFTER ((timidity timidity-server))
- "Grep the sequencer port."
- ;; we have to wait a bit before reading timidity's output
- (sleep-for 1)
- (let ((port
- (with-current-buffer (buffer-name (process-buffer (slot-value timidity 'process)))
- (goto-char (point-max))
- (if (re-search-backward "Opening sequencer port: \\([0-9]+\\):" nil t)
- (buffer-substring (match-beginning 1)
- (match-end 1))))))
- (when port
- (setf (slot-value timidity 'seqport) (string-to-int port)))))
-
-(defclass external-timidity-server (midi-process)
- ((seqport ;:initform lyqi-midi-external-timidity-port
- :documentation "External timidity ALSA sequencer port")))
-(defmethod process-runningp ((timidity external-timidity-server))
- t)
-(defmethod process-start ((timidity external-timidity-server))
- t)
-(defmethod process-stop ((timidity external-timidity-server))
- t)
-
-
-(defclass timidity-client (midi-process)
- ((server-port :initform nil
- :documentation "The timidity server ALSA port")))
-
-(defclass mymidikbd (timidity-client) nil)
-(defmethod process-start :BEFORE ((kbd mymidikbd))
- "Update command argument list before execution."
- (setf (slot-value kbd 'args)
- (list (number-to-string (slot-value kbd 'server-port)))))
-
-(provide 'lyqi-midi)
-
+++ /dev/null
-;; $RCSfile: lyqi-mode.el,v $
-;; $Revision: 1.9 $
-;; $Date: 2004/03/14 15:14:55 $
-;; $Author: nicolas $
-;;;
-;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
-;;; for quick note insertion while editing GNU LilyPond music scores.
-;;;
-;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
-;;; See http://nicolas.sceaux.free.fr/lilypond/
-;;;
-
-(defgroup lyqi nil
- "LilyPond quick insert mode."
- :prefix "lyqi-"
- :group 'applications)
-
-(eval-when-compile (require 'cl))
-(require 'lyqi-base)
-(require 'lyqi-parser)
-(require 'lyqi-editor)
-(require 'lyqi-midi)
-(require 'lyqi-rumor)
-
-(defconst lyqi-version "0.2.5")
-
-(defconst lyqi-languages
- '(nederlands english deutsch norsk svenska italiano catalan espanol)
- "Possible languages for writing LilyPond note names.")
-
-(defcustom lyqi-self-inserting-keys "()<>~{}|[] "
- "Self inserting keys in lyqi-mode-map."
- :group 'lyqi
- :type 'string)
-
-(defcustom lyqi-self-inserting-+-char-keys "-_^\\"
- "Self inserting keys, after which the user is asked an extra char to insert."
- :group 'lyqi
- :type 'string)
-
-(defcustom lyqi-self-inserting-+-string-keys
- '((?- "\C-c-") (?_ "\C-c_") (?^ "\C-c^") (?\\ "\C-c\\") (?# "#") (?\" "\"" "\""))
- "Self inserting keys, after which the user is asked an extra string to insert."
- :group 'lyqi)
-
-(defcustom lyqi-force-duration t
- "Force duration to appear when inserting a note"
- :group 'lyqi
- :type 'boolean)
-
-(defcustom lyqi-relative-octave-default nil
- "Relative or absolute octave in lilypond insert mode by default?"
- :group 'lyqi
- :type 'boolean)
-
-(defcustom lyqi-default-language 'nederlands
- "The default language for writing LilyPond note names."
- :group 'lyqi
- :options lyqi-languages
- :type 'symbol)
-
-(defvar lyqi-editing-state nil
- "The current editing state: language, octave mode, etc.")
-
-(defvar lyqi-mudela-editor nil
- "A mudela editor.")
-
-(defvar lyqi-mudela-parser nil
- "A rudimentary mudela parser")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; lilypond-quick-insert-mode interactive functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro with-GNUEmacs (&rest body)
- (if (string-match "GNU Emacs" (version)) `(progn ,@body)))
-
-(defmacro with-XEmacs (&rest body)
- (if (string-match "XEmacs" (version)) `(progn ,@body)))
-
-(with-XEmacs
- (defun my-get-key (fn)
- "Returns the key (a string) binded to `fn'"
- (let ((keys (where-is-internal fn nil t)))
- (and keys (my-join (mapcar (lambda (key)
- (if (consp key)
- (format "%s-%s"
- (upcase (substring (symbol-name (car key)) 0 1))
- (symbol-name (cadr key)))
- (symbol-name key)))
- (append keys nil)) " ")))))
-(with-GNUEmacs
- (defun my-get-key (fn)
- "Returns the key (a string) binded to `fn'"
- (let ((keys (where-is-internal fn nil t)))
- (and keys (my-join (mapcar (lambda (key) (if (and (<= 1 key) (<= key 26))
- (format "C-%c" (+ 96 key))
- (char-to-string key)))
- keys) " ")))))
-
-(defun lyqi-display-state ()
- "Display current state (language used, octave mode) and help commands in the minibuffer."
- (message "lyqi-%s [%s,%s pitches,midi %s] Press %s to quit, %s for help."
- lyqi-version
- (slot-value lyqi-editing-state 'language)
- (if (slot-value lyqi-editing-state 'relative-octave) "relative" "absolute")
- (if lyqi-midi-on "on" "off")
- (my-get-key 'lyqi-quit)
- (my-get-key 'lyqi-help)))
-
-;; (defmacro with-lyqi-interactive (&rest body)
-;; "Utility to make a lyqi interactive command, with message display at the end."
-;; `(progn
-;; (interactive)
-;; ,@body
-;; (lyqi-display-state)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; note, rest, skips insertion
-
-(defun lyqi-insert-note (pitch)
- "Insert a new mudela note of pitch `pitch'."
- (let ((note (make-note lyqi-mudela-editor pitch)))
- (word-insert lyqi-mudela-editor note)
- (when lyqi-midi-on
- (play-note note t))
- (lyqi-display-state)))
-
-(defun lyqi-insert-note-do ()
- "Insert a new do / c note at point."
- (interactive)
- (lyqi-insert-note 0))
-
-(defun lyqi-insert-note-re ()
- "Insert a new re / d note at point."
- (interactive)
- (lyqi-insert-note 1))
-
-(defun lyqi-insert-note-mi ()
- "Insert a new mi / e note at point."
- (interactive)
- (lyqi-insert-note 2))
-
-(defun lyqi-insert-note-fa ()
- "Insert a new fa / f note at point."
- (interactive)
- (lyqi-insert-note 3))
-
-(defun lyqi-insert-note-sol ()
- "Insert a new sol / g note at point."
- (interactive)
- (lyqi-insert-note 4))
-
-(defun lyqi-insert-note-la ()
- "Insert a new la / a note at point."
- (interactive)
- (lyqi-insert-note 5))
-
-(defun lyqi-insert-note-si ()
- "Insert a new si / b note at point."
- (interactive)
- (lyqi-insert-note 6))
-
-(defun lyqi-insert-rest ()
- "Insert a rest at point."
- (interactive)
- (word-insert lyqi-mudela-editor (make-rest lyqi-mudela-editor))
- (lyqi-display-state))
-
-(defun lyqi-insert-skip ()
- "Insert a skip at point."
- (interactive)
- (word-insert lyqi-mudela-editor (make-skip lyqi-mudela-editor))
- (lyqi-display-state))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; note, rest, skips update
-
-;; (defun lyqi-change-duration (duration)
-;; "Change the last word duration, if any, and if possible."
-;; (with-word-update lyqi-mudela-editor the-word
-;; (set-duration the-word duration)))
-(defun lyqi-change-duration (duration)
- "Change the last word duration, if any, and if possible."
- (with-word-update lyqi-mudela-editor the-word
- (set-duration the-word duration)))
-
-(defun lyqi-change-duration-1 ()
- "Change the previous word duration to 1."
- (interactive)
- (lyqi-change-duration 1)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-2 ()
- "Change the previous word duration to 2."
- (interactive)
- (lyqi-change-duration 2)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-4 ()
- "Change the previous word duration to 4."
- (interactive)
- (lyqi-change-duration 3)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-8 ()
- "Change the previous word duration to 8."
- (interactive)
- (lyqi-change-duration 4)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-16 ()
- "Change the previous word duration to 16."
- (interactive)
- (lyqi-change-duration 5)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-32 ()
- "Change the previous word duration to 32."
- (interactive)
- (lyqi-change-duration 6)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-64 ()
- "Change the previous word duration to 64."
- (interactive)
- (lyqi-change-duration 7)
- (lyqi-display-state))
-
-(defun lyqi-change-duration-128 ()
- "Change the previous word duration to 128."
- (interactive)
- (lyqi-change-duration 8)
- (lyqi-display-state))
-
-(defun lyqi-change-dots ()
- "Increase modulo 5 the previous word dot number."
- (interactive)
- (with-word-update lyqi-mudela-editor the-word
- (set-dots the-word))
- (lyqi-display-state))
-
-(defun lyqi-change-alteration-up ()
- "Increase, if possible, the last note alteration."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-alteration-up the-note)
- (when lyqi-midi-on
- (play-note the-note t)))
- (lyqi-display-state))
-
-(defun lyqi-change-alteration-down ()
- "Decrease, if possible, the last note alteration."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-alteration-down the-note)
- (when lyqi-midi-on
- (play-note the-note t)))
- (lyqi-display-state))
-
-(defun lyqi-change-alteration-natural ()
- "Set, if possible, the last note alteration to natural."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-alteration-natural the-note)
- (when lyqi-midi-on
- (play-note the-note t)))
- (lyqi-display-state))
-
-(defun lyqi-change-octave-up ()
- "Increase the last note octave."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-octave-up the-note)
- (when lyqi-midi-on
- (play-note the-note t)))
- (lyqi-display-state))
-
-(defun lyqi-change-octave-down ()
- "Decrease the last note octave."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-octave-down the-note)
- (when lyqi-midi-on
- (play-note the-note t)))
- (lyqi-display-state))
-
-(defun lyqi-change-octave-zero ()
- "Set the last note octave to zero."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-octave-zero the-note)
- (when lyqi-midi-on
- (play-note the-note t)))
- (lyqi-display-state))
-
-(defun lyqi-change-reminder-alt ()
- "Change the last note's reminder alteration state."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-reminder-alt the-note))
- (lyqi-display-state))
-
-(defun lyqi-change-cautionary-alt ()
- "Change the last note's cautionary alteration state."
- (interactive)
- (with-word-update lyqi-mudela-editor the-note
- (set-cautionary-alt the-note))
- (lyqi-display-state))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-(with-XEmacs
- (defun my-read-char-exclusive (prompt)
- (let ((event (next-event nil prompt)))
- (while (not (key-press-event-p event))
- (next-event event prompt))
- (event-to-character event))))
-(with-GNUEmacs
- (defun my-read-char-exclusive (prompt)
- (read-char-exclusive prompt)))
-
-(defun lyqi-insert-tuplet ()
- "Interactively inserts a \\times x/y {"
- (interactive)
- (let ((x ""))
- (lyqi-just-one-space)
- (insert "\\times ")
- (while (not (and (string< x "9") (string< "0" x)))
- (setq x (char-to-string (my-read-char-exclusive
- "Insert a number for the numerator (\"x/\")"))))
- (insert (format "%s/" x)) (setq x "/")
- (while (not (and (string< x "9") (string< "0" x)))
- (setq x (char-to-string (my-read-char-exclusive
- "Insert a number for the denominator (\"/y\")"))))
- (insert (format "%s { " x)))
- (lyqi-display-state))
-
-(defun lyqi-word-forward ()
- "Move to the following mudela word end, if any, otherwise to the end of the
-following text word."
- (interactive)
- (unless (re-search-forward (slot-value lyqi-mudela-parser 'regexp) nil t)
- (forward-word 1))
- (lyqi-display-state))
-
-(defun lyqi-word-backward ()
- "Move to the previous mudela word beginning, if any, otherwise to the beginning of the
-previous text word."
- (interactive)
- (unless (re-search-backward (slot-value lyqi-mudela-parser 'regexp) nil t)
- (backward-word 1))
- (lyqi-display-state))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-(defun my-next (elt seq)
- "Returns the element following `elt' in `seq'.
-If it is the last, returns the first element of the sequence."
- (let ((nexts (cdr (member elt seq))))
- (if (consp nexts)
- (car nexts)
- (car seq))))
-
-(defun lyqi-switch-language ()
- "Select the next mudela language in `lyqi-languages'."
- (interactive)
- (setf lyqi-default-language
- (my-next (slot-value lyqi-editing-state 'language) lyqi-languages))
- (set-language lyqi-editing-state lyqi-default-language)
- (update-regexp lyqi-mudela-parser)
- (lyqi-display-state))
-
-(defun lyqi-switch-octave-mode ()
- "Switch between relative and absolute octave modes."
- (interactive)
- (setf (slot-value lyqi-editing-state 'relative-octave)
- (not (slot-value lyqi-editing-state 'relative-octave)))
- (lyqi-display-state))
-
-(defun my-center-string (str len)
- "Makes a centered string from `str', of length `len'"
- (let* ((inner-str (if (< (length str) len)
- str
- (substring str 0 len)))
- (right-space (/ (- len (length inner-str)) 2))
- (left-space (- len right-space (length inner-str))))
- (format "%s%s%s"
- (make-string left-space (string-to-char " "))
- inner-str
- (make-string right-space (string-to-char " ")))))
-
-(defun lyqi-help ()
- "Display a help message in a dedicated buffer."
- (interactive)
- (describe-mode)
-;; (with-output-to-temp-buffer "*Help*"
-;; (princ "LilyPond quick insert mode
-;; Note entry:
-;; | | | | | | | | | | | | |
-;; | | | | | | | | | | | | |
-;; | |_| |_| | |_| |_| |_| |
-;; | | | | | | | |
-;; |___|___|___|___|___|___|___|\n")
-
-;; (princ (format "pitch keys: %s \n\n"
-;; (my-join (mapcar (lambda (fn)
-;; (my-center-string (format "`%s'" (my-get-key fn)) 3))
-;; '(lyqi-insert-note-do
-;; lyqi-insert-note-re
-;; lyqi-insert-note-mi
-;; lyqi-insert-note-fa
-;; lyqi-insert-note-sol
-;; lyqi-insert-note-la
-;; lyqi-insert-note-si)) " ")))
-;; (princ (format "duration keys: %s\n"
-;; (my-join (mapcar (lambda (fn)
-;; (my-center-string (format "`%s'" (my-get-key fn)) 3))
-;; '(lyqi-change-duration-1
-;; lyqi-change-duration-2
-;; lyqi-change-duration-4
-;; lyqi-change-duration-8
-;; lyqi-change-duration-16
-;; lyqi-change-duration-32
-;; lyqi-change-duration-64
-;; lyqi-change-duration-128)) " ")))
-;; (princ (format " %s\n"
-;; (my-join (mapcar (lambda (num)
-;; (my-center-string
-;; (int-to-string (expt 2 (- num 1))) 3))
-;; '(1 2 3 4 5 6 7 8)) "|")))
-;; (princ (format "alteration: `%s' flat
-;; `%s' sharp\n
-;; `%s' force reminder alteration\n
-;; `%s' force cautionary alteration\n"
-;; (my-get-key 'lyqi-change-alteration-down)
-;; (my-get-key 'lyqi-change-alteration-up)
-;; (my-get-key 'lyqi-change-reminder-alt)
-;; (my-get-key 'lyqi-change-cautionary-alt)))
-;; (princ (format "dot key: `%s'\n" (my-get-key 'lyqi-change-dots)))
-;; (princ (format "octave keys: `%s' down
-;; `%s' up\n"
-;; (my-get-key 'lyqi-change-octave-down)
-;; (my-get-key 'lyqi-change-octave-up)))
-;; (princ (format "rests: `%s'\n" (my-get-key 'lyqi-insert-rest)))
-;; (princ (format "skips: `%s'\n" (my-get-key 'lyqi-insert-skip)))
-;; (princ (format "tuplets: `%s'\n" (my-get-key 'lyqi-insert-tuplet)))
-;; (princ (format "self inserting keys: `%s'\n" (my-join (split-string lyqi-self-inserting-keys "") "' `")))
-;; (princ "\nOther bindings:\n")
-;; (princ (format "absolute/relative octave switch: `%s'\n"
-;; (my-get-key 'lyqi-switch-octave-mode)))
-;; (princ (format "language switch: `%s'\n" (my-get-key 'lyqi-switch-language)))
-;; (princ (format "help: `%s'\n" (my-get-key 'lyqi-help)))
-;; (princ (format "Midi note playing start/stop: `%s'\n"
-;; (my-get-key 'lyqi-midi-start-stop)))
-;; (princ (format "back to LilyPond-mode: `%s'\n" (my-get-key 'lyqi-quit)))
-;; (princ (format "Transpose region: `%s'\n" (my-get-key 'lyqi-transpose-region)))
- (lyqi-display-state))
-
-(defun lyqi-quit ()
- "Quit lilypond-quick-insert-mode, back to LilyPond-mode"
- (interactive)
- (LilyPond-mode))
-
-(defun lyqi-relative-to-absolute-region ()
- "Rewrite region with absolute octave mode instead of relative octave mode.
-An octave transposition may be required afterward."
- (interactive)
- (when (not (slot-value lyqi-editing-state 'relative-octave))
- (lyqi-switch-octave-mode))
- (change-octave-mode-region lyqi-mudela-editor (region-beginning) (region-end))
- (lyqi-display-state))
-
-(defun lyqi-absolute-to-relative-region ()
- "Rewrite region with relative octave mode instead of absolute octave mode."
- (interactive)
- (when (slot-value lyqi-editing-state 'relative-octave)
- (lyqi-switch-octave-mode))
- (change-octave-mode-region lyqi-mudela-editor (region-beginning) (region-end))
- (lyqi-display-state))
-
-(defun lyqi-transpose-region-aux (from-note to-note)
- "Transpose the current region, the interval being defined by `from-note'
-and `to-note', two mudela-notes."
- (when to-note
- (let ((note-diff (+ (- (slot-value to-note 'pitch)
- (slot-value from-note 'pitch))
- (* 7 (- (slot-value to-note 'octave)
- (slot-value from-note 'octave)))))
- (exact-pitch-diff (- (midi-pitch to-note) (midi-pitch from-note))))
- (transpose-region lyqi-mudela-editor note-diff exact-pitch-diff (region-beginning) (region-end)))))
-
-(defun lyqi-transpose-region (to-note-str)
- "Interactively transpose the current region. The user is asked the transposition interval,
-starting from c/do."
- (interactive "sTranspose to: ")
- (let ((from-note (make-instance 'mudela-note :pitch 0 :octave 0))
- (to-note (parse-string lyqi-mudela-parser to-note-str (make-instance 'mudela-note-state :octave 0))))
- (lyqi-transpose-region-aux from-note to-note)))
-
-;;; by Reuben Thomas <rrt@sc3d.org>
-(defun lyqi-transpose-interval-region (trans)
- "Interactively transpose the current region. The user is asked the transposition interval in tones."
- (interactive "sTranspose by interval (tones[+]|[-]) : ")
- (let* ((interval (string-to-int trans))
- (adj (substring trans -1))
- (alt (cond ((equal adj "+") 3)
- ((equal adj "-") 1)
- (t 2)))
- (oct (/ interval 7))
- (tone (% interval 7)))
- (when (< tone 0)
- (setq tone (+ tone 7))
- (setq oct (- oct 1)))
- (let ((from-note (make-instance 'mudela-note :pitch 0 :octave 0))
- (to-note (make-instance 'mudela-note :pitch tone :octave oct :alteration alt)))
- (lyqi-transpose-region-aux from-note to-note)))
- (lyqi-display-state))
-
-(defun lyqi-play-back-region ()
- "If midi is on, play back notes in region."
- (interactive)
- (when (process-runningp lyqi-midi-keyboard)
- (mapcar 'play-note (parse-region lyqi-mudela-parser (region-beginning) (region-end)))))
-
-(defun lyqi-change-language-region ()
- "Change note language in region. The user is asked for source and destination languages."
- (interactive)
- (let* ((current-lang (slot-value lyqi-editing-state 'language))
- (next-lang (my-next current-lang lyqi-languages))
- (lang-collection (mapcar (lambda (lang) (list (symbol-name lang))) lyqi-languages))
- (from-lang (intern (completing-read (format "Change from language [%s]: " current-lang)
- lang-collection nil t nil nil (symbol-name current-lang))))
- (to-lang (intern (completing-read (format "Change from language %s to [%s]: " from-lang next-lang)
- lang-collection nil t nil nil (symbol-name next-lang)))))
- (change-language-region lyqi-mudela-editor from-lang to-lang (region-beginning) (region-end)))
- (lyqi-display-state))
-
-;; (defun lyqi-self-insert-plus-char (char))
-;; (defun lyqi-self-insert-plus-string (char) &optional ending)
-
-;;; Rumor
-
-(defun lyqi-rumor-session-stop ()
- "Stop a running rumor session."
- (interactive)
- (process-stop lyqi-rumor-process)
- (define-key lyqi-mode-map " " 'self-insert-command))
-
-(defun lyqi-rumor-session-start ()
- "Start a rumor session. Press SPC to stop the session"
- (interactive)
- (define-key lyqi-mode-map " " 'lyqi-rumor-session-stop)
- (process-start lyqi-rumor-process))
-
-(defun lyqi-rumor-set-legato ()
- "Change rumor's legato parameter."
- (interactive)
- (let ((legato (with-slots (legato) lyqi-rumor-process
- (setf (slot-value lyqi-rumor-process 'legato)
- (not legato)))))
- (message "rumor: legato mode set %s for next session." (if legato "on" "off"))
- legato))
-
-(defun lyqi-rumor-set-no-dots ()
- "Change rumor's no-dots parameter."
- (interactive)
- (let ((no-dots (with-slots (no-dots) lyqi-rumor-process
- (setf (slot-value lyqi-rumor-process 'no-dots)
- (not no-dots)))))
- (message "rumor: dots %sshown in next session." (if no-dots "not " ""))
- no-dots))
-
-(defun lyqi-rumor-set-flat ()
- "Change rumor's flat parameter."
- (interactive)
- (let ((flat (with-slots (flat) lyqi-rumor-process
- (setf (slot-value lyqi-rumor-process 'flat)
- (not flat)))))
- (message "rumor: flat mode set %s for next session." (if flat "on" "off"))
- flat))
-
-(defun lyqi-rumor-set-grain (grain-str)
- "Set rumor's grain."
- (interactive "sRumor's new grain: ")
- (let ((grain (setf (slot-value lyqi-rumor-process 'grain)
- (string-to-number grain-str))))
- (message "rumor: grain set to %d for next session" grain)
- grain))
-
-(defun lyqi-rumor-set-tempo (tempo-str)
- "Set rumor's tempo."
- (interactive "sRumor's new tempo: ")
- (let ((tempo (setf (slot-value lyqi-rumor-process 'tempo)
- (string-to-number tempo-str))))
- (message "rumor: tempo set to %d for next session" tempo)
- tempo))
-
-(defun lyqi-rumor-set-alsa-port (alsa-port-str)
- "Set rumor's alsa-port."
- (interactive "sRumor's new alsa port: ")
- (let ((port (setf (slot-value lyqi-rumor-process 'port)
- (string-to-number alsa-port-str))))
- (message "rumor: alsa port set to %d for next session" port)
- port))
-
-(defun lyqi-rumor-set-meter (meter)
- "Set rumor's meter."
- (interactive "sRumor's new meter: ")
- (setf (slot-value lyqi-rumor-process 'meter)
- meter)
- (message "rumor: meter set to %s for next session" meter)
- meter)
-
-(defun lyqi-rumor-set-key (key)
- "Set rumor's key."
- (interactive "sRumor's new key (in dutsch): ")
- (setf (slot-value lyqi-rumor-process 'key)
- key)
- (message "rumor: key set to %s for next session" key)
- key)
-
-;;; Midi play back
-
-(defun lyqi-midi-start-stop ()
- "Start or stop midi playing."
- (interactive)
- (if lyqi-midi-on
- (lyqi-midi-stop)
- (lyqi-midi-start))
- (setq lyqi-midi-manually-off (not lyqi-midi-on))
- (lyqi-display-state))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; lyqi-mode definition
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro lyqi-make-self-insert-+-char (key)
- "Define a self-insert-<char>-+-char function, and "
- (let ((fn-symb (intern (format "lyqi-%s-self-insert-+-char" key))))
- `(progn
- (defun ,fn-symb ()
- ,(format "Insert the character %s and ask the user an extra character to insert." key)
- (interactive)
- (insert ,key)
- (insert (char-to-string (my-read-char-exclusive "Following character: "))))
- (define-key lyqi-mode-map ,key ',fn-symb))))
-
-(defmacro lyqi-make-self-insert-+-string (char key &optional end-string)
- "Define a self-insert-<char>-+-char function, and "
- (let ((fn-symb (intern (format "lyqi-%s-self-insert-+-string" (char-to-string char)))))
- `(progn
- (defun ,fn-symb ()
- ,(format "Insert the character %c and ask the user an extra character to insert." char)
- (interactive)
- (insert ,(char-to-string char))
- (insert (read-string "Following string: "))
- ,(if end-string `(insert ,end-string)))
- (define-key lyqi-mode-map ,key ',fn-symb))))
-
-(define-derived-mode lyqi-mode
- LilyPond-mode "lyqi"
- "Major mode for LilyPond quick note insert.
-\\{lyqi-mode-map}"
- (make-local-variable 'lyqi-editing-state)
- (make-local-variable 'lyqi-mudela-parser)
- (make-local-variable 'lyqi-mudela-editor)
-
- (setq lyqi-editing-state (make-instance 'mudela-editing-state
- :translation-table mudela-translation-table
- :relative-octave lyqi-relative-octave-default
- :force-duration lyqi-force-duration))
- (set-language lyqi-editing-state lyqi-default-language)
- (setq lyqi-mudela-parser (make-mudela-parser lyqi-editing-state))
- (setq lyqi-mudela-editor (make-instance 'mudela-editor
- :editing-state lyqi-editing-state
- :parser lyqi-mudela-parser
- :note-state (make-instance 'mudela-note-state)))
- ;; I don't know how to directly set a class slot !
- ;; Is that a feature or a bug ? when I set a class allocated slot
- ;; of a mother class instance, the slot is not also updated in child
- ;; class instances...
- (let ((c (make-instance 'mudela-note))
- (r (make-instance 'mudela-rest))
- (s (make-instance 'mudela-skip)))
- (setf (slot-value c 'editing-state) lyqi-editing-state)
- (setf (slot-value r 'editing-state) lyqi-editing-state)
- (setf (slot-value s 'editing-state) lyqi-editing-state))
-
- ;; midi start
- (unless lyqi-midi-timidity
- (cond (lyqi-midi-use-external-timidity-server
- (setq lyqi-midi-timidity (make-instance 'external-timidity-server))
- (setf (slot-value lyqi-midi-timidity 'seqport) lyqi-midi-external-timidity-port))
- (t
- (setq lyqi-midi-timidity (make-instance 'timidity-server
- :command lyqi-midi-demon-command
- :name "timidity")))))
- (unless lyqi-midi-keyboard
- (setq lyqi-midi-keyboard (make-instance 'mymidikbd
- :command lyqi-midi-keyboard-command
- :name "mymidikbd")))
- (unless lyqi-rumor-process
- (setq lyqi-rumor-process (make-instance 'rumor
- :command lyqi-rumor-command
- :name "rumor"
- :grain lyqi-rumor-default-grain
- :tempo lyqi-rumor-default-tempo
- :legato lyqi-rumor-default-legato
- :no-dots lyqi-rumor-default-no-dots
- :flat lyqi-rumor-default-flat
- :strip lyqi-rumor-default-strip
- :meter lyqi-rumor-default-meter
- :key lyqi-rumor-default-key
- :alsa-port lyqi-rumor-default-alsa-port)))
- (when (and (not lyqi-midi-manually-off)
- lyqi-midi-enabled-default)
- (lyqi-midi-start)))
-
-;; makes all the printing characters undefined.
-(suppress-keymap lyqi-mode-map t)
-;; rests and skips
-(define-key lyqi-mode-map "r" 'lyqi-insert-rest)
-(define-key lyqi-mode-map "s" 'lyqi-insert-skip)
-;; pitches : do re mi fa sol la si
-(define-key lyqi-mode-map "d" 'lyqi-insert-note-do)
-(define-key lyqi-mode-map "f" 'lyqi-insert-note-re)
-(define-key lyqi-mode-map "g" 'lyqi-insert-note-mi)
-(define-key lyqi-mode-map "h" 'lyqi-insert-note-fa)
-(define-key lyqi-mode-map "j" 'lyqi-insert-note-sol)
-(define-key lyqi-mode-map "k" 'lyqi-insert-note-la)
-(define-key lyqi-mode-map "l" 'lyqi-insert-note-si)
-;; alterations
-(define-key lyqi-mode-map "i" 'lyqi-change-alteration-up)
-(define-key lyqi-mode-map "e" 'lyqi-change-alteration-down)
-(define-key lyqi-mode-map "n" 'lyqi-change-alteration-natural)
-(define-key lyqi-mode-map "!" 'lyqi-change-reminder-alt)
-(define-key lyqi-mode-map "?" 'lyqi-change-cautionary-alt)
-;; octave
-(define-key lyqi-mode-map "'" 'lyqi-change-octave-up)
-(define-key lyqi-mode-map "," 'lyqi-change-octave-down)
-(define-key lyqi-mode-map "=" 'lyqi-change-octave-zero)
-;; durations: 1 2 4 8 16 32 64 128
-(define-key lyqi-mode-map "1" 'lyqi-change-duration-1)
-(define-key lyqi-mode-map "2" 'lyqi-change-duration-2)
-(define-key lyqi-mode-map "4" 'lyqi-change-duration-4)
-(define-key lyqi-mode-map "8" 'lyqi-change-duration-8)
-(define-key lyqi-mode-map "7" 'lyqi-change-duration-16)
-(define-key lyqi-mode-map "5" 'lyqi-change-duration-32)
-(define-key lyqi-mode-map "0" 'lyqi-change-duration-64)
-(define-key lyqi-mode-map "9" 'lyqi-change-duration-128)
-;; dots
-(define-key lyqi-mode-map "." 'lyqi-change-dots)
-;; tuplets
-(define-key lyqi-mode-map "\C-ct" 'lyqi-insert-tuplet)
-;; other bindings
-(define-key lyqi-mode-map "\C-co" 'lyqi-switch-octave-mode)
-(define-key lyqi-mode-map "\C-c\C-l" 'lyqi-switch-language)
-(define-key lyqi-mode-map "\C-cq" 'lyqi-quit) ; back to LilyPond-mode
-(define-key lyqi-mode-map "\C-ch" 'lyqi-help)
-(define-key lyqi-mode-map "\M-b" 'lyqi-word-backward)
-(define-key lyqi-mode-map "\M-f" 'lyqi-word-forward)
-(define-key lyqi-mode-map "\C-c\C-t" 'lyqi-transpose-region)
-(define-key lyqi-mode-map "\C-cm" 'lyqi-midi-start-stop)
-(define-key lyqi-mode-map "\C-cp" 'lyqi-play-back-region)
-;; prefix key for rumor commands
-(define-prefix-command 'ctl-c-p)
-(define-key lyqi-mode-map "\C-cr" ctl-c-p)
-(define-key lyqi-mode-map "\C-crs" 'lyqi-rumor-session-start)
-(define-key lyqi-mode-map "\C-crg" 'lyqi-rumor-set-grain)
-(define-key lyqi-mode-map "\C-crt" 'lyqi-rumor-set-tempo)
-(define-key lyqi-mode-map "\C-crl" 'lyqi-rumor-set-legato)
-(define-key lyqi-mode-map "\C-crd" 'lyqi-rumor-set-no-dots)
-(define-key lyqi-mode-map "\C-crf" 'lyqi-rumor-set-flat)
-(define-key lyqi-mode-map "\C-crm" 'lyqi-rumor-set-meter)
-(define-key lyqi-mode-map "\C-crk" 'lyqi-rumor-set-key)
-(define-key lyqi-mode-map "\C-crp" 'lyqi-rumor-set-alsa-port)
-;; self inserting keys
-(dolist (key (split-string lyqi-self-inserting-keys ""))
- (define-key lyqi-mode-map key 'self-insert-command))
-(dolist (key (split-string lyqi-self-inserting-+-char-keys ""))
- (eval `(lyqi-make-self-insert-+-char ,key)))
-(dolist (key-descr lyqi-self-inserting-+-string-keys)
- (eval `(lyqi-make-self-insert-+-string ,@key-descr)))
+++ /dev/null
-;; $RCSfile: lyqi-parser.el,v $
-;; $Revision: 1.5 $
-;; $Date: 2003/09/27 16:33:49 $
-;; $Author: nicolas $
-;;;
-;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
-;;; for quick note insertion while editing GNU LilyPond music scores.
-;;;
-;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
-;;; See http://nicolas.sceaux.free.fr/lilypond/
-;;;
-
-(eval-when-compile (require 'cl))
-(require 'eieio)
-(require 'lyqi-base)
-
-;;;;;; few string utilities ;;;;;;;;;;
-
-;; for XEmacs21 compatibility
-(if (not (fboundp 'match-string-no-properties))
- (defalias 'match-string-no-properties 'match-string))
-
-(defun my-join (string-list joiner)
- "Returns a concatenation of all string-list elements, with joiner between elements"
- (apply 'concat
- (car string-list)
- (mapcar (lambda (str) (concat joiner str))
- (cdr string-list))))
-
-(defun my-sort-string-by-length (string-list)
- "Sort the given string list by decreasing string length."
- (nreverse
- (sort string-list
- (lambda (str1 str2)
- (or (< (length str1) (length str2))
- (and (= (length str1) (length str2))
- (string< str1 str2)))))))
-
-(defun my-char-to-restring (char)
- (concat (if (member char '(?. ?* ?+ ??)) "\\" "")
- (char-to-string char)))
-
-;;;;;; parser classes ;;;;;;;;;
-
-(defclass base-parser ()
- ((regexp :initarg :regexp
- :documentation "A regular expression associated with the parser"))
- "base class for parsers")
-
-(defmethod update-regexp ((parser base-parser))
- "(do nothing) Return the parser's regexp"
- (slot-value parser 'regexp))
-
-(defclass syllab-parser (base-parser)
- nil
- "A syllab parser, ie a specialized word component parser.")
-
-(defclass word-parser (base-parser)
- ((regexp-not-before :initarg :not-before
- :initform nil
- :documentation "A regexp describing what should not be found after the words
-that the parser recognize.")
- (regexp-not-after :initarg :not-after
- :initform nil
- :documentation "A regexp describing what should not be found before the words
-that the parser recognize.")
- (syllab-parsers :initarg :syllab-parsers
- :initform nil
- :documentation "A list of (syllab-parser . facultative) pair, where `syllab-parser'
-is a syllab-parser object, and facultative says if the syylab if facultative in the word.")
- (word-class :initarg :word-class
- :type symbol
- :documentation "The class name of the recognized words."))
- "A word parser, which aims at building a given type of objects when parsing a recognized word.
-A word is composed of syllabs, and thus a word-parser is composed of syllab-parsers.")
-
-(defmethod update-regexp ((parser word-parser))
- "Update the parser's regexp thanks to its syllabe-parsers regexps.
-Return the new regexp."
- (with-slots (syllab-parsers) parser
- (setf (slot-value parser 'regexp)
- (apply 'concat "\\b" (mapcar (lambda (sylparser)
- (format (if (cdr sylparser) "\\(%s\\)?" "%s")
- (update-regexp (car sylparser))))
- syllab-parsers)))))
-
-(defclass text-parser (base-parser)
- ((word-parsers :initarg :word-parsers
- :initform nil
- :documentation "List of word-parser objects used to parse a text. Order matters.")
- (class-unknown :initarg :class-unknown
- :type symbol
- :documentation "Class name used to store not recognized text.")
- (slot-unknown :initarg :slot-unknown
- :type symbol
- :documentation "Slot name of class-unknown where the not recognized text will be stored"))
- "A text parser, which aims at building an object list, each object being built when a word is recognized.
-A text is composed of words, and thus a text-parser is composed of word-parsers. When a piece of text is not
-recognized by word-parsers, it is stored in the slot `slot-unknown' of an object of class `class-unknown'.")
-
-(defmethod update-regexp ((parser text-parser))
- "Update the text-parser's regexp thanks to its word-parsers regexps.
-Return the new regexp."
- (with-slots (word-parsers) parser
- (setf (slot-value parser 'regexp)
- (format "\\(%s\\)" (my-join (mapcar (lambda (word-parser)
- (format "\\(%s\\)" (update-regexp word-parser)))
- word-parsers)
- "\\|")))))
-
-;;;;;;;; mudela parser ;;;;;;;;;;;;;
-;; no multiple inheritance with eieio... can not define a base class that has an editing-state slot
-
-(defclass mudela-syllab-parser (syllab-parser)
- ((editing-state :initarg :editing-state
- :documentation "The current editing state (language, relative/absolute octaves, etc),
-used to generate mudela regexps"))
- "A syllab parser specialized for mudela.")
-
-(defmethod parse-string ((parser mudela-syllab-parser) mudela-str note-state)
- "do nothing"
- nil)
-
-(defclass duration-parser (mudela-syllab-parser)
- nil
- "A duration and dots parser.")
-
-(defmethod init-parser ((parser duration-parser) editing-state)
- "Init the parser regexp"
- (setf (slot-value parser 'editing-state) editing-state)
- (setf (slot-value parser 'regexp)
- (format "\\(%s\\)\\(%s*\\)"
- (my-join (my-sort-string-by-length
- (mapcar 'int-to-string
- (mapcar (lambda (n) (expt 2 (- n 1)))
- '(1 2 3 4 5 6 7 8))))
- "\\|")
- (my-char-to-restring (get-translation editing-state 'dot))))
- parser)
-
-(defmethod parse-string ((parser duration-parser) mudela-str note-state)
- "If `parser' regexp matches `mudela-str', return slot initialization description,
-ie (:duration N :dots P), with N and P read from `mudela-str'. Otherwise, a default definition
-is generated thanks to `note-state'."
- (with-slots (regexp) parser
- (if (string-match regexp mudela-str)
- (list :duration (round (1+ (log (string-to-number (match-string-no-properties 1 mudela-str)) 2)))
- :dots (length (match-string-no-properties 2 mudela-str)))
- (with-slots (duration dots) note-state
- (list :duration duration :dots dots)))))
-
-(defclass pitch-parser (mudela-syllab-parser)
- nil
- "A pitch, alteration and octave parser.")
-
-(defmethod update-regexp ((parser pitch-parser))
- "Update the parser's regexp and return it"
- (with-slots (editing-state) parser
- (setf (slot-value parser 'regexp)
- (format "\\(%s\\)\\(%s+\\|%s+\\)?"
- (my-join (my-sort-string-by-length (mapcar 'cdr (slot-value editing-state 'pitch-dict)))
- "\\|")
- (my-char-to-restring (get-translation editing-state 'octave-down))
- (my-char-to-restring (get-translation editing-state 'octave-up))))))
-
-(defmethod init-parser ((parser pitch-parser) editing-state)
- "Init the parser regexp"
- (setf (slot-value parser 'editing-state) editing-state)
- (update-regexp parser)
- parser)
-
-(defmethod parse-string ((parser pitch-parser) mudela-str note-state)
- "If `parser' regexp matches `mudela-str', return slot initialization description,
-ie (:pitch N :alteration P :octave Q), with N, P and Q read from `mudela-str'."
- (with-slots (regexp editing-state) parser
- (when (string-match regexp mudela-str)
- (let* ((pitch-alter (get-pitch editing-state (match-string-no-properties 1 mudela-str)))
- (pitch (car pitch-alter))
- (alter (cdr pitch-alter)))
- (list :pitch pitch
- :alteration alter
- :octave (+ 0
- (if (slot-value editing-state 'relative-octave)
- (+ (slot-value note-state 'octave)
- (cond ((> (- pitch (slot-value note-state 'pitch)) 3) -1)
- ((> (- (slot-value note-state 'pitch) pitch) 3) 1)
- (t 0)))
- 0)
- (if (match-string-no-properties 2 mudela-str)
- (* (if (string= (char-to-string (get-translation editing-state 'octave-down))
- (substring (match-string-no-properties 2 mudela-str) 0 1))
- -1
- 1)
- (length (match-string-no-properties 2 mudela-str)))
- 0)))))))
-
-(defclass chromatic-parser (mudela-syllab-parser)
- nil
- "A chromatic information parser.")
-
-(defmethod init-parser ((parser chromatic-parser) editing-state)
- "Init the parser regexp"
- (setf (slot-value parser 'editing-state) editing-state)
- (setf (slot-value parser 'regexp)
- (format "\\(%s\\|%s\\)"
- (my-char-to-restring (get-translation editing-state 'reminder-accidental))
- (my-char-to-restring (get-translation editing-state 'cautionary-accidental))))
- parser)
-
-(defmethod parse-string ((parser chromatic-parser) mudela-str note-state)
- "If `parser' regexp matches `mudela-str', return slot initialization description,
-ie (:reminder-accidental N :cautionary-accidental P, with N and P read from `mudela-str'."
- (with-slots (regexp editing-state) parser
- (if (string-match regexp mudela-str)
- (list :reminder-accidental (string= (char-to-string (get-translation editing-state 'reminder-accidental))
- (substring (match-string-no-properties 0 mudela-str) 0 1))
- :cautionary-accidental (string= (char-to-string (get-translation editing-state 'cautionary-accidental))
- (substring (match-string-no-properties 0 mudela-str) 0 1)))
- (list :reminder-accidental nil :cautionary-accidental nil))))
-
-(defclass r-parser (mudela-syllab-parser)
- nil
- "A r (rest) parser.")
-
-(defmethod init-parser ((parser r-parser) editing-state)
- "Init the parser regexp"
- (setf (slot-value parser 'editing-state) editing-state)
- (setf (slot-value parser 'regexp)
- (format "\\(%s\\|%s\\)"
- (get-translation editing-state 'rest)
- (upcase (get-translation editing-state 'rest))))
- parser)
-
-(defclass s-parser (mudela-syllab-parser)
- ((editing-state :initarg :editing-state
- :documentation "The current editing state (language, relative/absolute octaves, etc),
-used to generate mudela regexps"))
- "A s (skip) parser.")
-
-(defmethod init-parser ((parser s-parser) editing-state)
- "Init the parser regexp"
- (setf (slot-value parser 'editing-state) editing-state)
- (setf (slot-value parser 'regexp) (get-translation editing-state 'skip))
- parser)
-
-(defclass mudela-word-parser (word-parser)
- ((editing-state :initarg :editing-state
- :documentation "The current editing state (language, relative/absolute octaves, etc),
-used to generate mudela regexps"))
- "A specialized mudella word parser.")
-
-(defmethod init-parser ((parser mudela-word-parser) editing-state)
- "Init the parser regexp"
- (setf (slot-value parser 'editing-state) editing-state)
- (with-slots (syllab-parsers) parser
- (dolist (sylparser syllab-parsers)
- (init-parser (car sylparser) editing-state)))
- (update-regexp parser)
- parser)
-
-(defmethod parse-string ((parser mudela-word-parser) mudela-str note-state &optional before after)
- "If the parser regexp matches `mudela-str' exactly and if `regexp-not-after' and
-`regexp-not-before' do not match the strings `before' or `after', return an instance
-of `word-class' by parsing `mudela-str'."
- (with-slots (word-class syllab-parsers regexp regexp-not-after regexp-not-before) parser
- (when (and (string-match regexp mudela-str)
- (string= (match-string-no-properties 0 mudela-str) mudela-str)
- (not (and before (string-match regexp-not-after before)))
- (not (and after (string-match regexp-not-before after))))
- (apply 'make-instance word-class (apply 'append
- (remove-if 'null (mapcar (lambda (syl-parser)
- (parse-string (car syl-parser) mudela-str note-state))
- syllab-parsers)))))))
-
-(defclass mudela-parser (text-parser)
- ((editing-state :initarg :editing-state
- :documentation "The current editing state (language, relative/absolute octaves, etc),
-used to generate mudela regexps"))
- "A simple mudela parser, that can read notes, rests and skips")
-
-(defmethod init-parser ((parser mudela-parser) editing-state)
- "Initialize `parser' : editing-state, syllab and word parsers, etc."
- (setf (slot-value parser 'editing-state) editing-state)
- (with-slots (word-parsers) parser
- (dolist (word-pars word-parsers)
- (init-parser word-pars editing-state)))
- (update-regexp parser)
- parser)
-
-(defmethod parse-string ((parser mudela-parser) mudela-str note-state &optional before after)
- "If `mudela-str' is exactly recognized as a known word, return an object
-corresponding to that word. Otherwise, return nil."
- (with-slots (word-parsers) parser
- (do* ((wparsers word-parsers (cdr wparsers))
- (wparser (car wparsers) (car wparsers))
- obj)
- ((or obj (not wparser)) obj)
- (setq obj (parse-string wparser mudela-str note-state before after)))))
-
-(defmethod get-word ((parser mudela-parser) note-state &optional backward limit)
- "Return a (word beginning end) list, `word' being the first mudela-word
-found after (if `backward' is nil) or before (otherwise) point, `beginning' and
-`end' being its beginning and end points. If no such word is found,
- (nil beginning end) is returned, `beginning' and `end' being the parsed region.
-The position is preserved."
- (save-excursion
- (with-slots (regexp) parser
- (let (word
- (beginning (and (not backward) (point)))
- (end (and backward (point))))
- (while (and (not word)
- (if backward
- (re-search-backward regexp limit t)
- (re-search-forward regexp limit t)))
- (let* ((b (match-beginning 0))
- (e (match-end 0))
- (point-before (and (> b (point-min)) (1- b)))
- (point-after (and (< e (point-max)) e))
- (str-before (and point-before (buffer-substring-no-properties point-before (1+ point-before))))
- (str-after (and point-after (buffer-substring-no-properties point-after (1+ point-after))))
- (token (parse-string parser (match-string-no-properties 0) note-state str-before str-after)))
- (if token
- (setq word token
- beginning b
- end e)
- (goto-char (if backward (1- e) (1+ b))))))
- (list word
- (if backward (or beginning limit) beginning)
- (if backward end (or end limit)))))))
-
-(defmethod parse-region ((parser mudela-parser) beginning end)
- "Return an object list describing what as been read by `parser' in the
-region delimited by `beginning' and `end'."
- (with-slots (class-unknown slot-unknown) parser
- (labels ((make-verbatim (text)
- (let ((obj (make-instance class-unknown)))
- (setf (slot-value obj slot-unknown) text)
- obj)))
- (save-excursion
- (let ((start-verb beginning)
- tokens
- (note-state (make-instance 'mudela-note-state)))
- (goto-char beginning)
- (do ((word-descr (get-word parser note-state nil end)
- (get-word parser note-state nil end)))
- ((or (null (car word-descr)) (>= (point) end)))
- ;; first, we push verbatim text in tokens
- (push (make-verbatim (buffer-substring-no-properties start-verb (cadr word-descr))) tokens)
- ;; then, the recognized word
- (push (car word-descr) tokens)
- ;; finally, update position
- (goto-char (caddr word-descr))
- (setq start-verb (point))
- (setf note-state (update-note-state (car word-descr) note-state)))
- ;; remaining verbatim text
- (when (< start-verb end)
- (push (make-verbatim (buffer-substring-no-properties start-verb end)) tokens))
- (nreverse tokens))))))
-
-
-(defun make-mudela-parser (editing-state)
- "Build and initialize a simple mudela parser."
- (let* (;; syllab-parsers
- (duration-pars (make-instance 'duration-parser))
- (pitch-pars (make-instance 'pitch-parser))
- (chromatic-pars (make-instance 'chromatic-parser))
- (r-pars (make-instance 'r-parser))
- (s-pars (make-instance 's-parser))
- ;; word-parsers
- (note-pars (make-instance 'mudela-word-parser
- :not-before "[a-zA-Z]"
- :not-after "[a-zA-Z\\\\]"
- :word-class 'mudela-note
- :syllab-parsers (list (cons pitch-pars nil)
- (cons chromatic-pars t)
- (cons duration-pars t))))
- (rest-pars (make-instance 'mudela-word-parser
- :not-before "[a-zA-Z]"
- :not-after "[a-zA-Z\\\\]"
- :word-class 'mudela-rest
- :syllab-parsers (list (cons r-pars nil)
- (cons duration-pars t))))
- (skip-pars (make-instance 'mudela-word-parser
- :not-before "[a-zA-Z]"
- :not-after "[a-zA-Z\\\\]"
- :word-class 'mudela-skip
- :syllab-parsers (list (cons s-pars nil)
- (cons duration-pars t))))
- ;; text-parser
- (mudela-pars (make-instance 'mudela-parser
- :class-unknown 'mudela-verbatim
- :slot-unknown 'text
- :word-parsers (list note-pars
- rest-pars
- skip-pars))))
- (init-parser mudela-pars editing-state)
- mudela-pars))
-
-(provide 'lyqi-parser)
+++ /dev/null
-;; $RCSfile: lyqi-rumor.el,v $
-;; $Revision: 1.2 $
-;; $Date: 2004/03/14 15:15:24 $
-;; $Author: nicolas $
-;;;
-;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
-;;; for quick note insertion while editing GNU LilyPond music scores.
-;;;
-;;; (c) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
-;;; See http://nicolas.sceaux.free.fr/lilypond/
-;;;
-
-(require 'eieio)
-(require 'lyqi-base)
-(require 'lyqi-midi)
-
-(defcustom lyqi-rumor-command "rumor"
- "Command used to start the rumor process."
- :group 'lyqi
- :type 'string)
-
-;;; rumor options
-(defcustom lyqi-rumor-default-grain 16
- "Set minimum time resolution to the NUMth note. Only powers of two are valid, from 1 up to 128."
- :group 'lyqi
- :type 'number)
-
-(defcustom lyqi-rumor-default-tempo 80
- "Metronome speed in beats per minute."
- :group 'lyqi
- :type 'number)
-
-(defcustom lyqi-rumor-default-legato nil
- "If true, ignore any rests between notes."
- :group 'lyqi
- :type 'boolean)
-
-(defcustom lyqi-rumor-default-no-dots nil
- "If true, do not use dotted notes."
- :group 'lyqi
- :type 'boolean)
-
-(defcustom lyqi-rumor-default-flat nil
- "If true, output only pitches as you play, no lengths."
- :group 'lyqi
- :type 'boolean)
-
-(defcustom lyqi-rumor-default-strip t
- "If true, strip leading and trailing rests from output."
- :group 'lyqi
- :type 'boolean)
-
-;; the two following are obiously score-dependant, not really
-;; custom vars. However, with defcustom, they can be set thanks
-;; to set-variable.
-(defcustom lyqi-rumor-default-meter "4/4"
- "P/Q. Set time signature. Bar will have P beats of duration of the Qth note. Q must be a power of two."
- :group 'lyqi
- :type 'string)
-
-(defcustom lyqi-rumor-default-key "c"
- "Set base note of current scale.
-Valid values for KEY are ces, c, cis, des, .... Double sharps/flats are not allowed.
-Note that KEY has to be given using note language `nederlands'."
- :group 'lyqi
- :type 'string)
-
-(defcustom lyqi-rumor-default-alsa-port 64
- "rumor ALSA port"
- :group 'lyqi
- :type 'number)
-
-(defvar lyqi-rumor-process nil
- "The rumor process.")
-
-(defclass rumor (midi-process)
- ((grain :initarg :grain)
- (tempo :initarg :tempo)
- (legato :initarg :legato)
- (no-dots :initarg :no-dots)
- (flat :initarg :flat)
- (strip :initarg :strip)
- (meter :initarg :meter)
- (key :initarg :key)
- (port :initarg :alsa-port)))
-
-(defmethod process-start :BEFORE ((rumor rumor))
- "Start a rumor recording session"
- (with-slots (grain tempo legato no-dots flat strip meter key port) rumor
- (setf (slot-value rumor 'args)
- (list "2>/dev/null"
- (format "--meter=%s" meter)
- (format "--tempo=%d" tempo)
- (format "--grain=%d" grain)
- (format "--key=%s" key)
- (format "--alsa=%d:0,%d:0" port port)))
- (when legato
- (push "--legato" (slot-value rumor 'args)))
- (when no-dots
- (push "--no-dots" (slot-value rumor 'args)))
- (when flat
- (push "--flat" (slot-value rumor 'args)))
- (when strip
- (push "--strip" (slot-value rumor 'args)))
- (push (format "--lang=%s" (case (slot-value lyqi-editing-state 'language)
- (nederlands "ne")
- (english "en-short")
- (deutsch "de")
- (norsk "no")
- (svenska "sv")
- (italiano "it")
- (catalan "ca")
- (espanol"es")))
- (slot-value rumor 'args))
- (when (slot-value lyqi-editing-state 'force-duration)
- (push "--explicit-duration" (slot-value rumor 'args)))
- (unless (slot-value lyqi-editing-state 'relative-octave)
- (push "--absolute-pitches" (slot-value rumor 'args)))
- (push "--no-chords" (slot-value rumor 'args))
- (setf (slot-value rumor 'args) (nreverse (slot-value rumor 'args)))))
-
-(defmethod process-start :AFTER ((rumor rumor))
- (set-process-filter (slot-value rumor 'process) 'rumor-filter))
-
-(defun rumor-filter (process output)
- "Process Filter Function for rumor.
- Just insert rumor output in current buffer."
- (insert output)
- (accept-process-output process 0.3 0))
-
-(provide 'lyqi-rumor)
-
projects / lib.git / commitdiff