lilypond-mode.el

   1 ;;;
   2 ;;; lilypond-mode.el --- Major mode for editing GNU LilyPond music scores
   3 ;;;
   4 ;;; source file of the GNU LilyPond music typesetter
   5 ;;;
   6 ;;; (c) 1999--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8 ;;; Changed 2001--2002 Heikki Junes <heikki.junes@hut.fi>
   9 ;;;    * Add PS-compilation, PS-viewing and MIDI-play (29th Aug 2001)
  10 ;;;    * Keyboard shortcuts (12th Sep 2001)
  11 ;;;    * Inserting tags, inspired on sgml-mode (11th Oct 2001)
  12 ;;;    * Autocompletion & Info (23rd Nov 2002)
  13 ;;;
  14 ;;; Changed 2002 Carlos Betancourt <carlos.betancourt@chello.be>
  15 ;;;    * Added spanish-note-replacements
  16
  17 ;;; Inspired on auctex
  18
  19 ;;; Look lilypond-init.el or Documentation/topdocs/INSTALL.texi
  20 ;;; for installing instructions.
  21
  22 (require 'easymenu)
  23 (require 'compile)
  24
  25 (defconst LilyPond-version "1.7.8"
  26   "`LilyPond-mode' version number.")
  27
  28 (defconst LilyPond-help-address "bug-lilypond@gnu.org"
  29   "Address accepting submission of bug reports.")
  30
  31 (defvar LilyPond-mode-hook nil
  32   "*Hook called by `LilyPond-mode'.")
  33
  34 (defvar LilyPond-kick-xdvi nil
  35   "If true, no simultaneous xdvi's are started, but reload signal is sent.")
  36
  37 (defvar LilyPond-command-history nil
  38   "Command history list.")
  39
  40 (defvar LilyPond-regexp-alist
  41   '(("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
  42   "Regexp used to match LilyPond errors.  See `compilation-error-regexp-alist'.")
  43
  44 (defcustom LilyPond-include-path ".:/tmp"
  45   "* LilyPond include path."
  46   :type 'string
  47   :group 'LilyPond)
  48
  49 (defun LilyPond-words-filename ()
  50   "The file containing LilyPond \keywords \Identifiers and ReservedWords.
  51 Finds file lilypond-words from load-path."
  52   (let ((fn nil)
  53         (lp load-path)
  54         (words-file "lilypond.words"))
  55     (while (and (> (length lp) 0) (not fn))
  56       (setq fn (concat (car lp) "/" words-file))
  57       (if (not (file-readable-p fn))
  58           (progn (setq fn nil) (setq lp (cdr lp)))))
  59     fn))
  60
  61 (defun LilyPond-add-dictionary-word (x)
  62   "Contains all words: keywords, identifiers, reserved words."
  63   (nconc '(("" . 1)) x))
  64
  65 ; creates dictionary if empty
  66 (if (eq (length (LilyPond-add-dictionary-word ())) 1)
  67     (progn
  68       (setq fn (LilyPond-words-filename))
  69       (setq b (find-file-noselect fn t t))
  70       (setq m (set-marker (make-marker) 1 (get-buffer b)))
  71       (setq i 1)
  72       (while (> (buffer-size b) (marker-position m))
  73         (setq i (+ i 1))
  74         (setq copy (copy-alist (list (eval (symbol-name (read m))))))
  75         (setcdr copy i)
  76         (LilyPond-add-dictionary-word (list copy)))
  77       (kill-buffer b)))
  78
  79 (defconst LilyPond-keywords
  80   (let ((wordlist ())
  81         (co (all-completions "" (LilyPond-add-dictionary-word ()))))
  82     (progn
  83       (while (> (length co) 0)
  84         (if (> (length (car co)) 1)
  85             (if (and (string-equal "\\" (substring (car co) 0 1))
  86                      (string-equal (downcase (car co)) (car co)))
  87                 (add-to-list 'wordlist (car co))))
  88         (setq co (cdr co)))
  89       wordlist))
  90   "LilyPond \\keywords")
  91
  92 (defconst LilyPond-identifiers
  93   (let ((wordlist ())
  94         (co (all-completions "" (LilyPond-add-dictionary-word ()))))
  95     (progn
  96       (while (> (length co) 0)
  97         (if (> (length (car co)) 1)
  98             (if (and (string-equal "\\" (substring (car co) 0 1))
  99                      (not (string-equal (downcase (car co)) (car co))))
 100                 (add-to-list 'wordlist (car co))))
 101         (setq co (cdr co)))
 102       wordlist))
 103   "LilyPond \\Identifiers")
 104
 105 (defconst LilyPond-reserved-words
 106   (let ((wordlist ())
 107         (co (all-completions "" (LilyPond-add-dictionary-word ()))))
 108     (progn
 109       (while (> (length co) 0)
 110         (if (> (length (car co)) 0)
 111             (if (not (string-equal "\\" (substring (car co) 0 1)))
 112                 (add-to-list 'wordlist (car co))))
 113         (setq co (cdr co)))
 114       wordlist))
 115   "LilyPond ReservedWords")
 116
 117 (defun LilyPond-check-files (derived originals extensions)
 118   "Check that DERIVED is newer than any of the ORIGINALS.
 119 Try each original with each member of EXTENSIONS, in all directories
 120 in LilyPond-include-path."
 121   (let ((found nil)
 122         (regexp (concat "\\`\\("
 123                         (mapconcat (function (lambda (dir)
 124                                       (regexp-quote (expand-file-name dir))))
 125                                    LilyPond-include-path "\\|")
 126                         "\\).*\\("
 127                         (mapconcat 'regexp-quote originals "\\|")
 128                         "\\)\\.\\("
 129                         (mapconcat 'regexp-quote extensions "\\|")
 130                         "\\)\\'"))
 131         (buffers (buffer-list)))
 132     (while buffers
 133       (let* ((buffer (car buffers))
 134              (name (buffer-file-name buffer)))
 135         (setq buffers (cdr buffers))
 136         (if (and name (string-match regexp name))
 137             (progn
 138               (and (buffer-modified-p buffer)
 139                    (or (not LilyPond-save-query)
 140                        (y-or-n-p (concat "Save file "
 141                                          (buffer-file-name buffer)
 142                                          "? ")))
 143                    (save-excursion (set-buffer buffer) (save-buffer)))
 144               (if (file-newer-than-file-p name derived)
 145                   (setq found t))))))
 146     found))
 147
 148 (defun LilyPond-running ()
 149   (let ((process (get-process "lilypond")))
 150   (and process
 151        (eq (process-status process) 'run))))
 152
 153 (defun Midi-running ()
 154   (let ((process (get-process "midi")))
 155   (and process
 156        (eq (process-status process) 'run))))
 157
 158 (defun LilyPond-kill-job ()
 159   "Kill the currently running LilyPond job."
 160   (interactive)
 161   ;; What bout TeX, Xdvi?
 162   (quit-process (get-process "lilypond") t))
 163
 164 ;; URG, should only run LilyPond-compile for LilyPond
 165 ;; not for tex,xdvi (ly2dvi?)
 166 (defun LilyPond-compile-file (command name)
 167   ;; We maybe should know what we run here (Lily, ly2dvi, tex)
 168   ;; and adjust our error-matching regex ?
 169   (compile-internal command "No more errors" name ))
 170
 171 ;; do we still need this, now that we're using compile-internal?
 172 (defun LilyPond-save-buffer ()
 173   "Save buffer and set default command for compiling."
 174   (interactive)
 175   (if (buffer-modified-p)
 176       (progn (save-buffer)
 177              (setq LilyPond-command-default "LilyPond"))))
 178
 179 ;;; return (dir base ext)
 180 (defun split-file-name (name)
 181   (let* ((i (string-match "[^/]*$" name))
 182          (dir (if (> i 0) (substring name 0 i) "./"))
 183          (file (substring name i (length name)))
 184          (i (string-match "[^.]*$" file)))
 185     (if (and
 186          (> i 0)
 187          (< i (length file)))
 188         (list dir (substring file 0 (- i 1)) (substring file i (length file)))
 189       (list dir file ""))))
 190
 191
 192 ;; Should check whether in command-alist?
 193 (defcustom LilyPond-command-default "LilyPond"
 194   "Default command. Must identify a member of LilyPond-command-alist."
 195
 196   :group 'LilyPond
 197   :type 'string)
 198 ;;;(make-variable-buffer-local 'LilyPond-command-last)
 199
 200 (defvar LilyPond-command-current 'LilyPond-command-master)
 201 ;;;(make-variable-buffer-local 'LilyPond-command-master)
 202
 203
 204 ;; If non-nil, LilyPond-command-query will return the value of this
 205 ;; variable instead of quering the user.
 206 (defvar LilyPond-command-force nil)
 207
 208 (defcustom LilyPond-xdvi-command "xdvi"
 209   "Command used to display DVI files."
 210
 211   :group 'LilyPond
 212   :type 'string)
 213
 214 (defcustom LilyPond-gv-command "gv -watch"
 215   "Command used to display PS files."
 216
 217   :group 'LilyPond
 218   :type 'string)
 219
 220 (defcustom LilyPond-midi-command "timidity"
 221   "Command used to play MIDI files."
 222
 223   :group 'LilyPond
 224   :type 'string)
 225
 226 (defcustom LilyPond-midi-all-command "timidity -ig"
 227   "Command used to play MIDI files."
 228
 229   :group 'LilyPond
 230   :type 'string)
 231
 232 ;; This is the major configuration variable.
 233 (defcustom LilyPond-command-alist
 234   `(
 235     ("LilyPond" . ("lilypond %s" . "LaTeX"))
 236     ("TeX" . ("tex '\\nonstopmode\\input %t'" . "View"))
 237
 238     ("2Dvi" . ("ly2dvi %s" . "View"))
 239     ("2PS" . ("ly2dvi -P %s" . "View"))
 240     ("2Midi" . ("lilypond -m %s" . "View"))
 241
 242     ("Book" . ("lilypond-book %x" . "LaTeX"))
 243     ("LaTeX" . ("latex '\\nonstopmode\\input %l'" . "View"))
 244
 245     ;; point-n-click (arg: exits upop USR1)
 246     ("SmartView" . ("xdvi %d" . "LilyPond"))
 247
 248     ;; refreshes when kicked USR1
 249     ("View" . (,(concat LilyPond-xdvi-command " %d") . "LilyPond"))
 250
 251     ("ViewPS" . (,(concat LilyPond-gv-command " %p") . "LilyPond"))
 252
 253     ("Midi" . (,(concat LilyPond-midi-command " %m") . "LilyPond"))
 254     )
 255
 256   "AList of commands to execute on the current document.
 257
 258 The key is the name of the command as it will be presented to the
 259 user, the value is a cons of the command string handed to the shell
 260 after being expanded, and the next command to be executed upon
 261 success.  The expansion is done using the information found in
 262 LilyPond-expand-list.
 263 "
 264   :group 'LilyPond
 265   :type '(repeat (cons :tag "Command Item"
 266                        (string :tag "Key")
 267                        (cons :tag "How"
 268                         (string :tag "Command")
 269                         (string :tag "Next Key")))))
 270
 271 ;; drop this?
 272 (defcustom LilyPond-file-extensions '(".ly" ".sly" ".fly")
 273   "*File extensions used by manually generated TeX files."
 274   :group 'LilyPond
 275   :type '(repeat (string :format "%v")))
 276
 277
 278 (defcustom LilyPond-expand-alist
 279   '(
 280     ("%s" . ".ly")
 281     ("%t" . ".tex")
 282     ("%d" . ".dvi")
 283     ("%p" . ".ps")
 284     ("%l" . ".tex")
 285     ("%x" . ".tely")
 286     ("%m" . ".midi")
 287     )
 288
 289   "Alist of expansion strings for LilyPond command names."
 290   :group 'LilyPond
 291   :type '(repeat (cons :tag "Alist item"
 292                   (string :tag "Symbol")
 293                   (string :tag "Expansion"))))
 294
 295
 296 (defcustom LilyPond-command-Show "View"
 297   "*The default command to show (view or print) a LilyPond file.
 298 Must be the car of an entry in `LilyPond-command-alist'."
 299   :group 'LilyPond
 300   :type 'string)
 301   (make-variable-buffer-local 'LilyPond-command-Show)
 302
 303 (defcustom LilyPond-command-Print "Print"
 304   "The name of the Print entry in LilyPond-command-Print."
 305   :group 'LilyPond
 306   :type 'string)
 307
 308 (defun xLilyPond-compile-sentinel (process msg)
 309   (if (and process
 310            (= 0 (process-exit-status process)))
 311       (setq LilyPond-command-default
 312               (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 313
 314 ;; FIXME: shouldn't do this for stray View/xdvi
 315 (defun LilyPond-compile-sentinel (buffer msg)
 316   (if (string-match "^finished" msg)
 317       (setq LilyPond-command-default
 318             (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 319
 320 ;;(make-variable-buffer-local 'compilation-finish-function)
 321 (setq compilation-finish-function 'LilyPond-compile-sentinel)
 322
 323 (defun LilyPond-command-query (name)
 324   "Query the user for what LilyPond command to use."
 325   (let* ((default (cond ((if (string-equal name "emacs-lily")
 326                              (LilyPond-check-files (concat name ".tex")
 327                                                    (list name)
 328                                                    LilyPond-file-extensions)
 329                            (if (buffer-modified-p)
 330                                (if (y-or-n-p "Save buffer before next command? ")
 331                                    (LilyPond-save-buffer)))
 332                            ;;"LilyPond"
 333                            LilyPond-command-default))
 334                         (t LilyPond-command-default)))
 335
 336          (completion-ignore-case t)
 337
 338          (answer (or LilyPond-command-force
 339                      (completing-read
 340                       (concat "Command: (default " default ") ")
 341                       LilyPond-command-alist nil t nil 'LilyPond-command-history))))
 342
 343     ;; If the answer is "LilyPond" it will not be expanded to "LilyPond"
 344     (let ((answer (car-safe (assoc answer LilyPond-command-alist))))
 345       (if (and answer
 346                (not (string-equal answer "")))
 347           answer
 348         default))))
 349
 350
 351 ;; FIXME: find ``\score'' in buffers / make settable?
 352 (defun LilyPond-master-file ()
 353   ;; duh
 354   (buffer-file-name))
 355
 356 (defun LilyPond-command-master ()
 357   "Run command on the current document."
 358   (interactive)
 359   (LilyPond-command (LilyPond-command-query (LilyPond-master-file))
 360                     'LilyPond-master-file))
 361
 362 (defun LilyPond-command-lilypond ()
 363   "Run lilypond for the current document."
 364   (interactive)
 365   (LilyPond-command (LilyPond-command-menu "LilyPond") 'LilyPond-master-file)
 366 )
 367
 368 (defun LilyPond-command-formatdvi ()
 369   "Format the dvi output of the current document."
 370   (interactive)
 371   (LilyPond-command (LilyPond-command-menu "2Dvi") 'LilyPond-master-file)
 372 )
 373
 374 (defun LilyPond-command-formatps ()
 375   "Format the ps output of the current document."
 376   (interactive)
 377   (LilyPond-command (LilyPond-command-menu "2PS") 'LilyPond-master-file)
 378 )
 379
 380 (defun LilyPond-command-smartview ()
 381   "View the dvi output of current document."
 382   (interactive)
 383   (LilyPond-command (LilyPond-command-menu "SmartView") 'LilyPond-master-file)
 384 )
 385
 386 (defun LilyPond-command-view ()
 387   "View the dvi output of current document."
 388   (interactive)
 389   (LilyPond-command (LilyPond-command-menu "View") 'LilyPond-master-file)
 390 )
 391
 392 (defun LilyPond-command-viewps ()
 393   "View the ps output of current document."
 394   (interactive)
 395   (LilyPond-command (LilyPond-command-menu "ViewPS") 'LilyPond-master-file)
 396 )
 397
 398 (defun LilyPond-command-midi ()
 399   "Play midi corresponding to the current document."
 400   (interactive)
 401   (LilyPond-command (LilyPond-command-menu "Midi") 'LilyPond-master-file)
 402 )
 403
 404 (defun count-rexp (start end rexp)
 405   "Print number of found regular expressions in the region."
 406   (interactive "r")
 407   (save-excursion
 408     (save-restriction
 409       (narrow-to-region start end)
 410       (goto-char (point-min))
 411       (count-matches rexp))))
 412
 413 (defun count-midi-words ()
 414   "Print number of scores before the curser."
 415   (interactive)
 416   (count-rexp (point-min) (point-max) "\\\\midi"))
 417
 418 (defun count-midi-words-backwards ()
 419   "Print number of scores before the curser."
 420   (interactive)
 421   (count-rexp (point-min) (point) "\\\\midi"))
 422
 423 (defun LilyPond-command-next-midi ()
 424   "Play next midi score of the current document."
 425   (interactive)
 426   (if (Midi-running)
 427       (quit-process (get-process "midi") t)
 428     (LilyPond-compile-file
 429      (let ((fname (LilyPond-master-file))
 430            (allcount (string-to-number (substring (count-midi-words) 0 -12)))
 431            (count (string-to-number (substring (count-midi-words-backwards) 0 -12))))
 432        (concat  LilyPond-midi-command " "
 433                 (substring fname 0 -3) ; suppose ".ly"
 434                 (if (and (> allcount 1) (> count 0)) ; not first score
 435                     (if (eq count allcount)          ; last score
 436                         (concat "-" (number-to-string (+ count -1)))
 437                       (concat "-" (number-to-string count))))
 438                 ".midi"))
 439      "Midi")))
 440
 441 (defun LilyPond-command-all-midi ()
 442   "Play next midi score of the current document."
 443   (interactive)
 444   (if (Midi-running)
 445       (quit-process (get-process "midi") t)
 446     (LilyPond-compile-file
 447      (let ((fname (LilyPond-master-file))
 448            (allcount (string-to-number (substring (count-midi-words) 0 -12))))
 449        (concat  LilyPond-midi-all-command " "
 450                 (if (> allcount 0) ; at least one midi-score
 451                     (concat (substring fname 0 -3) ".midi "))
 452                 (if (> allcount 1) ; more than one midi-score
 453                     (concat (substring fname 0 -3) "-?.midi "))
 454                 (if (> allcount 9) ; etc.
 455                     (concat (substring fname 0 -3) "-??.midi"))
 456                 (if (> allcount 99) ; not first score
 457                     (concat (substring fname 0 -3) "-???.midi"))))
 458      "Midi")))
 459
 460 (defun LilyPond-un-comment-region (start end level)
 461   "Remove up to LEVEL comment characters from each line in the region."
 462   (interactive "*r\np")
 463   (comment-region start end (- level)))
 464
 465 ;; FIXME, this is broken
 466 (defun LilyPond-region-file (begin end)
 467   (let (
 468         ;; (dir "/tmp/")
 469         ;; urg
 470         (dir "./")
 471         (base "emacs-lily")
 472         ;; Hmm
 473         (ext (if (string-match "^[\\]score" (buffer-substring begin end))
 474                  ".ly"
 475                (if (< 50 (abs (- begin end)))
 476                    ".fly"
 477                  ".sly"))))
 478     (concat dir base ext)))
 479
 480 (defun LilyPond-command-region (begin end)
 481   "Run LilyPond on the current region."
 482   (interactive "r")
 483   (write-region begin end (LilyPond-region-file begin end) nil 'nomsg)
 484   (LilyPond-command (LilyPond-command-query
 485                      (LilyPond-region-file begin end))
 486                     '(lambda () (LilyPond-region-file begin end))))
 487
 488 (defun LilyPond-command-buffer ()
 489   "Run LilyPond on buffer."
 490   (interactive)
 491   (LilyPond-command-region (point-min) (point-max)))
 492
 493 (defun LilyPond-command-expand (string file)
 494   (let ((case-fold-search nil))
 495     (if (string-match "%" string)
 496         (let* ((b (match-beginning 0))
 497                (e (+ b 2))
 498                (l (split-file-name file))
 499                (dir (car l))
 500                (base (cadr l)))
 501           (LilyPond-command-expand
 502            (concat (substring string 0 b)
 503                    dir
 504                    base
 505                    (let ((entry (assoc (substring string b e)
 506                                        LilyPond-expand-alist)))
 507                      (if entry (cdr entry) ""))
 508                    (substring string e))
 509            file))
 510       string)))
 511
 512 (defun LilyPond-shell-process (name buffer command)
 513   (let ((old (current-buffer)))
 514     (switch-to-buffer-other-window buffer)
 515     ;; If we empty the buffer don't see messages scroll by.
 516     ;; (erase-buffer)
 517
 518     (start-process-shell-command name buffer command)
 519     (switch-to-buffer-other-window old)))
 520
 521
 522 (defun LilyPond-command (name file)
 523   "Run command NAME on the file you get by calling FILE.
 524
 525 FILE is a function return a file name.  It has one optional argument,
 526 the extension to use on the file.
 527
 528 Use the information in LilyPond-command-alist to determine how to run the
 529 command."
 530
 531   (let ((entry (assoc name LilyPond-command-alist)))
 532     (if entry
 533         (let ((command (LilyPond-command-expand (cadr entry)
 534                                                 (apply file nil))))
 535           (if (string-equal name "View")
 536               (let ((buffer-xdvi (get-buffer-create "*view*")))
 537                 (if LilyPond-kick-xdvi
 538                   (let ((process-xdvi (get-buffer-process buffer-xdvi)))
 539                     (if process-xdvi
 540                         (signal-process (process-id process-xdvi) 'SIGUSR1)
 541                       (LilyPond-shell-process name buffer-xdvi command)))
 542                   (LilyPond-shell-process name buffer-xdvi command)))
 543             (progn
 544               (setq LilyPond-command-default name)
 545               (LilyPond-compile-file command name)))))))
 546
 547 ;; XEmacs stuff
 548 ;; Sadly we need this for a macro in Emacs 19.
 549 (eval-when-compile
 550   ;; Imenu isn't used in XEmacs, so just ignore load errors.
 551   (condition-case ()
 552       (require 'imenu)
 553     (error nil)))
 554
 555
 556 ;;; Keymap
 557
 558 (defvar LilyPond-mode-map ()
 559   "Keymap used in `LilyPond-mode' buffers.")
 560
 561 ;; Note:  if you make changes to the map, you must do
 562 ;;    M-x set-variable LilyPond-mode-map nil
 563 ;;    M-x eval-buffer
 564 ;;    M-x LilyPond-mode
 565 ;; to let the changest take effect
 566
 567 (if LilyPond-mode-map
 568     ()
 569   (setq LilyPond-mode-map (make-sparse-keymap))
 570   (define-key LilyPond-mode-map "\C-c\C-l" 'LilyPond-command-lilypond)
 571   (define-key LilyPond-mode-map "\C-c\C-r" 'LilyPond-command-region)
 572   (define-key LilyPond-mode-map "\C-c\C-b" 'LilyPond-command-buffer)
 573   (define-key LilyPond-mode-map "\C-c\C-k" 'LilyPond-kill-job)
 574   (define-key LilyPond-mode-map "\C-c\C-c" 'LilyPond-command-master)
 575   (define-key LilyPond-mode-map "\C-c\C-d" 'LilyPond-command-formatdvi)
 576   (define-key LilyPond-mode-map "\C-c\C-f" 'LilyPond-command-formatps)
 577   (define-key LilyPond-mode-map "\C-c\C-s" 'LilyPond-command-smartview)
 578   (define-key LilyPond-mode-map "\C-c\C-v" 'LilyPond-command-view)
 579   (define-key LilyPond-mode-map "\C-c\C-p" 'LilyPond-command-viewps)
 580   (define-key LilyPond-mode-map "\C-c\C-m" 'LilyPond-command-next-midi)
 581   (define-key LilyPond-mode-map "\C-x\C-s" 'LilyPond-save-buffer)
 582   (define-key LilyPond-mode-map "\C-cf" 'font-lock-fontify-buffer)
 583   (define-key LilyPond-mode-map "\C-ci" 'LilyPond-quick-note-insert)
 584   (define-key LilyPond-mode-map "\C-cn" 'LilyPond-insert-tag-notes)
 585   (define-key LilyPond-mode-map "\C-cs" 'LilyPond-insert-tag-score)
 586   (define-key LilyPond-mode-map "\C-c:" 'LilyPond-un-comment-region)
 587   (define-key LilyPond-mode-map "\C-c;" 'comment-region)
 588   (define-key LilyPond-mode-map ")" 'LilyPond-electric-close-paren)
 589   (define-key LilyPond-mode-map ">" 'LilyPond-electric-close-paren)
 590   (define-key LilyPond-mode-map "}" 'LilyPond-electric-close-paren)
 591   (define-key LilyPond-mode-map [S-iso-lefttab] 'LilyPond-autocompletion)
 592   (define-key LilyPond-mode-map "\C-c\t" 'LilyPond-info-index-search)
 593   )
 594
 595 ;;; Menu Support
 596
 597 (defun LilyPond-quick-note-insert()
 598   "Insert notes with fewer key strokes by using a simple keyboard piano."
 599   (interactive)
 600   (setq dutch-notes
 601         '(("k" "a") ("l" "b") ("a" "c") ("s" "d")
 602           ("d" "e") ("f" "f") ("j" "g") ("r" "r")))
 603   (setq dutch-note-ends '("eses" "es" "" "is" "isis"))
 604   (setq dutch-note-replacements '("" ""))
 605   (setq finnish-note-replacements
 606         '(("eeses" "eses") ("ees" "es") ("aeses" "asas") ("aes" "as") ("b" "h")
 607           ("beses" "heses") ("bes" "b") ("bis" "his") ("bisis" "hisis")))
 608                               ; add more translations of the note names
 609   (setq spanish-note-replacements
 610         '(("c" "do") ("d" "re") ("e" "mi") ("f" "fa") ("g" "sol") ("a" "la") ("b" "si")
 611       ("cis" "dos") ("cisis" "doss") ("ces" "dob") ("ceses" "dobb")
 612       ("dis" "res") ("disis" "ress") ("des" "reb") ("deses" "rebb")
 613       ("eis" "mis") ("eisis" "miss") ("ees" "mib") ("eeses" "mibb")
 614       ("fis" "fas") ("fisis" "fass") ("fes" "fab") ("feses" "fabb")
 615       ("gis" "sols") ("gisis" "solss") ("ges" "solb") ("geses" "solbb")
 616       ("ais" "las") ("aisis" "lass") ("aes" "lab") ("aeses" "labb")
 617       ("bis" "sis") ("bisis" "siss") ("bes" "sib") ("beses" "sibb")))
 618   (setq other-keys "()<>~}")
 619   (setq accid 0) (setq octav 0) (setq durat "") (setq dots 0)
 620
 621   (message "Press h for help.") (sit-for 0 750 1)
 622
 623   (setq note-replacements dutch-note-replacements)
 624   (while (not (= 27 ; esc to quit
 625     (setq x (read-char-exclusive
 626              (format " | a[_]s[_]d | f[_]j[_]k[_]l | r with ie ,' 12345678 . 0 (<~>)/}\\b\\n Esc \n | c | d | e | f | g | a | %s | r with %s%s%s%s"
 627                      (if (string= (car(cdr(assoc "b" note-replacements))) "h")
 628                          "h" "b")
 629                      (nth (+ accid 2) dutch-note-ends)
 630                      (make-string (abs octav) (if (> octav 0) ?' ?,))
 631                      durat
 632                      (if (string= durat "") "" (make-string dots ?.)))))))
 633 ;    (insert (number-to-string x)) ; test numbers for characters
 634     (setq note (cdr (assoc (char-to-string x) dutch-notes)))
 635     (cond
 636      ((= x 127) (backward-kill-word 1)) ; backspace
 637      ((= x 13) (progn (insert "\n") (LilyPond-indent-line)))) ; return
 638     (setq x (char-to-string x))
 639     (cond
 640      ((and (string< x "9") (string< "0" x))
 641       (progn (setq durat (int-to-string (expt 2 (- (string-to-int x) 1))))
 642              (setq dots 0)))
 643      ((string= x " ") (insert " "))
 644      ((string= x "/") (progn (insert "\\times ")
 645                              (while (not (and (string< x "9") (string< "0" x)))
 646                                (setq x (char-to-string (read-char-exclusive "Insert a number for the denominator (\"x/\")"))))
 647                              (insert (format "%s/" x)) (setq x "/")
 648                              (while (not (and (string< x "9") (string< "0" x)))
 649                                (setq x (char-to-string (read-char-exclusive "Insert a number for the numerator (\"/y\")"))))
 650                              (insert (format "%s { " x))))
 651      ((string= x "0") (progn (setq accid 0) (setq octav 0)
 652                              (setq durat "") (setq dots 0)))
 653      ((string= x "i") (setq accid (if (= accid 2) 0 (max (+ accid 1) 1))))
 654      ((string= x "e") (setq accid (if (= accid -2) 0 (min (+ accid -1) -1))))
 655      ((string= x "'") (setq octav (if (= octav 4) 0 (max (+ octav 1) 1))))
 656      ((string= x ",") (setq octav (if (= octav -4) 0 (min (+ octav -1) -1))))
 657      ((string= x ".") (setq dots (if (= dots 4) 0 (+ dots 1))))
 658      ((not (null (member x (split-string other-keys ""))))
 659       (insert (format "%s " x)))
 660      ((not (null note))
 661       (progn
 662         (setq note
 663               (format "%s%s" (car note) (if (string= "r" (car note)) ""
 664                                           (nth (+ accid 2) dutch-note-ends))))
 665         (setq notetwo (car (cdr (assoc note note-replacements))))
 666         (if (not (null notetwo)) (setq note notetwo))
 667         (insert
 668          (format "%s%s%s%s "
 669                  note
 670                  (if (string= "r" note) ""
 671                      (make-string (abs octav) (if (> octav 0) ?' ?,)))
 672                  durat
 673                  (if (string= durat "") "" (make-string dots ?.))))
 674         (setq accid 0) (setq octav 0) (setq durat "") (setq dots 0)))
 675      ((string= x "t") (progn (setq note-replacements dutch-note-replacements)
 676                              (message "Selected Dutch notes")
 677                              (sit-for 0 750 1))) ; t
 678      ((string= x "n") (progn (setq note-replacements finnish-note-replacements)
 679                              (message "Selected Finnish/Deutsch notes")
 680                              (sit-for 0 750 1))) ; n
 681                               ; add more translations of the note names
 682      ((string= x "p") (progn (setq note-replacements spanish-note-replacements)
 683                              (message "Selected Spanish notes")
 684                              (sit-for 0 750 1))) ; p
 685      ((string= x "h")
 686       (progn (message "Insert notes with fewer key strokes. For example \"i,5.f\" produces \"fis,32. \".") (sit-for 5 0 1)
 687              (message "Add also \"a ~ a\"-ties, \"a ( ) b\"-slurs and \"< a b >\"-chords.") (sit-for 5 0 1)
 688              (message "Note names are in Du(t)ch by default. Hit 'n' for Fin(n)ish/Deutsch note names. Hit 'p' for S(p)anish note names") (sit-for 5 0 1)
 689              (message "Backspace deletes last note, return starts a new indented line and Esc quits.") (sit-for 5 0 1)
 690              (message "Insert note triplets \"\\times 2/3 { a b } \" by typing \"/23ab}\".") (sit-for 5 0 1)
 691              (message "Remember to add all other details as well.") (sit-for 5 0 1)))
 692     )))
 693
 694 (defun LilyPond-pre-word-search ()
 695   "Fetch the alphabetic characters and \\ in front of the cursor."
 696   (interactive)
 697   (let ((pre "")
 698         (prelen 0)
 699         (ch (char-before (- (point) 0))))
 700     (while (and ch (or (and (>= ch 65) (<= ch 90)) ; not bolp, A-Z
 701                        (and (>= ch 97) (<= ch 122)) ; a-z
 702                        (= ch 92))) ; \\
 703       (setq pre (concat (char-to-string ch) pre))
 704       (setq prelen (+ prelen 1))
 705       (setq ch (char-before (- (point) prelen))))
 706     pre))
 707
 708 (defun LilyPond-post-word-search ()
 709   "Fetch the alphabetic characters behind the cursor."
 710   (interactive)
 711   (let ((post "")
 712         (postlen 0)
 713         (ch (char-after (+ (point) 0))))
 714     (while (and ch (or (and (>= ch 65) (<= ch 90)) ; not eolp, A-Z
 715                        (and (>= ch 97) (<= ch 122)))) ; a-z
 716       (setq post (concat post (char-to-string ch)))
 717       (setq postlen (+ postlen 1))
 718       (setq ch (char-after (+ (point) postlen))))
 719     post))
 720
 721 (defun LilyPond-autocompletion ()
 722   "Show completions in mini-buffer for the given word."
 723   (interactive)
 724   (let ((pre (LilyPond-pre-word-search))
 725         (post (LilyPond-post-word-search))
 726         (compsstr ""))
 727   ; insert try-completion and show all-completions
 728     (if (> (length pre) 0)
 729         (progn
 730           (setq trycomp (try-completion pre (LilyPond-add-dictionary-word ())))
 731           (if (char-or-string-p trycomp)
 732               (if (string-equal (concat pre post) trycomp)
 733                   (goto-char (+ (point) (length post)))
 734                 (progn
 735                   (delete-region (point) (+ (point) (length post)))
 736                   (insert (substring trycomp (length pre) nil))))
 737             (progn
 738               (delete-region (point) (+ (point) (length post)))
 739               (font-lock-fontify-buffer))) ; only inserting fontifies
 740
 741         (setq complist (all-completions pre (LilyPond-add-dictionary-word ())))
 742         (while (> (length complist) 0)
 743           (setq compsstr (concat compsstr "\"" (car complist) "\" "))
 744           (setq complist (cdr complist)))
 745         (message compsstr)
 746         (sit-for 0 100 1)))))
 747
 748 (defun LilyPond-info ()
 749   "Launch Info for lilypond."
 750   (interactive)
 751   (info "lilypond"))
 752
 753 (defun LilyPond-music-glossary-info ()
 754   "Launch Info for music-glossary."
 755   (interactive)
 756   (info "music-glossary"))
 757 (defun LilyPond-internals-info ()
 758   "Launch Info for lilypond-internals."
 759   (interactive)
 760   (info "lilypond-internals"))
 761
 762 (defun LilyPond-info-index-search ()
 763   "Inside Emacs, launch `info lilypond --index-search word-under-cursor'"
 764   (interactive)
 765   (let ((str (concat (LilyPond-pre-word-search) (LilyPond-post-word-search))))
 766     (if (and (> (length str) 0)
 767              (string-equal (substring str 0 1) "\\"))
 768         (setq str (substring str 1 nil)))
 769     (LilyPond-info)
 770     (Info-index str)))
 771
 772 (defun LilyPond-insert-string (pre)
 773   "Insert text to the buffer."
 774   (interactive)
 775   (insert pre)
 776   (length pre))
 777
 778 (defun LilyPond-insert-between (text pre post)
 779   "Insert text to the buffer if non-empty string is given."
 780   (interactive)
 781   (let ((str (read-string text)))
 782     (if (string-equal str "")
 783         0
 784       (progn (setq pre_str_post (concat pre str post))
 785              (insert pre_str_post)
 786              (length pre_str_post)))))
 787
 788 (defun LilyPond-insert-tag-notes ()
 789   "LilyPond notes tag."
 790   (interactive)
 791   (setq begin (if (and transient-mark-mode mark-active)
 792                   (mark-marker) (point-marker)))
 793   (setq end (point-marker))
 794   (goto-char begin)
 795   (setq l1 (LilyPond-insert-string "\\notes "))
 796   (setq l2 (LilyPond-insert-between "Relative (e.g. c'): " "\\relative " " "))
 797   (if (eq l2 0)
 798       (setq l2 (LilyPond-insert-between "Transpose (e.g. c c'): " "\\transpose " " ")))
 799   (setq l3 (LilyPond-insert-string "{ "))
 800   (goto-char (+ end l1 l2 l3))
 801   (LilyPond-insert-string " }")
 802   (goto-char (+ end l1 l2 l3)))
 803
 804 (defun LilyPond-insert-tag-score ()
 805   "LilyPond score tag."
 806   (interactive)
 807   (setq begin (if (and transient-mark-mode mark-active)
 808                   (mark-marker) (point-marker)))
 809   (setq end (point-marker))
 810   (goto-char begin)
 811   (setq l1 (LilyPond-insert-string "\\score {\n    ")) ; keep track of lengths
 812   (goto-char (+ end l1))
 813   (LilyPond-insert-string "\n    \\paper { }\n")
 814   (setq l2 (if (y-or-n-p "Insert \"\\header\" field? ")
 815                (+ (LilyPond-insert-string "    \\header {")
 816                   (LilyPond-insert-between "Title: " "\n      title = \"" "\"")
 817                   (LilyPond-insert-between "Subtitle: " "\n      subtitle = \"" "\"")
 818                   (LilyPond-insert-between "Piece: " "\n      piece = \"" "\"")
 819                   (LilyPond-insert-between "Opus: "  "\n      opus = \"" "\"")
 820                   (LilyPond-insert-string "\n    }\n"))
 821              0))
 822   (setq l3 (if (y-or-n-p "Insert \"\\midi\" field? ")
 823                (+ (LilyPond-insert-string "    \\midi {")
 824                   (LilyPond-insert-between "Tempo: " " \\tempo (e.g. 4 = 60)" "")
 825                   (LilyPond-insert-string " }\n"))
 826              0))
 827   (setq l4 (LilyPond-insert-string "}\n"))
 828   (goto-char (+ end l1)))
 829
 830 (defun LilyPond-command-menu-entry (entry)
 831   ;; Return LilyPond-command-alist ENTRY as a menu item.
 832   (let ((name (car entry)))
 833     (cond ((and (string-equal name LilyPond-command-Print)
 834                 LilyPond-printer-list)
 835            (let ((command LilyPond-print-command)
 836                  (lookup 1))
 837              (append (list LilyPond-command-Print)
 838                      (mapcar 'LilyPond-command-menu-printer-entry
 839                              LilyPond-printer-list))))
 840           (t
 841            (vector name (list 'LilyPond-command-menu name) t)))))
 842
 843
 844 (easy-menu-define LilyPond-command-menu
 845   LilyPond-mode-map
 846   "Menu used in LilyPond mode."
 847   (append '("Command")
 848           '(("Command on"
 849              [ "Master File" LilyPond-command-select-master
 850                :keys "C-c C-c" :style radio
 851                :selected (eq LilyPond-command-current 'LilyPond-command-master) ]
 852              [ "Buffer" LilyPond-command-select-buffer
 853                :keys "C-c C-b" :style radio
 854                :selected (eq LilyPond-command-current 'LilyPond-command-buffer) ]
 855              [ "Region" LilyPond-command-select-region
 856                :keys "C-c C-r" :style radio
 857                :selected (eq LilyPond-command-current 'LilyPond-command-region) ]))
 858 ;         (let ((file 'LilyPond-command-on-current))
 859 ;           (mapcar 'LilyPond-command-menu-entry LilyPond-command-alist))
 860 ;;; Some kind of mapping which includes :keys might be more elegant
 861           '([ "LilyPond" LilyPond-command-lilypond t])
 862           '([ "TeX" (LilyPond-command (LilyPond-command-menu "TeX") 'LilyPond-master-file) ])
 863           '([ "2Dvi" LilyPond-command-formatdvi t])
 864           '([ "2PS" LilyPond-command-formatps t])
 865           '([ "2Midi" (LilyPond-command (LilyPond-command-menu "2Midi") 'LilyPond-master-file)])
 866           '([ "Book" (LilyPond-command (LilyPond-command-menu "Book") 'LilyPond-master-file) ])
 867           '([ "LaTeX" (LilyPond-command (LilyPond-command-menu "LaTeX") 'LilyPond-master-file) ])
 868           '([ "SmartView" LilyPond-command-smartview t])
 869           '([ "View" LilyPond-command-view t])
 870           '([ "ViewPS" LilyPond-command-viewps t])
 871           '([ "Midi (off)" LilyPond-command-next-midi t])
 872           '([ "Midi all" LilyPond-command-all-midi t])
 873           ))
 874
 875 (easy-menu-define LilyPond-mode-menu
 876   LilyPond-mode-map
 877   "Menu used in LilyPond mode."
 878   (append '("LilyPond")
 879           '(("Insert"
 880              [ "\\notes..."  LilyPond-insert-tag-notes t]
 881              [ "\\score..."  LilyPond-insert-tag-score t]
 882              ["Quick Notes"  LilyPond-quick-note-insert t]
 883              ["Autocompletion"   LilyPond-autocompletion t]
 884              ))
 885           '(("Miscellaneous"
 886              ["Uncomment Region" LilyPond-un-comment-region t]
 887              ["Comment Region" comment-region t]
 888              ["Refontify buffer" font-lock-fontify-buffer t]
 889              ))
 890           '(("Info"
 891              ["LilyPond" LilyPond-info t]
 892              ["LilyPond index-search" LilyPond-info-index-search t]
 893              ["Music Glossary" LilyPond-music-glossary-info t]
 894              ["LilyPond internals" LilyPond-internals-info t]
 895              ))
 896           ))
 897
 898 (defconst LilyPond-imenu-generic-re "^\\([a-zA-Z]+\\) *="
 899   "Regexp matching Identifier definitions.")
 900
 901 (defvar LilyPond-imenu-generic-expression
 902   (list (list nil LilyPond-imenu-generic-re 1))
 903   "Expression for imenu")
 904
 905 (defun LilyPond-command-select-master ()
 906   (interactive)
 907   (message "Next command will be on the master file")
 908   (setq LilyPond-command-current 'LilyPond-command-master))
 909
 910 (defun LilyPond-command-select-buffer ()
 911   (interactive)
 912   (message "Next command will be on the buffer")
 913   (setq LilyPond-command-current 'LilyPond-command-buffer))
 914
 915 (defun LilyPond-command-select-region ()
 916   (interactive)
 917   (message "Next command will be on the region")
 918   (setq LilyPond-command-current 'LilyPond-command-region))
 919
 920 (defun LilyPond-command-menu (name)
 921   ;; Execute LilyPond-command-alist NAME from a menu.
 922   (let ((LilyPond-command-force name))
 923     (funcall LilyPond-command-current)))
 924
 925 (defun LilyPond-mode ()
 926   "Major mode for editing LilyPond music files.
 927
 928 This mode knows about LilyPond keywords and line comments, not about
 929 indentation or block comments.  It features easy compilation, error
 930 finding and viewing of a LilyPond source buffer or region.
 931
 932 COMMANDS
 933 \\{LilyPond-mode-map}
 934 VARIABLES
 935
 936 LilyPond-command-alist\t\talist from name to command
 937 LilyPond-xdvi-command\t\tcommand to display dvi files -- bit superfluous"
 938   (interactive)
 939   ;; set up local variables
 940   (kill-all-local-variables)
 941
 942   (make-local-variable 'font-lock-defaults)
 943   (setq font-lock-defaults '(LilyPond-font-lock-keywords))
 944
 945   ;; string and comments are fontified explicitly
 946   (make-local-variable 'font-lock-keywords-only)
 947   (setq font-lock-keywords-only t)
 948
 949   ;; Multi-line font-locking needs Emacs 21.1 or newer.
 950   ;; For older versions there is hotkey "C-c f".
 951   (make-local-variable 'font-lock-multiline)
 952   (setq font-lock-multiline t)
 953
 954   (make-local-variable 'paragraph-separate)
 955   (setq paragraph-separate "^[ \t]*$")
 956
 957   (make-local-variable 'paragraph-start)
 958   (setq paragraph-start "^[ \t]*$")
 959
 960   (make-local-variable 'comment-start)
 961   (setq comment-start "%")
 962
 963   (make-local-variable 'comment-start-skip)
 964   (setq comment-start-skip "%{? *")
 965
 966   (make-local-variable 'comment-end)
 967   (setq comment-end "")
 968
 969   (make-local-variable 'block-comment-start)
 970   (setq block-comment-start "%{")
 971
 972   (make-local-variable 'block-comment-end)
 973   (setq block-comment-end   "%}")
 974
 975   (make-local-variable 'indent-line-function)
 976   (setq indent-line-function 'LilyPond-indent-line)
 977
 978     (set-syntax-table LilyPond-mode-syntax-table)
 979   (setq major-mode 'LilyPond-mode)
 980   (setq mode-name "LilyPond")
 981   (setq local-abbrev-table LilyPond-mode-abbrev-table)
 982   (use-local-map LilyPond-mode-map)
 983
 984   (make-local-variable 'imenu-generic-expression)
 985   (setq imenu-generic-expression LilyPond-imenu-generic-expression)
 986   (imenu-add-to-menubar "Index")
 987
 988     ;; run the mode hook. LilyPond-mode-hook use is deprecated
 989   (run-hooks 'LilyPond-mode-hook))
 990
 991 (defun LilyPond-version ()
 992   "Echo the current version of `LilyPond-mode' in the minibuffer."
 993   (interactive)
 994   (message "Using `LilyPond-mode' version %s" LilyPond-version))
 995
 996 (load-library "lilypond-font-lock")
 997 (load-library "lilypond-indent")
 998
 999 (provide 'lilypond-mode)
1000 ;;; lilypond-mode.el ends here
1001