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 ;;; Inspired on auctex
   9
  10 ;;;
  11 ;;; Add this to your ~/.emacs or ~/.emacs.el
  12 ;;;     (load-library "lilypond-mode.el")
  13 ;;;     (setq auto-mode-alist
  14 ;;;      (append '(("\\.ly$" . LilyPond-mode) auto-mode-alist)))
  15 ;;;
  16
  17 (load-library "lilypond-font-lock")
  18
  19 (require 'easymenu)
  20 (require 'compile)
  21
  22 (defconst LilyPond-version "1.3.143"
  23   "`LilyPond-mode' version number.")
  24
  25 (defconst LilyPond-help-address "bug-gnu-music@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-kick-xdvi nil
  32   "If true, no simultaneous xdvi's are started, but reload signal is sent.")
  33
  34 (defvar LilyPond-command-history nil
  35   "Command history list.")
  36
  37 (defvar LilyPond-regexp-alist
  38   '(("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
  39   "Regexp used to match LilyPond errors.  See `compilation-error-regexp-alist'.")
  40
  41 (defcustom LilyPond-include-path ".:/tmp"
  42   "* LilyPond include path."
  43   :type 'string
  44   :group 'LilyPond)
  45
  46
  47 (defun LilyPond-check-files (derived originals extensions)
  48   "Check that DERIVED is newer than any of the ORIGINALS.
  49 Try each original with each member of EXTENSIONS, in all directories
  50 in LilyPond-include-path."
  51   (let ((found nil)
  52         (regexp (concat "\\`\\("
  53                         (mapconcat (function (lambda (dir)
  54                                       (regexp-quote (expand-file-name dir))))
  55                                    LilyPond-include-path "\\|")
  56                         "\\).*\\("
  57                         (mapconcat 'regexp-quote originals "\\|")
  58                         "\\)\\.\\("
  59                         (mapconcat 'regexp-quote extensions "\\|")
  60                         "\\)\\'"))
  61         (buffers (buffer-list)))
  62     (while buffers
  63       (let* ((buffer (car buffers))
  64              (name (buffer-file-name buffer)))
  65         (setq buffers (cdr buffers))
  66         (if (and name (string-match regexp name))
  67             (progn
  68               (and (buffer-modified-p buffer)
  69                    (or (not LilyPond-save-query)
  70                        (y-or-n-p (concat "Save file "
  71                                          (buffer-file-name buffer)
  72                                          "? ")))
  73                    (save-excursion (set-buffer buffer) (save-buffer)))
  74               (if (file-newer-than-file-p name derived)
  75                   (setq found t))))))
  76     found))
  77
  78 (defun LilyPond-running ()
  79   (let ((process (get-process "lilypond")))
  80   (and process
  81        (eq (process-status process) 'run))))
  82
  83 (defun LilyPond-kill-job ()
  84   "Kill the currently running LilyPond job."
  85   (interactive)
  86   ;; What bout TeX, Xdvi?
  87   (quit-process (get-process "lilypond") t))
  88
  89 ;; URG, should only run LilyPond-compile for LilyPond
  90 ;; not for tex,xdvi (ly2dvi?)
  91 (defun LilyPond-compile-file (command name)
  92   ;; We maybe should know what we run here (Lily, ly2dvi, tex)
  93   ;; and adjust our error-matching regex ?
  94   (compile-internal command "No more errors" name ))
  95
  96 ;; do we still need this, now that we're using compile-internal?
  97 (defun LilyPond-save-buffer ()
  98   (if (buffer-modified-p) (save-buffer)))
  99
 100 ;;; return (dir base ext)
 101 (defun split-file-name (name)
 102   (let* ((i (string-match "[^/]*$" name))
 103          (dir (if (> i 0) (substring name 0 i) "./"))
 104          (file (substring name i (length name)))
 105          (i (string-match "[^.]*$" file)))
 106     (if (and
 107          (> i 0)
 108          (< i (length file)))
 109         (list dir (substring file 0 (- i 1)) (substring file i (length file)))
 110       (list dir file ""))))
 111
 112
 113 ;; Should check whether in command-alist?
 114 (defcustom LilyPond-command-default "LilyPond"
 115   "Default command. Must identify a member of LilyPond-command-alist."
 116
 117   :group 'LilyPond
 118   :type 'string)
 119 ;;;(make-variable-buffer-local 'LilyPond-command-last)
 120
 121 (defvar LilyPond-command-current 'LilyPond-command-master)
 122 ;;;(make-variable-buffer-local 'LilyPond-command-master)
 123
 124
 125 ;; If non-nil, LilyPond-command-query will return the value of this
 126 ;; variable instead of quering the user.
 127 (defvar LilyPond-command-force nil)
 128
 129 (defcustom LilyPond-xdvi-command "xdvik"
 130   "Command used to display DVI files."
 131
 132   :group 'LilyPond
 133   :type 'string)
 134
 135 ;; This is the major configuration variable.
 136 (defcustom LilyPond-command-alist
 137   `(
 138     ("LilyPond" . ("lilypond %s" . "TeX"))
 139     ("TeX" . ("tex '\\nonstopmode\\input %t'" . "View"))
 140
 141     ("2Dvi" . ("ly2dvi %s" . "View"))
 142
 143     ("Book" . ("lilypond-book %x" . "LaTeX"))
 144     ("LaTeX" . ("latex '\\nonstopmode\\input %l'" . "View"))
 145
 146     ;; point-n-click (arg: exits upop USR1)
 147     ("SmartView" . ("xdvi %d" . "LilyPond"))
 148
 149     ;; refreshes when kicked USR1
 150     ("View" . (,(concat LilyPond-xdvi-command " %d") . "LilyPond"))
 151     )
 152
 153   "AList of commands to execute on the current document.
 154
 155 The key is the name of the command as it will be presented to the
 156 user, the value is a cons of the command string handed to the shell
 157 after being expanded, and the next command to be executed upon
 158 success.  The expansion is done using the information found in
 159 LilyPond-expand-list.
 160 "
 161   :group 'LilyPond
 162   :type '(repeat (cons :tag "Command Item"
 163                        (string :tag "Key")
 164                        (cons :tag "How"
 165                         (string :tag "Command")
 166                         (string :tag "Next Key")))))
 167
 168 ;; drop this?
 169 (defcustom LilyPond-file-extensions '(".ly" ".sly" ".fly")
 170   "*File extensions used by manually generated TeX files."
 171   :group 'LilyPond
 172   :type '(repeat (string :format "%v")))
 173
 174
 175 (defcustom LilyPond-expand-alist
 176   '(
 177     ("%s" . ".ly")
 178     ("%t" . ".tex")
 179     ("%d" . ".dvi")
 180     ("%p" . ".ps")
 181     ("%l" . ".latex")
 182     ("%x" . ".tely")
 183     )
 184
 185   "Alist of expansion strings for LilyPond command names."
 186   :group 'LilyPond
 187   :type '(repeat (cons :tag "Alist item"
 188                   (string :tag "Symbol")
 189                   (string :tag "Expansion"))))
 190
 191
 192 (defcustom LilyPond-command-Show "View"
 193   "*The default command to show (view or print) a LilyPond file.
 194 Must be the car of an entry in `LilyPond-command-alist'."
 195   :group 'LilyPond
 196   :type 'string)
 197   (make-variable-buffer-local 'LilyPond-command-Show)
 198
 199 (defcustom LilyPond-command-Print "Print"
 200   "The name of the Print entry in LilyPond-command-Print."
 201   :group 'LilyPond
 202   :type 'string)
 203
 204 (defun xLilyPond-compile-sentinel (process msg)
 205   (if (and process
 206            (= 0 (process-exit-status process)))
 207       (setq LilyPond-command-default
 208               (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 209
 210 ;; FIXME: shouldn't do this for stray View/xdvi
 211 (defun LilyPond-compile-sentinel (buffer msg)
 212   (if (string-match "^finished" msg)
 213       (setq LilyPond-command-default
 214             (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 215
 216 ;;(make-variable-buffer-local 'compilation-finish-function)
 217 (setq compilation-finish-function 'LilyPond-compile-sentinel)
 218
 219 (defun LilyPond-command-query (name)
 220   "Query the user for what LilyPond command to use."
 221   (let* ((default (cond ((if (string-equal name "emacs-lily")
 222                              (LilyPond-check-files (concat name ".tex")
 223                                                    (list name)
 224                                                    LilyPond-file-extensions)
 225                            ;; FIXME
 226                            (LilyPond-save-buffer)
 227                            ;;"LilyPond"
 228                            LilyPond-command-default))
 229                         (t LilyPond-command-default)))
 230
 231          (answer (or LilyPond-command-force
 232                      (completing-read
 233                       (concat "Command: (default " default ") ")
 234                       LilyPond-command-alist nil t nil 'LilyPond-command-history))))
 235
 236     ;; If the answer is "LilyPond" it will not be expanded to "LilyPond"
 237     (let ((answer (car-safe (assoc answer LilyPond-command-alist))))
 238       (if (and answer
 239                (not (string-equal answer "")))
 240           answer
 241         default))))
 242
 243
 244 ;; FIXME: find ``\score'' in buffers / make settable?
 245 (defun LilyPond-master-file ()
 246   ;; duh
 247   (buffer-file-name))
 248
 249 (defun LilyPond-command-master ()
 250   "Run command on the current document."
 251   (interactive)
 252   (LilyPond-command (LilyPond-command-query (LilyPond-master-file))
 253                     'LilyPond-master-file))
 254
 255 ;; FIXME, this is broken
 256 (defun LilyPond-region-file (begin end)
 257   (let (
 258         ;; (dir "/tmp/")
 259         ;; urg
 260         (dir "./")
 261         (base "emacs-lily")
 262         ;; Hmm
 263         (ext (if (string-match "^[\\]score" (buffer-substring begin end))
 264                  ".ly"
 265                (if (< 50 (abs (- begin end)))
 266                    ".fly"
 267                  ".sly"))))
 268     (concat dir base ext)))
 269
 270 (defun LilyPond-command-region (begin end)
 271   "Run LilyPond on the current region."
 272   (interactive "r")
 273   (write-region begin end (LilyPond-region-file begin end) nil 'nomsg)
 274   (LilyPond-command (LilyPond-command-query
 275                      (LilyPond-region-file begin end))
 276                     '(lambda () (LilyPond-region-file begin end))))
 277
 278 (defun LilyPond-command-buffer ()
 279   "Run LilyPond on buffer."
 280   (interactive)
 281   (LilyPond-command-region (point-min) (point-max)))
 282
 283 (defun LilyPond-command-expand (string file)
 284   (let ((case-fold-search nil))
 285     (if (string-match "%" string)
 286         (let* ((b (match-beginning 0))
 287                (e (+ b 2))
 288                (l (split-file-name file))
 289                (dir (car l))
 290                (base (cadr l)))
 291           (LilyPond-command-expand
 292            (concat (substring string 0 b)
 293                    dir
 294                    base
 295                    (let ((entry (assoc (substring string b e)
 296                                        LilyPond-expand-alist)))
 297                      (if entry (cdr entry) ""))
 298                    (substring string e))
 299            file))
 300       string)))
 301
 302 (defun LilyPond-shell-process (name buffer command)
 303   (let ((old (current-buffer)))
 304     (switch-to-buffer-other-window buffer)
 305     ;; If we empty the buffer don't see messages scroll by.
 306     ;; (erase-buffer)
 307
 308     (start-process-shell-command name buffer command)
 309     (switch-to-buffer-other-window old)))
 310
 311
 312 (defun LilyPond-command (name file)
 313   "Run command NAME on the file you get by calling FILE.
 314
 315 FILE is a function return a file name.  It has one optional argument,
 316 the extension to use on the file.
 317
 318 Use the information in LilyPond-command-alist to determine how to run the
 319 command."
 320
 321   (let ((entry (assoc name LilyPond-command-alist)))
 322     (if entry
 323         (let ((command (LilyPond-command-expand (cadr entry)
 324                                                 (apply file nil))))
 325           (if (string-equal name "View")
 326               (let ((buffer-xdvi (get-buffer-create "*view*")))
 327                 (if LilyPond-kick-xdvi
 328                   (let ((process-xdvi (get-buffer-process buffer-xdvi)))
 329                     (if process-xdvi
 330                         (signal-process (process-id process-xdvi) 'SIGUSR1)
 331                       (LilyPond-shell-process name buffer-xdvi command)))
 332                   (LilyPond-shell-process name buffer-xdvi command)))
 333             (progn
 334               (setq LilyPond-command-default name)
 335               (LilyPond-compile-file command name)))))))
 336
 337 ;; XEmacs stuff
 338 ;; Sadly we need this for a macro in Emacs 19.
 339 (eval-when-compile
 340   ;; Imenu isn't used in XEmacs, so just ignore load errors.
 341   (condition-case ()
 342       (require 'imenu)
 343     (error nil)))
 344
 345
 346 ;;; Keymap
 347
 348 (defvar LilyPond-mode-map ()
 349   "Keymap used in `LilyPond-mode' buffers.")
 350
 351 ;; Note:  if you make changes to the map, you must do
 352 ;;    M-x set-variable LilyPond-mode-map nil
 353 ;;    M-x eval-buffer
 354 ;;    M-x LilyPond-mode
 355 ;; to let the changest take effect
 356
 357 (if LilyPond-mode-map
 358     ()
 359   (setq LilyPond-mode-map (make-sparse-keymap))
 360   (define-key LilyPond-mode-map "\C-c\C-r" 'LilyPond-command-region)
 361   (define-key LilyPond-mode-map "\C-c\C-b" 'LilyPond-command-buffer)
 362   (define-key LilyPond-mode-map "\C-c\C-k" 'LilyPond-kill-job)
 363   (define-key LilyPond-mode-map "\C-c\C-c" 'LilyPond-command-master)
 364   )
 365
 366 ;;; Menu Support
 367
 368 (defun LilyPond-command-menu-entry (entry)
 369   ;; Return LilyPond-command-alist ENTRY as a menu item.
 370   (let ((name (car entry)))
 371     (cond ((and (string-equal name LilyPond-command-Print)
 372                 LilyPond-printer-list)
 373            (let ((command LilyPond-print-command)
 374                  (lookup 1))
 375              (append (list LilyPond-command-Print)
 376                      (mapcar 'LilyPond-command-menu-printer-entry
 377                              LilyPond-printer-list))))
 378           (t
 379            (vector name (list 'LilyPond-command-menu name) t)))))
 380
 381
 382 (easy-menu-define LilyPond-mode-menu
 383     LilyPond-mode-map
 384     "Menu used in LilyPond mode."
 385   (append '("Command")
 386           '(("Command on"
 387              [ "Master File" LilyPond-command-select-master
 388                :keys "C-c C-c" :style radio
 389                :selected (eq LilyPond-command-current 'LilyPond-command-master) ]
 390              [ "Buffer" LilyPond-command-select-buffer
 391                :keys "C-c C-b" :style radio
 392                :selected (eq LilyPond-command-current 'LilyPond-command-buffer) ]
 393              [ "Region" LilyPond-command-select-region
 394                :keys "C-c C-r" :style radio
 395                :selected (eq LilyPond-command-current 'LilyPond-command-region) ]))
 396           (let ((file 'LilyPond-command-on-current))
 397             (mapcar 'LilyPond-command-menu-entry LilyPond-command-alist))))
 398
 399
 400 (defconst LilyPond-imenu-generic-re "^\\([a-zA-Z_][a-zA-Z0-9_]*\\) *="
 401   "Regexp matching Identifier definitions.")
 402
 403 (defvar LilyPond-imenu-generic-expression
 404   (list (list nil LilyPond-imenu-generic-re 1))
 405   "Expression for imenu")
 406
 407 (defun LilyPond-command-select-master ()
 408   (interactive)
 409   (message "Next command will be on the master file")
 410   (setq LilyPond-command-current 'LilyPond-command-master))
 411
 412 (defun LilyPond-command-select-buffer ()
 413   (interactive)
 414   (message "Next command will be on the buffer")
 415   (setq LilyPond-command-current 'LilyPond-command-buffer))
 416
 417 (defun LilyPond-command-select-region ()
 418   (interactive)
 419   (message "Next command will be on the region")
 420   (setq LilyPond-command-current 'LilPond-command-region))
 421
 422 (defun LilyPond-command-menu (name)
 423   ;; Execute LilyPond-command-alist NAME from a menu.
 424   (let ((LilyPond-command-force name))
 425     (funcall LilyPond-command-current)))
 426
 427 (defun LilyPond-mode ()
 428   "Major mode for editing LilyPond music files.
 429
 430 This mode knows about LilyPond keywords and line comments, not about
 431 indentation or block comments.  It features easy compilation, error
 432 finding and viewing of a LilyPond source buffer or region.
 433
 434 COMMANDS
 435 \\{LilyPond-mode-map}
 436 VARIABLES
 437
 438 LilyPond-command-alist\t\talist from name to command
 439 LilyPond-xdvi-command\t\tcommand to display dvi files -- bit superfluous"
 440   (interactive)
 441   ;; set up local variables
 442   (kill-all-local-variables)
 443
 444   (make-local-variable 'font-lock-defaults)
 445   (setq font-lock-defaults '(LilyPond-font-lock-keywords))
 446
 447   (make-local-variable 'paragraph-separate)
 448   (setq paragraph-separate "^[ \t]*$")
 449
 450   (make-local-variable 'paragraph-start)
 451   (setq paragraph-start "^[ \t]*$")
 452
 453   (make-local-variable 'comment-start)
 454   (setq comment-start "%")
 455
 456   (make-local-variable 'comment-start-skip)
 457   (setq comment-start-skip "%{? *")
 458
 459   (make-local-variable 'comment-end)
 460   (setq comment-end "")
 461
 462   (make-local-variable 'block-comment-start)
 463   (setq block-comment-start "%{")
 464
 465   (make-local-variable 'block-comment-end)
 466   (setq block-comment-end   "%}")
 467
 468   (make-local-variable 'indent-line-function)
 469   (setq indent-line-function 'indent-relative-maybe)
 470
 471     (set-syntax-table LilyPond-mode-syntax-table)
 472   (setq major-mode 'LilyPond-mode)
 473   (setq mode-name "LilyPond")
 474   (setq local-abbrev-table LilyPond-mode-abbrev-table)
 475   (use-local-map LilyPond-mode-map)
 476
 477   (make-local-variable 'imenu-generic-expression)
 478   (setq imenu-generic-expression LilyPond-imenu-generic-expression)
 479   (imenu-add-to-menubar "Index")
 480
 481     ;; run the mode hook. LilyPond-mode-hook use is deprecated
 482   (run-hooks 'LilyPond-mode-hook))
 483
 484 (defun LilyPond-version ()
 485   "Echo the current version of `LilyPond-mode' in the minibuffer."
 486   (interactive)
 487   (message "Using `LilyPond-mode' version %s" LilyPond-version))
 488
 489 (provide 'lilypond-mode)
 490 ;;; lilypond-mode.el ends here
 491