1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
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
14 ;;; * currently, in bracket matching one may need a non-bracket
15 ;;; chararacter between the bracket characters, like ( ( ) )
17 (defcustom LilyPond-indent-level 2
18 "*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."
28 (defcustom LilyPond-angle-offset 0
29 "*Extra indentation for open angled brackets.
30 Compares with other text in same context."
34 (defcustom LilyPond-square-offset 0
35 "*Extra indentation for open square brackets.
36 Compares with other text in same context."
40 (defcustom LilyPond-scheme-paren-offset 0
41 "*Extra indentation for open scheme parens.
42 Compares with other text in same context."
46 (defcustom LilyPond-close-brace-offset 0
47 "*Extra indentation for closing braces."
51 (defcustom LilyPond-close-angle-offset 0
52 "*Extra indentation for closing angle brackets."
56 (defcustom LilyPond-close-square-offset 0
57 "*Extra indentation for closing square brackets."
61 (defcustom LilyPond-close-scheme-paren-offset 0
62 "*Extra indentation for closing scheme parens."
66 (defcustom LilyPond-fancy-comments t
67 "*Non-nil means distiguish between %, %%, and %%% for indentation."
71 (defcustom LilyPond-comment-region "%%%"
72 "*String inserted by \\[LilyPond-comment-region]\
73 at start of each line in region."
77 (defun LilyPond-comment-region (beg-region end-region)
78 "Comment/uncomment every line in the region.
79 Insert LilyPond-comment-region at the beginning of every line in the region
80 or, if already present, remove it."
82 (let ((end (make-marker)))
83 (set-marker end end-region)
84 (goto-char beg-region)
86 (if (looking-at (regexp-quote LilyPond-comment-region))
87 (delete-region (point) (match-end 0))
88 (insert LilyPond-comment-region))
89 (while (and (zerop (forward-line 1))
90 (< (point) (marker-position end)))
91 (if (looking-at (regexp-quote LilyPond-comment-region))
92 (delete-region (point) (match-end 0))
93 (insert LilyPond-comment-region)))
94 (set-marker end nil)))
96 (defun LilyPond-calculate-indent ()
97 "Return appropriate indentation for current line as lilypond code.
98 In usual case returns an integer: the column to indent to.
99 Returns nil if line starts inside a string"
102 (let ((indent-point (point))
103 (case-fold-search nil)
105 (setq containing-sexp (save-excursion (LilyPond-scan-containing-sexp)))
107 (while (< (point) indent-point)
108 (setq state (parse-partial-sexp (point) indent-point 0)))
109 ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
110 ;; with simpler parenthesis delimiters
112 ;; point is in the middle of a string
115 ;; point is in the middle of a block comment
116 (LilyPond-calculate-indent-within-blockcomment))
117 ((null containing-sexp)
118 ;; Line is at top level - no indent
122 ;; Find previous non-comment character.
123 (goto-char indent-point)
124 (LilyPond-backward-to-noncomment containing-sexp)
125 ;; Now we get the answer.
126 ;; Position following last unclosed open.
127 (goto-char containing-sexp)
129 ;; Is line first statement after an open brace or bracket?
130 ;; If no, find that first statement and indent like it.
133 ;; Skip over comments following open brace.
134 (skip-chars-forward " \t\n")
135 (cond ((looking-at "%{")
137 (and (not (looking-at "%}"))
138 (< (point) (point-max))))
140 (skip-chars-forward " \t\n"))
142 (skip-chars-forward " \t\n"))
144 (while (progn (skip-chars-forward " \t\n")
147 ;; The first following code counts
148 ;; if it is before the line we want to indent.
149 (and (< (point) indent-point)
151 ;; If no previous statement,
152 ;; indent it relative to line brace is on.
153 ;; For open brace in column zero, don't let statement
154 ;; start there too. If LilyPond-indent-level is zero, use
155 ;; LilyPond-brace-offset instead
156 (+ (if (and (bolp) (zerop LilyPond-indent-level))
157 (cond ((= (following-char) ?{)
158 LilyPond-brace-offset)
159 ((= (following-char) ?<)
160 LilyPond-angle-offset)
161 ((= (following-char) ?\[)
162 LilyPond-square-offset)
163 ((= (following-char) ?\))
164 LilyPond-scheme-paren-offset)
167 LilyPond-indent-level)
169 (skip-chars-backward " \t")
170 (current-indentation)))))))))
173 (defun LilyPond-indent-line ()
174 "Indent current line as lilypond code.
175 Return the amount the indentation changed by."
176 (let ((indent (LilyPond-calculate-indent))
178 (case-fold-search nil)
179 (pos (- (point-max) (point))))
182 (cond ((eq indent nil)
183 (setq indent (current-indentation)))
185 (skip-chars-forward " \t")
186 (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
188 (if (and LilyPond-fancy-comments
190 (not (looking-at "%%\\|%{\\|%}")))
191 (setq indent comment-column)
192 (if (eq indent t) (setq indent 0))
193 (if (listp indent) (setq indent (car indent)))
195 ((= (following-char) ?})
196 (setq indent (+ indent (- LilyPond-close-brace-offset LilyPond-indent-level))))
197 ((= (following-char) ?>)
198 (setq indent (+ indent (- LilyPond-close-angle-offset LilyPond-indent-level))))
199 ((= (following-char) ?\])
200 (setq indent (+ indent (- LilyPond-close-square-offset LilyPond-indent-level))))
201 ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p))
202 (setq indent (+ indent (- LilyPond-close-scheme-paren-offset LilyPond-indent-level))))
203 ((= (following-char) ?{)
204 (setq indent (+ indent LilyPond-brace-offset)))
205 ((= (following-char) ?<)
206 (setq indent (+ indent LilyPond-angle-offset)))
207 ((= (following-char) ?\[)
208 (setq indent (+ indent LilyPond-square-offset)))
209 ((and (= (following-char) ?\() (LilyPond-inside-scheme-p))
210 (setq indent (+ indent LilyPond-scheme-paren-offset)))
212 (skip-chars-forward " \t")
213 (setq shift-amt (- indent (current-column)))
214 (if (zerop shift-amt)
215 (if (> (- (point-max) pos) (point))
216 (goto-char (- (point-max) pos)))
217 (delete-region beg (point))
219 ;; If initial point was within line's indentation,
220 ;; position after the indentation.
221 ;; Else stay at same point in text.
222 (if (> (- (point-max) pos) (point))
223 (goto-char (- (point-max) pos))))
227 (defun LilyPond-inside-comment-p ()
228 "Return non-nil if point is inside a line or block comment"
229 (setq this-point (point))
230 (or (save-excursion (beginning-of-line)
231 (skip-chars-forward " \t")
234 ;; point is in the middle of a block comment
235 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" (point-min) t)))
236 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" (point-min) t)))
237 (if (or (and (= (char-before) ?%) (= (char-after) ?{))
238 (and (= (char-after) ?%) (= (char-after (1+ (point))) ?{)))
239 (setq lastopen (save-excursion (backward-char) (point))))
243 (<= lastclose lastopen))))
247 (defun LilyPond-inside-string-or-comment-p ()
248 "Test if point is inside a string or a comment"
249 (setq this-point (point))
250 (or (save-excursion (beginning-of-line)
251 (skip-chars-forward " \t")
255 (while (< (point) this-point)
256 (setq state (parse-partial-sexp (point) this-point 0)))
258 ;; point is in the middle of a string
261 ;; point is in the middle of a block comment
267 (defun LilyPond-backward-over-blockcomments (lim)
268 "Move point back to closest non-whitespace character not part of a block comment"
269 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
270 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
273 (if (<= lastclose lastopen)
274 (goto-char lastopen))
275 (goto-char lastopen)))
276 (skip-chars-backward " %\t\n\f"))
279 (defun LilyPond-backward-over-linecomments (lim)
280 "Move point back to the closest non-whitespace character not part of a line comment.
284 (skip-chars-backward " \t\n\f" lim)
285 (setq opoint (point))
287 (search-forward "%" opoint 'move)
288 (skip-chars-backward " \t%")
289 (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
291 (beginning-of-line)))))
294 (defun LilyPond-backward-to-noncomment (lim)
295 "Move point back to closest non-whitespace character not part of a comment"
296 (LilyPond-backward-over-linecomments lim)
297 (LilyPond-backward-over-blockcomments lim))
300 (defun LilyPond-calculate-indent-within-blockcomment ()
301 "Return the indentation amount for line inside a block comment."
302 (let (end percent-start)
305 (skip-chars-forward " \t")
306 (skip-chars-backward " \t\n")
309 (skip-chars-forward " \t")
310 (and (re-search-forward "%{[ \t]*" end t)
311 (goto-char (1+ (match-beginning 0))))
312 (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
313 (1+ (current-column))
317 ;; Key: Type of bracket (character).
318 ;; Value: Pair of regexps representing the corresponding open and close bracket
319 ;; () are treated specially (need to indent in Scheme but not in music)
321 (defconst LilyPond-parens-regexp-alist
322 `( ( ?> . ("\\([^\\]\\|^\\)<" . "\\([^ \\n\\t_^-]\\|[_^-][-^]\\|\\s-\\)\\s-*>"))
323 ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
324 ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
325 ;; also \> and \< are hairpins
326 ;; duh .. a single '>', as in chords '<< ... >>', was not matched here
328 ;; ligatures '\[ ... \]' are skipped in the following expression
329 ( ?\] . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]"))
330 ( "\\]" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]"))
331 ( "\\)" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]"))
335 (defconst LilyPond-parens-alist
345 (defun LilyPond-matching-paren (bracket-type)
346 "Returns the open corresponding to the close specified by bracket-type, or vice versa"
347 (cond ( (member bracket-type (mapcar 'car LilyPond-parens-alist))
348 (cdr (assoc bracket-type LilyPond-parens-alist)) )
349 ( (member bracket-type (mapcar 'cdr LilyPond-parens-alist))
350 (car (rassoc bracket-type LilyPond-parens-alist)) )
354 (defun LilyPond-scan-containing-sexp (&optional bracket-type slur-paren-p dir)
355 "Move point to the beginning of the deepest parenthesis pair enclosing point.
357 If the optional argument bracket-type, a character representing a
358 close bracket such as ) or }, is specified, then the parenthesis pairs
359 searched are limited to this type.
361 If the optional argument slur-paren-p is non-nil, then slur
362 parentheses () are considered as matching pairs. Otherwise Scheme
363 parentheses are considered to be matching pairs, but slurs are not.
364 slur-paren-p defaults to nil.
366 ;;; An user does not call this function directly, or by a key sequence.
368 (let ( (level (if (not (eq dir 1)) 1 -1))
369 (regexp-alist LilyPond-parens-regexp-alist)
371 (assoc-bracket-type (if (not (eq dir 1)) bracket-type (LilyPond-matching-paren bracket-type))))
373 (if (LilyPond-inside-scheme-p)
374 (setq paren-regexp "(\\|)")
376 ;; expressional slurs '\( ... \)' are not taken into account
377 (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" . "\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist)))
378 (if (member assoc-bracket-type (mapcar 'car regexp-alist))
379 (progn (setq paren-regexp (cdr (assoc assoc-bracket-type regexp-alist)))
380 (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
381 (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
382 (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
383 ;; match concurrent one-char opening and closing slurs
385 (not (sequencep bracket-type))
386 (eq (char-syntax (or (char-after oldpos) 0)) ?\()
387 (not (eq (char-after oldpos) ?<)))
388 ;; anyway do not count open slur, since already level = -1
389 (progn (forward-char 1)
390 (if (eq (following-char)
391 (LilyPond-matching-paren (char-after oldpos)))
392 ;; matching char found, go after it and set level = 0
393 (progn (forward-char 1)
395 ;; browse the code until matching slur is found, or report mismatch
396 (while (and (if (not (eq dir 1))
399 ;; dir tells whether to search backward or forward
401 (re-search-backward paren-regexp nil t)
402 (re-search-forward paren-regexp nil t))
403 ;; note: in case of two-char bracket only latter is compared
404 (setq match (char-before (match-end 0))))
405 ;;; (message "%d" level) (sit-for 0 300)
406 (if (not (save-excursion (goto-char (match-end 0))
407 ;; skip over strings and comments
408 (LilyPond-inside-string-or-comment-p)))
409 (if (memq match '(?} ?> ?\] ?\)))
410 ;; count closing brackets
411 (progn (setq level (1+ level))
412 ;; slurs may be close to each other, e.g.,
413 ;; a single '>' was not matched .. need to be corrected
414 (if (and (eq dir 1) (eq (char-after (match-end 0)) match))
417 (setq level (1+ level))
419 ;;; (message "%d %c" level match) (sit-for 0 300)
421 (if (and (= match ?>)
422 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
424 ;; count opening brackets
425 (progn (setq level (1- level))
426 ;;; (message "%d %c" level match) (sit-for 0 300)
428 (if (and (= match ?<)
429 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
430 (forward-char 1))))))
431 ;; jump to the matching slur
434 (if (sequencep bracket-type)
435 ;; match the latter char in two-char brackets
436 (if (looking-at "..[][)(]") (forward-char 1)))
437 ;; if the following char is not already a slur
438 (if (and (not (looking-at "[)(]"))
439 ;; match the slur which follows
440 (looking-at ".[][><)(]")) (forward-char 1)))
444 (progn (goto-char oldpos)
448 (defun LilyPond-inside-scheme-p ()
449 "Tests if point is inside embedded Scheme code"
450 ;;; An user does not call this function directly, or by a key sequence.
452 (let ( (test-point (point))
455 (if (or (and (eq (char-after (point)) ?\()
457 (skip-chars-backward "'`")
458 (memq (char-before) '(?# ?$))))
459 (and (re-search-backward "[#$][`']?(" nil t)
463 (while (and (> level 0)
464 (re-search-forward "[()]" test-point t)
465 (setq match (char-after (match-beginning 0)))
466 (<= (point) test-point))
468 (setq level (1+ level))
469 (setq level (1- level))))
475 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
476 ;;; the Emacs distribution.
478 (defun LilyPond-blink-matching-paren (&optional dir)
479 "Move cursor momentarily to the beginning of the sexp before
480 point. In lilypond files this is used for closing ), ], } and >, whereas the
481 builtin 'blink-matching-open' is not used. In syntax table, see
482 `lilypond-font-lock.el', all brackets are punctuation characters."
483 ;;; An user does not call this function directly, or by a key sequence.
485 (let ( (oldpos (point))
488 (if (not (or (equal this-command 'LilyPond-electric-close-paren)
490 (goto-char (setq oldpos (- oldpos 1))))
491 ;; Test if a ligature \] or expressional slur \) was encountered
492 (setq bracket-type (char-after (point)))
493 (setq char-before-bracket-type nil)
494 (if (memq bracket-type '(?\] ?\) ?\[ ?\())
497 (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\)
498 (setq char-before-bracket-type (if char-before-bracket-type nil ?\\)))
499 (if (eq char-before-bracket-type ?\\)
500 (setq bracket-type (string char-before-bracket-type bracket-type)))))
501 (when blink-matching-paren-distance
503 (max (point-min) (- (point) blink-matching-paren-distance))
504 (min (point-max) (+ (point) blink-matching-paren-distance))))
505 (if (and (equal this-command 'LilyPond-electric-close-paren)
506 (memq bracket-type '(?> ?} ?< ?{)))
507 ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
508 (LilyPond-scan-containing-sexp nil nil dir)
509 ;; whereas ( ) slurs within music don't, so only need to search for ( )
510 ;; use same mechanism for [ ] slurs
511 (LilyPond-scan-containing-sexp bracket-type t dir))
512 (setq blinkpos (point))
514 (or (null (LilyPond-matching-paren (char-after blinkpos)))
515 (/= (char-after oldpos)
516 (LilyPond-matching-paren (char-after blinkpos)))))
517 (if mismatch (progn (setq blinkpos nil)
518 (message "Mismatched parentheses")))
520 (equal this-command 'LilyPond-electric-close-paren))
521 (if (pos-visible-in-window-p)
522 (and blink-matching-paren-on-screen
523 (sit-for blink-matching-delay))
526 ;; Show what precedes the open in its line, if anything.
528 (skip-chars-backward " \t")
530 (buffer-substring (progn (beginning-of-line) (point))
532 ;; Show what follows the open in its line, if anything.
535 (skip-chars-forward " \t")
537 (buffer-substring blinkpos
538 (progn (end-of-line) (point)))
539 ;; Otherwise show the previous nonblank line,
542 (skip-chars-backward "\n \t")
545 (buffer-substring (progn
546 (skip-chars-backward "\n \t")
550 (skip-chars-backward " \t")
552 ;; Replace the newline and other whitespace with `...'.
554 (buffer-substring blinkpos (1+ blinkpos)))
555 ;; There is nothing to show except the char itself.
556 (buffer-substring blinkpos (1+ blinkpos))))))))
557 (if (not (equal this-command 'LilyPond-electric-close-paren))
558 (goto-char (setq oldpos (+ oldpos 1)))
565 (defun LilyPond-electric-close-paren ()
566 "Blink on the matching open paren when a >, ), } or ] is inserted"
568 (let ((oldpos (point)))
569 (self-insert-command 1)
570 ;; Refontify buffer if a block-comment-ender '%}' is inserted
571 (if (and (eq (char-before (point)) ?})
572 (eq (char-before (- (point) 1)) ?%))
573 (font-lock-fontify-buffer)
574 ;; Match paren if the cursor is not inside string or comment.
575 (if (and blink-matching-paren
576 (not (LilyPond-inside-string-or-comment-p))
577 (save-excursion (re-search-backward
578 (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
579 (eq oldpos (1- (match-end 0)))))
580 (progn (backward-char 1)
581 (LilyPond-blink-matching-paren)
582 (forward-char 1))))))
584 (defun LilyPond-scan-sexps (pos dir)
585 "This function is redefined to be used in Emacs' show-paren-function and
586 in XEmacs' paren-highlight."
587 (LilyPond-blink-matching-paren dir))