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