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.
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 ( ( ) )
16 ;;; * in syntax-highlighting slurs are not always highlighted the right way
17 ;;; e.g. opening slurs are found found better in "#( ( ) ( ) )" than
19 ;;; * is locality of show-paren-function and paren-highlight possible?
21 (defcustom LilyPond-indent-level 4
22 "*Indentation of lilypond statements with respect to containing block.")
24 (defcustom LilyPond-brace-offset 0
25 "*Extra indentation for open braces.
26 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.")
32 (defcustom LilyPond-square-offset 0
33 "*Extra indentation for open square brackets.
34 Compares with other text in same context.")
36 (defcustom LilyPond-scheme-paren-offset 0
37 "*Extra indentation for open scheme parens.
38 Compares with other text in same context.")
40 (defcustom LilyPond-close-brace-offset 0
41 "*Extra indentation for closing braces.")
43 (defcustom LilyPond-close-angle-offset 0
44 "*Extra indentation for closing angle brackets.")
46 (defcustom LilyPond-close-square-offset 0
47 "*Extra indentation for closing square brackets.")
49 (defcustom LilyPond-close-scheme-paren-offset 0
50 "*Extra indentation for closing scheme parens.")
52 (defcustom LilyPond-fancy-comments t
53 "*Non-nil means distiguish between %, %%, and %%% for indentation.")
55 (defcustom LilyPond-comment-region "%%$"
56 "*String inserted by \\[LilyPond-comment-region]\
57 at start of each line in region.")
59 (defun LilyPond-comment-region (beg-region end-region)
60 "Comment/uncomment every line in the region.
61 Insert LilyPond-comment-region at the beginning of every line in the region
62 or, if already present, remove it."
64 (let ((end (make-marker)))
65 (set-marker end end-region)
66 (goto-char beg-region)
68 (if (looking-at (regexp-quote LilyPond-comment-region))
69 (delete-region (point) (match-end 0))
70 (insert LilyPond-comment-region))
71 (while (and (zerop (forward-line 1))
72 (< (point) (marker-position end)))
73 (if (looking-at (regexp-quote LilyPond-comment-region))
74 (delete-region (point) (match-end 0))
75 (insert LilyPond-comment-region)))
76 (set-marker end nil)))
78 (defun LilyPond-calculate-indent ()
79 "Return appropriate indentation for current line as lilypond code.
80 In usual case returns an integer: the column to indent to.
81 Returns nil if line starts inside a string"
84 (let ((indent-point (point))
85 (case-fold-search nil)
87 (setq containing-sexp (save-excursion (LilyPond-scan-containing-sexp)))
89 (while (< (point) indent-point)
90 (setq state (parse-partial-sexp (point) indent-point 0)))
91 ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
92 ;; with simpler parenthesis delimiters
94 ;; point is in the middle of a string
97 ;; point is in the middle of a block comment
98 (LilyPond-calculate-indent-within-blockcomment))
99 ((null containing-sexp)
100 ;; Line is at top level - no indent
104 ;; Find previous non-comment character.
105 (goto-char indent-point)
106 (LilyPond-backward-to-noncomment containing-sexp)
107 ;; Now we get the answer.
108 ;; Position following last unclosed open.
109 (goto-char containing-sexp)
111 ;; Is line first statement after an open brace or bracket?
112 ;; If no, find that first statement and indent like it.
115 ;; Skip over comments following open brace.
116 (skip-chars-forward " \t\n")
117 (cond ((looking-at "%{")
119 (and (not (looking-at "%}"))
120 (< (point) (point-max))))
122 (skip-chars-forward " \t\n"))
124 (skip-chars-forward " \t\n"))
126 (while (progn (skip-chars-forward " \t\n")
129 ;; The first following code counts
130 ;; if it is before the line we want to indent.
131 (and (< (point) indent-point)
133 ;; If no previous statement,
134 ;; indent it relative to line brace is on.
135 ;; For open brace in column zero, don't let statement
136 ;; start there too. If LilyPond-indent-level is zero, use
137 ;; LilyPond-brace-offset instead
138 (+ (if (and (bolp) (zerop LilyPond-indent-level))
139 (cond ((= (following-char) ?{)
140 LilyPond-brace-offset)
141 ((= (following-char) ?<)
142 LilyPond-angle-offset)
143 ((= (following-char) ?[)
144 LilyPond-square-offset)
145 ((= (following-char) ?\))
146 LilyPond-scheme-paren-offset)
149 LilyPond-indent-level)
151 (skip-chars-backward " \t")
152 (current-indentation)))))))))
155 (defun LilyPond-indent-line ()
156 "Indent current line as lilypond code.
157 Return the amount the indentation changed by."
158 (let ((indent (LilyPond-calculate-indent))
160 (case-fold-search nil)
161 (pos (- (point-max) (point))))
164 (cond ((eq indent nil)
165 (setq indent (current-indentation)))
167 (skip-chars-forward " \t")
168 (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
170 (if (and LilyPond-fancy-comments
172 (not (looking-at "%%\\|%{\\|%}")))
173 (setq indent comment-column)
174 (if (eq indent t) (setq indent 0))
175 (if (listp indent) (setq indent (car indent)))
177 ((= (following-char) ?})
178 (setq indent (+ indent (- LilyPond-close-brace-offset LilyPond-indent-level))))
179 ((= (following-char) ?>)
180 (setq indent (+ indent (- LilyPond-close-angle-offset LilyPond-indent-level))))
181 ((= (following-char) ?])
182 (setq indent (+ indent (- LilyPond-close-square-offset LilyPond-indent-level))))
183 ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p))
184 (setq indent (+ indent (- LilyPond-close-scheme-paren-offset LilyPond-indent-level))))
185 ((= (following-char) ?{)
186 (setq indent (+ indent LilyPond-brace-offset)))
187 ((= (following-char) ?<)
188 (setq indent (+ indent LilyPond-angle-offset)))
189 ((= (following-char) ?[)
190 (setq indent (+ indent LilyPond-square-offset)))
191 ((and (= (following-char) ?\() (LilyPond-inside-scheme-p))
192 (setq indent (+ indent LilyPond-scheme-paren-offset)))
194 (skip-chars-forward " \t")
195 (setq shift-amt (- indent (current-column)))
196 (if (zerop shift-amt)
197 (if (> (- (point-max) pos) (point))
198 (goto-char (- (point-max) pos)))
199 (delete-region beg (point))
201 ;; If initial point was within line's indentation,
202 ;; position after the indentation.
203 ;; Else stay at same point in text.
204 (if (> (- (point-max) pos) (point))
205 (goto-char (- (point-max) pos))))
209 (defun LilyPond-inside-comment-p ()
210 "Return non-nil if point is inside a line or block comment"
211 (setq this-point (point))
212 (or (save-excursion (beginning-of-line)
213 (skip-chars-forward " \t")
216 ;; point is in the middle of a block comment
217 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" (point-min) t)))
218 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" (point-min) t)))
219 (if (or (and (= (char-before) ?%) (= (char-after) ?{))
220 (and (= (char-after) ?%) (= (char-after (1+ (point))) ?{)))
221 (setq lastopen (save-excursion (backward-char) (point))))
225 (<= lastclose lastopen))))
229 (defun LilyPond-inside-string-or-comment-p ()
230 "Test if point is inside a string or a comment"
231 (setq this-point (point))
232 (or (save-excursion (beginning-of-line)
233 (skip-chars-forward " \t")
237 (while (< (point) this-point)
238 (setq state (parse-partial-sexp (point) this-point 0)))
240 ;; point is in the middle of a string
243 ;; point is in the middle of a block comment
249 (defun LilyPond-backward-over-blockcomments (lim)
250 "Move point back to closest non-whitespace character not part of a block comment"
251 (setq lastopen (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
252 (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
255 (if (<= lastclose lastopen)
256 (goto-char lastopen))
257 (goto-char lastopen)))
258 (skip-chars-backward " %\t\n\f"))
261 (defun LilyPond-backward-over-linecomments (lim)
262 "Move point back to the closest non-whitespace character not part of a line comment.
266 (skip-chars-backward " \t\n\f" lim)
267 (setq opoint (point))
269 (search-forward "%" opoint 'move)
270 (skip-chars-backward " \t%")
271 (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
273 (beginning-of-line)))))
276 (defun LilyPond-backward-to-noncomment (lim)
277 "Move point back to closest non-whitespace character not part of a comment"
278 (LilyPond-backward-over-linecomments lim)
279 (LilyPond-backward-over-blockcomments lim))
282 (defun LilyPond-calculate-indent-within-blockcomment ()
283 "Return the indentation amount for line inside a block comment."
284 (let (end percent-start)
287 (skip-chars-forward " \t")
288 (skip-chars-backward " \t\n")
291 (skip-chars-forward " \t")
292 (and (re-search-forward "%{[ \t]*" end t)
293 (goto-char (1+ (match-beginning 0))))
294 (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
295 (1+ (current-column))
299 ;; Key: Type of bracket (character).
300 ;; Value: Pair of regexps representing the corresponding open and close bracket
301 ;; () are treated specially (need to indent in Scheme but not in music)
303 (defconst LilyPond-parens-regexp-alist
304 `( ( ?> . ("\\([^\\]\\|^\\)<" . "\\([^ \\n\\t_^-]\\|[_^-][-^]\\|\\s-\\)\\s-*>"))
305 ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
306 ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
307 ;; also \> and \< are hairpins
308 ;; duh .. a single '>', as in chords '<< ... >>', was not matched here
310 ;; ligatures '\[ ... \]' are skipped in the following expression
311 ( ?] . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]"))
312 ( "\\]" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]"))
313 ( "\\)" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]"))
317 (defconst LilyPond-parens-alist
327 (defun LilyPond-matching-paren (bracket-type)
328 "Returns the open corresponding to the close specified by bracket-type, or vice versa"
329 (cond ( (member bracket-type (mapcar 'car LilyPond-parens-alist))
330 (cdr (assoc bracket-type LilyPond-parens-alist)) )
331 ( (member bracket-type (mapcar 'cdr LilyPond-parens-alist))
332 (car (rassoc bracket-type LilyPond-parens-alist)) )
336 (defun LilyPond-scan-containing-sexp (&optional bracket-type slur-paren-p dir)
337 "Move point to the beginning of the deepest parenthesis pair enclosing point.
339 If the optional argument bracket-type, a character representing a
340 close bracket such as ) or }, is specified, then the parenthesis pairs
341 searched are limited to this type.
343 If the optional argument slur-paren-p is non-nil, then slur
344 parentheses () are considered as matching pairs. Otherwise Scheme
345 parentheses are considered to be matching pairs, but slurs are not.
346 slur-paren-p defaults to nil.
348 ;;; An user does not call this function directly, or by a key sequence.
350 (let ( (level (if (not (eq dir 1)) 1 -1))
351 (regexp-alist LilyPond-parens-regexp-alist)
353 (assoc-bracket-type (if (not (eq dir 1)) bracket-type (LilyPond-matching-paren bracket-type))))
355 (if (LilyPond-inside-scheme-p)
356 (setq paren-regexp "(\\|)")
358 ;; expressional slurs '\( ... \)' are not taken into account
359 (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" . "\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist)))
360 (if (member assoc-bracket-type (mapcar 'car regexp-alist))
361 (progn (setq paren-regexp (cdr (assoc assoc-bracket-type regexp-alist)))
362 (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
363 (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
364 (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
365 ;; match concurrent one-char opening and closing slurs
367 (not (sequencep bracket-type))
368 (eq (char-syntax (char-after oldpos)) ?\()
369 (not (eq (char-after oldpos) ?<)))
370 ;; anyway do not count open slur, since already level = -1
371 (progn (forward-char 1)
372 (if (eq (following-char)
373 (LilyPond-matching-paren (char-after oldpos)))
374 ;; matching char found, go after it and set level = 0
375 (progn (forward-char 1)
377 ;; browse the code until matching slur is found, or report mismatch
378 (while (and (if (not (eq dir 1))
381 ;; dir tells whether to search backward or forward
383 (re-search-backward paren-regexp nil t)
384 (re-search-forward paren-regexp nil t))
385 ;; note: in case of two-char bracket only latter is compared
386 (setq match (char-before (match-end 0))))
387 ;;; (message "%d" level) (sit-for 0 300)
388 (if (not (save-excursion (goto-char (match-end 0))
389 ;; skip over strings and comments
390 (LilyPond-inside-string-or-comment-p)))
391 (if (memq match '(?} ?> ?] ?\)))
392 ;; count closing brackets
393 (progn (setq level (1+ level))
394 ;; slurs may be close to each other, e.g.,
395 ;; a single '>' was not matched .. need to be corrected
396 (if (and (eq dir 1) (eq (char-after (match-end 0)) match))
399 (setq level (1+ level))
401 ;;; (message "%d %c" level match) (sit-for 0 300)
403 (if (and (= match ?>)
404 (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
406 ;; count opening brackets
407 (progn (setq level (1- level))
408 ;;; (message "%d %c" level match) (sit-for 0 300)
410 (if (and (= match ?<)
411 (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
412 (forward-char 1))))))
413 ;; jump to the matching slur
416 (if (sequencep bracket-type)
417 ;; match the latter char in two-char brackets
418 (if (looking-at "..[][)(]") (forward-char 1)))
419 ;; if the following char is not already a slur
420 (if (and (not (looking-at "[)(]"))
421 ;; match the slur which follows
422 (looking-at ".[][><)(]")) (forward-char 1)))
426 (progn (goto-char oldpos)
430 (defun LilyPond-inside-scheme-p ()
431 "Tests if point is inside embedded Scheme code"
432 ;;; An user does not call this function directly, or by a key sequence.
434 (let ( (test-point (point))
437 (if (or (and (/= (point) (point-max))
438 (= (char-after (point)) ?\()
439 (or (= (char-after (- (point) 1)) ?#)
440 (and (= (char-after (- (point) 2)) ?#)
441 (= (char-after (- (point) 1)) ?`))))
442 (and (re-search-backward "#(\\|#`(" nil t)
446 (while (and (> level 0)
447 (re-search-forward "(\\|)" test-point t)
448 (setq match (char-after (match-beginning 0)))
449 (<= (point) test-point))
451 (setq level (1+ level))
452 (setq level (1- level))))
458 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
459 ;;; the Emacs distribution.
461 (defun LilyPond-blink-matching-paren (&optional dir)
462 "Move cursor momentarily to the beginning of the sexp before
463 point. In lilypond files this is used for closing ), ], } and >, whereas the
464 builtin 'blink-matching-open' is not used. In syntax table, see
465 `lilypond-font-lock.el', all brackets are punctuation characters."
466 ;;; An user does not call this function directly, or by a key sequence.
468 (let ( (oldpos (point))
471 (if (not (or (equal this-command 'LilyPond-electric-close-paren)
473 (goto-char (setq oldpos (- oldpos 1))))
474 ;; Test if a ligature \] or expressional slur \) was encountered
475 (setq bracket-type (char-after (point)))
476 (setq char-before-bracket-type nil)
477 (if (memq bracket-type '(?] ?\) ?[ ?\())
480 (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\)
481 (setq char-before-bracket-type (if char-before-bracket-type nil ?\\)))
482 (if (eq char-before-bracket-type ?\\)
483 (setq bracket-type (string char-before-bracket-type bracket-type)))))
484 (when blink-matching-paren-distance
486 (max (point-min) (- (point) blink-matching-paren-distance))
487 (min (point-max) (+ (point) blink-matching-paren-distance))))
488 (if (and (equal this-command 'LilyPond-electric-close-paren)
489 (memq bracket-type '(?> ?} ?< ?{)))
490 ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
491 (LilyPond-scan-containing-sexp nil nil dir)
492 ;; whereas ( ) slurs within music don't, so only need to search for ( )
493 ;; use same mechanism for [ ] slurs
494 (LilyPond-scan-containing-sexp bracket-type t dir))
495 (setq blinkpos (point))
497 (or (null (LilyPond-matching-paren (char-after blinkpos)))
498 (/= (char-after oldpos)
499 (LilyPond-matching-paren (char-after blinkpos)))))
500 (if mismatch (progn (setq blinkpos nil)
501 (message "Mismatched parentheses")))
503 (equal this-command 'LilyPond-electric-close-paren))
504 (if (pos-visible-in-window-p)
505 (and blink-matching-paren-on-screen
506 (sit-for blink-matching-delay))
509 ;; Show what precedes the open in its line, if anything.
511 (skip-chars-backward " \t")
513 (buffer-substring (progn (beginning-of-line) (point))
515 ;; Show what follows the open in its line, if anything.
518 (skip-chars-forward " \t")
520 (buffer-substring blinkpos
521 (progn (end-of-line) (point)))
522 ;; Otherwise show the previous nonblank line,
525 (skip-chars-backward "\n \t")
528 (buffer-substring (progn
529 (skip-chars-backward "\n \t")
533 (skip-chars-backward " \t")
535 ;; Replace the newline and other whitespace with `...'.
537 (buffer-substring blinkpos (1+ blinkpos)))
538 ;; There is nothing to show except the char itself.
539 (buffer-substring blinkpos (1+ blinkpos))))))))
540 (if (not (equal this-command 'LilyPond-electric-close-paren))
541 (goto-char (setq oldpos (+ oldpos 1)))
548 (defun LilyPond-electric-close-paren ()
549 "Blink on the matching open paren when a >, ), } or ] is inserted"
551 (let ((oldpos (point)))
552 (self-insert-command 1)
553 ;; Refontify buffer if a block-comment-ender '%}' is inserted
554 (if (and (eq (char-before (point)) ?})
555 (eq (char-before (- (point) 1)) ?%))
556 (font-lock-fontify-buffer)
557 ;; Match paren if the cursor is not inside string or comment.
558 (if (and blink-matching-paren
559 (not (LilyPond-inside-string-or-comment-p))
560 (save-excursion (re-search-backward
561 (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
562 (eq oldpos (1- (match-end 0)))))
563 (progn (backward-char 1)
564 (LilyPond-blink-matching-paren)
565 (forward-char 1))))))
567 (defun LilyPond-scan-sexps (pos dir)
568 "This function is redefined to be used in Emacs' show-paren-function and
569 in XEmacs' paren-highlight."
570 (LilyPond-blink-matching-paren dir))
572 ;;; REDEFINITIONS: in future make show-paren-mode and paren-highlight local?
574 ;;; From Emacs' paren.el, with minimal changes (see "LilyPond"-lines)
575 ;; Find the place to show, if there is one,
576 ;; and show it until input arrives.
577 ; (defun show-paren-function ()
580 ;; don't redefine emacs functions. It breaks other modes.
582 (defun LilyPond-show-paren-function () ; make show-paren-function local ??
584 (let (pos dir mismatch face (oldpos (point)))
585 (cond ((eq (char-syntax (preceding-char)) ?\))
587 ((eq (char-syntax (following-char)) ?\()
590 ;; Find the other end of the sexp.
592 (not (LilyPond-inside-string-or-comment-p)))
595 ;; Determine the range within which to look for a match.
596 (when blink-matching-paren-distance
598 (max (point-min) (- (point) blink-matching-paren-distance))
599 (min (point-max) (+ (point) blink-matching-paren-distance))))
600 ;; Scan across one sexp within that range.
601 ;; Errors or nil mean there is a mismatch.
603 (setq pos (LilyPond-scan-sexps (point) dir))
604 (error (setq pos t mismatch t)))
605 ;; If found a "matching" paren, see if it is the right
606 ;; kind of paren to match the one we started at.
608 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
609 (when (/= (char-syntax (char-after beg)) ?\$)
611 (not (eq (char-before end)
612 ;; This can give nil.
613 (matching-paren (char-after beg)))))))))))
615 ;; Highlight the other end of the sexp, or unhighlight if none.
618 ;; If not at a paren that has a match,
619 ;; turn off any previous paren highlighting.
620 (and show-paren-overlay (overlay-buffer show-paren-overlay)
621 (delete-overlay show-paren-overlay))
622 (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
623 (delete-overlay show-paren-overlay-1)))
625 ;; Use the correct face.
628 (if show-paren-ring-bell-on-mismatch
630 (setq face 'show-paren-mismatch-face))
631 (setq face 'show-paren-match-face))
633 ;; If matching backwards, highlight the closeparen
634 ;; before point as well as its matching open.
635 ;; If matching forward, and the openparen is unbalanced,
636 ;; highlight the paren at point to indicate misbalance.
637 ;; Otherwise, turn off any such highlighting.
638 (if (and (= dir 1) (integerp pos))
639 (when (and show-paren-overlay-1
640 (overlay-buffer show-paren-overlay-1))
641 (delete-overlay show-paren-overlay-1))
642 (let ((from (if (= dir 1)
648 (if show-paren-overlay-1
649 (move-overlay show-paren-overlay-1 from to (current-buffer))
650 (setq show-paren-overlay-1 (make-overlay from to)))
651 ;; Always set the overlay face, since it varies.
652 (overlay-put show-paren-overlay-1 'priority show-paren-priority)
653 (overlay-put show-paren-overlay-1 'face face)))
655 ;; Turn on highlighting for the matching paren, if found.
656 ;; If it's an unmatched paren, turn off any such highlighting.
657 (unless (integerp pos)
658 (delete-overlay show-paren-overlay))
659 (let ((to (if (or (eq show-paren-style 'expression)
660 (and (eq show-paren-style 'mixed)
661 (not (pos-visible-in-window-p pos))))
664 (from (if (or (eq show-paren-style 'expression)
665 (and (eq show-paren-style 'mixed)
666 (not (pos-visible-in-window-p pos))))
670 (forward-point (- dir))))))
671 (if show-paren-overlay
672 (move-overlay show-paren-overlay from to (current-buffer))
673 (setq show-paren-overlay (make-overlay from to))))
675 ;; Always set the overlay face, since it varies.
676 (overlay-put show-paren-overlay 'priority show-paren-priority)
677 (overlay-put show-paren-overlay 'face face)))
678 ;; show-paren-mode is nil in this buffer.
679 (and show-paren-overlay
680 (delete-overlay show-paren-overlay))
681 (and show-paren-overlay-1
682 (delete-overlay show-paren-overlay-1))))
684 ;;; From XEmacs' paren.el, with minimal changes (see "LilyPond"-lines)
685 ;; Find the place to show, if there is one,
686 ;; and show it until input arrives.
687 (if (string-match "XEmacs\\|Lucid" emacs-version)
688 (paren-set-mode 'paren)) ; works if this is set here (, right place?)
689 ;(defun paren-highlight ()
690 (defun LilyPond-paren-highlight () ; make paren-highlight local ??
691 "This highlights matching parentheses.
694 paren-message-offscreen use modeline when matching paren is offscreen?
695 paren-ding-unmatched make noise when passing over mismatched parens?
696 paren-mode 'blink-paren, 'paren, or 'sexp
697 blink-matching-paren-distance maximum distance to search for parens.
699 and the following faces:
700 paren-match, paren-mismatch, paren-blink-off"
702 ;; I suppose I could check here to see if a keyboard macro is executing,
703 ;; but I did a quick empirical check and couldn't tell that there was any
704 ;; difference in performance
706 (let ((oldpos (point))
707 (pface nil) ; face for paren...nil kills the overlay
709 (not (input-pending-p))
710 (not executing-kbd-macro)
711 (cond ((eq (char-syntax (preceding-char)) ?\))
713 ((eq (char-syntax (following-char)) ?\()
719 (LilyPond-inside-string-or-comment-p)
720 (not (save-restriction
721 ;; Determine the range within which to look for a match.
722 (if blink-matching-paren-distance
725 (- (point) blink-matching-paren-distance))
727 (+ (point) blink-matching-paren-distance))))
729 ;; Scan across one sexp within that range.
731 (setq pos (LilyPond-scan-sexps (point) dir))
732 ;; NOTE - if blink-matching-paren-distance is set,
733 ;; then we can have spurious unmatched parens.
734 (error (paren-maybe-ding)
737 ;; do nothing if we didn't find a matching paren...
740 ;; See if the "matching" paren is the right kind of paren
741 ;; to match the one we started at.
742 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
744 (and (/= (char-syntax (char-after beg)) ?\\)
745 (/= (char-syntax (char-after beg)) ?\$)
747 (matching-paren (char-after beg))
748 (/= (char-after (1- end))
749 (matching-paren (char-after beg)))))
750 (if (eq paren-mode 'sexp)
751 (setq paren-extent (make-extent beg end))))
754 (setq pface (if mismatch
757 (and (memq paren-mode '(blink-paren paren))
758 (setq paren-extent (make-extent (- pos dir) pos)))
760 (if (and paren-message-offscreen
762 (not (current-message))
763 (not (window-minibuffer-p (selected-window)))
764 (not (pos-visible-in-window-safe pos)))
765 (paren-describe-match pos mismatch))
767 ;; put the right face on the extent
769 (set-extent-face paren-extent pface)
770 (set-extent-priority paren-extent 100) ; want this to be high
771 (and (eq paren-mode 'blink-paren)
772 (setq paren-blink-on-face pface
775 (and paren-blink-interval
776 (add-timeout paren-blink-interval
779 paren-blink-interval))))))