lilypond-indent.el

   1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
   2 ;;;
   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
   7
   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>
  10
  11 ;;; Variables for customising indentation style
  12
  13 ;;; TODO:
  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
  18 ;;;      opening slurs
  19 ;;;    * is locality of show-paren-function and paren-highlight possible?
  20
  21 (defcustom LilyPond-indent-level 4
  22   "*Indentation of lilypond statements with respect to containing block.")
  23
  24 (defcustom LilyPond-brace-offset 0
  25   "*Extra indentation for open braces.
  26 Compares with other text in same context.")
  27
  28 (defcustom LilyPond-angle-offset 0
  29   "*Extra indentation for open angled brackets.
  30 Compares with other text in same context.")
  31
  32 (defcustom LilyPond-square-offset 0
  33   "*Extra indentation for open square brackets.
  34 Compares with other text in same context.")
  35
  36 (defcustom LilyPond-scheme-paren-offset 0
  37   "*Extra indentation for open scheme parens.
  38 Compares with other text in same context.")
  39
  40 (defcustom LilyPond-close-brace-offset 0
  41   "*Extra indentation for closing braces.")
  42
  43 (defcustom LilyPond-close-angle-offset 0
  44   "*Extra indentation for closing angle brackets.")
  45
  46 (defcustom LilyPond-close-square-offset 0
  47   "*Extra indentation for closing square brackets.")
  48
  49 (defcustom LilyPond-close-scheme-paren-offset 0
  50   "*Extra indentation for closing scheme parens.")
  51
  52 (defcustom LilyPond-fancy-comments t
  53   "*Non-nil means distiguish between %, %%, and %%% for indentation.")
  54
  55 (defcustom LilyPond-comment-region "%%$"
  56   "*String inserted by \\[LilyPond-comment-region]\
  57  at start of each line in region.")
  58
  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."
  63   (interactive "*r")
  64   (let ((end (make-marker)))
  65     (set-marker end end-region)
  66     (goto-char beg-region)
  67     (beginning-of-line)
  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)))
  77
  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"
  82   (save-excursion
  83     (beginning-of-line)
  84     (let ((indent-point (point))
  85           (case-fold-search nil)
  86           state)
  87       (setq containing-sexp (save-excursion (LilyPond-scan-containing-sexp)))
  88       (beginning-of-defun)
  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
  93       (cond ((nth 3 state)
  94              ;; point is in the middle of a string
  95              nil)
  96             ((nth 4 state)
  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
 101              (beginning-of-line)
 102              0)
 103             (t
 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)
 110              (or
 111               ;; Is line first statement after an open brace or bracket?
 112               ;; If no, find that first statement and indent like it.
 113               (save-excursion
 114                 (forward-char 1)
 115                 ;; Skip over comments following open brace.
 116                 (skip-chars-forward " \t\n")
 117                 (cond ((looking-at "%{")
 118                        (while  (progn
 119                                  (and (not (looking-at "%}"))
 120                                       (< (point) (point-max))))
 121                          (forward-line 1)
 122                          (skip-chars-forward " \t\n"))
 123                        (forward-line 1)
 124                        (skip-chars-forward " \t\n"))
 125                       ((looking-at "%")
 126                        (while (progn (skip-chars-forward " \t\n")
 127                                      (looking-at "%"))
 128                          (forward-line 1))))
 129                 ;; The first following code counts
 130                 ;; if it is before the line we want to indent.
 131                 (and (< (point) indent-point)
 132                      (current-column)))
 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)
 147                            (t
 148                             0))
 149                    LilyPond-indent-level)
 150                  (progn
 151                    (skip-chars-backward " \t")
 152                    (current-indentation)))))))))
 153
 154
 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))
 159         beg shift-amt
 160         (case-fold-search nil)
 161         (pos (- (point-max) (point))))
 162     (beginning-of-line)
 163     (setq beg (point))
 164     (cond ((eq indent nil)
 165            (setq indent (current-indentation)))
 166           (t
 167            (skip-chars-forward " \t")
 168            (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
 169                (setq indent 0))
 170            (if (and LilyPond-fancy-comments
 171                     (looking-at "%")
 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)))
 176              (cond
 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)))
 193               ))))
 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))
 200       (indent-to indent)
 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))))
 206     shift-amt))
 207
 208
 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")
 214                       (looking-at "%"))
 215       (save-excursion
 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))))
 222         (and
 223          lastopen
 224          (or (not lastclose)
 225              (<= lastclose lastopen))))
 226       ))
 227
 228
 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")
 234                       (looking-at "%"))
 235       (save-excursion
 236         (beginning-of-defun)
 237         (while (< (point) this-point)
 238           (setq state (parse-partial-sexp (point) this-point 0)))
 239         (cond ((nth 3 state)
 240                ;; point is in the middle of a string
 241                t )
 242               ((nth 4 state)
 243                ;; point is in the middle of a block comment
 244                t )
 245               (t
 246                nil)))))
 247
 248
 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)))
 253   (if lastopen
 254       (if lastclose
 255           (if (<= lastclose lastopen)
 256               (goto-char lastopen))
 257         (goto-char lastopen)))
 258   (skip-chars-backward " %\t\n\f"))
 259
 260
 261 (defun LilyPond-backward-over-linecomments (lim)
 262   "Move point back to the closest non-whitespace character not part of a line comment.
 263 Argument LIM limit."
 264   (let (opoint stop)
 265     (while (not stop)
 266       (skip-chars-backward " \t\n\f" lim)
 267       (setq opoint (point))
 268       (beginning-of-line)
 269       (search-forward "%" opoint 'move)
 270       (skip-chars-backward " \t%")
 271       (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
 272       (if stop (point)
 273         (beginning-of-line)))))
 274
 275
 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))
 280
 281
 282 (defun LilyPond-calculate-indent-within-blockcomment ()
 283   "Return the indentation amount for line inside a block comment."
 284   (let (end percent-start)
 285     (save-excursion
 286       (beginning-of-line)
 287       (skip-chars-forward " \t")
 288       (skip-chars-backward " \t\n")
 289       (setq end (point))
 290       (beginning-of-line)
 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))
 296         (current-column)))))
 297
 298
 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)
 302
 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
 309      ( ?}  .  ("{" . "}"))
 310      ;; ligatures  '\[ ... \]' are skipped in the following expression
 311      ( ?]  .  ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]"))
 312      ( "\\]" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]"))
 313      ( "\\)" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]"))
 314      ))
 315
 316
 317 (defconst LilyPond-parens-alist
 318   `( ( ?<  .  ?> )
 319      ( ?{  .  ?} )
 320      ( ?[  .  ?] )
 321      ( "\\["  .  "\\]" )
 322      ( ?\(  .  ?\) )
 323      ( "\\("  .  "\\)" )
 324      ))
 325
 326
 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)) )
 333         nil))
 334
 335
 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.
 338
 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.
 342
 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.
 347 "
 348 ;;; An user does not call this function directly, or by a key sequence.
 349   ;;  (interactive)
 350   (let ( (level (if (not (eq dir 1)) 1 -1))
 351          (regexp-alist LilyPond-parens-regexp-alist)
 352          (oldpos (point))
 353          (assoc-bracket-type (if (not (eq dir 1)) bracket-type (LilyPond-matching-paren bracket-type))))
 354
 355     (if (LilyPond-inside-scheme-p)
 356         (setq paren-regexp "(\\|)")
 357       (if slur-paren-p
 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
 366     (if (and (eq dir 1)
 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)
 376                           (setq level 0)))))
 377     ;; browse the code until matching slur is found, or report mismatch
 378     (while (and (if (not (eq dir 1))
 379                     (> level 0)
 380                   (< level 0))
 381                 ;; dir tells whether to search backward or forward
 382                 (if (not (eq dir 1))
 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))
 397                          (if (/= level 0)
 398                              (progn
 399                                (setq level (1+ level))
 400                                (forward-char 1))))
 401 ;;;                  (message "%d %c" level match) (sit-for 0 300)
 402                      ;; hmm..
 403                      (if (and (= match ?>)
 404                               (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>"))
 405                          (forward-char 1)))
 406             ;; count opening brackets
 407             (progn (setq level (1- level))
 408 ;;;                (message "%d %c" level match) (sit-for 0 300)
 409                    ;; hmm..
 410                    (if (and (= match ?<)
 411                             (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<"))
 412                        (forward-char 1))))))
 413     ;; jump to the matching slur
 414     (if (not (eq dir 1))
 415         (progn
 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)))
 423       (backward-char 1))
 424     (if (= level 0)
 425         (point)
 426       (progn (goto-char oldpos)
 427              nil))))
 428
 429
 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.
 433   ;;  (interactive)
 434   (let ( (test-point (point))
 435          (level 0) )
 436     (save-excursion
 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)
 443                    (progn
 444                      (search-forward "(")
 445                      (setq level 1)
 446                      (while (and (> level 0)
 447                                  (re-search-forward "(\\|)" test-point t)
 448                                  (setq match (char-after (match-beginning 0)))
 449                                  (<= (point) test-point))
 450                        (if (= match ?\()
 451                            (setq level (1+ level))
 452                          (setq level (1- level))))
 453                      (> level 0))))
 454           t
 455         nil))))
 456
 457
 458 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
 459 ;;; the Emacs distribution.
 460
 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.
 467   ;;  (interactive)
 468   (let ( (oldpos (point))
 469          (level 0)
 470          (mismatch) )
 471     (if (not (or (equal this-command 'LilyPond-electric-close-paren)
 472                  (eq dir 1)))
 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 '(?] ?\) ?[ ?\())
 478       (progn
 479         (setq np -1)
 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
 485       (narrow-to-region
 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))
 496     (setq mismatch
 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")))
 502     (if (and blinkpos
 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))
 507           (message
 508            "Matches %s"
 509            ;; Show what precedes the open in its line, if anything.
 510            (if (save-excursion
 511                  (skip-chars-backward " \t")
 512                  (not (bolp)))
 513                (buffer-substring (progn (beginning-of-line) (point))
 514                                  (1+ blinkpos))
 515              ;; Show what follows the open in its line, if anything.
 516              (if (save-excursion
 517                    (forward-char 1)
 518                    (skip-chars-forward " \t")
 519                    (not (eolp)))
 520                  (buffer-substring blinkpos
 521                                    (progn (end-of-line) (point)))
 522                ;; Otherwise show the previous nonblank line,
 523                ;; if there is one.
 524                (if (save-excursion
 525                      (skip-chars-backward "\n \t")
 526                      (not (bobp)))
 527                    (concat
 528                     (buffer-substring (progn
 529                                         (skip-chars-backward "\n \t")
 530                                         (beginning-of-line)
 531                                         (point))
 532                                       (progn (end-of-line)
 533                                              (skip-chars-backward " \t")
 534                                              (point)))
 535                     ;; Replace the newline and other whitespace with `...'.
 536                     "..."
 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)))
 542       (goto-char oldpos))
 543     (if (not (eq dir 1))
 544         blinkpos
 545       (+ blinkpos 1))))
 546
 547
 548 (defun LilyPond-electric-close-paren ()
 549   "Blink on the matching open paren when a >, ), } or ] is inserted"
 550   (interactive)
 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))))))
 566
 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))
 571
 572 ;;; REDEFINITIONS: in future make show-paren-mode and paren-highlight local?
 573
 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 ()
 578
 579
 580 ;;  don't redefine emacs functions. It breaks other modes.
 581
 582 (defun LilyPond-show-paren-function () ; make show-paren-function local ??
 583   (if show-paren-mode
 584       (let (pos dir mismatch face (oldpos (point)))
 585         (cond ((eq (char-syntax (preceding-char)) ?\))
 586                (setq dir -1))
 587               ((eq (char-syntax (following-char)) ?\()
 588                (setq dir 1)))
 589         ;;
 590         ;; Find the other end of the sexp.
 591         (when (and dir
 592                    (not (LilyPond-inside-string-or-comment-p)))
 593           (save-excursion
 594             (save-restriction
 595               ;; Determine the range within which to look for a match.
 596               (when blink-matching-paren-distance
 597                 (narrow-to-region
 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.
 602               (condition-case ()
 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.
 607               (when (integerp pos)
 608                 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
 609                   (when (/= (char-syntax (char-after beg)) ?\$)
 610                     (setq mismatch
 611                           (not (eq (char-before end)
 612                                    ;; This can give nil.
 613                                    (matching-paren (char-after beg)))))))))))
 614         ;;
 615         ;; Highlight the other end of the sexp, or unhighlight if none.
 616         (if (not pos)
 617             (progn
 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)))
 624           ;;
 625           ;; Use the correct face.
 626           (if mismatch
 627               (progn
 628                 (if show-paren-ring-bell-on-mismatch
 629                     (beep))
 630                 (setq face 'show-paren-mismatch-face))
 631             (setq face 'show-paren-match-face))
 632           ;;
 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)
 643                             (point)
 644                           (forward-point -1)))
 645                   (to (if (= dir 1)
 646                           (forward-point 1)
 647                         (point))))
 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)))
 654           ;;
 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))))
 662                         (point)
 663                       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))))
 667                           pos
 668                         (save-excursion
 669                           (goto-char 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))))
 674           ;;
 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))))
 683
 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.
 692
 693 See the variables:
 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.
 698
 699 and the following faces:
 700   paren-match, paren-mismatch, paren-blink-off"
 701
 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
 705
 706   (let ((oldpos (point))
 707         (pface nil)                     ; face for paren...nil kills the overlay
 708         (dir (and paren-mode
 709                   (not (input-pending-p))
 710                   (not executing-kbd-macro)
 711                   (cond ((eq (char-syntax (preceding-char)) ?\))
 712                          -1)
 713                         ((eq (char-syntax (following-char)) ?\()
 714                          1))))
 715         pos mismatch)
 716
 717     (save-excursion
 718       (if (or (not dir)
 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
 723                          (narrow-to-region
 724                           (max (point-min)
 725                                (- (point) blink-matching-paren-distance))
 726                           (min (point-max)
 727                                (+ (point) blink-matching-paren-distance))))
 728
 729                      ;; Scan across one sexp within that range.
 730                      (condition-case nil
 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)
 735                               nil)))))
 736
 737           ;; do nothing if we didn't find a matching paren...
 738           nil
 739
 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)))
 743           (setq mismatch
 744                 (and (/= (char-syntax (char-after beg)) ?\\)
 745                      (/= (char-syntax (char-after beg)) ?\$)
 746                      ;; XEmacs change
 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))))
 752         (and mismatch
 753              (paren-maybe-ding))
 754         (setq pface (if mismatch
 755                         'paren-mismatch
 756                       'paren-match))
 757         (and (memq paren-mode '(blink-paren paren))
 758              (setq paren-extent (make-extent (- pos dir) pos)))
 759
 760         (if (and paren-message-offscreen
 761                  (eq dir -1)
 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))
 766
 767         ;; put the right face on the extent
 768         (cond (pface
 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
 773                           paren-n-blinks 0
 774                           paren-timeout-id
 775                           (and paren-blink-interval
 776                                (add-timeout paren-blink-interval
 777                                             'paren-blink-timeout
 778                                             nil
 779                                             paren-blink-interval))))))
 780         ))))