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--2003 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8 ;;; Changed 2001--2003 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 ;;; Inspired on auctex
  15
  16 ;;; Look lilypond-init.el or Documentation/topdocs/INSTALL.texi
  17 ;;; for installing instructions.
  18
  19 (require 'easymenu)
  20 (require 'compile)
  21
  22 (defconst LilyPond-version "1.7.30"
  23   "`LilyPond-mode' version number.")
  24
  25 (defconst LilyPond-help-address "bug-lilypond@gnu.org"
  26   "Address accepting submission of bug reports.")
  27
  28 (defvar LilyPond-mode-hook nil
  29   "*Hook called by `LilyPond-mode'.")
  30
  31 (defvar LilyPond-region-file-prefix "emacs-lily"
  32   "File prefix for commands on buffer or region.")
  33
  34 ;; FIXME: find ``\score'' in buffers / make settable?
  35 (defun LilyPond-master-file ()
  36   ;; duh
  37   (buffer-file-name))
  38
  39 (defvar LilyPond-kick-xdvi nil
  40   "If true, no simultaneous xdvi's are started, but reload signal is sent.")
  41
  42 (defvar LilyPond-command-history nil
  43   "Command history list.")
  44
  45 (defvar LilyPond-regexp-alist
  46   '(("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
  47   "Regexp used to match LilyPond errors.  See `compilation-error-regexp-alist'.")
  48
  49 (defvar LilyPond-imenu nil
  50   "A flag to tell whether LilyPond-imenu is turned on.")
  51 (make-variable-buffer-local 'LilyPond-imenu)
  52
  53 (defcustom LilyPond-include-path ".:/tmp"
  54   "* LilyPond include path."
  55   :type 'string
  56   :group 'LilyPond)
  57
  58 (defun LilyPond-words-filename ()
  59   "The file containing LilyPond \keywords \Identifiers and ReservedWords.
  60 Finds file lilypond-words from load-path."
  61   (let ((fn nil)
  62         (lp load-path)
  63         (words-file "lilypond.words"))
  64     (while (and (> (length lp) 0) (not fn))
  65       (setq fn (concat (car lp) "/" words-file))
  66       (if (not (file-readable-p fn))
  67           (progn (setq fn nil) (setq lp (cdr lp)))))
  68     (if (not fn)
  69         (progn (message "Warning: `lilypond.words' not found in `load-path'. See `lilypond-init.el'.")
  70                (sit-for 5 0)))
  71     fn))
  72
  73 (defun LilyPond-add-dictionary-word (x)
  74   "Contains all words: \keywords \Identifiers and ReservedWords."
  75   (nconc '(("" . 1)) x))
  76
  77 ;; creates dictionary if empty
  78 (if (and (eq (length (LilyPond-add-dictionary-word ())) 1)
  79          (not (eq (LilyPond-words-filename) nil)))
  80     (progn
  81       (setq b (find-file-noselect (LilyPond-words-filename) t t))
  82       (setq m (set-marker (make-marker) 1 (get-buffer b)))
  83       (setq i 1)
  84       (while (> (buffer-size b) (marker-position m))
  85         (setq i (+ i 1))
  86         (setq copy (copy-alist (list (eval (symbol-name (read m))))))
  87         (setcdr copy i)
  88         (LilyPond-add-dictionary-word (list copy)))
  89       (kill-buffer b)))
  90
  91 (defconst LilyPond-menu-keywords nil
  92   "Keywords which can be inserted from the menu.")
  93
  94 (defconst LilyPond-keywords
  95   (let ((wordlist '("\\score")) ; add \keywords to lilypond.words
  96         (co (all-completions "" (LilyPond-add-dictionary-word ())))
  97         (currword ""))
  98     (progn
  99       (setq LilyPond-menu-keywords '())
 100       (while (> (length co) 0)
 101         (setq currword (car co))
 102         (if (> (length currword) 1)
 103             (if (and (string-equal "\\" (substring currword 0 1))
 104                      (string-equal (downcase currword) currword))
 105                 (add-to-list 'wordlist currword)))
 106         (if (string-equal "-" (car (setq co (cdr co))))
 107             (progn
 108               (add-to-list 'LilyPond-menu-keywords currword)
 109               (while (and (> (length co) 0)
 110                           (not (string-equal "-" (car (setq co (cdr co))))))))))
 111       wordlist))
 112   "LilyPond \\keywords")
 113
 114 (defconst LilyPond-identifiers
 115   (let ((wordlist '("\\voiceOne")) ; add \Identifiers to lilypond.words
 116         (co (all-completions "" (LilyPond-add-dictionary-word ()))))
 117     (progn
 118       (while (> (length co) 0)
 119         (if (> (length (car co)) 1)
 120             (if (and (string-equal "\\" (substring (car co) 0 1))
 121                      (not (string-equal (downcase (car co)) (car co))))
 122                 (add-to-list 'wordlist (car co))))
 123         (if (string-equal "-" (car (setq co (cdr co))))
 124             (while (and (> (length co) 0)
 125                         (not (string-equal "-" (car (setq co (cdr co)))))))))
 126       wordlist))
 127   "LilyPond \\Identifiers")
 128
 129 (defconst LilyPond-reserved-words
 130   (let ((wordlist '("Staff")) ; add ReservedWords to lilypond.words
 131         (co (all-completions "" (LilyPond-add-dictionary-word ()))))
 132     (progn
 133       (while (> (length co) 0)
 134         (if (> (length (car co)) 0)
 135             (if (not (string-match "[^a-zA-Z]" (car co)))
 136                 (add-to-list 'wordlist (car co))))
 137         (if (string-equal "-" (car (setq co (cdr co))))
 138             (while (and (> (length co) 0)
 139                         (not (string-equal "-" (car (setq co (cdr co)))))))))
 140       wordlist))
 141   "LilyPond ReservedWords")
 142
 143 (defun LilyPond-check-files (derived originals extensions)
 144   "Check that DERIVED is newer than any of the ORIGINALS.
 145 Try each original with each member of EXTENSIONS, in all directories
 146 in LilyPond-include-path."
 147   (let ((found nil)
 148         (regexp (concat "\\`\\("
 149                         (mapconcat (function (lambda (dir)
 150                                       (regexp-quote (expand-file-name dir))))
 151                                    LilyPond-include-path "\\|")
 152                         "\\).*\\("
 153                         (mapconcat 'regexp-quote originals "\\|")
 154                         "\\)\\.\\("
 155                         (mapconcat 'regexp-quote extensions "\\|")
 156                         "\\)\\'"))
 157         (buffers (buffer-list)))
 158     (while buffers
 159       (let* ((buffer (car buffers))
 160              (name (buffer-file-name buffer)))
 161         (setq buffers (cdr buffers))
 162         (if (and name (string-match regexp name))
 163             (progn
 164               (and (buffer-modified-p buffer)
 165                    (or (not LilyPond-save-query)
 166                        (y-or-n-p (concat "Save file "
 167                                          (buffer-file-name buffer)
 168                                          "? ")))
 169                    (save-excursion (set-buffer buffer) (save-buffer)))
 170               (if (file-newer-than-file-p name derived)
 171                   (setq found t))))))
 172     found))
 173
 174 (defun LilyPond-running ()
 175   "Check the currently running LilyPond compiling jobs."
 176   (let ((process-names (list "lilypond" "tex" "2dvi" "2ps" "2midi"
 177                              "book" "latex"))
 178         (running nil))
 179     (while (setq process-name (pop process-names))
 180       (setq process (get-process process-name))
 181       (if (and process
 182                (eq (process-status process) 'run))
 183           (push process-name running)))
 184     running)) ; return the running jobs
 185
 186 (defun LilyPond-midi-running ()
 187   "Check the currently running Midi processes."
 188   (let ((process-names (list "midi" "midiall"))
 189         (running nil))
 190     (while (setq process-name (pop process-names))
 191       (setq process (get-process process-name))
 192       (if (and process
 193                (eq (process-status process) 'run))
 194           (push process-name running)))
 195     running)) ; return the running jobs
 196
 197 (defun LilyPond-kill-jobs ()
 198   "Kill the currently running LilyPond compiling jobs."
 199   (interactive)
 200   (let ((process-names (LilyPond-running))
 201         (killed nil))
 202     (while (setq process-name (pop process-names))
 203       (quit-process (get-process process-name) t)
 204       (push process-name killed))
 205     killed)) ; return the killed jobs
 206
 207 (defun LilyPond-kill-midi ()
 208   "Kill the currently running midi processes."
 209   (let ((process-names (LilyPond-midi-running))
 210         (killed nil))
 211     (while (setq process-name (pop process-names))
 212       (quit-process (get-process process-name) t)
 213       (push process-name killed))
 214     killed)) ; return the killed jobs
 215
 216 ;; URG, should only run LilyPond-compile for LilyPond
 217 ;; not for tex,xdvi (ly2dvi?)
 218 (defun LilyPond-compile-file (command name)
 219   ;; We maybe should know what we run here (Lily, ly2dvi, tex)
 220   ;; and adjust our error-matching regex ?
 221   (compile-internal
 222    (if (eq LilyPond-command-current 'LilyPond-command-master)
 223        command
 224      ;; use temporary directory for Commands on Buffer/Region
 225      ;; hm.. the directory is set twice, first to default-dir
 226      (concat "cd " (LilyPond-temp-directory) "; " command))
 227    "No more errors" name))
 228
 229 ;; do we still need this, now that we're using compile-internal?
 230 (defun LilyPond-save-buffer ()
 231   "Save buffer and set default command for compiling."
 232   (interactive)
 233   (if (buffer-modified-p)
 234       (progn (save-buffer)
 235              (setq LilyPond-command-default "LilyPond"))))
 236
 237 ;;; return (dir base ext)
 238 (defun split-file-name (name)
 239   (let* ((i (string-match "[^/]*$" name))
 240          (dir (if (> i 0) (substring name 0 i) "./"))
 241          (file (substring name i (length name)))
 242          (i (string-match "[^.]*$" file)))
 243     (if (and
 244          (> i 0)
 245          (< i (length file)))
 246         (list dir (substring file 0 (- i 1)) (substring file i (length file)))
 247       (list dir file ""))))
 248
 249
 250 ;; Should check whether in command-alist?
 251 (defcustom LilyPond-command-default "LilyPond"
 252   "Default command. Must identify a member of LilyPond-command-alist."
 253
 254   :group 'LilyPond
 255   :type 'string)
 256 ;;;(make-variable-buffer-local 'LilyPond-command-last)
 257
 258 (defvar LilyPond-command-current 'LilyPond-command-master)
 259 ;;;(make-variable-buffer-local 'LilyPond-command-master)
 260
 261
 262 ;; If non-nil, LilyPond-command-query will return the value of this
 263 ;; variable instead of quering the user.
 264 (defvar LilyPond-command-force nil)
 265
 266 (defcustom LilyPond-xdvi-command "xdvi"
 267   "Command used to display DVI files."
 268
 269   :group 'LilyPond
 270   :type 'string)
 271
 272 (defcustom LilyPond-gv-command "gv -watch"
 273   "Command used to display PS files."
 274
 275   :group 'LilyPond
 276   :type 'string)
 277
 278 (defcustom LilyPond-midi-command "timidity"
 279   "Command used to play MIDI files."
 280
 281   :group 'LilyPond
 282   :type 'string)
 283
 284 (defcustom LilyPond-all-midi-command "timidity -ia"
 285   "Command used to play MIDI files."
 286
 287   :group 'LilyPond
 288   :type 'string)
 289
 290 (defun LilyPond-command-current-midi ()
 291   "Play midi corresponding to the current document."
 292   (interactive)
 293   (LilyPond-command (LilyPond-command-menu "Midi") 'LilyPond-master-file))
 294
 295 (defun LilyPond-command-all-midi ()
 296   "Play midi corresponding to the current document."
 297   (interactive)
 298   (LilyPond-command (LilyPond-command-menu "MidiAll") 'LilyPond-master-file))
 299
 300 (defun count-rexp (start end rexp)
 301   "Print number of found regular expressions in the region."
 302   (interactive "r")
 303   (save-excursion
 304     (save-restriction
 305       (narrow-to-region start end)
 306       (goto-char (point-min))
 307       (count-matches rexp))))
 308
 309 (defun count-midi-words ()
 310   "Check number of midi-scores before the curser."
 311   (if (eq LilyPond-command-current 'LilyPond-command-region)
 312       (count-rexp (mark t) (point) "\\\\midi")
 313     (count-rexp (point-min) (point-max) "\\\\midi")))
 314
 315 (defun count-midi-words-backwards ()
 316   "Check number of midi-scores before the curser."
 317   (if (eq LilyPond-command-current 'LilyPond-command-region)
 318       (count-rexp (mark t) (point) "\\\\midi")
 319     (count-rexp (point-min) (point) "\\\\midi")))
 320
 321 (defun LilyPond-string-current-midi ()
 322   "Check the midi file of the following midi-score in the current document."
 323   (let ((fnameprefix (if (eq LilyPond-command-current 'LilyPond-command-master)
 324                          (substring (LilyPond-master-file) 0 -3); suppose ".ly"
 325                        LilyPond-region-file-prefix))
 326         (allcount (string-to-number (substring (count-midi-words) 0 -12)))
 327         (count (string-to-number (substring (count-midi-words-backwards) 0 -12))))
 328     (concat  fnameprefix
 329              (if (and (> allcount 1) (> count 0)) ; not first score
 330                  (if (eq count allcount)          ; last score
 331                      (concat "-" (number-to-string (+ count -1)))
 332                    (concat "-" (number-to-string count))))
 333              ".midi")))
 334
 335 (defun LilyPond-string-all-midi ()
 336   "Return the midi files of the current document in ascending order."
 337   (let ((fnameprefix (if (eq LilyPond-command-current 'LilyPond-command-master)
 338                          (substring (LilyPond-master-file) 0 -3); suppose ".ly"
 339                        LilyPond-region-file-prefix))
 340         (allcount (string-to-number (substring (count-midi-words) 0 -12))))
 341     (concat (if (> allcount 0)  ; at least one midi-score
 342                 (concat fnameprefix ".midi "))
 343             (if (> allcount 1)  ; more than one midi-score
 344                 (concat fnameprefix "-[1-9].midi "))
 345             (if (> allcount 9)  ; etc.
 346                 (concat fnameprefix "-[1-9][0-9].midi"))
 347             (if (> allcount 99) ; not first score
 348                 (concat fnameprefix "-[1-9][0-9][0-9].midi")))))
 349
 350 ;; This is the major configuration variable.
 351 (defcustom LilyPond-command-alist
 352   ;; Should expand this to include possible keyboard shortcuts which
 353   ;; could then be mapped to define-key and menu.
 354   `(
 355     ("LilyPond" . ("lilypond %s" . "LaTeX"))
 356     ("TeX" . ("tex '\\nonstopmode\\input %t'" . "View"))
 357
 358     ("2Dvi" . ("ly2dvi %s" . "View"))
 359     ("2PS" . ("ly2dvi -P %s" . "ViewPS"))
 360     ("2Midi" . ("lilypond -m %s" . "View"))
 361
 362     ("Book" . ("lilypond-book %x" . "LaTeX"))
 363     ("LaTeX" . ("latex '\\nonstopmode\\input %l'" . "View"))
 364
 365     ;; point-n-click (arg: exits upop USR1)
 366     ("SmartView" . ("xdvi %d" . "LilyPond"))
 367
 368     ;; refreshes when kicked USR1
 369     ("View" . (,(concat LilyPond-xdvi-command " %d") . "LilyPond"))
 370     ("ViewPS" . (,(concat LilyPond-gv-command " %p") . "LilyPond"))
 371
 372     ;; The following are refreshed in LilyPond-command:
 373     ;; - current-midi depends on cursor position and
 374     ("Midi" . (,(concat LilyPond-midi-command " " (LilyPond-string-current-midi)) . "LilyPond" )) ;
 375     ;; - all-midi depends on number of midi-score.
 376     ("MidiAll" . (,(concat LilyPond-all-midi-command " " (LilyPond-string-all-midi)) . "LilyPond"))
 377     )
 378
 379   "AList of commands to execute on the current document.
 380
 381 The key is the name of the command as it will be presented to the
 382 user, the value is a cons of the command string handed to the shell
 383 after being expanded, and the next command to be executed upon
 384 success.  The expansion is done using the information found in
 385 LilyPond-expand-list.
 386 "
 387   :group 'LilyPond
 388   :type '(repeat (cons :tag "Command Item"
 389                        (string :tag "Key")
 390                        (cons :tag "How"
 391                         (string :tag "Command")
 392                         (string :tag "Next Key")))))
 393
 394 ;; drop this?
 395 (defcustom LilyPond-file-extension ".ly"
 396   "*File extension used in LilyPond sources."
 397   :group 'LilyPond
 398   :type 'string)
 399
 400
 401 (defcustom LilyPond-expand-alist
 402   '(
 403     ("%s" . ".ly")
 404     ("%t" . ".tex")
 405     ("%d" . ".dvi")
 406     ("%p" . ".ps")
 407     ("%l" . ".tex")
 408     ("%x" . ".tely")
 409     ("%m" . ".midi")
 410     )
 411
 412   "Alist of expansion strings for LilyPond command names."
 413   :group 'LilyPond
 414   :type '(repeat (cons :tag "Alist item"
 415                   (string :tag "Symbol")
 416                   (string :tag "Expansion"))))
 417
 418
 419 (defcustom LilyPond-command-Show "View"
 420   "*The default command to show (view or print) a LilyPond file.
 421 Must be the car of an entry in `LilyPond-command-alist'."
 422   :group 'LilyPond
 423   :type 'string)
 424   (make-variable-buffer-local 'LilyPond-command-Show)
 425
 426 (defcustom LilyPond-command-Print "Print"
 427   "The name of the Print entry in LilyPond-command-Print."
 428   :group 'LilyPond
 429   :type 'string)
 430
 431 (defun xLilyPond-compile-sentinel (process msg)
 432   (if (and process
 433            (= 0 (process-exit-status process)))
 434       (setq LilyPond-command-default
 435               (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 436
 437 ;; FIXME: shouldn't do this for stray View/xdvi
 438 (defun LilyPond-compile-sentinel (buffer msg)
 439   (if (string-match "^finished" msg)
 440       (setq LilyPond-command-default
 441             (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 442
 443 ;;(make-variable-buffer-local 'compilation-finish-function)
 444 (setq compilation-finish-function 'LilyPond-compile-sentinel)
 445
 446 (defun LilyPond-command-query (name)
 447   "Query the user for what LilyPond command to use."
 448   (let* ((default (cond ((if (string-equal name LilyPond-region-file-prefix)
 449                              (LilyPond-check-files (concat name ".tex")
 450                                                    (list name)
 451                                                    (list LilyPond-file-extension))
 452                            (if (verify-visited-file-modtime (current-buffer))
 453                                (if (buffer-modified-p)
 454                                    (if (y-or-n-p "Save buffer before next command? ")
 455                                        (LilyPond-save-buffer)))
 456                              (if (y-or-n-p "The command will be invoked to an already saved buffer. Revert it? ")
 457                                  (revert-buffer t t)))
 458                            ;;"LilyPond"
 459                            LilyPond-command-default))
 460                         (t LilyPond-command-default)))
 461
 462          (completion-ignore-case t)
 463
 464          (answer (or LilyPond-command-force
 465                      (completing-read
 466                       (concat "Command: (default " default ") ")
 467                       LilyPond-command-alist nil t nil 'LilyPond-command-history))))
 468
 469     ;; If the answer is "LilyPond" it will not be expanded to "LilyPond"
 470     (let ((answer (car-safe (assoc answer LilyPond-command-alist))))
 471       (if (and answer
 472                (not (string-equal answer "")))
 473           answer
 474         default))))
 475
 476 (defun LilyPond-command-master ()
 477   "Run command on the current document."
 478   (interactive)
 479   (LilyPond-command-select-master)
 480   (LilyPond-command (LilyPond-command-query (LilyPond-master-file))
 481                     'LilyPond-master-file))
 482
 483 (defun LilyPond-command-lilypond ()
 484   "Run lilypond for the current document."
 485   (interactive)
 486   (LilyPond-command (LilyPond-command-menu "LilyPond") 'LilyPond-master-file)
 487 )
 488
 489 (defun LilyPond-command-formatdvi ()
 490   "Format the dvi output of the current document."
 491   (interactive)
 492   (LilyPond-command (LilyPond-command-menu "2Dvi") 'LilyPond-master-file)
 493 )
 494
 495 (defun LilyPond-command-formatps ()
 496   "Format the ps output of the current document."
 497   (interactive)
 498   (LilyPond-command (LilyPond-command-menu "2PS") 'LilyPond-master-file)
 499 )
 500
 501 (defun LilyPond-command-formatmidi ()
 502   "Format the midi output of the current document."
 503   (interactive)
 504   (LilyPond-command (LilyPond-command-menu "2Midi") 'LilyPond-master-file)
 505 )
 506
 507 (defun LilyPond-command-smartview ()
 508   "View the dvi output of current document."
 509   (interactive)
 510   (LilyPond-command (LilyPond-command-menu "SmartView") 'LilyPond-master-file)
 511 )
 512
 513 (defun LilyPond-command-view ()
 514   "View the dvi output of current document."
 515   (interactive)
 516   (LilyPond-command (LilyPond-command-menu "View") 'LilyPond-master-file)
 517 )
 518
 519 (defun LilyPond-command-viewps ()
 520   "View the ps output of current document."
 521   (interactive)
 522   (LilyPond-command (LilyPond-command-menu "ViewPS") 'LilyPond-master-file)
 523 )
 524
 525 ;; FIXME, this is broken
 526 (defun LilyPond-region-file (begin end)
 527   (let (
 528         ;; (dir "./")
 529         (dir (LilyPond-temp-directory))
 530         (base LilyPond-region-file-prefix)
 531         (ext LilyPond-file-extension))
 532     (concat dir base ext)))
 533
 534 ;;; Commands on Region work if there is an appropriate '\score'.
 535 (defun LilyPond-command-region (begin end)
 536   "Run LilyPond on the current region."
 537   (interactive "r")
 538   (if (or (> begin (point-min)) (< end (point-max)))
 539       (LilyPond-command-select-region))
 540   (write-region begin end (LilyPond-region-file begin end) nil 'nomsg)
 541   (LilyPond-command (LilyPond-command-query
 542                      (LilyPond-region-file begin end))
 543                     '(lambda () (LilyPond-region-file begin end)))
 544   ;; Region may deactivate even if buffer was intact, reactivate?
 545   ;; Currently, also deactived regions are used.
 546   )
 547
 548 (defun LilyPond-command-buffer ()
 549   "Run LilyPond on buffer."
 550   (interactive)
 551   (LilyPond-command-select-buffer)
 552   (LilyPond-command-region (point-min) (point-max)))
 553
 554 (defun LilyPond-command-expand (string file)
 555   (let ((case-fold-search nil))
 556     (if (string-match "%" string)
 557         (let* ((b (match-beginning 0))
 558                (e (+ b 2))
 559                (l (split-file-name file))
 560                (dir (car l))
 561                (base (cadr l)))
 562           (LilyPond-command-expand
 563            (concat (substring string 0 b)
 564                    dir
 565                    base
 566                    (let ((entry (assoc (substring string b e)
 567                                        LilyPond-expand-alist)))
 568                      (if entry (cdr entry) ""))
 569                    (substring string e))
 570            file))
 571       string)))
 572
 573 (defun LilyPond-shell-process (name buffer command)
 574   (let ((old (current-buffer)))
 575     (switch-to-buffer-other-window buffer)
 576     ;; If we empty the buffer don't see messages scroll by.
 577     ;; (erase-buffer)
 578
 579     (start-process-shell-command name buffer command)
 580     (switch-to-buffer-other-window old)))
 581
 582
 583 (defun LilyPond-command (name file)
 584   "Run command NAME on the file you get by calling FILE.
 585
 586 FILE is a function return a file name.  It has one optional argument,
 587 the extension to use on the file.
 588
 589 Use the information in LilyPond-command-alist to determine how to run the
 590 command."
 591
 592   (let ((entry (assoc name LilyPond-command-alist)))
 593     (if entry
 594         (let ((command (LilyPond-command-expand (cadr entry)
 595                                                 (apply file nil)))
 596               (jobs nil)
 597               (job-string "no jobs"))
 598           (if (member name (list "View" "ViewPS"))
 599               ;; is USR1 a right signal for viewps?
 600               (let ((buffer-xdvi (get-buffer-create (concat "*" name "*"))))
 601                 (if LilyPond-kick-xdvi
 602                   (let ((process-xdvi (get-buffer-process buffer-xdvi)))
 603                     (if process-xdvi
 604                         (signal-process (process-id process-xdvi) 'SIGUSR1)
 605                       (LilyPond-shell-process name buffer-xdvi command)))
 606                   (LilyPond-shell-process name buffer-xdvi command)))
 607             (progn
 608               (if (string-equal name "Midi")
 609                   (progn
 610                     (setq command (concat LilyPond-midi-command " " (LilyPond-string-current-midi)))
 611                     (if (LilyPond-kill-midi)
 612                         (setq job-string nil)))) ; either stop or start playing
 613               (if (string-equal name "MidiAll")
 614                   (progn
 615                     (setq command (concat LilyPond-all-midi-command " " (LilyPond-string-all-midi)))
 616                     (LilyPond-kill-midi))) ; stop and start playing
 617               (if (and (member name (list "Midi" "MidiAll")) job-string)
 618                   (if (file-newer-than-file-p
 619                        (LilyPond-master-file)
 620                        (concat (substring (LilyPond-master-file) 0 -3) ".midi"))
 621                       (if (y-or-n-p "Midi older than source. Reformat midi?")
 622                           (progn
 623                             (LilyPond-command-formatmidi)
 624                             (while (LilyPond-running)
 625                               (message "Starts playing midi once it is built.")
 626                               (sit-for 0 100))))))
 627               (if (member name (list "LilyPond" "TeX" "2Midi" "2PS" "2Dvi"
 628                                      "Book" "LaTeX"))
 629                   (if (setq jobs (LilyPond-running))
 630                       (progn
 631                         (setq job-string "Process") ; could also suggest compiling after process has ended
 632                         (while jobs
 633                           (setq job-string (concat job-string " \"" (pop jobs) "\"")))
 634                         (setq job-string (concat job-string " is already running; kill it to proceed "))
 635                         (if (y-or-n-p job-string)
 636                             (progn
 637                               (setq job-string "no jobs")
 638                               (LilyPond-kill-jobs)
 639                               (while (LilyPond-running)
 640                                 (sit-for 0 100)))
 641                           (setq job-string nil)))))
 642
 643               (setq LilyPond-command-default name)
 644               (if (string-equal job-string "no jobs")
 645                   (LilyPond-compile-file command name))))))))
 646
 647 (defun LilyPond-mark-active ()
 648   "Check if there is an active mark."
 649   (and transient-mark-mode
 650        (if (string-match "XEmacs\\|Lucid" emacs-version) (mark) mark-active)))
 651
 652 (defun LilyPond-temp-directory ()
 653   "Temporary file directory for Commands on Region."
 654   (interactive)
 655   (if (string-match "XEmacs\\|Lucid" emacs-version)
 656       (concat (temp-directory) "/")
 657     temporary-file-directory))
 658
 659 ;;; Keymap
 660
 661 (defvar LilyPond-mode-map ()
 662   "Keymap used in `LilyPond-mode' buffers.")
 663
 664 ;; Note:  if you make changes to the map, you must do
 665 ;;    M-x set-variable LilyPond-mode-map nil
 666 ;;    M-x eval-buffer
 667 ;;    M-x LilyPond-mode
 668 ;; to let the changest take effect
 669
 670 (if LilyPond-mode-map
 671     ()
 672   (setq LilyPond-mode-map (make-sparse-keymap))
 673   ;; Put keys to LilyPond-command-alist and fetch them from there somehow.
 674   (define-key LilyPond-mode-map "\C-c\C-l" 'LilyPond-command-lilypond)
 675   (define-key LilyPond-mode-map "\C-c\C-r" 'LilyPond-command-region)
 676   (define-key LilyPond-mode-map "\C-c\C-b" 'LilyPond-command-buffer)
 677   (define-key LilyPond-mode-map "\C-c\C-k" 'LilyPond-kill-jobs)
 678   (define-key LilyPond-mode-map "\C-c\C-c" 'LilyPond-command-master)
 679   (define-key LilyPond-mode-map "\C-cm" 'LilyPond-command-formatmidi)
 680   (define-key LilyPond-mode-map "\C-c\C-d" 'LilyPond-command-formatdvi)
 681   (define-key LilyPond-mode-map "\C-c\C-f" 'LilyPond-command-formatps)
 682   (define-key LilyPond-mode-map "\C-c\C-s" 'LilyPond-command-smartview)
 683   (define-key LilyPond-mode-map "\C-c\C-v" 'LilyPond-command-view)
 684   (define-key LilyPond-mode-map "\C-c\C-p" 'LilyPond-command-viewps)
 685   (define-key LilyPond-mode-map [(control c) return] 'LilyPond-command-current-midi)
 686   (define-key LilyPond-mode-map [(control c) (control return)] 'LilyPond-command-all-midi)
 687   (define-key LilyPond-mode-map "\C-x\C-s" 'LilyPond-save-buffer)
 688   (define-key LilyPond-mode-map "\C-cf" 'font-lock-fontify-buffer)
 689   ;; the following will should be overriden by Lilypond Quick Insert Mode
 690   (define-key LilyPond-mode-map "\C-cq" 'LilyPond-quick-insert-mode)
 691   (define-key LilyPond-mode-map "\C-c;" 'LilyPond-comment-region)
 692   (define-key LilyPond-mode-map ")" 'LilyPond-electric-close-paren)
 693   (define-key LilyPond-mode-map ">" 'LilyPond-electric-close-paren)
 694   (define-key LilyPond-mode-map "}" 'LilyPond-electric-close-paren)
 695   (define-key LilyPond-mode-map "]" 'LilyPond-electric-close-paren)
 696   (if (string-match "XEmacs\\|Lucid" emacs-version)
 697       (define-key LilyPond-mode-map [iso-left-tab] 'LilyPond-autocompletion)
 698     (define-key LilyPond-mode-map [iso-lefttab] 'LilyPond-autocompletion))
 699   (define-key LilyPond-mode-map "\C-c\t" 'LilyPond-info-index-search)
 700   )
 701
 702 ;;; Menu Support
 703
 704 ;;; This mode was originally LilyPond-quick-note-insert by Heikki Junes.
 705 ;;; The original version has been junked since CVS-1.97,
 706 ;;; in order to merge the efforts done by Nicolas Sceaux.
 707 ;;; LilyPond Quick Insert Mode is a major mode, toggled by C-c q.
 708 (defun LilyPond-quick-insert-mode ()
 709   "Insert notes with fewer key strokes by using a simple keyboard piano."
 710   (interactive)
 711   (progn
 712     (message "Invoke (C-c q) from keyboard. If you still see this message,") (sit-for 5 0)
 713     (message "then you have not installed LilyPond Quick Insert Mode (lyqi).") (sit-for 5 0)
 714     (message "Download lyqi from http://nicolas.sceaux.free.fr/lilypond/lyqi.html,") (sit-for 5 0)
 715     (message "see installation instructions from lyqi's README -file.") (sit-for 5 0)
 716     (message "You need also eieio (Enhanced Integration of Emacs Interpreted Objects).") (sit-for 5 0)
 717     (message "Download eieio from http://cedet.sourceforge.net/eieio.shtml,") (sit-for 5 0)
 718     (message "see installation instructions from eieio's INSTALL -file.") (sit-for 5 0)
 719     (message "")
 720     ))
 721
 722 (defun LilyPond-pre-word-search ()
 723   "Fetch the alphabetic characters and \\ in front of the cursor."
 724   (let ((pre "")
 725         (prelen 0)
 726         (ch (char-before (- (point) 0))))
 727     (while (and ch (or (and (>= ch 65) (<= ch 90))  ; not bolp, A-Z
 728                        (and (>= ch 97) (<= ch 122)) ; a-z
 729                        (= ch 92)))                  ; \\
 730       (setq pre (concat (char-to-string ch) pre))
 731       (setq prelen (+ prelen 1))
 732       (setq ch (char-before (- (point) prelen))))
 733     pre))
 734
 735 (defun LilyPond-post-word-search ()
 736   "Fetch the alphabetic characters behind the cursor."
 737   (let ((post "")
 738         (postlen 0)
 739         (ch (char-after (+ (point) 0))))
 740     (while (and ch (or (and (>= ch 65) (<= ch 90))    ; not eolp, A-Z
 741                        (and (>= ch 97) (<= ch 122)))) ; a-z
 742       (setq post (concat post (char-to-string ch)))
 743       (setq postlen (+ postlen 1))
 744       (setq ch (char-after (+ (point) postlen))))
 745     post))
 746
 747 (defun LilyPond-autocompletion ()
 748   "Show completions in mini-buffer for the given word."
 749   (interactive)
 750   (let ((pre (LilyPond-pre-word-search))
 751         (post (LilyPond-post-word-search))
 752         (compsstr ""))
 753     ;; insert try-completion and show all-completions
 754     (if (> (length pre) 0)
 755         (progn
 756           (setq trycomp (try-completion pre (LilyPond-add-dictionary-word ())))
 757           (if (char-or-string-p trycomp)
 758               (if (string-equal (concat pre post) trycomp)
 759                   (goto-char (+ (point) (length post)))
 760                 (progn
 761                   (delete-region (point) (+ (point) (length post)))
 762                   (insert (substring trycomp (length pre) nil))))
 763             (progn
 764               (delete-region (point) (+ (point) (length post)))
 765               (font-lock-fontify-buffer))) ; only inserting fontifies
 766
 767         (setq complist (all-completions pre (LilyPond-add-dictionary-word ())))
 768         (while (> (length complist) 0)
 769           (setq compsstr (concat compsstr "\"" (car complist) "\" "))
 770           (setq complist (cdr complist)))
 771         (message compsstr)
 772         (sit-for 0 100)))))
 773
 774 (defun LilyPond-info ()
 775   "Launch Info for lilypond."
 776   (interactive)
 777   (info "lilypond"))
 778
 779 (defun LilyPond-music-glossary-info ()
 780   "Launch Info for music-glossary."
 781   (interactive)
 782   (info "music-glossary"))
 783
 784 (defun LilyPond-internals-info ()
 785   "Launch Info for lilypond-internals."
 786   (interactive)
 787   (info "lilypond-internals"))
 788
 789 (defun LilyPond-info-index-search ()
 790   "In `*info*'-buffer, launch `info lilypond --index-search word-under-cursor'"
 791   (interactive)
 792   (let ((str (concat (LilyPond-pre-word-search) (LilyPond-post-word-search))))
 793     (if (and (> (length str) 0)
 794              (string-equal (substring str 0 1) "\\"))
 795         (setq str (substring str 1 nil)))
 796     (LilyPond-info)
 797     (Info-index str)))
 798
 799 (defun LilyPond-insert-tag (word)
 800   "Insert syntax for given word. The definition is in lilypond.words."
 801   (setq b (find-file-noselect (LilyPond-words-filename) t t))
 802   (let ((found nil)
 803         (p nil)
 804         (query nil)
 805         (m (set-marker (make-marker) 1 (get-buffer b)))
 806         (distance (if (LilyPond-mark-active)
 807                       (abs (- (mark-marker) (point-marker))) 0))
 808        )
 809    ;; find the place first
 810    (if (LilyPond-mark-active)
 811        (goto-char (min (mark-marker) (point-marker))))
 812    (while (and (not found) (> (buffer-size b) (marker-position m)))
 813     (setq copy (car (copy-alist (list (eval (symbol-name (read m)))))))
 814     (if (string-equal word copy) (setq found t)))
 815    (if found (insert word))
 816    (if (> (buffer-size b) (marker-position m))
 817        (setq copy (car (copy-alist (list (eval (symbol-name (read m))))))))
 818    (if (not (string-equal "-" copy))
 819        (setq found nil))
 820    (while (and found (> (buffer-size b) (marker-position m)))
 821     ;; find next symbol
 822     (setq copy (car (copy-alist (list (eval (symbol-name (read m)))))))
 823     ;; check whether it is the word, or the word has been found
 824     (cond
 825      ((string-equal "-" copy) (setq found nil))
 826      ((string-equal "%" copy) (insert " " (read-string "Give Arguments: ")))
 827      ((string-equal "_" copy)
 828       (progn
 829        (setq p (point))
 830        (goto-char (+ p distance))))
 831      ((string-equal "\?" copy) (setq query t))
 832      ((string-equal "\!" copy) (setq query nil))
 833      ((string-equal "\\n" copy)
 834       (if (not query)
 835        (progn (LilyPond-indent-line) (insert "\n") (LilyPond-indent-line))))
 836      ((string-equal "{" copy)
 837       (if (not query)
 838           (progn (insert " { "))))
 839      ((string-equal "}" copy)
 840       (if (not query)
 841        (progn (insert " } ") (setq query nil) )))
 842      ((not query)
 843       (insert copy))
 844      (query
 845       (if (y-or-n-p (concat "Proceed with `" copy "'? "))
 846        (progn (insert copy) (setq query nil))))
 847    ))
 848    (if p (goto-char p))
 849    (kill-buffer b))
 850 )
 851
 852 (defun LilyPond-command-menu-entry (entry)
 853   ;; Return LilyPond-command-alist ENTRY as a menu item.
 854   (let ((name (car entry)))
 855     (cond ((and (string-equal name LilyPond-command-Print)
 856                 LilyPond-printer-list)
 857            (let ((command LilyPond-print-command)
 858                  (lookup 1))
 859              (append (list LilyPond-command-Print)
 860                      (mapcar 'LilyPond-command-menu-printer-entry
 861                              LilyPond-printer-list))))
 862           (t
 863            (vector name (list 'LilyPond-command-menu name) t)))))
 864
 865
 866 (easy-menu-define LilyPond-command-menu
 867   LilyPond-mode-map
 868   "Menu used in LilyPond mode."
 869   (append '("Command")
 870           '(("Command on"
 871              [ "Master File" LilyPond-command-select-master
 872                :keys "C-c C-c" :style radio
 873                :selected (eq LilyPond-command-current 'LilyPond-command-master) ]
 874              [ "Buffer" LilyPond-command-select-buffer
 875                :keys "C-c C-b" :style radio
 876                :selected (eq LilyPond-command-current 'LilyPond-command-buffer) ]
 877              [ "Region" LilyPond-command-select-region
 878                :keys "C-c C-r" :style radio
 879                :selected (eq LilyPond-command-current 'LilyPond-command-region) ]))
 880 ;;;       (let ((file 'LilyPond-command-on-current))
 881 ;;;         (mapcar 'LilyPond-command-menu-entry LilyPond-command-alist))
 882 ;;; Some kind of mapping which includes :keys might be more elegant
 883 ;;; Put keys to LilyPond-command-alist and fetch them from there somehow.
 884           '([ "LilyPond" LilyPond-command-lilypond t])
 885           '([ "TeX" (LilyPond-command (LilyPond-command-menu "TeX") 'LilyPond-master-file) ])
 886           '([ "2Dvi" LilyPond-command-formatdvi t])
 887           '([ "2PS" LilyPond-command-formatps t])
 888           '([ "2Midi" LilyPond-command-formatmidi t])
 889           '([ "Book" (LilyPond-command (LilyPond-command-menu "Book") 'LilyPond-master-file) ])
 890           '([ "LaTeX" (LilyPond-command (LilyPond-command-menu "LaTeX") 'LilyPond-master-file) ])
 891           '([ "Kill jobs" LilyPond-kill-jobs t])
 892           '("-----")
 893           '([ "SmartView" LilyPond-command-smartview t])
 894           '([ "View" LilyPond-command-view t])
 895           '([ "ViewPS" LilyPond-command-viewps t])
 896           '("-----")
 897           '([ "Midi (toggle)" LilyPond-command-current-midi t])
 898           '([ "Midi all" LilyPond-command-all-midi t])
 899           ))
 900
 901 (defun LilyPond-menu-keywords (arg)
 902   "Make vector for LilyPond-mode-menu."
 903   (vector arg (list 'LilyPond-insert-tag arg)))
 904
 905 ;;; LilyPond-mode-menu should not be interactive, via "M-x LilyPond-<Tab>"
 906 (easy-menu-define LilyPond-mode-menu
 907   LilyPond-mode-map
 908   "Menu used in LilyPond mode."
 909   (append '("LilyPond")
 910           '(["Add index menu" LilyPond-add-imenu-menu])
 911           (list (cons "Insert" (mapcar 'LilyPond-menu-keywords
 912                                        (reverse LilyPond-menu-keywords))))
 913           '(("Miscellaneous"
 914              ["Autocompletion"   LilyPond-autocompletion t]
 915              ["(Un)comment Region" LilyPond-comment-region t]
 916              ["Refontify buffer" font-lock-fontify-buffer t]
 917              "-----"
 918              ["Quick Insert Mode"  LilyPond-quick-insert-mode :keys "C-c q"]
 919              ))
 920           '(("Info"
 921              ["LilyPond" LilyPond-info t]
 922              ["LilyPond index-search" LilyPond-info-index-search t]
 923              ["Music Glossary" LilyPond-music-glossary-info t]
 924              ["LilyPond internals" LilyPond-internals-info t]
 925              ))
 926           ))
 927
 928 (defconst LilyPond-imenu-generic-re "^\\([a-zA-Z]+\\) *="
 929   "Regexp matching Identifier definitions.")
 930
 931 (defvar LilyPond-imenu-generic-expression
 932   (list (list nil LilyPond-imenu-generic-re 1))
 933   "Expression for imenu")
 934
 935 (defun LilyPond-command-select-master ()
 936   (interactive)
 937   (message "Next command will be on the master file")
 938   (setq LilyPond-command-current 'LilyPond-command-master))
 939
 940 (defun LilyPond-command-select-buffer ()
 941   (interactive)
 942   (message "Next command will be on the buffer")
 943   (setq LilyPond-command-current 'LilyPond-command-buffer))
 944
 945 (defun LilyPond-command-select-region ()
 946   (interactive)
 947   (message "Next command will be on the region")
 948   (setq LilyPond-command-current 'LilyPond-command-region))
 949
 950 (defun LilyPond-command-menu (name)
 951   ;; Execute LilyPond-command-alist NAME from a menu.
 952   (let ((LilyPond-command-force name))
 953     (if (eq LilyPond-command-current 'LilyPond-command-region)
 954         (if (eq (mark t) nil)
 955             (progn (message "The mark is not set now") (sit-for 0 500))
 956           (progn (if (not (not (LilyPond-mark-active)))
 957                      (progn (message "Region is not active, using region between inactive mark and current point.") (sit-for 0 500)))
 958                  (LilyPond-command-region (mark t) (point))))
 959       (funcall LilyPond-command-current))))
 960
 961 (defun LilyPond-add-imenu-menu ()
 962   (interactive)
 963   "Add an imenu menu to the menubar."
 964   (if (not LilyPond-imenu)
 965       (progn
 966         (imenu-add-to-menubar "Index")
 967         (redraw-frame (selected-frame))
 968         (setq LilyPond-imenu t))
 969     (message "%s" "LilyPond-imenu already exists.")))
 970 (put 'LilyPond-add-imenu-menu 'menu-enable '(not LilyPond-imenu))
 971
 972 (defun LilyPond-mode ()
 973   "Major mode for editing LilyPond music files.
 974
 975 This mode knows about LilyPond keywords and line comments, not about
 976 indentation or block comments.  It features easy compilation, error
 977 finding and viewing of a LilyPond source buffer or region.
 978
 979 COMMANDS
 980 \\{LilyPond-mode-map}
 981 VARIABLES
 982
 983 LilyPond-command-alist\t\talist from name to command
 984 LilyPond-xdvi-command\t\tcommand to display dvi files -- bit superfluous"
 985   (interactive)
 986   ;; set up local variables
 987   (kill-all-local-variables)
 988
 989   (make-local-variable 'font-lock-defaults)
 990   (setq font-lock-defaults '(LilyPond-font-lock-keywords))
 991
 992   ;; string and comments are fontified explicitly
 993   (make-local-variable 'font-lock-keywords-only)
 994   (setq font-lock-keywords-only t)
 995
 996   ;; Multi-line font-locking needs Emacs 21.1 or newer.
 997   ;; For older versions there is hotkey "C-c f".
 998   (make-local-variable 'font-lock-multiline)
 999   (setq font-lock-multiline t)
1000
1001   (make-local-variable 'paragraph-separate)
1002   (setq paragraph-separate "^[ \t]*$")
1003
1004   (make-local-variable 'paragraph-start)
1005   (setq paragraph-start "^[ \t]*$")
1006
1007   (make-local-variable 'comment-start)
1008   (setq comment-start "%")
1009
1010   (make-local-variable 'comment-start-skip)
1011   (setq comment-start-skip "%{? *")
1012
1013   (make-local-variable 'comment-end)
1014   (setq comment-end "")
1015
1016   (make-local-variable 'block-comment-start)
1017   (setq block-comment-start "%{")
1018
1019   (make-local-variable 'block-comment-end)
1020   (setq block-comment-end   "%}")
1021
1022   (make-local-variable 'indent-line-function)
1023   (setq indent-line-function 'LilyPond-indent-line)
1024
1025   (LilyPond-mode-set-syntax-table '(?\< ?\> ?\{ ?\}))
1026   (setq major-mode 'LilyPond-mode)
1027   (setq mode-name "LilyPond")
1028   (setq local-abbrev-table LilyPond-mode-abbrev-table)
1029   (use-local-map LilyPond-mode-map)
1030
1031   ;; In XEmacs imenu was synched up with: FSF 20.4
1032   (make-local-variable 'imenu-generic-expression)
1033   (setq imenu-generic-expression LilyPond-imenu-generic-expression)
1034   ;; (imenu-add-to-menubar "Index") ; see LilyPond-add-imenu-menu
1035
1036   ;; In XEmacs one needs to use 'easy-menu-add'.
1037   (if (string-match "XEmacs\\|Lucid" emacs-version)
1038       (progn
1039         (easy-menu-add LilyPond-mode-menu)
1040         (easy-menu-add LilyPond-command-menu)))
1041
1042   ;; Use Command on Region even for inactive mark (region).
1043   (if (string-match "XEmacs\\|Lucid" emacs-version)
1044       (setq zmacs-regions nil)
1045     (setq mark-even-if-inactive t))
1046
1047   ;; Context dependent syntax tables in LilyPond-mode
1048   (make-local-hook 'post-command-hook) ; XEmacs requires
1049   (add-hook 'post-command-hook 'LilyPond-mode-context-set-syntax-table nil t)
1050
1051   ;; Turn on paren-mode buffer-locally, i.e., in LilyPond-mode
1052   (if (string-match "XEmacs\\|Lucid" emacs-version)
1053       (progn
1054         (make-local-variable 'paren-mode)
1055         (paren-set-mode 'paren)
1056         (make-local-variable 'blink-matching-paren)
1057         (setq blink-matching-paren t)
1058         )
1059     (progn
1060       (make-local-variable 'blink-matching-paren-on-screen)
1061       (setq blink-matching-paren-on-screen t)
1062      ))
1063
1064   ;; run the mode hook. LilyPond-mode-hook use is deprecated
1065   (run-hooks 'LilyPond-mode-hook))
1066
1067 (defun LilyPond-version ()
1068   "Echo the current version of `LilyPond-mode' in the minibuffer."
1069   (interactive)
1070   (message "Using `LilyPond-mode' version %s" LilyPond-version))
1071
1072 (load-library "lilypond-font-lock")
1073 (load-library "lilypond-indent")
1074
1075 (provide 'lilypond-mode)
1076 ;;; lilypond-mode.el ends here
1077