1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
3 ;;; Heikki Junes <hjunes@cc.hut.fi>
4 ;;; * introduce Lilypond-show-paren-function for Emacs and
5 ;;; Lilypond-paren-highlight for XEmacs
6 ;;; * match two-char slurs '\( ... \)' and '\[ ... \]' separately.
7 ;;; * adopt Emacs' f90-comment-region
9 ;;; Chris Jackson <chris@fluffhouse.org.uk>
10 ;;; some code is taken from ESS (Emacs Speaks Statistics) S-mode by A.J.Rossini <rossini@biostat.washington.edu>
12 ;;; Variables for customising indentation style
15 ;;; * currently, in bracket matching one may need a non-bracket
16 ;;; chararacter between the bracket characters, like ( ( ) )
17 ;;; * in syntax-highlighting slurs are not always highlighted the right way
18 ;;; e.g. opening slurs are found found better in "#( ( ) ( ) )" than
20 ;;; * Mouse double-clicks should use LilyPond-scan-sexps for slur matching.
22 (defcustom LilyPond-indent-level
4
23 "*Indentation of lilypond statements with respect to containing block.")
25 (defcustom LilyPond-brace-offset
0
26 "*Extra indentation for open braces.
27 Compares with other text in same context.")
29 (defcustom LilyPond-angle-offset
0
30 "*Extra indentation for open angled brackets.
31 Compares with other text in same context.")
33 (defcustom LilyPond-square-offset
0
34 "*Extra indentation for open square brackets.
35 Compares with other text in same context.")
37 (defcustom LilyPond-scheme-paren-offset
0
38 "*Extra indentation for open scheme parens.
39 Compares with other text in same context.")
41 (defcustom LilyPond-close-brace-offset
0
42 "*Extra indentation for closing braces.")
44 (defcustom LilyPond-close-angle-offset
0
45 "*Extra indentation for closing angle brackets.")
47 (defcustom LilyPond-close-square-offset
0
48 "*Extra indentation for closing square brackets.")
50 (defcustom LilyPond-close-scheme-paren-offset
0
51 "*Extra indentation for closing scheme parens.")
53 (defcustom LilyPond-fancy-comments t
54 "*Non-nil means distiguish between %, %%, and %%% for indentation.")
56 (defcustom LilyPond-comment-region
"%%$"
57 "*String inserted by \\[LilyPond-comment-region]\
58 at start of each line in region.")
60 (defun LilyPond-comment-region (beg-region end-region
)
61 "Comment/uncomment every line in the region.
62 Insert LilyPond-comment-region at the beginning of every line in the region
63 or, if already present, remove it."
65 (let ((end (make-marker)))
66 (set-marker end end-region
)
67 (goto-char beg-region
)
69 (if (looking-at (regexp-quote LilyPond-comment-region
))
70 (delete-region (point) (match-end 0))
71 (insert LilyPond-comment-region
))
72 (while (and (zerop (forward-line 1))
73 (< (point) (marker-position end
)))
74 (if (looking-at (regexp-quote LilyPond-comment-region
))
75 (delete-region (point) (match-end 0))
76 (insert LilyPond-comment-region
)))
77 (set-marker end nil
)))
79 (defun LilyPond-calculate-indent ()
80 "Return appropriate indentation for current line as lilypond code.
81 In usual case returns an integer: the column to indent to.
82 Returns nil if line starts inside a string"
85 (let ((indent-point (point))
86 (case-fold-search nil
)
88 (setq containing-sexp
(save-excursion (LilyPond-scan-containing-sexp)))
90 (while (< (point) indent-point
)
91 (setq state
(parse-partial-sexp (point) indent-point
0)))
92 ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
93 ;; with simpler parenthesis delimiters
95 ;; point is in the middle of a string
98 ;; point is in the middle of a block comment
99 (LilyPond-calculate-indent-within-blockcomment))
100 ((null containing-sexp
)
101 ;; Line is at top level - no indent
105 ;; Find previous non-comment character.
106 (goto-char indent-point
)
107 (LilyPond-backward-to-noncomment containing-sexp
)
108 ;; Now we get the answer.
109 ;; Position following last unclosed open.
110 (goto-char containing-sexp
)
112 ;; Is line first statement after an open brace or bracket?
113 ;; If no, find that first statement and indent like it.
116 ;; Skip over comments following open brace.
117 (skip-chars-forward " \t\n")
118 (cond ((looking-at "%{")
120 (and (not (looking-at "%}"))
121 (< (point) (point-max))))
123 (skip-chars-forward " \t\n"))
125 (skip-chars-forward " \t\n"))
127 (while (progn (skip-chars-forward " \t\n")
130 ;; The first following code counts
131 ;; if it is before the line we want to indent.
132 (and (< (point) indent-point
)
134 ;; If no previous statement,
135 ;; indent it relative to line brace is on.
136 ;; For open brace in column zero, don't let statement
137 ;; start there too. If LilyPond-indent-level is zero, use
138 ;; LilyPond-brace-offset instead
139 (+ (if (and (bolp) (zerop LilyPond-indent-level
))
140 (cond ((= (following-char) ?
{)
141 LilyPond-brace-offset
)
142 ((= (following-char) ?
<)
143 LilyPond-angle-offset
)
144 ((= (following-char) ?
[)
145 LilyPond-square-offset
)
146 ((= (following-char) ?\
))
147 LilyPond-scheme-paren-offset
)
150 LilyPond-indent-level
)
152 (skip-chars-backward " \t")
153 (current-indentation)))))))))
156 (defun LilyPond-indent-line ()
157 "Indent current line as lilypond code.
158 Return the amount the indentation changed by."
159 (let ((indent (LilyPond-calculate-indent))
161 (case-fold-search nil
)
162 (pos (- (point-max) (point))))
165 (cond ((eq indent nil
)
166 (setq indent
(current-indentation)))
168 (skip-chars-forward " \t")
169 (if (and LilyPond-fancy-comments
(looking-at "%%%\\|%{\\|%}"))
171 (if (and LilyPond-fancy-comments
173 (not (looking-at "%%\\|%{\\|%}")))
174 (setq indent comment-column
)
175 (if (eq indent t
) (setq indent
0))
176 (if (listp indent
) (setq indent
(car indent
)))
178 ((= (following-char) ?
})
179 (setq indent
(+ indent
(- LilyPond-close-brace-offset LilyPond-indent-level
))))
180 ((= (following-char) ?
>)
181 (setq indent
(+ indent
(- LilyPond-close-angle-offset LilyPond-indent-level
))))
182 ((= (following-char) ?
])
183 (setq indent
(+ indent
(- LilyPond-close-square-offset LilyPond-indent-level
))))
184 ((and (= (following-char) ?\
)) (LilyPond-inside-scheme-p))
185 (setq indent
(+ indent
(- LilyPond-close-scheme-paren-offset LilyPond-indent-level
))))
186 ((= (following-char) ?
{)
187 (setq indent
(+ indent LilyPond-brace-offset
)))
188 ((= (following-char) ?
<)
189 (setq indent
(+ indent LilyPond-angle-offset
)))
190 ((= (following-char) ?
[)
191 (setq indent
(+ indent LilyPond-square-offset
)))
192 ((and (= (following-char) ?\
() (LilyPond-inside-scheme-p))
193 (setq indent
(+ indent LilyPond-scheme-paren-offset
)))
195 (skip-chars-forward " \t")
196 (setq shift-amt
(- indent
(current-column)))
197 (if (zerop shift-amt
)
198 (if (> (- (point-max) pos
) (point))
199 (goto-char (- (point-max) pos
)))
200 (delete-region beg
(point))
202 ;; If initial point was within line's indentation,
203 ;; position after the indentation.
204 ;; Else stay at same point in text.
205 (if (> (- (point-max) pos
) (point))
206 (goto-char (- (point-max) pos
))))
210 (defun LilyPond-inside-comment-p ()
211 "Return non-nil if point is inside a line or block comment"
212 (setq this-point
(point))
213 (or (save-excursion (beginning-of-line)
214 (skip-chars-forward " \t")
217 ;; point is in the middle of a block comment
218 (setq lastopen
(save-excursion (re-search-backward "%{[ \\t]*" (point-min) t
)))
219 (setq lastclose
(save-excursion (re-search-backward "%}[ \\t]*" (point-min) t
)))
220 (if (or (and (= (char-before) ?%
) (= (char-after) ?
{))
221 (and (= (char-after) ?%
) (= (char-after (1+ (point))) ?
{)))
222 (setq lastopen
(save-excursion (backward-char) (point))))
226 (<= lastclose lastopen
))))
230 (defun LilyPond-inside-string-or-comment-p ()
231 "Test if point is inside a string or a comment"
232 (setq this-point
(point))
233 (or (save-excursion (beginning-of-line)
234 (skip-chars-forward " \t")
238 (while (< (point) this-point
)
239 (setq state
(parse-partial-sexp (point) this-point
0)))
241 ;; point is in the middle of a string
244 ;; point is in the middle of a block comment
250 (defun LilyPond-backward-over-blockcomments (lim)
251 "Move point back to closest non-whitespace character not part of a block comment"
252 (setq lastopen
(save-excursion (re-search-backward "%{[ \\t]*" lim t
)))
253 (setq lastclose
(save-excursion (re-search-backward "%}[ \\t]*" lim t
)))
256 (if (<= lastclose lastopen
)
257 (goto-char lastopen
))
258 (goto-char lastopen
)))
259 (skip-chars-backward " %\t\n\f"))
262 (defun LilyPond-backward-over-linecomments (lim)
263 "Move point back to the closest non-whitespace character not part of a line comment.
267 (skip-chars-backward " \t\n\f" lim
)
268 (setq opoint
(point))
270 (search-forward "%" opoint
'move
)
271 (skip-chars-backward " \t%")
272 (setq stop
(or (/= (preceding-char) ?
\n) (<= (point) lim
)))
274 (beginning-of-line)))))
277 (defun LilyPond-backward-to-noncomment (lim)
278 "Move point back to closest non-whitespace character not part of a comment"
279 (LilyPond-backward-over-linecomments lim
)
280 (LilyPond-backward-over-blockcomments lim
))
283 (defun LilyPond-calculate-indent-within-blockcomment ()
284 "Return the indentation amount for line inside a block comment."
285 (let (end percent-start
)
288 (skip-chars-forward " \t")
289 (skip-chars-backward " \t\n")
292 (skip-chars-forward " \t")
293 (and (re-search-forward "%{[ \t]*" end t
)
294 (goto-char (1+ (match-beginning 0))))
295 (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%
))
296 (1+ (current-column))
300 ;; Key: Type of bracket (character).
301 ;; Value: Pair of regexps representing the corresponding open and close bracket
302 ;; () are treated specially (need to indent in Scheme but not in music)
304 (defconst LilyPond-parens-regexp-alist
305 `( ( ?
> .
("\\([^\\]\\|^\\)<" .
"\\([^ \\n\\t_^-]\\|[_^-][-^]\\|\\s-\\)\\s-*>"))
306 ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
307 ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
308 ;; also \> and \< are hairpins
309 ;; duh .. a single '>', as in chords '<< ... >>', was not matched here
311 ;; ligatures '\[ ... \]' are skipped in the following expression
312 ( ?
] .
("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" .
"\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]"))
313 ( "\\]" .
("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" .
"\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]"))
314 ( "\\)" .
("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" .
"\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]"))
318 (defconst LilyPond-parens-alist
328 (defun LilyPond-matching-paren (bracket-type)
329 "Returns the open corresponding to the close specified by bracket-type, or vice versa"
330 (cond ( (member bracket-type
(mapcar 'car LilyPond-parens-alist
))
331 (cdr (assoc bracket-type LilyPond-parens-alist
)) )
332 ( (member bracket-type
(mapcar 'cdr LilyPond-parens-alist
))
333 (car (rassoc bracket-type LilyPond-parens-alist
)) )
337 (defun LilyPond-scan-containing-sexp (&optional bracket-type slur-paren-p dir
)
338 "Move point to the beginning of the deepest parenthesis pair enclosing point.
340 If the optional argument bracket-type, a character representing a
341 close bracket such as ) or }, is specified, then the parenthesis pairs
342 searched are limited to this type.
344 If the optional argument slur-paren-p is non-nil, then slur
345 parentheses () are considered as matching pairs. Otherwise Scheme
346 parentheses are considered to be matching pairs, but slurs are not.
347 slur-paren-p defaults to nil.
349 ;;; An user does not call this function directly, or by a key sequence.
351 (let ( (level (if (not (eq dir
1)) 1 -
1))
352 (regexp-alist LilyPond-parens-regexp-alist
)
354 (assoc-bracket-type (if (not (eq dir
1)) bracket-type
(LilyPond-matching-paren bracket-type
))))
356 (if (LilyPond-inside-scheme-p)
357 (setq paren-regexp
"(\\|)")
359 ;; expressional slurs '\( ... \)' are not taken into account
360 (setq regexp-alist
(cons '( ?\
) .
("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" .
"\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist
)))
361 (if (member assoc-bracket-type
(mapcar 'car regexp-alist
))
362 (progn (setq paren-regexp
(cdr (assoc assoc-bracket-type regexp-alist
)))
363 (setq paren-regexp
(concat (car paren-regexp
) "\\|" (cdr paren-regexp
))))
364 (setq paren-regexp
(concat (mapconcat 'car
(mapcar 'cdr regexp-alist
) "\\|") "\\|"
365 (mapconcat 'cdr
(mapcar 'cdr regexp-alist
) "\\|")))))
366 ;; match concurrent one-char opening and closing slurs
368 (not (sequencep bracket-type
))
369 (eq (char-syntax (char-after oldpos
)) ?\
()
370 (not (eq (char-after oldpos
) ?
<)))
371 ;; anyway do not count open slur, since already level = -1
372 (progn (forward-char 1)
373 (if (eq (following-char)
374 (LilyPond-matching-paren (char-after oldpos
)))
375 ;; matching char found, go after it and set level = 0
376 (progn (forward-char 1)
378 ;; browse the code until matching slur is found, or report mismatch
379 (while (and (if (not (eq dir
1))
382 ;; dir tells whether to search backward or forward
384 (re-search-backward paren-regexp nil t
)
385 (re-search-forward paren-regexp nil t
))
386 ;; note: in case of two-char bracket only latter is compared
387 (setq match
(char-before (match-end 0))))
388 ;;; (message "%d" level) (sit-for 0 300)
389 (if (not (save-excursion (goto-char (match-end 0))
390 ;; skip over strings and comments
391 (LilyPond-inside-string-or-comment-p)))
392 (if (memq match
'(?
} ?
> ?
] ?\
)))
393 ;; count closing brackets
394 (progn (setq level
(1+ level
))
395 ;; slurs may be close to each other, e.g.,
396 ;; a single '>' was not matched .. need to be corrected
397 (if (and (eq dir
1) (eq (char-after (match-end 0)) match
))
400 (setq level
(1+ level
))
402 ;;; (message "%d %c" level match) (sit-for 0 300)
404 (if (and (= match ?
>)
405 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
407 ;; count opening brackets
408 (progn (setq level
(1- level
))
409 ;;; (message "%d %c" level match) (sit-for 0 300)
411 (if (and (= match ?
<)
412 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
413 (forward-char 1))))))
414 ;; jump to the matching slur
417 (if (sequencep bracket-type
)
418 ;; match the latter char in two-char brackets
419 (if (looking-at "..[][)(]") (forward-char 1)))
420 ;; if the following char is not already a slur
421 (if (and (not (looking-at "[)(]"))
422 ;; match the slur which follows
423 (looking-at ".[][><)(]")) (forward-char 1)))
427 (progn (goto-char oldpos
)
431 (defun LilyPond-inside-scheme-p ()
432 "Tests if point is inside embedded Scheme code"
433 ;;; An user does not call this function directly, or by a key sequence.
435 (let ( (test-point (point))
438 (if (or (and (/= (point) (point-max))
439 (= (char-after (point)) ?\
()
440 (or (= (char-after (- (point) 1)) ?
#)
441 (and (= (char-after (- (point) 2)) ?
#)
442 (= (char-after (- (point) 1)) ?
`))))
443 (and (re-search-backward "#(\\|#`(" nil t
)
447 (while (and (> level
0)
448 (re-search-forward "(\\|)" test-point t
)
449 (setq match
(char-after (match-beginning 0)))
450 (<= (point) test-point
))
452 (setq level
(1+ level
))
453 (setq level
(1- level
))))
459 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
460 ;;; the Emacs distribution.
462 (defun LilyPond-blink-matching-paren (&optional dir
)
463 "Move cursor momentarily to the beginning of the sexp before
464 point. In lilypond files this is used for closing ), ], } and >, whereas the
465 builtin 'blink-matching-open' is not used. In syntax table, see
466 `lilypond-font-lock.el', all brackets are punctuation characters."
467 ;;; An user does not call this function directly, or by a key sequence.
469 (let ( (oldpos (point))
472 (if (not (or (equal this-command
'LilyPond-electric-close-paren
)
474 (goto-char (setq oldpos
(- oldpos
1))))
475 ;; Test if a ligature \] or expressional slur \) was encountered
476 (setq bracket-type
(char-after (point)))
477 (setq char-before-bracket-type nil
)
478 (if (memq bracket-type
'(?
] ?\
) ?
[ ?\
())
481 (while (eq (char-before (- (point) (setq np
(+ np
1)))) ?
\\)
482 (setq char-before-bracket-type
(if char-before-bracket-type nil ?
\\)))
483 (if (eq char-before-bracket-type ?
\\)
484 (setq bracket-type
(string char-before-bracket-type bracket-type
)))))
485 (when blink-matching-paren-distance
487 (max (point-min) (- (point) blink-matching-paren-distance
))
488 (min (point-max) (+ (point) blink-matching-paren-distance
))))
489 (if (and (equal this-command
'LilyPond-electric-close-paren
)
490 (memq bracket-type
'(?
> ?
} ?
< ?
{)))
491 ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
492 (LilyPond-scan-containing-sexp nil nil dir
)
493 ;; whereas ( ) slurs within music don't, so only need to search for ( )
494 ;; use same mechanism for [ ] slurs
495 (LilyPond-scan-containing-sexp bracket-type t dir
))
496 (setq blinkpos
(point))
498 (or (null (LilyPond-matching-paren (char-after blinkpos
)))
499 (/= (char-after oldpos
)
500 (LilyPond-matching-paren (char-after blinkpos
)))))
501 (if mismatch
(progn (setq blinkpos nil
)
502 (message "Mismatched parentheses")))
504 (equal this-command
'LilyPond-electric-close-paren
))
505 (if (pos-visible-in-window-p)
506 (and blink-matching-paren-on-screen
507 (sit-for blink-matching-delay
))
510 ;; Show what precedes the open in its line, if anything.
512 (skip-chars-backward " \t")
514 (buffer-substring (progn (beginning-of-line) (point))
516 ;; Show what follows the open in its line, if anything.
519 (skip-chars-forward " \t")
521 (buffer-substring blinkpos
522 (progn (end-of-line) (point)))
523 ;; Otherwise show the previous nonblank line,
526 (skip-chars-backward "\n \t")
529 (buffer-substring (progn
530 (skip-chars-backward "\n \t")
534 (skip-chars-backward " \t")
536 ;; Replace the newline and other whitespace with `...'.
538 (buffer-substring blinkpos
(1+ blinkpos
)))
539 ;; There is nothing to show except the char itself.
540 (buffer-substring blinkpos
(1+ blinkpos
))))))))
541 (if (not (equal this-command
'LilyPond-electric-close-paren
))
542 (goto-char (setq oldpos
(+ oldpos
1)))
549 (defun LilyPond-electric-close-paren ()
550 "Blink on the matching open paren when a >, ), } or ] is inserted"
552 (let ((oldpos (point)))
553 (self-insert-command 1)
554 ;; Refontify buffer if a block-comment-ender '%}' is inserted
555 (if (and (eq (char-before (point)) ?
})
556 (eq (char-before (- (point) 1)) ?%
))
557 (font-lock-fontify-buffer)
558 ;; Match paren if the cursor is not inside string or comment.
559 (if (and blink-matching-paren
560 (not (LilyPond-inside-string-or-comment-p))
561 (save-excursion (re-search-backward
562 (concat (mapconcat 'cdr
(mapcar 'cdr LilyPond-parens-regexp-alist
) "\\|") "\\|)") nil t
)
563 (eq oldpos
(1- (match-end 0)))))
564 (progn (backward-char 1)
565 (LilyPond-blink-matching-paren)
566 (forward-char 1))))))
568 (defun LilyPond-scan-sexps (pos dir
)
569 "This function is redefined to be used in Emacs' show-paren-function and
570 in XEmacs' paren-highlight."
571 (LilyPond-blink-matching-paren dir
))