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