emacs_el/lyqi-editor.el

   1 ;;      $RCSfile: lyqi-editor.el,v $
   2 ;;      $Revision: 1.6 $
   3 ;;      $Date: 2004/03/14 15:15:54 $
   4 ;;      $Author: nicolas $
   5 ;;;
   6 ;;; Part of lyqi, a major emacs mode derived from LilyPond-Mode,
   7 ;;; for quick note insertion while editing GNU LilyPond music scores.
   8 ;;;
   9 ;;; (c) 2003 copyright Nicolas Sceaux <nicolas.sceaux@free.fr>
  10 ;;; See http://nicolas.sceaux.free.fr/lilypond/
  11 ;;;
  12
  13 (eval-when-compile (require 'cl))
  14 (require 'eieio)
  15 (require 'lyqi-base)
  16 (require 'lyqi-parser)
  17
  18 (unless (fboundp 'object-of-class-p)
  19   (defun object-of-class-p (obj class)
  20     (obj-of-class-p obj class)))
  21
  22 (defun lyqi-just-one-space ()
  23   "Invoke `just-one-space', unless point is at the beginning of a line."
  24   (unless (bolp)
  25     (just-one-space)))
  26
  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.")
  36
  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
  42             (save-excursion
  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
  60             (save-excursion
  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
  69             (if prev-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)
  74                                                 'relative-octave)))
  75                 (slot-value prev-note 'octave)
  76                 (slot-value note-state 'octave))))
  77       (make-instance 'mudela-note-state
  78                      :pitch pitch
  79                      :octave octave
  80                      :duration duration
  81                      :dots dots))))
  82
  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)
  88       (when word
  89         (delete-region beginning end)
  90         (goto-char beginning)
  91         (lyqi-just-one-space)
  92         (backward-char)))))
  93
  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
  97 slot."
  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))
 106                                    (t octave0))))))
 107
 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))))
 114
 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))))
 121
 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.
 131     word))
 132
 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)
 140       (cond (tmpword
 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)
 145                                    new-note-state)
 146                      new-note-state
 147                      beginning
 148                      end)))
 149             (t (list nil nil 0 0))))))
 150
 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',
 157 will be inserted."
 158   (let ((beginning (gensym))
 159         (end (gensym))
 160         (note-state-at-point (gensym)))
 161     `(destructuring-bind (,word-symbol ,note-state-at-point ,beginning ,end) (search-word ,editor t)
 162        (when ,word-symbol
 163          ,@body
 164          (goto-char ,beginning)
 165          (delete-region ,beginning ,end)
 166          (word-insert ,editor ,word-symbol)
 167          ,word-symbol))))
 168
 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))))))
 179
 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)))))
 192
 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)))))
 210
 211 (provide 'lyqi-editor)