1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
3 ;;; Chris Jackson <chris@fluffhouse.org.uk>
4 ;;; some code is taken from ESS (Emacs Speaks Statistics) S-mode by A.J.Rossini <rossini@biostat.washington.edu>
6 ;;; Variables for customising indentation style
9 ;;; * emulate show-paren-mode, i.e., highlight the matching bracket if
10 ;;; - the cursor is on the matching opening bracket
11 ;;; - the cursor is after the matching closing bracket
12 ;;; * separate '('- and ')'-slurs from '\('- and '\)'-slurs.
13 ;;; * separate '['- and ']'-slurs from '\['- and '\]'-slurs.
15 (defcustom LilyPond-indent-level 4
16 "*Indentation of lilypond statements with respect to containing block.")
18 (defcustom LilyPond-brace-offset 0
19 "*Extra indentation for open braces.
20 Compares with other text in same context.")
22 (defcustom LilyPond-angle-offset 0
23 "*Extra indentation for open angled brackets .
24 Compares with other text in same context.")
26 (defcustom LilyPond-square-offset 0
27 "*Extra indentation for open square brackets .
28 Compares with other text in same context.")
30 (defcustom LilyPond-scheme-paren-offset 0
31 "*Extra indentation for open scheme parens .
32 Compares with other text in same context.")
34 (defcustom LilyPond-close-brace-offset 0
35 "*Extra indentation for closing braces.")
37 (defcustom LilyPond-close-angle-offset 0
38 "*Extra indentation for closing angle brackets.")
40 (defcustom LilyPond-close-square-offset 0
41 "*Extra indentation for closing square brackets.")
43 (defcustom LilyPond-close-scheme-paren-offset 0
44 "*Extra indentation for closing scheme parens.")
46 (defcustom LilyPond-fancy-comments t
47 "*Non-nil means distiguish between %, %%, and %%% for indentation.")
50 (defun LilyPond-calculate-indent ()
51 "Return appropriate indentation for current line as lilypond code.
52 In usual case returns an integer: the column to indent to.
53 Returns nil if line starts inside a string"
56 (let ((indent-point (point))
57 (case-fold-search nil)
59 (setq containing-sexp (save-excursion (LilyPond-beginning-of-containing-sexp)))
61 (while (< (point) indent-point)
62 (setq state (parse-partial-sexp (point) indent-point 0)))
63 ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
64 ;; with simpler parenthesis delimiters
66 ;; point is in the middle of a string
69 ;; point is in the middle of a block comment
70 (LilyPond-calculate-indent-within-blockcomment))
71 ((null containing-sexp)
72 ;; Line is at top level - no indent
76 ;; Find previous non-comment character.
77 (goto-char indent-point)
78 (LilyPond-backward-to-noncomment containing-sexp)
79 ;; Now we get the answer.
80 ;; Position following last unclosed open.
81 (goto-char containing-sexp)
83 ;; Is line first statement after an open brace or bracket?
84 ;; If no, find that first statement and indent like it.
87 ;; Skip over comments following open brace.
88 (skip-chars-forward " \t\n")
89 (cond ((looking-at "%{")
91 (and (not (looking-at "%}"))
92 (< (point) (point-max))))
94 (skip-chars-forward " \t\n"))
96 (skip-chars-forward " \t\n"))
98 (while (progn (skip-chars-forward " \t\n")
101 ;; The first following code counts
102 ;; if it is before the line we want to indent.
103 (and (< (point) indent-point)
105 ;; If no previous statement,
106 ;; indent it relative to line brace is on.
107 ;; For open brace in column zero, don't let statement
108 ;; start there too. If LilyPond-indent-level is zero, use
109 ;; LilyPond-brace-offset instead
110 (+ (if (and (bolp) (zerop LilyPond-indent-level))
111 (cond ((= (following-char) ?{)
112 LilyPond-brace-offset)
113 ((= (following-char) ?<)
114 LilyPond-angle-offset)
115 ((= (following-char) ?[)
116 LilyPond-square-offset)
117 ((= (following-char) ?\))
118 LilyPond-scheme-paren-offset)
121 LilyPond-indent-level)
123 (skip-chars-backward " \t")
124 (current-indentation)))))))))
128 (defun LilyPond-indent-line ()
129 "Indent current line as lilypond code.
130 Return the amount the indentation changed by."
131 (let ((indent (LilyPond-calculate-indent))
133 (case-fold-search nil)
134 (pos (- (point-max) (point))))
137 (cond ((eq indent nil)
138 (setq indent (current-indentation)))
140 (skip-chars-forward " \t")
141 (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
143 (if (and LilyPond-fancy-comments
145 (not (looking-at "%%\\|%{\\|%}")))
146 (setq indent comment-column)
147 (if (eq indent t) (setq indent 0))
148 (if (listp indent) (setq indent (car indent)))
150 ((= (following-char) ?})
151 (setq indent (+ indent (- LilyPond-close-brace-offset LilyPond-indent-level))))
152 ((= (following-char) ?>)
153 (setq indent (+ indent (- LilyPond-close-angle-offset LilyPond-indent-level))))
154 ((= (following-char) ?])
155 (setq indent (+ indent (- LilyPond-close-square-offset LilyPond-indent-level))))
156 ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p))
157 (setq indent (+ indent (- LilyPond-close-scheme-paren-offset LilyPond-indent-level))))
158 ((= (following-char) ?{)
159 (setq indent (+ indent LilyPond-brace-offset)))
160 ((= (following-char) ?<)
161 (setq indent (+ indent LilyPond-angle-offset)))
162 ((= (following-char) ?[)
163 (setq indent (+ indent LilyPond-square-offset)))
164 ((and (= (following-char) ?\() (LilyPond-inside-scheme-p))
165 (setq indent (+ indent LilyPond-scheme-paren-offset)))
167 (skip-chars-forward " \t")
168 (setq shift-amt (- indent (current-column)))
169 (if (zerop shift-amt)
170 (if (> (- (point-max) pos) (point))
171 (goto-char (- (point-max) pos)))
172 (delete-region beg (point))
174 ;; If initial point was within line's indentation,
175 ;; position after the indentation.
176 ;; Else stay at same point in text.
177 (if (> (- (point-max) pos) (point))
178 (goto-char (- (point-max) pos))))
182 (defun LilyPond-inside-comment-p ()
183 "Return non-nil if point is inside a line or block comment"
184 (setq this-point (point))
185 (or (save-excursion (beginning-of-line)
186 (skip-chars-forward " \t")
189 ;; point is in the middle of a block comment
190 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" (point-min) t)))
191 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" (point-min) t)))
192 (if (or (and (= (char-before) ?%) (= (char-after) ?{))
193 (and (= (char-after) ?%) (= (char-after (1+ (point))) ?{)))
194 (setq lastopen (save-excursion (backward-char) (point))))
198 (<= lastclose lastopen))))
202 (defun LilyPond-inside-string-or-comment-p ()
203 "Test if point is inside a string or a comment"
204 (setq this-point (point))
205 (or (save-excursion (beginning-of-line)
206 (skip-chars-forward " \t")
210 (while (< (point) this-point)
211 (setq state (parse-partial-sexp (point) this-point 0)))
213 ;; point is in the middle of a string
216 ;; point is in the middle of a block comment
222 (defun LilyPond-backward-over-blockcomments (lim)
223 "Move point back to closest non-whitespace character not part of a block comment"
224 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
225 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
228 (if (<= lastclose lastopen)
229 (goto-char lastopen))
230 (goto-char lastopen)))
231 (skip-chars-backward " %\t\n\f"))
234 (defun LilyPond-backward-over-linecomments (lim)
235 "Move point back to the closest non-whitespace character not part of a line comment.
239 (skip-chars-backward " \t\n\f" lim)
240 (setq opoint (point))
242 (search-forward "%" opoint 'move)
243 (skip-chars-backward " \t%")
244 (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
246 (beginning-of-line)))))
249 (defun LilyPond-backward-to-noncomment (lim)
250 "Move point back to closest non-whitespace character not part of a comment"
251 (LilyPond-backward-over-linecomments lim)
252 (LilyPond-backward-over-blockcomments lim))
255 (defun LilyPond-calculate-indent-within-blockcomment ()
256 "Return the indentation amount for line inside a block comment."
257 (let (end percent-start)
260 (skip-chars-forward " \t")
261 (skip-chars-backward " \t\n")
264 (skip-chars-forward " \t")
265 (and (re-search-forward "%{[ \t]*" end t)
266 (goto-char (1+ (match-beginning 0))))
267 (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
268 (1+ (current-column))
272 ;; Key: Type of bracket (character).
273 ;; Value: Pair of regexps representing the corresponding open and close bracket
274 ;; () are treated specially (need to indent in Scheme but not in music)
276 (defconst LilyPond-parens-regexp-alist
277 `( ( ?> . ("\\([^\\]\\|^\\)<" . "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>"))
278 ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
279 ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
280 ;; also \> and \< are hairpins
282 ;; ligatures '\[ ... \]' are skipped in the following expression
283 ( ?] . ("\\([^\\]\\|^\\)[[]" . "\\([^\\]\\|^\\)[]]"))
287 (defconst LilyPond-parens-alist
295 (defun LilyPond-matching-paren (bracket-type)
296 "Returns the open corresponding to the close specified by bracket-type, or vice versa"
297 (cond ( (memq bracket-type (mapcar 'car LilyPond-parens-alist))
298 (cdr (assoc bracket-type LilyPond-parens-alist)) )
299 ( (memq bracket-type (mapcar 'cdr LilyPond-parens-alist))
300 (car (rassoc bracket-type LilyPond-parens-alist)) )
304 (defun LilyPond-beginning-of-containing-sexp (&optional bracket-type slur-paren-p)
305 "Move point to the beginning of the deepest parenthesis pair enclosing point.
307 If the optional argument bracket-type, a character representing a
308 close bracket such as ) or }, is specified, then the parenthesis pairs
309 searched are limited to this type.
311 If the optional argument slur-paren-p is non-nil, then slur
312 parentheses () are considered as matching pairs. Otherwise Scheme
313 parentheses are considered to be matching pairs, but slurs are not.
314 slur-paren-p defaults to nil.
316 ;;; An user does not call this function directly, or by a key sequence.
319 (regexp-alist LilyPond-parens-regexp-alist)
321 (if (LilyPond-inside-scheme-p)
322 (setq paren-regexp "(\\|)")
324 ;; expressional slurs '\( ... \)' are not taken into account
325 (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\|^\\)(" . "\\([^\\]\\|^\\))")) regexp-alist)))
326 (if (memq bracket-type (mapcar 'car regexp-alist))
327 (progn (setq paren-regexp (cdr (assoc bracket-type regexp-alist)))
328 (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
329 (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
330 (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
331 (while (and (> level 0)
332 (re-search-backward paren-regexp nil t)
333 (setq match (char-before (match-end 0))))
334 (if (not (save-excursion (goto-char (match-end 0))
335 (LilyPond-inside-string-or-comment-p)))
336 (if (memq match '(?} ?> ?] ?\)))
337 (progn (setq level (1+ level))
338 (if (and (= match ?>)
339 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
341 (progn (setq level (1- level))
342 (if (and (= match ?<)
343 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
344 (forward-char 1))))))
345 ;; somehow here two-char brackets \<, \>, \[, \], \(, \) are handled
346 (if (looking-at ".<\\|.>\\|.[][)(]") (forward-char 1))
349 (progn (goto-char oldpos)
353 (defun LilyPond-inside-scheme-p ()
354 "Tests if point is inside embedded Scheme code"
355 ;;; An user does not call this function directly, or by a key sequence.
357 (let ( (test-point (point))
360 (if (or (and (/= (point) (point-max))
361 (= (char-after (point)) ?\()
362 (or (= (char-after (- (point) 1)) ?#)
363 (and (= (char-after (- (point) 2)) ?#)
364 (= (char-after (- (point) 1)) ?`))))
365 (and (re-search-backward "#(\\|#`(" nil t)
369 (while (and (> level 0)
370 (re-search-forward "(\\|)" test-point t)
371 (setq match (char-after (match-beginning 0)))
372 (<= (point) test-point))
374 (setq level (1+ level))
375 (setq level (1- level))))
381 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
382 ;;; the Emacs distribution.
384 (defun LilyPond-blink-matching-open (bracket-type char-before-bracket-type)
385 "Move cursor momentarily to the beginning of the sexp before
386 point. In lilypond files this is used for closing ), ], } and >, whereas the
387 builtin 'blink-matching-open' is not used. In syntax table, see
388 `lilypond-font-lock.el', all brackets are punctuation characters."
389 ;;; An user does not call this function directly, or by a key sequence.
391 (let ( (oldpos (point))
394 (if (eq char-before-bracket-type ?\\)
395 (if (eq bracket-type ?])
396 (message "trying to match ligatures \\[ ... \\]")
397 (message "trying to match slurs \\( ... \\)")))
399 (if blink-matching-paren-distance
400 (narrow-to-region (max (point-min)
401 (- (point) blink-matching-paren-distance))
403 (if (memq bracket-type '(?> ?} ?]))
404 ;; < { [ need to be mutually balanced and nested, so search backwards for both of these bracket types
405 (LilyPond-beginning-of-containing-sexp nil nil)
406 ;; whereas ( ) slurs within music don't, so only need to search for ( )
407 (LilyPond-beginning-of-containing-sexp bracket-type t))
408 (setq blinkpos (point))
410 (or (null (LilyPond-matching-paren (char-after blinkpos)))
411 (/= (char-after oldpos)
412 (LilyPond-matching-paren (char-after blinkpos)))))
413 (if mismatch (progn (setq blinkpos nil)
414 (message "Mismatched parentheses")))
416 (if (pos-visible-in-window-p)
417 (and blink-matching-paren-on-screen
418 (sit-for blink-matching-delay))
421 ;; Show what precedes the open in its line, if anything.
423 (skip-chars-backward " \t")
425 (buffer-substring (progn (beginning-of-line) (point))
427 ;; Show what follows the open in its line, if anything.
430 (skip-chars-forward " \t")
432 (buffer-substring blinkpos
433 (progn (end-of-line) (point)))
434 ;; Otherwise show the previous nonblank line,
437 (skip-chars-backward "\n \t")
440 (buffer-substring (progn
441 (skip-chars-backward "\n \t")
445 (skip-chars-backward " \t")
447 ;; Replace the newline and other whitespace with `...'.
449 (buffer-substring blinkpos (1+ blinkpos)))
450 ;; There is nothing to show except the char itself.
451 (buffer-substring blinkpos (1+ blinkpos))))))))
455 (defun LilyPond-electric-close-paren ()
456 "Blink on the matching open paren when a >, ), } or ] is inserted"
458 (let ((oldpos (point)))
459 (self-insert-command 1)
460 (setq close-char (char-before (point)))
461 ;; Test if a ligature \] or expressional slur \) was encountered;
462 ;; the result is now in backslashed-close-char, BUT
463 ;; the result should also be used -- match also \] or \) !
464 ;; Thus, update: LilyPond-parens-regexp-alist, LilyPond-blink-matching-open
465 (setq char-before-close-char nil)
466 (if (memq close-char '(?] ?\)))
469 (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\)
470 (setq char-before-close-char (if char-before-close-char nil ?\\)))))
471 (if (and blink-matching-paren
472 (not (LilyPond-inside-string-or-comment-p))
473 (save-excursion (re-search-backward
474 (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
475 (eq oldpos (1- (match-end 0)))))
476 (progn (backward-char 1)
477 (LilyPond-blink-matching-open close-char char-before-close-char)