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) "\\|")))))
343 (memq (char-after oldpos) '(?[ ?{ ?\()))
345 (while (and (if (not (eq dir 1))
349 (re-search-backward paren-regexp nil t)
350 (re-search-forward paren-regexp nil t))
351 (setq match (char-before (match-end 0))))
352 ;;; (message "%d" level) (sit-for 0 300)
353 (if (not (save-excursion (goto-char (match-end 0))
354 (LilyPond-inside-string-or-comment-p)))
355 (if (memq match '(?} ?> ?] ?\)))
356 (progn (setq level (1+ level))
357 ;; single '>' was not matched .. need to correct
358 (if (and (eq dir 1) (eq (char-after (match-end 0)) match))
361 (setq level (1+ level))
363 ;;; (message "%d %c" level match) (sit-for 0 300)
364 (if (and (= match ?>)
365 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
367 (progn (setq level (1- level))
368 ;;; (message "%d %c" level match) (sit-for 0 300)
369 (if (and (= match ?<)
370 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
371 (forward-char 1))))))
372 ;; jump to the matching slur
375 (if (sequencep bracket-type)
376 (if (looking-at "..[][)(]") (forward-char 1)))
377 (if (and (not (looking-at "[)(]"))
378 (looking-at ".[][><)(]")) (forward-char 1)))
382 (progn (goto-char oldpos)
386 (defun LilyPond-inside-scheme-p ()
387 "Tests if point is inside embedded Scheme code"
388 ;;; An user does not call this function directly, or by a key sequence.
390 (let ( (test-point (point))
393 (if (or (and (/= (point) (point-max))
394 (= (char-after (point)) ?\()
395 (or (= (char-after (- (point) 1)) ?#)
396 (and (= (char-after (- (point) 2)) ?#)
397 (= (char-after (- (point) 1)) ?`))))
398 (and (re-search-backward "#(\\|#`(" nil t)
402 (while (and (> level 0)
403 (re-search-forward "(\\|)" test-point t)
404 (setq match (char-after (match-beginning 0)))
405 (<= (point) test-point))
407 (setq level (1+ level))
408 (setq level (1- level))))
414 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
415 ;;; the Emacs distribution.
417 (defun LilyPond-blink-matching-paren (&optional dir)
418 "Move cursor momentarily to the beginning of the sexp before
419 point. In lilypond files this is used for closing ), ], } and >, whereas the
420 builtin 'blink-matching-open' is not used. In syntax table, see
421 `lilypond-font-lock.el', all brackets are punctuation characters."
422 ;;; An user does not call this function directly, or by a key sequence.
424 (let ( (oldpos (point))
427 (if (not (or (equal this-command 'LilyPond-electric-close-paren)
429 (goto-char (setq oldpos (- oldpos 1))))
430 ;; Test if a ligature \] or expressional slur \) was encountered
431 (setq bracket-type (char-after (point)))
432 (setq char-before-bracket-type nil)
433 (if (memq bracket-type '(?] ?\) ?[ ?\())
436 (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\)
437 (setq char-before-bracket-type (if char-before-bracket-type nil ?\\)))
438 (if (eq char-before-bracket-type ?\\)
439 (setq bracket-type (string char-before-bracket-type bracket-type)))))
440 (when blink-matching-paren-distance
442 (max (point-min) (- (point) blink-matching-paren-distance))
443 (min (point-max) (+ (point) blink-matching-paren-distance))))
444 (if (and (equal this-command 'LilyPond-electric-close-paren)
445 (memq bracket-type '(?> ?} ?< ?{)))
446 ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
447 (LilyPond-scan-containing-sexp nil nil dir)
448 ;; whereas ( ) slurs within music don't, so only need to search for ( )
449 ;; use same mechanism for [ ] slurs
450 (LilyPond-scan-containing-sexp bracket-type t dir))
451 (setq blinkpos (point))
453 (or (null (LilyPond-matching-paren (char-after blinkpos)))
454 (/= (char-after oldpos)
455 (LilyPond-matching-paren (char-after blinkpos)))))
456 (if mismatch (progn (setq blinkpos nil)
457 (message "Mismatched parentheses")))
459 (equal this-command 'LilyPond-electric-close-paren))
460 (if (pos-visible-in-window-p)
461 (and blink-matching-paren-on-screen
462 (sit-for blink-matching-delay))
465 ;; Show what precedes the open in its line, if anything.
467 (skip-chars-backward " \t")
469 (buffer-substring (progn (beginning-of-line) (point))
471 ;; Show what follows the open in its line, if anything.
474 (skip-chars-forward " \t")
476 (buffer-substring blinkpos
477 (progn (end-of-line) (point)))
478 ;; Otherwise show the previous nonblank line,
481 (skip-chars-backward "\n \t")
484 (buffer-substring (progn
485 (skip-chars-backward "\n \t")
489 (skip-chars-backward " \t")
491 ;; Replace the newline and other whitespace with `...'.
493 (buffer-substring blinkpos (1+ blinkpos)))
494 ;; There is nothing to show except the char itself.
495 (buffer-substring blinkpos (1+ blinkpos))))))))
496 (if (not (equal this-command 'LilyPond-electric-close-paren))
497 (goto-char (setq oldpos (+ oldpos 1)))
504 (defun LilyPond-electric-close-paren ()
505 "Blink on the matching open paren when a >, ), } or ] is inserted"
507 (let ((oldpos (point)))
508 (self-insert-command 1)
509 ;; Refontify buffer if a block-comment-ender '%}' is inserted
510 (if (and (eq (char-before (point)) ?})
511 (eq (char-before (- (point) 1)) ?%))
512 (font-lock-fontify-buffer)
513 ;; Match paren if the cursor is not inside string or comment.
514 (if (and blink-matching-paren
515 (not (LilyPond-inside-string-or-comment-p))
516 (save-excursion (re-search-backward
517 (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
518 (eq oldpos (1- (match-end 0)))))
519 (progn (backward-char 1)
520 (LilyPond-blink-matching-paren)
521 (forward-char 1))))))
524 (defun scan-sexps (pos dir)
525 "This function is redefined to be used in Emacs' show-paren-function and
526 in XEmacs' paren-highlight."
527 (LilyPond-blink-matching-paren dir))
529 ;; Emacs and XEmacs have slightly different names for parenthesis highlighting.
530 (if (not (string-match "XEmacs\\|Lucid" emacs-version))
532 (fset 'old-show-paren-function (symbol-function 'show-paren-function))
533 (defun show-paren-function ()
534 "Highlights the matching slur if cursor is moved before opening or
535 after closing slur. In this redefinition strings and comments are skipped."
536 (if (not (LilyPond-inside-string-or-comment-p))
537 (old-show-paren-function))))
539 ;; NOTE: paren-set-mode must be set before paren-highlight is redefined
540 (paren-set-mode 'paren)
541 (fset 'old-paren-highlight (symbol-function 'paren-highlight))
542 (defun paren-highlight ()
543 "Highlights the matching slur if cursor is moved before opening or
544 after closing slur. In this redefinition strings and comments are skipped."
545 (if (not (LilyPond-inside-string-or-comment-p))
546 (old-paren-highlight)))))