*** empty log message ***
[lilypond.git] / lilypond-indent.el
blob4626646d06a7139dd40c96cb843cdf71dc8ceae9
1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
2 ;;;
3 ;;; Heikki Junes <hjunes@cc.hut.fi>
4 ;;; * ond-char paren matching is handled by context dependent syntax tables
5 ;;; * match two-char slurs '\( ... \)' and '\[ ... \]' separately.
6 ;;; * adopt Emacs' f90-comment-region
8 ;;; Chris Jackson <chris@fluffhouse.org.uk>
9 ;;; some code is taken from ESS (Emacs Speaks Statistics) S-mode by A.J.Rossini <rossini@biostat.washington.edu>
11 ;;; Variables for customising indentation style
13 ;;; TODO:
14 ;;; * currently, in bracket matching one may need a non-bracket
15 ;;; chararacter between the bracket characters, like ( ( ) )
17 (defcustom LilyPond-indent-level 4
18 "*Indentation of lilypond statements with respect to containing block.")
20 (defcustom LilyPond-brace-offset 0
21 "*Extra indentation for open braces.
22 Compares with other text in same context.")
24 (defcustom LilyPond-angle-offset 0
25 "*Extra indentation for open angled brackets.
26 Compares with other text in same context.")
28 (defcustom LilyPond-square-offset 0
29 "*Extra indentation for open square brackets.
30 Compares with other text in same context.")
32 (defcustom LilyPond-scheme-paren-offset 0
33 "*Extra indentation for open scheme parens.
34 Compares with other text in same context.")
36 (defcustom LilyPond-close-brace-offset 0
37 "*Extra indentation for closing braces.")
39 (defcustom LilyPond-close-angle-offset 0
40 "*Extra indentation for closing angle brackets.")
42 (defcustom LilyPond-close-square-offset 0
43 "*Extra indentation for closing square brackets.")
45 (defcustom LilyPond-close-scheme-paren-offset 0
46 "*Extra indentation for closing scheme parens.")
48 (defcustom LilyPond-fancy-comments t
49 "*Non-nil means distiguish between %, %%, and %%% for indentation.")
51 (defcustom LilyPond-comment-region "%%$"
52 "*String inserted by \\[LilyPond-comment-region]\
53 at start of each line in region.")
55 (defun LilyPond-comment-region (beg-region end-region)
56 "Comment/uncomment every line in the region.
57 Insert LilyPond-comment-region at the beginning of every line in the region
58 or, if already present, remove it."
59 (interactive "*r")
60 (let ((end (make-marker)))
61 (set-marker end end-region)
62 (goto-char beg-region)
63 (beginning-of-line)
64 (if (looking-at (regexp-quote LilyPond-comment-region))
65 (delete-region (point) (match-end 0))
66 (insert LilyPond-comment-region))
67 (while (and (zerop (forward-line 1))
68 (< (point) (marker-position end)))
69 (if (looking-at (regexp-quote LilyPond-comment-region))
70 (delete-region (point) (match-end 0))
71 (insert LilyPond-comment-region)))
72 (set-marker end nil)))
74 (defun LilyPond-calculate-indent ()
75 "Return appropriate indentation for current line as lilypond code.
76 In usual case returns an integer: the column to indent to.
77 Returns nil if line starts inside a string"
78 (save-excursion
79 (beginning-of-line)
80 (let ((indent-point (point))
81 (case-fold-search nil)
82 state)
83 (setq containing-sexp (save-excursion (LilyPond-scan-containing-sexp)))
84 (beginning-of-defun)
85 (while (< (point) indent-point)
86 (setq state (parse-partial-sexp (point) indent-point 0)))
87 ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
88 ;; with simpler parenthesis delimiters
89 (cond ((nth 3 state)
90 ;; point is in the middle of a string
91 nil)
92 ((nth 4 state)
93 ;; point is in the middle of a block comment
94 (LilyPond-calculate-indent-within-blockcomment))
95 ((null containing-sexp)
96 ;; Line is at top level - no indent
97 (beginning-of-line)
100 ;; Find previous non-comment character.
101 (goto-char indent-point)
102 (LilyPond-backward-to-noncomment containing-sexp)
103 ;; Now we get the answer.
104 ;; Position following last unclosed open.
105 (goto-char containing-sexp)
107 ;; Is line first statement after an open brace or bracket?
108 ;; If no, find that first statement and indent like it.
109 (save-excursion
110 (forward-char 1)
111 ;; Skip over comments following open brace.
112 (skip-chars-forward " \t\n")
113 (cond ((looking-at "%{")
114 (while (progn
115 (and (not (looking-at "%}"))
116 (< (point) (point-max))))
117 (forward-line 1)
118 (skip-chars-forward " \t\n"))
119 (forward-line 1)
120 (skip-chars-forward " \t\n"))
121 ((looking-at "%")
122 (while (progn (skip-chars-forward " \t\n")
123 (looking-at "%"))
124 (forward-line 1))))
125 ;; The first following code counts
126 ;; if it is before the line we want to indent.
127 (and (< (point) indent-point)
128 (current-column)))
129 ;; If no previous statement,
130 ;; indent it relative to line brace is on.
131 ;; For open brace in column zero, don't let statement
132 ;; start there too. If LilyPond-indent-level is zero, use
133 ;; LilyPond-brace-offset instead
134 (+ (if (and (bolp) (zerop LilyPond-indent-level))
135 (cond ((= (following-char) ?{)
136 LilyPond-brace-offset)
137 ((= (following-char) ?<)
138 LilyPond-angle-offset)
139 ((= (following-char) ?[)
140 LilyPond-square-offset)
141 ((= (following-char) ?\))
142 LilyPond-scheme-paren-offset)
145 LilyPond-indent-level)
146 (progn
147 (skip-chars-backward " \t")
148 (current-indentation)))))))))
151 (defun LilyPond-indent-line ()
152 "Indent current line as lilypond code.
153 Return the amount the indentation changed by."
154 (let ((indent (LilyPond-calculate-indent))
155 beg shift-amt
156 (case-fold-search nil)
157 (pos (- (point-max) (point))))
158 (beginning-of-line)
159 (setq beg (point))
160 (cond ((eq indent nil)
161 (setq indent (current-indentation)))
163 (skip-chars-forward " \t")
164 (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
165 (setq indent 0))
166 (if (and LilyPond-fancy-comments
167 (looking-at "%")
168 (not (looking-at "%%\\|%{\\|%}")))
169 (setq indent comment-column)
170 (if (eq indent t) (setq indent 0))
171 (if (listp indent) (setq indent (car indent)))
172 (cond
173 ((= (following-char) ?})
174 (setq indent (+ indent (- LilyPond-close-brace-offset LilyPond-indent-level))))
175 ((= (following-char) ?>)
176 (setq indent (+ indent (- LilyPond-close-angle-offset LilyPond-indent-level))))
177 ((= (following-char) ?])
178 (setq indent (+ indent (- LilyPond-close-square-offset LilyPond-indent-level))))
179 ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p))
180 (setq indent (+ indent (- LilyPond-close-scheme-paren-offset LilyPond-indent-level))))
181 ((= (following-char) ?{)
182 (setq indent (+ indent LilyPond-brace-offset)))
183 ((= (following-char) ?<)
184 (setq indent (+ indent LilyPond-angle-offset)))
185 ((= (following-char) ?[)
186 (setq indent (+ indent LilyPond-square-offset)))
187 ((and (= (following-char) ?\() (LilyPond-inside-scheme-p))
188 (setq indent (+ indent LilyPond-scheme-paren-offset)))
189 ))))
190 (skip-chars-forward " \t")
191 (setq shift-amt (- indent (current-column)))
192 (if (zerop shift-amt)
193 (if (> (- (point-max) pos) (point))
194 (goto-char (- (point-max) pos)))
195 (delete-region beg (point))
196 (indent-to indent)
197 ;; If initial point was within line's indentation,
198 ;; position after the indentation.
199 ;; Else stay at same point in text.
200 (if (> (- (point-max) pos) (point))
201 (goto-char (- (point-max) pos))))
202 shift-amt))
205 (defun LilyPond-inside-comment-p ()
206 "Return non-nil if point is inside a line or block comment"
207 (setq this-point (point))
208 (or (save-excursion (beginning-of-line)
209 (skip-chars-forward " \t")
210 (looking-at "%"))
211 (save-excursion
212 ;; point is in the middle of a block comment
213 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" (point-min) t)))
214 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" (point-min) t)))
215 (if (or (and (= (char-before) ?%) (= (char-after) ?{))
216 (and (= (char-after) ?%) (= (char-after (1+ (point))) ?{)))
217 (setq lastopen (save-excursion (backward-char) (point))))
218 (and
219 lastopen
220 (or (not lastclose)
221 (<= lastclose lastopen))))
225 (defun LilyPond-inside-string-or-comment-p ()
226 "Test if point is inside a string or a comment"
227 (setq this-point (point))
228 (or (save-excursion (beginning-of-line)
229 (skip-chars-forward " \t")
230 (looking-at "%"))
231 (save-excursion
232 (beginning-of-defun)
233 (while (< (point) this-point)
234 (setq state (parse-partial-sexp (point) this-point 0)))
235 (cond ((nth 3 state)
236 ;; point is in the middle of a string
238 ((nth 4 state)
239 ;; point is in the middle of a block comment
240 t )
242 nil)))))
245 (defun LilyPond-backward-over-blockcomments (lim)
246 "Move point back to closest non-whitespace character not part of a block comment"
247 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
248 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
249 (if lastopen
250 (if lastclose
251 (if (<= lastclose lastopen)
252 (goto-char lastopen))
253 (goto-char lastopen)))
254 (skip-chars-backward " %\t\n\f"))
257 (defun LilyPond-backward-over-linecomments (lim)
258 "Move point back to the closest non-whitespace character not part of a line comment.
259 Argument LIM limit."
260 (let (opoint stop)
261 (while (not stop)
262 (skip-chars-backward " \t\n\f" lim)
263 (setq opoint (point))
264 (beginning-of-line)
265 (search-forward "%" opoint 'move)
266 (skip-chars-backward " \t%")
267 (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
268 (if stop (point)
269 (beginning-of-line)))))
272 (defun LilyPond-backward-to-noncomment (lim)
273 "Move point back to closest non-whitespace character not part of a comment"
274 (LilyPond-backward-over-linecomments lim)
275 (LilyPond-backward-over-blockcomments lim))
278 (defun LilyPond-calculate-indent-within-blockcomment ()
279 "Return the indentation amount for line inside a block comment."
280 (let (end percent-start)
281 (save-excursion
282 (beginning-of-line)
283 (skip-chars-forward " \t")
284 (skip-chars-backward " \t\n")
285 (setq end (point))
286 (beginning-of-line)
287 (skip-chars-forward " \t")
288 (and (re-search-forward "%{[ \t]*" end t)
289 (goto-char (1+ (match-beginning 0))))
290 (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
291 (1+ (current-column))
292 (current-column)))))
295 ;; Key: Type of bracket (character).
296 ;; Value: Pair of regexps representing the corresponding open and close bracket
297 ;; () are treated specially (need to indent in Scheme but not in music)
299 (defconst LilyPond-parens-regexp-alist
300 `( ( ?> . ("\\([^\\]\\|^\\)<" . "\\([^ \\n\\t_^-]\\|[_^-][-^]\\|\\s-\\)\\s-*>"))
301 ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
302 ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
303 ;; also \> and \< are hairpins
304 ;; duh .. a single '>', as in chords '<< ... >>', was not matched here
305 ( ?} . ("{" . "}"))
306 ;; ligatures '\[ ... \]' are skipped in the following expression
307 ( ?] . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]"))
308 ( "\\]" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]"))
309 ( "\\)" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]"))
313 (defconst LilyPond-parens-alist
314 `( ( ?< . ?> )
315 ( ?{ . ?} )
316 ( ?[ . ?] )
317 ( "\\[" . "\\]" )
318 ( ?\( . ?\) )
319 ( "\\(" . "\\)" )
323 (defun LilyPond-matching-paren (bracket-type)
324 "Returns the open corresponding to the close specified by bracket-type, or vice versa"
325 (cond ( (member bracket-type (mapcar 'car LilyPond-parens-alist))
326 (cdr (assoc bracket-type LilyPond-parens-alist)) )
327 ( (member bracket-type (mapcar 'cdr LilyPond-parens-alist))
328 (car (rassoc bracket-type LilyPond-parens-alist)) )
329 nil))
332 (defun LilyPond-scan-containing-sexp (&optional bracket-type slur-paren-p dir)
333 "Move point to the beginning of the deepest parenthesis pair enclosing point.
335 If the optional argument bracket-type, a character representing a
336 close bracket such as ) or }, is specified, then the parenthesis pairs
337 searched are limited to this type.
339 If the optional argument slur-paren-p is non-nil, then slur
340 parentheses () are considered as matching pairs. Otherwise Scheme
341 parentheses are considered to be matching pairs, but slurs are not.
342 slur-paren-p defaults to nil.
344 ;;; An user does not call this function directly, or by a key sequence.
345 ;; (interactive)
346 (let ( (level (if (not (eq dir 1)) 1 -1))
347 (regexp-alist LilyPond-parens-regexp-alist)
348 (oldpos (point))
349 (assoc-bracket-type (if (not (eq dir 1)) bracket-type (LilyPond-matching-paren bracket-type))))
351 (if (LilyPond-inside-scheme-p)
352 (setq paren-regexp "(\\|)")
353 (if slur-paren-p
354 ;; expressional slurs '\( ... \)' are not taken into account
355 (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" . "\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist)))
356 (if (member assoc-bracket-type (mapcar 'car regexp-alist))
357 (progn (setq paren-regexp (cdr (assoc assoc-bracket-type regexp-alist)))
358 (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
359 (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
360 (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
361 ;; match concurrent one-char opening and closing slurs
362 (if (and (eq dir 1)
363 (not (sequencep bracket-type))
364 (eq (char-syntax (char-after oldpos)) ?\()
365 (not (eq (char-after oldpos) ?<)))
366 ;; anyway do not count open slur, since already level = -1
367 (progn (forward-char 1)
368 (if (eq (following-char)
369 (LilyPond-matching-paren (char-after oldpos)))
370 ;; matching char found, go after it and set level = 0
371 (progn (forward-char 1)
372 (setq level 0)))))
373 ;; browse the code until matching slur is found, or report mismatch
374 (while (and (if (not (eq dir 1))
375 (> level 0)
376 (< level 0))
377 ;; dir tells whether to search backward or forward
378 (if (not (eq dir 1))
379 (re-search-backward paren-regexp nil t)
380 (re-search-forward paren-regexp nil t))
381 ;; note: in case of two-char bracket only latter is compared
382 (setq match (char-before (match-end 0))))
383 ;;; (message "%d" level) (sit-for 0 300)
384 (if (not (save-excursion (goto-char (match-end 0))
385 ;; skip over strings and comments
386 (LilyPond-inside-string-or-comment-p)))
387 (if (memq match '(?} ?> ?] ?\)))
388 ;; count closing brackets
389 (progn (setq level (1+ level))
390 ;; slurs may be close to each other, e.g.,
391 ;; a single '>' was not matched .. need to be corrected
392 (if (and (eq dir 1) (eq (char-after (match-end 0)) match))
393 (if (/= level 0)
394 (progn
395 (setq level (1+ level))
396 (forward-char 1))))
397 ;;; (message "%d %c" level match) (sit-for 0 300)
398 ;; hmm..
399 (if (and (= match ?>)
400 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
401 (forward-char 1)))
402 ;; count opening brackets
403 (progn (setq level (1- level))
404 ;;; (message "%d %c" level match) (sit-for 0 300)
405 ;; hmm..
406 (if (and (= match ?<)
407 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
408 (forward-char 1))))))
409 ;; jump to the matching slur
410 (if (not (eq dir 1))
411 (progn
412 (if (sequencep bracket-type)
413 ;; match the latter char in two-char brackets
414 (if (looking-at "..[][)(]") (forward-char 1)))
415 ;; if the following char is not already a slur
416 (if (and (not (looking-at "[)(]"))
417 ;; match the slur which follows
418 (looking-at ".[][><)(]")) (forward-char 1)))
419 (backward-char 1))
420 (if (= level 0)
421 (point)
422 (progn (goto-char oldpos)
423 nil))))
426 (defun LilyPond-inside-scheme-p ()
427 "Tests if point is inside embedded Scheme code"
428 ;;; An user does not call this function directly, or by a key sequence.
429 ;; (interactive)
430 (let ( (test-point (point))
431 (level 0) )
432 (save-excursion
433 (if (or (and (/= (point) (point-max))
434 (= (char-after (point)) ?\()
435 (or (= (char-after (- (point) 1)) ?#)
436 (and (= (char-after (- (point) 2)) ?#)
437 (= (char-after (- (point) 1)) ?`))))
438 (and (re-search-backward "#(\\|#`(" nil t)
439 (progn
440 (search-forward "(")
441 (setq level 1)
442 (while (and (> level 0)
443 (re-search-forward "(\\|)" test-point t)
444 (setq match (char-after (match-beginning 0)))
445 (<= (point) test-point))
446 (if (= match ?\()
447 (setq level (1+ level))
448 (setq level (1- level))))
449 (> level 0))))
451 nil))))
454 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
455 ;;; the Emacs distribution.
457 (defun LilyPond-blink-matching-paren (&optional dir)
458 "Move cursor momentarily to the beginning of the sexp before
459 point. In lilypond files this is used for closing ), ], } and >, whereas the
460 builtin 'blink-matching-open' is not used. In syntax table, see
461 `lilypond-font-lock.el', all brackets are punctuation characters."
462 ;;; An user does not call this function directly, or by a key sequence.
463 ;; (interactive)
464 (let ( (oldpos (point))
465 (level 0)
466 (mismatch) )
467 (if (not (or (equal this-command 'LilyPond-electric-close-paren)
468 (eq dir 1)))
469 (goto-char (setq oldpos (- oldpos 1))))
470 ;; Test if a ligature \] or expressional slur \) was encountered
471 (setq bracket-type (char-after (point)))
472 (setq char-before-bracket-type nil)
473 (if (memq bracket-type '(?] ?\) ?[ ?\())
474 (progn
475 (setq np -1)
476 (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\)
477 (setq char-before-bracket-type (if char-before-bracket-type nil ?\\)))
478 (if (eq char-before-bracket-type ?\\)
479 (setq bracket-type (string char-before-bracket-type bracket-type)))))
480 (when blink-matching-paren-distance
481 (narrow-to-region
482 (max (point-min) (- (point) blink-matching-paren-distance))
483 (min (point-max) (+ (point) blink-matching-paren-distance))))
484 (if (and (equal this-command 'LilyPond-electric-close-paren)
485 (memq bracket-type '(?> ?} ?< ?{)))
486 ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
487 (LilyPond-scan-containing-sexp nil nil dir)
488 ;; whereas ( ) slurs within music don't, so only need to search for ( )
489 ;; use same mechanism for [ ] slurs
490 (LilyPond-scan-containing-sexp bracket-type t dir))
491 (setq blinkpos (point))
492 (setq mismatch
493 (or (null (LilyPond-matching-paren (char-after blinkpos)))
494 (/= (char-after oldpos)
495 (LilyPond-matching-paren (char-after blinkpos)))))
496 (if mismatch (progn (setq blinkpos nil)
497 (message "Mismatched parentheses")))
498 (if (and blinkpos
499 (equal this-command 'LilyPond-electric-close-paren))
500 (if (pos-visible-in-window-p)
501 (and blink-matching-paren-on-screen
502 (sit-for blink-matching-delay))
503 (message
504 "Matches %s"
505 ;; Show what precedes the open in its line, if anything.
506 (if (save-excursion
507 (skip-chars-backward " \t")
508 (not (bolp)))
509 (buffer-substring (progn (beginning-of-line) (point))
510 (1+ blinkpos))
511 ;; Show what follows the open in its line, if anything.
512 (if (save-excursion
513 (forward-char 1)
514 (skip-chars-forward " \t")
515 (not (eolp)))
516 (buffer-substring blinkpos
517 (progn (end-of-line) (point)))
518 ;; Otherwise show the previous nonblank line,
519 ;; if there is one.
520 (if (save-excursion
521 (skip-chars-backward "\n \t")
522 (not (bobp)))
523 (concat
524 (buffer-substring (progn
525 (skip-chars-backward "\n \t")
526 (beginning-of-line)
527 (point))
528 (progn (end-of-line)
529 (skip-chars-backward " \t")
530 (point)))
531 ;; Replace the newline and other whitespace with `...'.
532 "..."
533 (buffer-substring blinkpos (1+ blinkpos)))
534 ;; There is nothing to show except the char itself.
535 (buffer-substring blinkpos (1+ blinkpos))))))))
536 (if (not (equal this-command 'LilyPond-electric-close-paren))
537 (goto-char (setq oldpos (+ oldpos 1)))
538 (goto-char oldpos))
539 (if (not (eq dir 1))
540 blinkpos
541 (+ blinkpos 1))))
544 (defun LilyPond-electric-close-paren ()
545 "Blink on the matching open paren when a >, ), } or ] is inserted"
546 (interactive)
547 (let ((oldpos (point)))
548 (self-insert-command 1)
549 ;; Refontify buffer if a block-comment-ender '%}' is inserted
550 (if (and (eq (char-before (point)) ?})
551 (eq (char-before (- (point) 1)) ?%))
552 (font-lock-fontify-buffer)
553 ;; Match paren if the cursor is not inside string or comment.
554 (if (and blink-matching-paren
555 (not (LilyPond-inside-string-or-comment-p))
556 (save-excursion (re-search-backward
557 (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
558 (eq oldpos (1- (match-end 0)))))
559 (progn (backward-char 1)
560 (LilyPond-blink-matching-paren)
561 (forward-char 1))))))
563 (defun LilyPond-scan-sexps (pos dir)
564 "This function is redefined to be used in Emacs' show-paren-function and
565 in XEmacs' paren-highlight."
566 (LilyPond-blink-matching-paren dir))