1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
3 ;;; Heikki Junes <hjunes@cc.hut.fi>
4 ;;; * redefine Emacs' show-paren-function and XEmacs' paren-highlight
5 ;;; * match two-char slurs '\( ... \)' and '\[ ... \]' separately.
7 ;;; Chris Jackson <chris@fluffhouse.org.uk>
8 ;;; some code is taken from ESS (Emacs Speaks Statistics) S-mode by A.J.Rossini <rossini@biostat.washington.edu>
10 ;;; Variables for customising indentation style
13 ;;; * currently, in bracket matching one may need a non-bracket
14 ;;; chararacter between the bracket characters, like ( ( ) )
15 ;;; * in syntax-highlighting slurs are not always highlighted the right way
16 ;;; e.g. opening slurs are found found better in "#( ( ) ( ) )" than
19 (defcustom LilyPond-indent-level 4
20 "*Indentation of lilypond statements with respect to containing block.")
22 (defcustom LilyPond-brace-offset 0
23 "*Extra indentation for open braces.
24 Compares with other text in same context.")
26 (defcustom LilyPond-angle-offset 0
27 "*Extra indentation for open angled brackets.
28 Compares with other text in same context.")
30 (defcustom LilyPond-square-offset 0
31 "*Extra indentation for open square brackets.
32 Compares with other text in same context.")
34 (defcustom LilyPond-scheme-paren-offset 0
35 "*Extra indentation for open scheme parens.
36 Compares with other text in same context.")
38 (defcustom LilyPond-close-brace-offset 0
39 "*Extra indentation for closing braces.")
41 (defcustom LilyPond-close-angle-offset 0
42 "*Extra indentation for closing angle brackets.")
44 (defcustom LilyPond-close-square-offset 0
45 "*Extra indentation for closing square brackets.")
47 (defcustom LilyPond-close-scheme-paren-offset 0
48 "*Extra indentation for closing scheme parens.")
50 (defcustom LilyPond-fancy-comments t
51 "*Non-nil means distiguish between %, %%, and %%% for indentation.")
54 (defun LilyPond-calculate-indent ()
55 "Return appropriate indentation for current line as lilypond code.
56 In usual case returns an integer: the column to indent to.
57 Returns nil if line starts inside a string"
60 (let ((indent-point (point))
61 (case-fold-search nil)
63 (setq containing-sexp (save-excursion (LilyPond-scan-containing-sexp)))
65 (while (< (point) indent-point)
66 (setq state (parse-partial-sexp (point) indent-point 0)))
67 ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
68 ;; with simpler parenthesis delimiters
70 ;; point is in the middle of a string
73 ;; point is in the middle of a block comment
74 (LilyPond-calculate-indent-within-blockcomment))
75 ((null containing-sexp)
76 ;; Line is at top level - no indent
80 ;; Find previous non-comment character.
81 (goto-char indent-point)
82 (LilyPond-backward-to-noncomment containing-sexp)
83 ;; Now we get the answer.
84 ;; Position following last unclosed open.
85 (goto-char containing-sexp)
87 ;; Is line first statement after an open brace or bracket?
88 ;; If no, find that first statement and indent like it.
91 ;; Skip over comments following open brace.
92 (skip-chars-forward " \t\n")
93 (cond ((looking-at "%{")
95 (and (not (looking-at "%}"))
96 (< (point) (point-max))))
98 (skip-chars-forward " \t\n"))
100 (skip-chars-forward " \t\n"))
102 (while (progn (skip-chars-forward " \t\n")
105 ;; The first following code counts
106 ;; if it is before the line we want to indent.
107 (and (< (point) indent-point)
109 ;; If no previous statement,
110 ;; indent it relative to line brace is on.
111 ;; For open brace in column zero, don't let statement
112 ;; start there too. If LilyPond-indent-level is zero, use
113 ;; LilyPond-brace-offset instead
114 (+ (if (and (bolp) (zerop LilyPond-indent-level))
115 (cond ((= (following-char) ?{)
116 LilyPond-brace-offset)
117 ((= (following-char) ?<)
118 LilyPond-angle-offset)
119 ((= (following-char) ?[)
120 LilyPond-square-offset)
121 ((= (following-char) ?\))
122 LilyPond-scheme-paren-offset)
125 LilyPond-indent-level)
127 (skip-chars-backward " \t")
128 (current-indentation)))))))))
132 (defun LilyPond-indent-line ()
133 "Indent current line as lilypond code.
134 Return the amount the indentation changed by."
135 (let ((indent (LilyPond-calculate-indent))
137 (case-fold-search nil)
138 (pos (- (point-max) (point))))
141 (cond ((eq indent nil)
142 (setq indent (current-indentation)))
144 (skip-chars-forward " \t")
145 (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
147 (if (and LilyPond-fancy-comments
149 (not (looking-at "%%\\|%{\\|%}")))
150 (setq indent comment-column)
151 (if (eq indent t) (setq indent 0))
152 (if (listp indent) (setq indent (car indent)))
154 ((= (following-char) ?})
155 (setq indent (+ indent (- LilyPond-close-brace-offset LilyPond-indent-level))))
156 ((= (following-char) ?>)
157 (setq indent (+ indent (- LilyPond-close-angle-offset LilyPond-indent-level))))
158 ((= (following-char) ?])
159 (setq indent (+ indent (- LilyPond-close-square-offset LilyPond-indent-level))))
160 ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p))
161 (setq indent (+ indent (- LilyPond-close-scheme-paren-offset LilyPond-indent-level))))
162 ((= (following-char) ?{)
163 (setq indent (+ indent LilyPond-brace-offset)))
164 ((= (following-char) ?<)
165 (setq indent (+ indent LilyPond-angle-offset)))
166 ((= (following-char) ?[)
167 (setq indent (+ indent LilyPond-square-offset)))
168 ((and (= (following-char) ?\() (LilyPond-inside-scheme-p))
169 (setq indent (+ indent LilyPond-scheme-paren-offset)))
171 (skip-chars-forward " \t")
172 (setq shift-amt (- indent (current-column)))
173 (if (zerop shift-amt)
174 (if (> (- (point-max) pos) (point))
175 (goto-char (- (point-max) pos)))
176 (delete-region beg (point))
178 ;; If initial point was within line's indentation,
179 ;; position after the indentation.
180 ;; Else stay at same point in text.
181 (if (> (- (point-max) pos) (point))
182 (goto-char (- (point-max) pos))))
186 (defun LilyPond-inside-comment-p ()
187 "Return non-nil if point is inside a line or block comment"
188 (setq this-point (point))
189 (or (save-excursion (beginning-of-line)
190 (skip-chars-forward " \t")
193 ;; point is in the middle of a block comment
194 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" (point-min) t)))
195 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" (point-min) t)))
196 (if (or (and (= (char-before) ?%) (= (char-after) ?{))
197 (and (= (char-after) ?%) (= (char-after (1+ (point))) ?{)))
198 (setq lastopen (save-excursion (backward-char) (point))))
202 (<= lastclose lastopen))))
206 (defun LilyPond-inside-string-or-comment-p ()
207 "Test if point is inside a string or a comment"
208 (setq this-point (point))
209 (or (save-excursion (beginning-of-line)
210 (skip-chars-forward " \t")
214 (while (< (point) this-point)
215 (setq state (parse-partial-sexp (point) this-point 0)))
217 ;; point is in the middle of a string
220 ;; point is in the middle of a block comment
226 (defun LilyPond-backward-over-blockcomments (lim)
227 "Move point back to closest non-whitespace character not part of a block comment"
228 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
229 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
232 (if (<= lastclose lastopen)
233 (goto-char lastopen))
234 (goto-char lastopen)))
235 (skip-chars-backward " %\t\n\f"))
238 (defun LilyPond-backward-over-linecomments (lim)
239 "Move point back to the closest non-whitespace character not part of a line comment.
243 (skip-chars-backward " \t\n\f" lim)
244 (setq opoint (point))
246 (search-forward "%" opoint 'move)
247 (skip-chars-backward " \t%")
248 (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
250 (beginning-of-line)))))
253 (defun LilyPond-backward-to-noncomment (lim)
254 "Move point back to closest non-whitespace character not part of a comment"
255 (LilyPond-backward-over-linecomments lim)
256 (LilyPond-backward-over-blockcomments lim))
259 (defun LilyPond-calculate-indent-within-blockcomment ()
260 "Return the indentation amount for line inside a block comment."
261 (let (end percent-start)
264 (skip-chars-forward " \t")
265 (skip-chars-backward " \t\n")
268 (skip-chars-forward " \t")
269 (and (re-search-forward "%{[ \t]*" end t)
270 (goto-char (1+ (match-beginning 0))))
271 (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
272 (1+ (current-column))
276 ;; Key: Type of bracket (character).
277 ;; Value: Pair of regexps representing the corresponding open and close bracket
278 ;; () are treated specially (need to indent in Scheme but not in music)
280 (defconst LilyPond-parens-regexp-alist
281 `( ( ?> . ("\\([^\\]\\|^\\)<" . "\\([^ \\n\\t_^-]\\|[_^-][-^]\\|\\s-\\)\\s-*>"))
282 ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
283 ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
284 ;; also \> and \< are hairpins
285 ;; duh .. a single '>', as in chords '<< ... >>', was not matched here
287 ;; ligatures '\[ ... \]' are skipped in the following expression
288 ( ?] . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]"))
289 ( "\\]" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]"))
290 ( "\\)" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]"))
294 (defconst LilyPond-parens-alist
304 (defun LilyPond-matching-paren (bracket-type)
305 "Returns the open corresponding to the close specified by bracket-type, or vice versa"
306 (cond ( (member bracket-type (mapcar 'car LilyPond-parens-alist))
307 (cdr (assoc bracket-type LilyPond-parens-alist)) )
308 ( (member bracket-type (mapcar 'cdr LilyPond-parens-alist))
309 (car (rassoc bracket-type LilyPond-parens-alist)) )
313 (defun LilyPond-scan-containing-sexp (&optional bracket-type slur-paren-p dir)
314 "Move point to the beginning of the deepest parenthesis pair enclosing point.
316 If the optional argument bracket-type, a character representing a
317 close bracket such as ) or }, is specified, then the parenthesis pairs
318 searched are limited to this type.
320 If the optional argument slur-paren-p is non-nil, then slur
321 parentheses () are considered as matching pairs. Otherwise Scheme
322 parentheses are considered to be matching pairs, but slurs are not.
323 slur-paren-p defaults to nil.
325 ;;; An user does not call this function directly, or by a key sequence.
327 (let ( (level (if (not (eq dir 1)) 1 -1))
328 (regexp-alist LilyPond-parens-regexp-alist)
330 (assoc-bracket-type (if (not (eq dir 1)) bracket-type (LilyPond-matching-paren bracket-type))))
332 (if (LilyPond-inside-scheme-p)
333 (setq paren-regexp "(\\|)")
335 ;; expressional slurs '\( ... \)' are not taken into account
336 (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" . "\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist)))
337 (if (member assoc-bracket-type (mapcar 'car regexp-alist))
338 (progn (setq paren-regexp (cdr (assoc assoc-bracket-type regexp-alist)))
339 (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
340 (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
341 (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
342 ;; match concurrent one-char opening and closing slurs
344 (not (sequencep bracket-type))
345 (eq (char-syntax (char-after oldpos)) ?\())
346 ;; anyway do not count open slur, since already level = -1
347 (progn (forward-char 1)
348 (if (eq (following-char)
349 (LilyPond-matching-paren (char-after oldpos)))
350 ;; matching char found, go after it and set level = 0
351 (progn (forward-char 1)
353 ;; browse the code until matching slur is found, or report mismatch
354 (while (and (if (not (eq dir 1))
357 ;; dir tells whether to search backward or forward
359 (re-search-backward paren-regexp nil t)
360 (re-search-forward paren-regexp nil t))
361 ;; note: in case of two-char bracket only latter is compared
362 (setq match (char-before (match-end 0))))
363 ;;; (message "%d" level) (sit-for 0 300)
364 (if (not (save-excursion (goto-char (match-end 0))
365 ;; skip over strings and comments
366 (LilyPond-inside-string-or-comment-p)))
367 (if (memq match '(?} ?> ?] ?\)))
368 ;; count closing brackets
369 (progn (setq level (1+ level))
370 ;; slurs may be close to each other, e.g.,
371 ;; a single '>' was not matched .. need to be corrected
372 (if (and (eq dir 1) (eq (char-after (match-end 0)) match))
375 (setq level (1+ level))
377 ;;; (message "%d %c" level match) (sit-for 0 300)
379 (if (and (= match ?>)
380 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
382 ;; count opening brackets
383 (progn (setq level (1- level))
384 ;;; (message "%d %c" level match) (sit-for 0 300)
386 (if (and (= match ?<)
387 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
388 (forward-char 1))))))
389 ;; jump to the matching slur
392 (if (sequencep bracket-type)
393 ;; match the latter char in two-char brackets
394 (if (looking-at "..[][)(]") (forward-char 1)))
395 ;; if the following char is not already a slur
396 (if (and (not (looking-at "[)(]"))
397 ;; match the slur which follows
398 (looking-at ".[][><)(]")) (forward-char 1)))
402 (progn (goto-char oldpos)
406 (defun LilyPond-inside-scheme-p ()
407 "Tests if point is inside embedded Scheme code"
408 ;;; An user does not call this function directly, or by a key sequence.
410 (let ( (test-point (point))
413 (if (or (and (/= (point) (point-max))
414 (= (char-after (point)) ?\()
415 (or (= (char-after (- (point) 1)) ?#)
416 (and (= (char-after (- (point) 2)) ?#)
417 (= (char-after (- (point) 1)) ?`))))
418 (and (re-search-backward "#(\\|#`(" nil t)
422 (while (and (> level 0)
423 (re-search-forward "(\\|)" test-point t)
424 (setq match (char-after (match-beginning 0)))
425 (<= (point) test-point))
427 (setq level (1+ level))
428 (setq level (1- level))))
434 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
435 ;;; the Emacs distribution.
437 (defun LilyPond-blink-matching-paren (&optional dir)
438 "Move cursor momentarily to the beginning of the sexp before
439 point. In lilypond files this is used for closing ), ], } and >, whereas the
440 builtin 'blink-matching-open' is not used. In syntax table, see
441 `lilypond-font-lock.el', all brackets are punctuation characters."
442 ;;; An user does not call this function directly, or by a key sequence.
444 (let ( (oldpos (point))
447 (if (not (or (equal this-command 'LilyPond-electric-close-paren)
449 (goto-char (setq oldpos (- oldpos 1))))
450 ;; Test if a ligature \] or expressional slur \) was encountered
451 (setq bracket-type (char-after (point)))
452 (setq char-before-bracket-type nil)
453 (if (memq bracket-type '(?] ?\) ?[ ?\())
456 (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\)
457 (setq char-before-bracket-type (if char-before-bracket-type nil ?\\)))
458 (if (eq char-before-bracket-type ?\\)
459 (setq bracket-type (string char-before-bracket-type bracket-type)))))
460 (when blink-matching-paren-distance
462 (max (point-min) (- (point) blink-matching-paren-distance))
463 (min (point-max) (+ (point) blink-matching-paren-distance))))
464 (if (and (equal this-command 'LilyPond-electric-close-paren)
465 (memq bracket-type '(?> ?} ?< ?{)))
466 ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
467 (LilyPond-scan-containing-sexp nil nil dir)
468 ;; whereas ( ) slurs within music don't, so only need to search for ( )
469 ;; use same mechanism for [ ] slurs
470 (LilyPond-scan-containing-sexp bracket-type t dir))
471 (setq blinkpos (point))
473 (or (null (LilyPond-matching-paren (char-after blinkpos)))
474 (/= (char-after oldpos)
475 (LilyPond-matching-paren (char-after blinkpos)))))
476 (if mismatch (progn (setq blinkpos nil)
477 (message "Mismatched parentheses")))
479 (equal this-command 'LilyPond-electric-close-paren))
480 (if (pos-visible-in-window-p)
481 (and blink-matching-paren-on-screen
482 (sit-for blink-matching-delay))
485 ;; Show what precedes the open in its line, if anything.
487 (skip-chars-backward " \t")
489 (buffer-substring (progn (beginning-of-line) (point))
491 ;; Show what follows the open in its line, if anything.
494 (skip-chars-forward " \t")
496 (buffer-substring blinkpos
497 (progn (end-of-line) (point)))
498 ;; Otherwise show the previous nonblank line,
501 (skip-chars-backward "\n \t")
504 (buffer-substring (progn
505 (skip-chars-backward "\n \t")
509 (skip-chars-backward " \t")
511 ;; Replace the newline and other whitespace with `...'.
513 (buffer-substring blinkpos (1+ blinkpos)))
514 ;; There is nothing to show except the char itself.
515 (buffer-substring blinkpos (1+ blinkpos))))))))
516 (if (not (equal this-command 'LilyPond-electric-close-paren))
517 (goto-char (setq oldpos (+ oldpos 1)))
524 (defun LilyPond-electric-close-paren ()
525 "Blink on the matching open paren when a >, ), } or ] is inserted"
527 (let ((oldpos (point)))
528 (self-insert-command 1)
529 ;; Refontify buffer if a block-comment-ender '%}' is inserted
530 (if (and (eq (char-before (point)) ?})
531 (eq (char-before (- (point) 1)) ?%))
532 (font-lock-fontify-buffer)
533 ;; Match paren if the cursor is not inside string or comment.
534 (if (and blink-matching-paren
535 (not (LilyPond-inside-string-or-comment-p))
536 (save-excursion (re-search-backward
537 (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
538 (eq oldpos (1- (match-end 0)))))
539 (progn (backward-char 1)
540 (LilyPond-blink-matching-paren)
541 (forward-char 1))))))
544 (defun aargh-this-breaks-other-emacs-modes-scan-sexps (pos dir)
545 "This function is redefined to be used in Emacs' show-paren-function and
546 in XEmacs' paren-highlight."
547 (LilyPond-blink-matching-paren dir))
549 ;; Emacs and XEmacs have slightly different names for parenthesis highlighting.
550 (if (not (string-match "XEmacs\\|Lucid" emacs-version))
552 (fset 'old-show-paren-function (symbol-function 'show-paren-function))
553 (defun show-paren-function ()
554 "Highlights the matching slur if cursor is moved before opening or
555 after closing slur. In this redefinition strings and comments are skipped."
556 (if (not (LilyPond-inside-string-or-comment-p))
557 (old-show-paren-function))))
559 ;; NOTE: paren-set-mode must be set before paren-highlight is redefined
560 (paren-set-mode 'paren)
561 (fset 'old-paren-highlight (symbol-function 'paren-highlight))
562 (defun paren-highlight ()
563 "Highlights the matching slur if cursor is moved before opening or
564 after closing slur. In this redefinition strings and comments are skipped."
565 (if (not (LilyPond-inside-string-or-comment-p))
566 (old-paren-highlight)))))