1 ;; $RCSfile: lyqi-editor.el,v $
3 ;; $Date: 2004/03/14 15:15:54 $
6 ;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
7 ;;; for quick note insertion while editing GNU LilyPond music scores.
9 ;;; (c) 2003 copyright Nicolas Sceaux <nicolas.sceaux@free.fr>
10 ;;; See http://nicolas.sceaux.free.fr/lilypond/
13 (eval-when-compile (require 'cl))
16 (require 'lyqi-parser)
18 (unless (fboundp 'object-of-class-p)
19 (defun object-of-class-p (obj class)
20 (obj-of-class-p obj class)))
22 (defun lyqi-just-one-space ()
23 "Invoke `just-one-space', unless point is at the beginning of a line."
27 (defclass mudela-editor ()
28 ((editing-state :initarg :editing-state
29 :documentation "The current editing state (language, relative/absolute octaves, etc),
30 used to generate mudela regexps")
31 (parser :initarg :parser
32 :documentation "A mudela-parser instance used to read buffer.")
33 (note-state :initarg :note-state
34 :documentation "Current note state."))
35 "A mudela parser: basic mudela edition, such as insert/deleting/updating notes.")
37 (defmethod point-note-state ((editor mudela-editor))
38 "Return a note state deduced thanks to words preceding point."
39 (with-slots (parser note-state) editor
40 (let* ((fake-note-state (make-instance 'mudela-note-state :duration nil :dots 0))
41 (prev-duration-word ;; the previous word with explicit duration
43 (do ((word-descr (get-word parser fake-note-state t)
44 (get-word parser fake-note-state t)))
45 ((or (null (car word-descr))
46 (<= (point) (point-min))))
47 (when (and (object-of-class-p (car word-descr) 'mudela-word-duration)
48 (slot-value (car word-descr) 'duration))
49 (return (car word-descr)))
50 (goto-char (cadr word-descr)))))
51 (duration ;; duration of that duration word
52 (if prev-duration-word
53 (slot-value prev-duration-word 'duration)
54 (slot-value note-state 'duration)))
55 (dots ;; number of dots in that duration word
56 (if prev-duration-word
57 (slot-value prev-duration-word 'dots)
58 (slot-value note-state 'dots)))
59 (prev-note ;; the previous note
61 (do ((word-descr (get-word parser note-state t)
62 (get-word parser note-state t)))
63 ((or (null (car word-descr))
64 (<= (point) (point-min))))
65 (when (mudela-note-p (car word-descr))
66 (return (car word-descr)))
67 (goto-char (cadr word-descr)))))
68 (pitch ;; the pitch of that note
70 (slot-value prev-note 'pitch)
71 (slot-value note-state 'pitch)))
72 (octave ;; the octave of that note
73 (if (and prev-note (not (slot-value (slot-value parser 'editing-state)
75 (slot-value prev-note 'octave)
76 (slot-value note-state 'octave))))
77 (make-instance 'mudela-note-state
83 (defmethod delete-word ((editor mudela-editor) &optional (backward t))
84 "Delete the first recognized word after (if `backward' is nil)
85 or before (otherwise) point (if any)."
86 (with-slots (parser note-state) editor
87 (destructuring-bind (word beginning end) (get-word parser note-state t)
89 (delete-region beginning end)
94 (defmethod make-note ((editor mudela-editor) pitch)
95 "Make a new note, of pitch `pitch', which octave and duration are taken
96 from `editor''s note-state slot, and alteration taken from editing-state alterations
98 (setf (slot-value editor 'note-state) (point-note-state editor))
99 (with-slots (note-state editing-state) editor
100 (with-slots ((pitch0 pitch) (octave0 octave) (duration0 duration) (dots0 dots)) note-state
101 (make-instance 'mudela-note :pitch pitch
102 :alteration (aref (slot-value editing-state 'alterations) pitch)
103 :duration duration0 :dots dots0
104 :octave (cond ((> (- pitch pitch0) 3) (1- octave0))
105 ((> (- pitch0 pitch) 3) (1+ octave0))
108 (defmethod make-rest ((editor mudela-editor))
109 "Make a new rest, which duration is taken from `editor''s note-state slot."
110 (setf (slot-value editor 'note-state) (point-note-state editor))
111 (with-slots (note-state) editor
112 (with-slots ((duration0 duration) (dots0 dots)) note-state
113 (make-instance 'mudela-rest :duration duration0 :dots dots0))))
115 (defmethod make-skip ((editor mudela-editor))
116 "Make a new rest, which duration is taken from `editor''s note-state slot."
117 (setf (slot-value editor 'note-state) (point-note-state editor))
118 (with-slots (note-state) editor
119 (with-slots ((duration0 duration) (dots0 dots)) note-state
120 (make-instance 'mudela-skip :duration duration0 :dots dots0))))
122 (defmethod word-insert ((editor mudela-editor) word)
123 "Insert the word's mudela string at current point, and updates
124 editor's note-state."
125 (setf (slot-value editor 'note-state) (point-note-state editor))
126 (with-slots (note-state) editor
127 (lyqi-just-one-space)
128 (insert (mudela-string word note-state))
129 (lyqi-just-one-space)
130 (indent-for-tab-command) ;; TODO: be softer.
133 (defmethod search-word ((editor mudela-editor) &optional backward)
134 "Return a (word note-state beginning end) list, `word' being a
135 mudela-word representation of the first word after (if `backward is nil)
136 or before (otherwise) point, `note-state' the note-state deduced before that
137 word, `beginning' and `end' being the beginning and end position of the word."
138 (with-slots (parser note-state) editor
139 (destructuring-bind (tmpword beginning end) (get-word parser note-state backward)
141 (goto-char beginning)
142 (let ((new-note-state (point-note-state editor)))
143 (list (parse-string parser
144 (buffer-substring-no-properties beginning end)
149 (t (list nil nil 0 0))))))
151 (defmacro with-word-update (editor word-symbol &rest body)
152 "Read last word / update / delete / re-write word facility.
153 The word preceding point will be read by `editor', and will
154 be modified in `body', by refereing it as `word-symbol' (a
155 non quoted symbol). Then, word will be deleted in the buffer,
156 and a new string, reflecting changes appareing in `body',
158 (let ((beginning (gensym))
160 (note-state-at-point (gensym)))
161 `(destructuring-bind (,word-symbol ,note-state-at-point ,beginning ,end) (search-word ,editor t)
164 (goto-char ,beginning)
165 (delete-region ,beginning ,end)
166 (word-insert ,editor ,word-symbol)
169 (defmethod transpose-region ((editor mudela-editor) note-diff exact-pitch-diff beginning end)
170 "Transpose notes in current region."
171 (with-slots (parser note-state) editor
172 (goto-char beginning)
173 (setf (slot-value editor 'note-state) (point-note-state editor))
174 (let ((word-list (parse-region parser beginning end)))
175 (delete-region beginning end)
176 (dolist (word word-list)
177 (let ((transp-word (transpose word note-diff exact-pitch-diff)))
178 (word-insert editor transp-word))))))
180 (defmethod change-octave-mode-region ((editor mudela-editor) beginning end)
181 "Switch octave mode for notes included between `beginning' and `end'"
182 (with-slots (parser note-state editing-state) editor
183 (goto-char beginning)
184 (setf (slot-value editor 'note-state) (point-note-state editor))
185 (let ((word-list (parse-region parser beginning end)))
186 (delete-region beginning end)
187 ;; we switch editing-state's octave mode
188 (setf (slot-value editing-state 'relative-octave)
189 (not (slot-value editing-state 'relative-octave)))
190 (dolist (word word-list)
191 (word-insert editor word)))))
193 (defmethod change-language-region ((editor mudela-editor) from-lang to-lang beginning end)
194 "Change language for notes included between `beginning' and `end',
195 from `from-lang' to `to-lang' (two symbols)."
196 (with-slots (parser note-state editing-state) editor
197 (goto-char beginning)
198 (setf (slot-value editor 'note-state) (point-note-state editor))
199 ;; first, read the region with from-lang language
200 (when (not (equal (slot-value editing-state 'language) from-lang))
201 (set-language editing-state from-lang)
202 (update-regexp parser))
203 (let ((word-list (parse-region parser beginning end)))
204 (delete-region beginning end)
205 ;; then, we change language from writing
206 (set-language editing-state to-lang)
207 (update-regexp parser)
208 (dolist (word word-list)
209 (word-insert editor word)))))
211 (provide 'lyqi-editor)