emacs_el/lyqi-mode.el

   1 ;;      $RCSfile: lyqi-mode.el,v $
   2 ;;      $Revision: 1.9 $
   3 ;;      $Date: 2004/03/14 15:14:55 $
   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) copyright 2003 Nicolas Sceaux <nicolas.sceaux@free.fr>
  10 ;;; See http://nicolas.sceaux.free.fr/lilypond/
  11 ;;;
  12
  13 (defgroup lyqi nil
  14   "LilyPond quick insert mode."
  15   :prefix "lyqi-"
  16   :group 'applications)
  17
  18 (eval-when-compile (require 'cl))
  19 (require 'lyqi-base)
  20 (require 'lyqi-parser)
  21 (require 'lyqi-editor)
  22 (require 'lyqi-midi)
  23 (require 'lyqi-rumor)
  24
  25 (defconst lyqi-version "0.2.5")
  26
  27 (defconst lyqi-languages
  28   '(nederlands english deutsch norsk svenska italiano catalan espanol)
  29   "Possible languages for writing LilyPond note names.")
  30
  31 (defcustom lyqi-self-inserting-keys "()<>~{}|[] "
  32   "Self inserting keys in lyqi-mode-map."
  33   :group 'lyqi
  34   :type 'string)
  35
  36 (defcustom lyqi-self-inserting-+-char-keys "-_^\\"
  37   "Self inserting keys, after which the user is asked an extra char to insert."
  38   :group 'lyqi
  39   :type 'string)
  40
  41 (defcustom lyqi-self-inserting-+-string-keys
  42   '((?- "\C-c-") (?_ "\C-c_") (?^ "\C-c^") (?\\ "\C-c\\") (?# "#") (?\" "\"" "\""))
  43   "Self inserting keys, after which the user is asked an extra string to insert."
  44   :group 'lyqi)
  45
  46 (defcustom lyqi-force-duration t
  47   "Force duration to appear when inserting a note"
  48   :group 'lyqi
  49   :type  'boolean)
  50
  51 (defcustom lyqi-relative-octave-default nil
  52   "Relative or absolute octave in lilypond insert mode by default?"
  53   :group 'lyqi
  54   :type  'boolean)
  55
  56 (defcustom lyqi-default-language 'nederlands
  57   "The default language for writing LilyPond note names."
  58   :group 'lyqi
  59   :options lyqi-languages
  60   :type 'symbol)
  61
  62 (defvar lyqi-editing-state nil
  63   "The current editing state: language, octave mode, etc.")
  64
  65 (defvar lyqi-mudela-editor nil
  66   "A mudela editor.")
  67
  68 (defvar lyqi-mudela-parser nil
  69   "A rudimentary mudela parser")
  70
  71 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  72 ;;; lilypond-quick-insert-mode interactive functions
  73 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74
  75 (defmacro with-GNUEmacs (&rest body)
  76   (if (string-match "GNU Emacs" (version)) `(progn ,@body)))
  77
  78 (defmacro with-XEmacs (&rest body)
  79   (if (string-match "XEmacs" (version)) `(progn ,@body)))
  80
  81 (with-XEmacs
  82  (defun my-get-key (fn)
  83    "Returns the key (a string) binded to `fn'"
  84    (let ((keys (where-is-internal fn nil t)))
  85      (and keys (my-join (mapcar (lambda (key)
  86                                   (if (consp key)
  87                                       (format "%s-%s"
  88                                               (upcase (substring (symbol-name (car key)) 0 1))
  89                                               (symbol-name (cadr key)))
  90                                          (symbol-name key)))
  91                                 (append keys nil)) " ")))))
  92 (with-GNUEmacs
  93  (defun my-get-key (fn)
  94    "Returns the key (a string) binded to `fn'"
  95    (let ((keys (where-is-internal fn nil t)))
  96      (and keys (my-join (mapcar (lambda (key) (if (and (<= 1 key) (<= key 26))
  97                                                   (format "C-%c" (+ 96 key))
  98                                                   (char-to-string key)))
  99                                 keys) " ")))))
 100
 101 (defun lyqi-display-state ()
 102   "Display current state (language used, octave mode) and help commands in the minibuffer."
 103   (message "lyqi-%s [%s,%s pitches,midi %s] Press %s to quit, %s for help."
 104            lyqi-version
 105            (slot-value lyqi-editing-state 'language)
 106            (if (slot-value lyqi-editing-state 'relative-octave) "relative" "absolute")
 107            (if lyqi-midi-on "on" "off")
 108            (my-get-key 'lyqi-quit)
 109            (my-get-key 'lyqi-help)))
 110
 111 ;; (defmacro with-lyqi-interactive (&rest body)
 112 ;;   "Utility to make a lyqi interactive command, with message display at the end."
 113 ;;   `(progn
 114 ;;      (interactive)
 115 ;;      ,@body
 116 ;;      (lyqi-display-state)))
 117
 118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 119 ;; note, rest, skips insertion
 120
 121 (defun lyqi-insert-note (pitch)
 122   "Insert a new mudela note of pitch `pitch'."
 123   (let ((note (make-note lyqi-mudela-editor pitch)))
 124     (word-insert lyqi-mudela-editor note)
 125     (when lyqi-midi-on
 126       (play-note note t))
 127     (lyqi-display-state)))
 128
 129 (defun lyqi-insert-note-do ()
 130   "Insert a new do / c note at point."
 131   (interactive)
 132   (lyqi-insert-note 0))
 133
 134 (defun lyqi-insert-note-re ()
 135   "Insert a new re / d note at point."
 136   (interactive)
 137   (lyqi-insert-note 1))
 138
 139 (defun lyqi-insert-note-mi ()
 140   "Insert a new mi / e note at point."
 141   (interactive)
 142   (lyqi-insert-note 2))
 143
 144 (defun lyqi-insert-note-fa ()
 145   "Insert a new fa / f note at point."
 146   (interactive)
 147   (lyqi-insert-note 3))
 148
 149 (defun lyqi-insert-note-sol ()
 150   "Insert a new sol / g note at point."
 151   (interactive)
 152   (lyqi-insert-note 4))
 153
 154 (defun lyqi-insert-note-la ()
 155   "Insert a new la / a note at point."
 156   (interactive)
 157   (lyqi-insert-note 5))
 158
 159 (defun lyqi-insert-note-si ()
 160   "Insert a new si / b note at point."
 161   (interactive)
 162   (lyqi-insert-note 6))
 163
 164 (defun lyqi-insert-rest ()
 165   "Insert a rest at point."
 166   (interactive)
 167   (word-insert lyqi-mudela-editor (make-rest lyqi-mudela-editor))
 168   (lyqi-display-state))
 169
 170 (defun lyqi-insert-skip ()
 171   "Insert a skip at point."
 172   (interactive)
 173   (word-insert lyqi-mudela-editor (make-skip lyqi-mudela-editor))
 174   (lyqi-display-state))
 175
 176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 177 ;; note, rest, skips update
 178
 179 ;; (defun lyqi-change-duration (duration)
 180 ;;   "Change the last word duration, if any, and if possible."
 181 ;;   (with-word-update lyqi-mudela-editor the-word
 182 ;;    (set-duration the-word duration)))
 183 (defun lyqi-change-duration (duration)
 184   "Change the last word duration, if any, and if possible."
 185   (with-word-update lyqi-mudela-editor the-word
 186     (set-duration the-word duration)))
 187
 188 (defun lyqi-change-duration-1 ()
 189   "Change the previous word duration to 1."
 190   (interactive)
 191   (lyqi-change-duration 1)
 192   (lyqi-display-state))
 193
 194 (defun lyqi-change-duration-2 ()
 195   "Change the previous word duration to 2."
 196   (interactive)
 197   (lyqi-change-duration 2)
 198   (lyqi-display-state))
 199
 200 (defun lyqi-change-duration-4 ()
 201   "Change the previous word duration to 4."
 202   (interactive)
 203   (lyqi-change-duration 3)
 204   (lyqi-display-state))
 205
 206 (defun lyqi-change-duration-8 ()
 207   "Change the previous word duration to 8."
 208   (interactive)
 209   (lyqi-change-duration 4)
 210   (lyqi-display-state))
 211
 212 (defun lyqi-change-duration-16 ()
 213   "Change the previous word duration to 16."
 214   (interactive)
 215   (lyqi-change-duration 5)
 216   (lyqi-display-state))
 217
 218 (defun lyqi-change-duration-32 ()
 219   "Change the previous word duration to 32."
 220   (interactive)
 221   (lyqi-change-duration 6)
 222   (lyqi-display-state))
 223
 224 (defun lyqi-change-duration-64 ()
 225   "Change the previous word duration to 64."
 226   (interactive)
 227   (lyqi-change-duration 7)
 228   (lyqi-display-state))
 229
 230 (defun lyqi-change-duration-128 ()
 231   "Change the previous word duration to 128."
 232   (interactive)
 233   (lyqi-change-duration 8)
 234   (lyqi-display-state))
 235
 236 (defun lyqi-change-dots ()
 237   "Increase modulo 5 the previous word dot number."
 238   (interactive)
 239   (with-word-update lyqi-mudela-editor the-word
 240    (set-dots the-word))
 241   (lyqi-display-state))
 242
 243 (defun lyqi-change-alteration-up ()
 244   "Increase, if possible, the last note alteration."
 245   (interactive)
 246   (with-word-update lyqi-mudela-editor the-note
 247    (set-alteration-up the-note)
 248    (when lyqi-midi-on
 249      (play-note the-note t)))
 250   (lyqi-display-state))
 251
 252 (defun lyqi-change-alteration-down ()
 253   "Decrease, if possible, the last note alteration."
 254   (interactive)
 255   (with-word-update lyqi-mudela-editor the-note
 256    (set-alteration-down the-note)
 257    (when lyqi-midi-on
 258      (play-note the-note t)))
 259   (lyqi-display-state))
 260
 261 (defun lyqi-change-alteration-natural ()
 262   "Set, if possible, the last note alteration to natural."
 263   (interactive)
 264   (with-word-update lyqi-mudela-editor the-note
 265    (set-alteration-natural the-note)
 266    (when lyqi-midi-on
 267      (play-note the-note t)))
 268   (lyqi-display-state))
 269
 270 (defun lyqi-change-octave-up ()
 271   "Increase the last note octave."
 272   (interactive)
 273   (with-word-update lyqi-mudela-editor the-note
 274    (set-octave-up the-note)
 275    (when lyqi-midi-on
 276      (play-note the-note t)))
 277   (lyqi-display-state))
 278
 279 (defun lyqi-change-octave-down ()
 280   "Decrease the last note octave."
 281   (interactive)
 282   (with-word-update lyqi-mudela-editor the-note
 283    (set-octave-down the-note)
 284    (when lyqi-midi-on
 285      (play-note the-note t)))
 286   (lyqi-display-state))
 287
 288 (defun lyqi-change-octave-zero ()
 289   "Set the last note octave to zero."
 290   (interactive)
 291   (with-word-update lyqi-mudela-editor the-note
 292    (set-octave-zero the-note)
 293    (when lyqi-midi-on
 294      (play-note the-note t)))
 295   (lyqi-display-state))
 296
 297 (defun lyqi-change-reminder-alt ()
 298   "Change the last note's reminder alteration state."
 299   (interactive)
 300   (with-word-update lyqi-mudela-editor the-note
 301    (set-reminder-alt the-note))
 302   (lyqi-display-state))
 303
 304 (defun lyqi-change-cautionary-alt ()
 305   "Change the last note's cautionary alteration state."
 306   (interactive)
 307   (with-word-update lyqi-mudela-editor the-note
 308    (set-cautionary-alt the-note))
 309   (lyqi-display-state))
 310
 311 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 312 ;;
 313
 314 (with-XEmacs
 315  (defun my-read-char-exclusive (prompt)
 316    (let ((event (next-event nil prompt)))
 317      (while (not (key-press-event-p event))
 318        (next-event event prompt))
 319      (event-to-character event))))
 320 (with-GNUEmacs
 321  (defun my-read-char-exclusive (prompt)
 322    (read-char-exclusive prompt)))
 323
 324 (defun lyqi-insert-tuplet ()
 325   "Interactively inserts a \\times x/y {"
 326   (interactive)
 327   (let ((x ""))
 328     (lyqi-just-one-space)
 329     (insert "\\times ")
 330     (while (not (and (string< x "9") (string< "0" x)))
 331       (setq x (char-to-string (my-read-char-exclusive
 332                                "Insert a number for the numerator (\"x/\")"))))
 333     (insert (format "%s/" x)) (setq x "/")
 334     (while (not (and (string< x "9") (string< "0" x)))
 335       (setq x (char-to-string (my-read-char-exclusive
 336                                "Insert a number for the denominator (\"/y\")"))))
 337     (insert (format "%s { " x)))
 338   (lyqi-display-state))
 339
 340 (defun lyqi-word-forward ()
 341   "Move to the following mudela word end, if any, otherwise to the end of the
 342 following text word."
 343   (interactive)
 344   (unless (re-search-forward (slot-value lyqi-mudela-parser 'regexp) nil t)
 345     (forward-word 1))
 346   (lyqi-display-state))
 347
 348 (defun lyqi-word-backward ()
 349   "Move to the previous mudela word beginning, if any, otherwise to the beginning of the
 350 previous text word."
 351   (interactive)
 352   (unless (re-search-backward (slot-value lyqi-mudela-parser 'regexp) nil t)
 353     (backward-word 1))
 354   (lyqi-display-state))
 355
 356 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 357 ;;
 358
 359 (defun my-next (elt seq)
 360   "Returns the element following `elt' in `seq'.
 361 If it is the last, returns the first element of the sequence."
 362   (let ((nexts (cdr (member elt seq))))
 363     (if (consp nexts)
 364         (car nexts)
 365         (car seq))))
 366
 367 (defun lyqi-switch-language ()
 368   "Select the next mudela language in `lyqi-languages'."
 369   (interactive)
 370   (setf lyqi-default-language
 371         (my-next (slot-value lyqi-editing-state 'language) lyqi-languages))
 372   (set-language lyqi-editing-state lyqi-default-language)
 373   (update-regexp lyqi-mudela-parser)
 374   (lyqi-display-state))
 375
 376 (defun lyqi-switch-octave-mode ()
 377   "Switch between relative and absolute octave modes."
 378   (interactive)
 379   (setf (slot-value lyqi-editing-state 'relative-octave)
 380         (not (slot-value lyqi-editing-state 'relative-octave)))
 381   (lyqi-display-state))
 382
 383 (defun my-center-string (str len)
 384   "Makes a centered string from `str', of length `len'"
 385   (let* ((inner-str (if (< (length str) len)
 386                         str
 387                         (substring str 0 len)))
 388          (right-space (/ (- len (length inner-str)) 2))
 389          (left-space (- len right-space (length inner-str))))
 390     (format "%s%s%s"
 391             (make-string left-space (string-to-char " "))
 392             inner-str
 393             (make-string right-space (string-to-char " ")))))
 394
 395 (defun lyqi-help ()
 396   "Display a help message in a dedicated buffer."
 397   (interactive)
 398   (describe-mode)
 399 ;;   (with-output-to-temp-buffer "*Help*"
 400 ;;     (princ "LilyPond quick insert mode
 401 ;; Note entry:
 402 ;;               |  | | | |  |  | | | | | |  |
 403 ;;               |  | | | |  |  | | | | | |  |
 404 ;;               |  |_| |_|  |  |_| |_| |_|  |
 405 ;;               |   |   |   |   |   |   |   |
 406 ;;               |___|___|___|___|___|___|___|\n")
 407
 408 ;;     (princ (format "pitch keys:    %s \n\n"
 409 ;;                    (my-join (mapcar (lambda (fn)
 410 ;;                                       (my-center-string (format "`%s'" (my-get-key fn)) 3))
 411 ;;                                     '(lyqi-insert-note-do
 412 ;;                                       lyqi-insert-note-re
 413 ;;                                       lyqi-insert-note-mi
 414 ;;                                       lyqi-insert-note-fa
 415 ;;                                       lyqi-insert-note-sol
 416 ;;                                       lyqi-insert-note-la
 417 ;;                                       lyqi-insert-note-si)) " ")))
 418 ;;     (princ (format "duration keys: %s\n"
 419 ;;                    (my-join (mapcar (lambda (fn)
 420 ;;                                       (my-center-string (format "`%s'" (my-get-key fn)) 3))
 421 ;;                                     '(lyqi-change-duration-1
 422 ;;                                       lyqi-change-duration-2
 423 ;;                                       lyqi-change-duration-4
 424 ;;                                       lyqi-change-duration-8
 425 ;;                                       lyqi-change-duration-16
 426 ;;                                       lyqi-change-duration-32
 427 ;;                                       lyqi-change-duration-64
 428 ;;                                       lyqi-change-duration-128)) " ")))
 429 ;;     (princ (format "               %s\n"
 430 ;;                    (my-join (mapcar (lambda (num)
 431 ;;                                       (my-center-string
 432 ;;                                        (int-to-string (expt 2 (- num 1))) 3))
 433 ;;                                     '(1 2 3 4 5 6 7 8)) "|")))
 434 ;;     (princ (format "alteration:    `%s' flat
 435 ;;                `%s' sharp\n
 436 ;;                `%s' force reminder alteration\n
 437 ;;                `%s' force cautionary alteration\n"
 438 ;;                    (my-get-key 'lyqi-change-alteration-down)
 439 ;;                    (my-get-key 'lyqi-change-alteration-up)
 440 ;;                    (my-get-key 'lyqi-change-reminder-alt)
 441 ;;                    (my-get-key 'lyqi-change-cautionary-alt)))
 442 ;;     (princ (format "dot key:       `%s'\n" (my-get-key 'lyqi-change-dots)))
 443 ;;     (princ (format "octave keys:   `%s' down
 444 ;;                `%s' up\n"
 445 ;;                    (my-get-key 'lyqi-change-octave-down)
 446 ;;                    (my-get-key 'lyqi-change-octave-up)))
 447 ;;     (princ (format "rests:         `%s'\n" (my-get-key 'lyqi-insert-rest)))
 448 ;;     (princ (format "skips:         `%s'\n" (my-get-key 'lyqi-insert-skip)))
 449 ;;     (princ (format "tuplets:       `%s'\n" (my-get-key 'lyqi-insert-tuplet)))
 450 ;;     (princ (format "self inserting keys: `%s'\n" (my-join (split-string lyqi-self-inserting-keys "") "' `")))
 451 ;;     (princ "\nOther bindings:\n")
 452 ;;     (princ (format "absolute/relative octave switch: `%s'\n"
 453 ;;                    (my-get-key 'lyqi-switch-octave-mode)))
 454 ;;     (princ (format "language switch: `%s'\n" (my-get-key 'lyqi-switch-language)))
 455 ;;     (princ (format "help:            `%s'\n" (my-get-key 'lyqi-help)))
 456 ;;     (princ (format "Midi note playing start/stop: `%s'\n"
 457 ;;                    (my-get-key 'lyqi-midi-start-stop)))
 458 ;;     (princ (format "back to LilyPond-mode: `%s'\n" (my-get-key 'lyqi-quit)))
 459 ;;     (princ (format "Transpose region: `%s'\n" (my-get-key 'lyqi-transpose-region)))
 460     (lyqi-display-state))
 461
 462 (defun lyqi-quit ()
 463   "Quit lilypond-quick-insert-mode, back to LilyPond-mode"
 464   (interactive)
 465   (LilyPond-mode))
 466
 467 (defun lyqi-relative-to-absolute-region ()
 468   "Rewrite region with absolute octave mode instead of relative octave mode.
 469 An octave transposition may be required afterward."
 470   (interactive)
 471   (when (not (slot-value lyqi-editing-state 'relative-octave))
 472     (lyqi-switch-octave-mode))
 473   (change-octave-mode-region lyqi-mudela-editor (region-beginning) (region-end))
 474   (lyqi-display-state))
 475
 476 (defun lyqi-absolute-to-relative-region ()
 477   "Rewrite region with relative octave mode instead of absolute octave mode."
 478   (interactive)
 479   (when (slot-value lyqi-editing-state 'relative-octave)
 480     (lyqi-switch-octave-mode))
 481   (change-octave-mode-region lyqi-mudela-editor (region-beginning) (region-end))
 482   (lyqi-display-state))
 483
 484 (defun lyqi-transpose-region-aux (from-note to-note)
 485   "Transpose the current region, the interval being defined by `from-note'
 486 and `to-note', two mudela-notes."
 487   (when to-note
 488     (let ((note-diff (+ (- (slot-value to-note 'pitch)
 489                            (slot-value from-note 'pitch))
 490                         (* 7 (- (slot-value to-note 'octave)
 491                                 (slot-value from-note 'octave)))))
 492           (exact-pitch-diff (- (midi-pitch to-note) (midi-pitch from-note))))
 493       (transpose-region lyqi-mudela-editor note-diff exact-pitch-diff (region-beginning) (region-end)))))
 494
 495 (defun lyqi-transpose-region (to-note-str)
 496   "Interactively transpose the current region. The user is asked the transposition interval,
 497 starting from c/do."
 498   (interactive "sTranspose to: ")
 499   (let ((from-note (make-instance 'mudela-note :pitch 0 :octave 0))
 500         (to-note (parse-string lyqi-mudela-parser to-note-str (make-instance 'mudela-note-state :octave 0))))
 501     (lyqi-transpose-region-aux from-note to-note)))
 502
 503 ;;; by Reuben Thomas <rrt@sc3d.org>
 504 (defun lyqi-transpose-interval-region (trans)
 505   "Interactively transpose the current region. The user is asked the transposition interval in tones."
 506   (interactive "sTranspose by interval (tones[+]|[-]) : ")
 507   (let* ((interval (string-to-int trans))
 508          (adj (substring trans -1))
 509          (alt (cond ((equal adj "+") 3)
 510                     ((equal adj "-") 1)
 511                     (t               2)))
 512          (oct (/ interval 7))
 513          (tone (% interval 7)))
 514     (when (< tone 0)
 515       (setq tone (+ tone 7))
 516       (setq oct (- oct 1)))
 517     (let ((from-note (make-instance 'mudela-note :pitch 0 :octave 0))
 518           (to-note (make-instance 'mudela-note :pitch tone :octave oct :alteration alt)))
 519       (lyqi-transpose-region-aux from-note to-note)))
 520   (lyqi-display-state))
 521
 522 (defun lyqi-play-back-region ()
 523   "If midi is on, play back notes in region."
 524   (interactive)
 525   (when (process-runningp lyqi-midi-keyboard)
 526     (mapcar 'play-note (parse-region lyqi-mudela-parser (region-beginning) (region-end)))))
 527
 528 (defun lyqi-change-language-region ()
 529   "Change note language in region. The user is asked for source and destination languages."
 530   (interactive)
 531   (let* ((current-lang (slot-value lyqi-editing-state 'language))
 532          (next-lang (my-next current-lang lyqi-languages))
 533          (lang-collection (mapcar (lambda (lang) (list (symbol-name lang))) lyqi-languages))
 534          (from-lang (intern (completing-read (format "Change from language [%s]: " current-lang)
 535                                              lang-collection nil t nil nil (symbol-name current-lang))))
 536          (to-lang (intern (completing-read (format "Change from language %s to [%s]: " from-lang next-lang)
 537                                            lang-collection nil t nil nil (symbol-name next-lang)))))
 538     (change-language-region lyqi-mudela-editor from-lang to-lang (region-beginning) (region-end)))
 539   (lyqi-display-state))
 540
 541 ;; (defun lyqi-self-insert-plus-char (char))
 542 ;; (defun lyqi-self-insert-plus-string (char) &optional ending)
 543
 544 ;;; Rumor
 545
 546 (defun lyqi-rumor-session-stop ()
 547   "Stop a running rumor session."
 548   (interactive)
 549   (process-stop lyqi-rumor-process)
 550   (define-key lyqi-mode-map " " 'self-insert-command))
 551
 552 (defun lyqi-rumor-session-start ()
 553   "Start a rumor session. Press SPC to stop the session"
 554   (interactive)
 555   (define-key lyqi-mode-map " " 'lyqi-rumor-session-stop)
 556   (process-start lyqi-rumor-process))
 557
 558 (defun lyqi-rumor-set-legato ()
 559   "Change rumor's legato parameter."
 560   (interactive)
 561   (let ((legato (with-slots (legato) lyqi-rumor-process
 562                             (setf (slot-value lyqi-rumor-process 'legato)
 563                                   (not legato)))))
 564     (message "rumor: legato mode set %s for next session." (if legato "on" "off"))
 565     legato))
 566
 567 (defun lyqi-rumor-set-no-dots ()
 568   "Change rumor's no-dots parameter."
 569   (interactive)
 570   (let ((no-dots (with-slots (no-dots) lyqi-rumor-process
 571                    (setf (slot-value lyqi-rumor-process 'no-dots)
 572                          (not no-dots)))))
 573     (message "rumor: dots %sshown in next session." (if no-dots "not " ""))
 574     no-dots))
 575
 576 (defun lyqi-rumor-set-flat ()
 577   "Change rumor's flat parameter."
 578   (interactive)
 579   (let ((flat (with-slots (flat) lyqi-rumor-process
 580                 (setf (slot-value lyqi-rumor-process 'flat)
 581                       (not flat)))))
 582     (message "rumor: flat mode set %s for next session." (if flat "on" "off"))
 583     flat))
 584
 585 (defun lyqi-rumor-set-grain (grain-str)
 586   "Set rumor's grain."
 587   (interactive "sRumor's new grain: ")
 588   (let ((grain (setf (slot-value lyqi-rumor-process 'grain)
 589                      (string-to-number grain-str))))
 590     (message "rumor: grain set to %d for next session" grain)
 591     grain))
 592
 593 (defun lyqi-rumor-set-tempo (tempo-str)
 594   "Set rumor's tempo."
 595   (interactive "sRumor's new tempo: ")
 596   (let ((tempo (setf (slot-value lyqi-rumor-process 'tempo)
 597                      (string-to-number tempo-str))))
 598     (message "rumor: tempo set to %d for next session" tempo)
 599     tempo))
 600
 601 (defun lyqi-rumor-set-alsa-port (alsa-port-str)
 602   "Set rumor's alsa-port."
 603   (interactive "sRumor's new alsa port: ")
 604   (let ((port (setf (slot-value lyqi-rumor-process 'port)
 605                     (string-to-number alsa-port-str))))
 606     (message "rumor: alsa port set to %d for next session" port)
 607     port))
 608
 609 (defun lyqi-rumor-set-meter (meter)
 610   "Set rumor's meter."
 611   (interactive "sRumor's new meter: ")
 612   (setf (slot-value lyqi-rumor-process 'meter)
 613         meter)
 614   (message "rumor: meter set to %s for next session" meter)
 615   meter)
 616
 617 (defun lyqi-rumor-set-key (key)
 618   "Set rumor's key."
 619   (interactive "sRumor's new key (in dutsch): ")
 620   (setf (slot-value lyqi-rumor-process 'key)
 621         key)
 622   (message "rumor: key set to %s for next session" key)
 623   key)
 624
 625 ;;; Midi play back
 626
 627 (defun lyqi-midi-start-stop ()
 628   "Start or stop midi playing."
 629   (interactive)
 630   (if lyqi-midi-on
 631       (lyqi-midi-stop)
 632       (lyqi-midi-start))
 633   (setq lyqi-midi-manually-off (not lyqi-midi-on))
 634   (lyqi-display-state))
 635
 636 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 637 ;; lyqi-mode definition
 638 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 639
 640 (defmacro lyqi-make-self-insert-+-char (key)
 641   "Define a self-insert-<char>-+-char function, and "
 642   (let ((fn-symb (intern (format "lyqi-%s-self-insert-+-char" key))))
 643     `(progn
 644        (defun ,fn-symb ()
 645          ,(format "Insert the character %s and ask the user an extra character to insert." key)
 646          (interactive)
 647          (insert ,key)
 648          (insert (char-to-string (my-read-char-exclusive "Following character: "))))
 649        (define-key lyqi-mode-map ,key ',fn-symb))))
 650
 651 (defmacro lyqi-make-self-insert-+-string (char key &optional end-string)
 652   "Define a self-insert-<char>-+-char function, and "
 653   (let ((fn-symb (intern (format "lyqi-%s-self-insert-+-string" (char-to-string char)))))
 654     `(progn
 655      (defun ,fn-symb ()
 656        ,(format "Insert the character %c and ask the user an extra character to insert." char)
 657        (interactive)
 658        (insert ,(char-to-string char))
 659        (insert (read-string "Following string: "))
 660        ,(if end-string `(insert ,end-string)))
 661      (define-key lyqi-mode-map ,key ',fn-symb))))
 662
 663 (define-derived-mode lyqi-mode
 664   LilyPond-mode "lyqi"
 665   "Major mode for LilyPond quick note insert.
 666 \\{lyqi-mode-map}"
 667   (make-local-variable 'lyqi-editing-state)
 668   (make-local-variable 'lyqi-mudela-parser)
 669   (make-local-variable 'lyqi-mudela-editor)
 670
 671   (setq lyqi-editing-state (make-instance 'mudela-editing-state
 672                                           :translation-table mudela-translation-table
 673                                           :relative-octave lyqi-relative-octave-default
 674                                           :force-duration lyqi-force-duration))
 675   (set-language lyqi-editing-state lyqi-default-language)
 676   (setq lyqi-mudela-parser (make-mudela-parser lyqi-editing-state))
 677   (setq lyqi-mudela-editor (make-instance 'mudela-editor
 678                                           :editing-state lyqi-editing-state
 679                                           :parser lyqi-mudela-parser
 680                                           :note-state (make-instance 'mudela-note-state)))
 681   ;; I don't know how to directly set a class slot !
 682   ;; Is that a feature or a bug ? when I set a class allocated slot
 683   ;; of a mother class instance, the slot is not also updated in child
 684   ;; class instances...
 685   (let ((c (make-instance 'mudela-note))
 686         (r (make-instance 'mudela-rest))
 687         (s (make-instance 'mudela-skip)))
 688     (setf (slot-value c 'editing-state) lyqi-editing-state)
 689     (setf (slot-value r 'editing-state) lyqi-editing-state)
 690     (setf (slot-value s 'editing-state) lyqi-editing-state))
 691
 692   ;; midi start
 693   (unless lyqi-midi-timidity
 694     (cond (lyqi-midi-use-external-timidity-server
 695            (setq lyqi-midi-timidity (make-instance 'external-timidity-server))
 696            (setf (slot-value lyqi-midi-timidity 'seqport) lyqi-midi-external-timidity-port))
 697           (t
 698            (setq lyqi-midi-timidity (make-instance 'timidity-server
 699                                                    :command lyqi-midi-demon-command
 700                                                    :name "timidity")))))
 701   (unless lyqi-midi-keyboard
 702     (setq lyqi-midi-keyboard (make-instance 'mymidikbd
 703                                             :command lyqi-midi-keyboard-command
 704                                             :name "mymidikbd")))
 705   (unless lyqi-rumor-process
 706     (setq lyqi-rumor-process (make-instance 'rumor
 707                                             :command lyqi-rumor-command
 708                                             :name "rumor"
 709                                             :grain     lyqi-rumor-default-grain
 710                                             :tempo     lyqi-rumor-default-tempo
 711                                             :legato    lyqi-rumor-default-legato
 712                                             :no-dots   lyqi-rumor-default-no-dots
 713                                             :flat      lyqi-rumor-default-flat
 714                                             :strip     lyqi-rumor-default-strip
 715                                             :meter     lyqi-rumor-default-meter
 716                                             :key       lyqi-rumor-default-key
 717                                             :alsa-port lyqi-rumor-default-alsa-port)))
 718   (when (and (not lyqi-midi-manually-off)
 719              lyqi-midi-enabled-default)
 720     (lyqi-midi-start)))
 721
 722 ;; makes all the printing characters undefined.
 723 (suppress-keymap lyqi-mode-map t)
 724 ;; rests and skips
 725 (define-key lyqi-mode-map "r" 'lyqi-insert-rest)
 726 (define-key lyqi-mode-map "s" 'lyqi-insert-skip)
 727 ;; pitches : do re mi fa sol la si
 728 (define-key lyqi-mode-map "d" 'lyqi-insert-note-do)
 729 (define-key lyqi-mode-map "f" 'lyqi-insert-note-re)
 730 (define-key lyqi-mode-map "g" 'lyqi-insert-note-mi)
 731 (define-key lyqi-mode-map "h" 'lyqi-insert-note-fa)
 732 (define-key lyqi-mode-map "j" 'lyqi-insert-note-sol)
 733 (define-key lyqi-mode-map "k" 'lyqi-insert-note-la)
 734 (define-key lyqi-mode-map "l" 'lyqi-insert-note-si)
 735 ;; alterations
 736 (define-key lyqi-mode-map "i" 'lyqi-change-alteration-up)
 737 (define-key lyqi-mode-map "e" 'lyqi-change-alteration-down)
 738 (define-key lyqi-mode-map "n" 'lyqi-change-alteration-natural)
 739 (define-key lyqi-mode-map "!" 'lyqi-change-reminder-alt)
 740 (define-key lyqi-mode-map "?" 'lyqi-change-cautionary-alt)
 741 ;; octave
 742 (define-key lyqi-mode-map "'" 'lyqi-change-octave-up)
 743 (define-key lyqi-mode-map "," 'lyqi-change-octave-down)
 744 (define-key lyqi-mode-map "=" 'lyqi-change-octave-zero)
 745 ;; durations: 1 2 4 8 16 32 64 128
 746 (define-key lyqi-mode-map "1" 'lyqi-change-duration-1)
 747 (define-key lyqi-mode-map "2" 'lyqi-change-duration-2)
 748 (define-key lyqi-mode-map "4" 'lyqi-change-duration-4)
 749 (define-key lyqi-mode-map "8" 'lyqi-change-duration-8)
 750 (define-key lyqi-mode-map "7" 'lyqi-change-duration-16)
 751 (define-key lyqi-mode-map "5" 'lyqi-change-duration-32)
 752 (define-key lyqi-mode-map "0" 'lyqi-change-duration-64)
 753 (define-key lyqi-mode-map "9" 'lyqi-change-duration-128)
 754 ;; dots
 755 (define-key lyqi-mode-map "." 'lyqi-change-dots)
 756 ;; tuplets
 757 (define-key lyqi-mode-map "\C-ct" 'lyqi-insert-tuplet)
 758 ;; other bindings
 759 (define-key lyqi-mode-map "\C-co" 'lyqi-switch-octave-mode)
 760 (define-key lyqi-mode-map "\C-c\C-l" 'lyqi-switch-language)
 761 (define-key lyqi-mode-map "\C-cq" 'lyqi-quit) ; back to LilyPond-mode
 762 (define-key lyqi-mode-map "\C-ch" 'lyqi-help)
 763 (define-key lyqi-mode-map "\M-b" 'lyqi-word-backward)
 764 (define-key lyqi-mode-map "\M-f" 'lyqi-word-forward)
 765 (define-key lyqi-mode-map "\C-c\C-t" 'lyqi-transpose-region)
 766 (define-key lyqi-mode-map "\C-cm" 'lyqi-midi-start-stop)
 767 (define-key lyqi-mode-map "\C-cp" 'lyqi-play-back-region)
 768 ;; prefix key for rumor commands
 769 (define-prefix-command 'ctl-c-p)
 770 (define-key lyqi-mode-map "\C-cr" ctl-c-p)
 771 (define-key lyqi-mode-map "\C-crs" 'lyqi-rumor-session-start)
 772 (define-key lyqi-mode-map "\C-crg" 'lyqi-rumor-set-grain)
 773 (define-key lyqi-mode-map "\C-crt" 'lyqi-rumor-set-tempo)
 774 (define-key lyqi-mode-map "\C-crl" 'lyqi-rumor-set-legato)
 775 (define-key lyqi-mode-map "\C-crd" 'lyqi-rumor-set-no-dots)
 776 (define-key lyqi-mode-map "\C-crf" 'lyqi-rumor-set-flat)
 777 (define-key lyqi-mode-map "\C-crm" 'lyqi-rumor-set-meter)
 778 (define-key lyqi-mode-map "\C-crk" 'lyqi-rumor-set-key)
 779 (define-key lyqi-mode-map "\C-crp" 'lyqi-rumor-set-alsa-port)
 780 ;; self inserting keys
 781 (dolist (key (split-string lyqi-self-inserting-keys ""))
 782   (define-key lyqi-mode-map key 'self-insert-command))
 783 (dolist (key (split-string lyqi-self-inserting-+-char-keys ""))
 784   (eval `(lyqi-make-self-insert-+-char ,key)))
 785 (dolist (key-descr lyqi-self-inserting-+-string-keys)
 786   (eval `(lyqi-make-self-insert-+-string ,@key-descr)))