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 (defvar LilyPond-xdvi-command "xdvik")
 114
 115 ;; This is the major configuration variable.
 116 (defcustom LilyPond-command-alist
 117   '(
 118     ("LilyPond" . ("lilypond %s" . "TeX"))
 119     ("TeX" . ("tex '\\nonstopmode\\input %t'" . "View"))
 120
 121     ;; point-n-click (arg: exits upop USR1)
 122     ("SmartView" . ("xdvi %d" . "LilyPond"))
 123
 124     ;; refreshes when kicked USR1
 125     ("View" . ((concat LilyPond-xdvi-command " %d") . "LilyPond"))
 126     )
 127
 128   "AList of commands to execute on the current document.
 129
 130 The key is the name of the command as it will be presented to the
 131 user, the value is a cons of the command string handed to the shell
 132 after being expanded, and the next command to be executed upon
 133 success.  The expansion is done using the information found in
 134 LilyPond-expand-list.
 135 "
 136   :group 'LilyPond
 137   :type '(repeat (group (string :tag "Name")
 138                         (string :tag "Command")
 139                         (choice :tag "How"
 140                                 :value LilyPond-run-command
 141                                 (function-item LilyPond-run-command)
 142                                 (function-item LilyPond-run-LilyPond)
 143                                 (function :tag "Other"))
 144                         (boolean :tag "Prompt")
 145                         (sexp :format "End\n"))))
 146
 147 ;; drop this?
 148 (defcustom LilyPond-file-extensions '(".ly" ".sly" ".fly")
 149   "*File extensions used by manually generated TeX files."
 150   :group 'LilyPond
 151   :type '(repeat (string :format "%v")))
 152
 153
 154 (defcustom LilyPond-expand-alist
 155   '(
 156     ("%s" . ".ly")
 157     ("%t" . ".tex")
 158     ("%d" . ".dvi")
 159     ("%p" . ".ps")
 160     )
 161
 162   "Alist of expansion strings for LilyPond command names."
 163   :group 'LilyPond
 164   :type '(repeat (group (string :tag "Key")
 165                         (sexp :tag "Expander")
 166                         (repeat :inline t
 167                                 :tag "Arguments"
 168                                 (sexp :format "%v")))))
 169
 170
 171 (defcustom LilyPond-command-Show "View"
 172   "*The default command to show (view or print) a LilyPond file.
 173 Must be the car of an entry in LilyPond-command-alist."
 174   :group 'LilyPond
 175   :type 'string)
 176   (make-variable-buffer-local 'LilyPond-command-Show)
 177
 178 (defcustom LilyPond-command-Print "Print"
 179   "The name of the Print entry in LilyPond-command-Print."
 180   :group 'LilyPond
 181   :type 'string)
 182
 183 (defun xLilyPond-compile-sentinel (process msg)
 184   (if (and process
 185            (= 0 (process-exit-status process)))
 186       (setq LilyPond-command-default
 187               (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 188
 189 ;; FIXME: shouldn't do this for stray View/xdvi
 190 (defun LilyPond-compile-sentinel (buffer msg)
 191   (if (string-match "^finished" msg)
 192       (setq LilyPond-command-default
 193             (cddr (assoc LilyPond-command-default LilyPond-command-alist)))))
 194
 195 ;;(make-variable-buffer-local 'compilation-finish-function)
 196 (setq compilation-finish-function 'LilyPond-compile-sentinel)
 197
 198 (defun LilyPond-command-query (name)
 199   "Query the user for what LilyPond command to use."
 200   (let* ((default (cond ((if (string-equal name "emacs-lily")
 201                              (LilyPond-check-files (concat name ".tex")
 202                                                    (list name)
 203                                                    LilyPond-file-extensions)
 204                            ;; FIXME
 205                            (LilyPond-save-buffer)
 206                            ;;"LilyPond"
 207                            LilyPond-command-default))
 208                         (t LilyPond-command-default)))
 209
 210          (answer (or LilyPond-command-force
 211                      (completing-read
 212                       (concat "Command: (default " default ") ")
 213                       LilyPond-command-alist nil t))))
 214
 215     ;; If the answer is "LilyPond" it will not be expanded to "LilyPond"
 216     (let ((answer (car-safe (assoc answer LilyPond-command-alist))))
 217       (if (and answer
 218                (not (string-equal answer "")))
 219           answer
 220         default))))
 221
 222
 223 ;; FIXME: find ``\score'' in buffers / make settable?
 224 (defun LilyPond-master-file ()
 225   ;; duh
 226   (buffer-file-name))
 227
 228 (defun LilyPond-command-master ()
 229   "Run command on the current document."
 230   (interactive)
 231   (LilyPond-command (LilyPond-command-query (LilyPond-master-file))
 232                     'LilyPond-master-file))
 233
 234 (defun LilyPond-region-file (begin end)
 235   (let (
 236         ;; (dir "/tmp/")
 237         ;; urg
 238         (dir "./")
 239         (base "emacs-lily")
 240         ;; Hmm
 241         (ext (if (string-match "^[\\]score" (buffer-substring begin end))
 242                  ".ly"
 243                (if (< 50 (abs (- begin end)))
 244                    ".fly"
 245                  ".sly"))))
 246     (concat dir base ext)))
 247
 248 (defun LilyPond-command-region (begin end)
 249   "Run LilyPond on the current region."
 250   (interactive "r")
 251   (write-region begin end (LilyPond-region-file begin end) nil 'nomsg)
 252   (LilyPond-command (LilyPond-command-query
 253                      (LilyPond-region-file begin end))
 254                     '(lambda () (LilyPond-region-file begin end))))
 255
 256 (defun LilyPond-command-buffer ()
 257   "Run LilyPond on buffer."
 258   (interactive)
 259   (LilyPond-command-region (point-min) (point-max)))
 260
 261 (defun LilyPond-command-expand (string file)
 262   (let ((case-fold-search nil))
 263     (if (string-match "%" string)
 264         (let* ((b (match-beginning 0))
 265                (e (+ b 2))
 266                (l (split-file-name file))
 267                (dir (car l))
 268                (base (cadr l)))
 269           (LilyPond-command-expand
 270            (concat (substring string 0 b)
 271                    dir
 272                    base
 273                    (let ((entry (assoc (substring string b e)
 274                                        LilyPond-expand-alist)))
 275                      (if entry (cdr entry) ""))
 276                    (substring string e))
 277            file))
 278       string)))
 279
 280 (defun LilyPond-command (name file)
 281   "Run command NAME on the file you get by calling FILE.
 282
 283 FILE is a function return a file name.  It has one optional argument,
 284 the extension to use on the file.
 285
 286 Use the information in LilyPond-command-alist to determine how to run the
 287 command."
 288
 289   (let ((entry (assoc name LilyPond-command-alist)))
 290     (if entry
 291         (let ((command (LilyPond-command-expand (cadr entry)
 292                                                 (apply file nil))))
 293           (let* (
 294                  (buffer-xdvi (get-buffer "*view*"))
 295                  (process-xdvi (if buffer-xdvi (get-buffer-process buffer-xdvi) nil)))
 296             (if (and process-xdvi
 297                      (string-equal name "View"))
 298                 ;; Don't open new xdvi window, but force redisplay
 299                 ;; We could make this an option.
 300                 (signal-process (process-id process-xdvi) 'SIGUSR1)
 301               (progn
 302                 (setq LilyPond-command-default name)
 303                 (LilyPond-compile-file command name))))))))
 304
 305 ;; XEmacs stuff
 306 ;; Sadly we need this for a macro in Emacs 19.
 307 (eval-when-compile
 308   ;; Imenu isn't used in XEmacs, so just ignore load errors.
 309   (condition-case ()
 310       (require 'imenu)
 311     (error nil)))
 312
 313
 314 ;;; Keymap
 315
 316 (defvar LilyPond-mode-map ()
 317   "Keymap used in `LilyPond-mode' buffers.")
 318
 319 ;; Note:  if you make changes to the map, you must do
 320 ;;    M-x set-variable LilyPond-mode-map nil
 321 ;;    M-x eval-buffer
 322 ;;    M-x LilyPond-mode
 323 ;; to let the changest take effect
 324
 325 (if LilyPond-mode-map
 326     ()
 327   (setq LilyPond-mode-map (make-sparse-keymap))
 328   (define-key LilyPond-mode-map "\C-c\C-c" 'LilyPond-command-master)
 329   (define-key LilyPond-mode-map "\C-c\C-r" 'LilyPond-command-region)
 330   (define-key LilyPond-mode-map "\C-c\C-b" 'LilyPond-command-buffer)
 331   (define-key LilyPond-mode-map "\C-c\C-k" 'LilyPond-kill-job)
 332   )
 333
 334 ;;; Menu Support
 335
 336 (defun LilyPond-command-menu-entry (entry)
 337   ;; Return LilyPond-command-alist ENTRY as a menu item.
 338   (let ((name (car entry)))
 339     (cond ((and (string-equal name LilyPond-command-Print)
 340                 LilyPond-printer-list)
 341            (let ((command LilyPond-print-command)
 342                  (lookup 1))
 343              (append (list LilyPond-command-Print)
 344                      (mapcar 'LilyPond-command-menu-printer-entry
 345                              LilyPond-printer-list))))
 346           (t
 347            (vector name (list 'LilyPond-command-menu name) t)))))
 348
 349
 350 (easy-menu-define LilyPond-mode-menu
 351     LilyPond-mode-map
 352     "Menu used in LilyPond mode."
 353   (append '("Command")
 354           '(("Command on"
 355              [ "Master File" LilyPond-command-select-master
 356                :keys "C-c C-c" :style radio
 357                :selected (eq LilyPond-command-current 'LilyPond-command-master) ]
 358              [ "Buffer" LilyPond-command-select-buffer
 359                :keys "C-c C-b" :style radio
 360                :selected (eq LilyPond-command-current 'LilyPond-command-buffer) ]
 361              [ "Region" LilyPond-command-select-region
 362                :keys "C-c C-r" :style radio
 363                :selected (eq LilyPond-command-current 'LilyPond-command-region) ]))
 364           (let ((file 'LilyPond-command-on-current))
 365             (mapcar 'LilyPond-command-menu-entry LilyPond-command-alist))))
 366
 367
 368 (defconst LilyPond-imenu-generic-re "^\\([a-zA-Z_][a-zA-Z0-9_]*\\) *="
 369   "Regexp matching Identifier definitions.")
 370
 371 (defvar LilyPond-imenu-generic-expression
 372   (list (list nil LilyPond-imenu-generic-re 1))
 373   "Expression for imenu")
 374
 375 (defun LilyPond-command-select-master ()
 376   (interactive)
 377   (message "Next command will be on the master file")
 378   (setq LilyPond-command-current 'LilyPond-command-master))
 379
 380 (defun LilyPond-command-select-buffer ()
 381   (interactive)
 382   (message "Next command will be on the buffer")
 383   (setq LilyPond-command-current 'LilyPond-command-buffer))
 384
 385 (defun LilyPond-command-select-region ()
 386   (interactive)
 387   (message "Next command will be on the region")
 388   (setq LilyPond-command-current 'LilPond-command-region))
 389
 390 (defun LilyPond-command-menu (name)
 391   ;; Execute LilyPond-command-alist NAME from a menu.
 392   (let ((LilyPond-command-force name))
 393     (funcall LilyPond-command-current)))
 394
 395 (defun LilyPond-mode ()
 396   "Major mode for editing LilyPond music files."
 397   (interactive)
 398   ;; set up local variables
 399   (kill-all-local-variables)
 400
 401   (make-local-variable 'font-lock-defaults)
 402   (setq font-lock-defaults '(LilyPond-font-lock-keywords))
 403
 404   (make-local-variable 'paragraph-separate)
 405   (setq paragraph-separate "^[ \t]*$")
 406
 407   (make-local-variable 'paragraph-start)
 408   (setq paragraph-start "^[ \t]*$")
 409
 410   (make-local-variable 'comment-start)
 411   (setq comment-start "%")
 412
 413   (make-local-variable 'comment-start-skip)
 414   (setq comment-start-skip "%{? *")
 415
 416   (make-local-variable 'comment-end)
 417   (setq comment-end "\n")
 418
 419   (make-local-variable 'block-comment-start)
 420   (setq block-comment-start "%{")
 421
 422   (make-local-variable 'block-comment-end)
 423   (setq block-comment-end   "%}")
 424
 425   (make-local-variable 'indent-line-function)
 426   (setq indent-line-function 'indent-relative-maybe)
 427
 428     (set-syntax-table LilyPond-mode-syntax-table)
 429   (setq major-mode 'LilyPond-mode)
 430   (setq mode-name "LilyPond")
 431   (setq local-abbrev-table LilyPond-mode-abbrev-table)
 432   (use-local-map LilyPond-mode-map)
 433
 434   (make-local-variable 'imenu-generic-expression)
 435   (setq imenu-generic-expression LilyPond-imenu-generic-expression)
 436   (imenu-add-to-menubar "Index")
 437
 438     ;; run the mode hook. LilyPond-mode-hook use is deprecated
 439   (run-hooks 'LilyPond-mode-hook))
 440
 441 (defun LilyPond-version ()
 442   "Echo the current version of `LilyPond-mode' in the minibuffer."
 443   (interactive)
 444   (message "Using `LilyPond-mode' version %s" LilyPond-version))
 445
 446 (provide 'lilypond-mode)
 447 ;;; lilypond-mode.el ends here
 448