lilypond-indent.el

   1 ;;; lilypond-indent.el --- Auto-indentation for lilypond code
   2 ;;;
   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>
   5
   6 ;;; Variables for customising indentation style
   7
   8 (defcustom LilyPond-indent-level 4
   9   "*Indentation of lilypond statements with respect to containing block.")
  10
  11 (defcustom LilyPond-brace-offset 0
  12   "*Extra indentation for open braces.
  13 Compares with other text in same context.")
  14
  15 (defcustom LilyPond-angle-offset 0
  16   "*Extra indentation for open angled brackets .
  17 Compares with other text in same context.")
  18
  19 (defcustom LilyPond-scheme-paren-offset 0
  20   "*Extra indentation for open scheme parens .
  21 Compares with other text in same context.")
  22
  23 (defcustom LilyPond-close-brace-offset 0
  24   "*Extra indentation for closing braces.")
  25
  26 (defcustom LilyPond-close-angle-offset 0
  27   "*Extra indentation for closing angle brackets.")
  28
  29 (defcustom LilyPond-close-scheme-paren-offset 0
  30   "*Extra indentation for closing scheme parens.")
  31
  32 (defcustom LilyPond-fancy-comments t
  33   "*Non-nil means distiguish between %, %%, and %%% for indentation.")
  34
  35
  36 (defun LilyPond-calculate-indent ()
  37   "Return appropriate indentation for current line as lilypond code.
  38 In usual case returns an integer: the column to indent to.
  39 Returns nil if line starts inside a string"
  40   (save-excursion
  41     (beginning-of-line)
  42     (let ((indent-point (point))
  43           (case-fold-search nil)
  44           state)
  45       (setq containing-sexp (save-excursion (LilyPond-beginning-of-containing-sexp)))
  46       (beginning-of-defun)
  47       (while (< (point) indent-point)
  48         (setq state (parse-partial-sexp (point) indent-point 0)))
  49       ;; (setq containing-sexp (car (cdr state))) is the traditional way for languages
  50       ;; with simpler parenthesis delimiters
  51       (cond ((nth 3 state)
  52              ;; point is in the middle of a string
  53              nil)
  54             ((nth 4 state)
  55              ;; point is in the middle of a block comment
  56              (LilyPond-calculate-indent-within-blockcomment))
  57             ((null containing-sexp)
  58              ;; Line is at top level - no indent
  59              (beginning-of-line)
  60              0)
  61             (t
  62              ;; Find previous non-comment character.
  63              (goto-char indent-point)
  64              (LilyPond-backward-to-noncomment containing-sexp)
  65              ;; Now we get the answer.
  66              ;; Position following last unclosed open.
  67              (goto-char containing-sexp)
  68              (or
  69               ;; Is line first statement after an open brace or bracket?
  70               ;; If no, find that first statement and indent like it.
  71               (save-excursion
  72                 (forward-char 1)
  73                 ;; Skip over comments following open brace.
  74                 (skip-chars-forward " \t\n")
  75                 (cond ((looking-at "%{")
  76                        (while  (progn
  77                                  (and (not (looking-at "%}"))
  78                                       (< (point) (point-max))))
  79                          (forward-line 1)
  80                          (skip-chars-forward " \t\n"))
  81                        (forward-line 1)
  82                        (skip-chars-forward " \t\n"))
  83                       ((looking-at "%")
  84                        (while (progn (skip-chars-forward " \t\n")
  85                                      (looking-at "%"))
  86                          (forward-line 1))))
  87                 ;; The first following code counts
  88                 ;; if it is before the line we want to indent.
  89                 (and (< (point) indent-point)
  90                      (current-column)))
  91               ;; If no previous statement,
  92               ;; indent it relative to line brace is on.
  93               ;; For open brace in column zero, don't let statement
  94               ;; start there too.  If LilyPond-indent-level is zero, use
  95               ;; LilyPond-brace-offset instead
  96               (+ (if (and (bolp) (zerop LilyPond-indent-level))
  97                      (cond ((= (following-char) ?{)
  98                             LilyPond-brace-offset)
  99                            ((= (following-char) ?<)
 100                             LilyPond-angle-offset)
 101                            ((= (following-char) ?\))
 102                             LilyPond-scheme-paren-offset)
 103                            (t
 104                             0))
 105                    LilyPond-indent-level)
 106                  (progn
 107                    (skip-chars-backward " \t")
 108                    (current-indentation)))))))))
 109
 110
 111
 112 (defun LilyPond-indent-line ()
 113   "Indent current line as lilypond code.
 114 Return the amount the indentation changed by."
 115   (let ((indent (LilyPond-calculate-indent))
 116         beg shift-amt
 117         (case-fold-search nil)
 118         (pos (- (point-max) (point))))
 119     (beginning-of-line)
 120     (setq beg (point))
 121     (cond ((eq indent nil)
 122            (setq indent (current-indentation)))
 123           (t
 124            (skip-chars-forward " \t")
 125            (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
 126                (setq indent 0))
 127            (if (and LilyPond-fancy-comments
 128                     (looking-at "%")
 129                     (not (looking-at "%%\\|%{\\|%}")))
 130                (setq indent comment-column)
 131              (if (eq indent t) (setq indent 0))
 132              (if (listp indent) (setq indent (car indent)))
 133              (cond
 134               ((= (following-char) ?})
 135                (setq indent  (+ indent (- LilyPond-close-brace-offset LilyPond-indent-level))))
 136               ((= (following-char) ?>)
 137                (setq indent  (+ indent (- LilyPond-close-angle-offset LilyPond-indent-level))))
 138               ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p))
 139                (setq indent  (+ indent (- LilyPond-close-scheme-paren-offset LilyPond-indent-level))))
 140               ((= (following-char) ?{)
 141                (setq indent  (+ indent LilyPond-brace-offset)))
 142               ((= (following-char) ?<)
 143                (setq indent  (+ indent LilyPond-angle-offset)))
 144               ((and (= (following-char) ?\() (LilyPond-inside-scheme-p))
 145                (setq indent  (+ indent LilyPond-scheme-paren-offset)))
 146               ))))
 147     (skip-chars-forward " \t")
 148     (setq shift-amt (- indent (current-column)))
 149     (if (zerop shift-amt)
 150         (if (> (- (point-max) pos) (point))
 151             (goto-char (- (point-max) pos)))
 152       (delete-region beg (point))
 153       (indent-to indent)
 154       ;; If initial point was within line's indentation,
 155       ;; position after the indentation.
 156       ;; Else stay at same point in text.
 157       (if (> (- (point-max) pos) (point))
 158           (goto-char (- (point-max) pos))))
 159     shift-amt))
 160
 161
 162 (defun LilyPond-inside-comment-p ()
 163   "Return non-nil if point is inside a line or block comment"
 164   (setq this-point (point))
 165   (or (save-excursion (beginning-of-line)
 166                       (skip-chars-forward " \t")
 167                       (looking-at "%"))
 168       (save-excursion
 169         ;; point is in the middle of a block comment
 170         (setq lastopen  (save-excursion (re-search-backward "%{[ \\t]*" (point-min) t)))
 171         (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" (point-min) t)))
 172         (if (or (and (= (char-before) ?%) (= (char-after) ?{))
 173                 (and (= (char-after)  ?%) (= (char-after (1+ (point))) ?{)))
 174             (setq lastopen (save-excursion (backward-char) (point))))
 175         (and
 176          lastopen
 177          (or (not lastclose)
 178              (<= lastclose lastopen))))
 179       ))
 180
 181
 182 (defun LilyPond-inside-string-or-comment-p ()
 183   "Test if point is inside a string or a comment"
 184   (setq this-point (point))
 185   (or (save-excursion (beginning-of-line)
 186                       (skip-chars-forward " \t")
 187                       (looking-at "%"))
 188       (save-excursion
 189         (beginning-of-defun)
 190         (while (< (point) this-point)
 191           (setq state (parse-partial-sexp (point) this-point 0)))
 192         (cond ((nth 3 state)
 193                ;; point is in the middle of a string
 194                t )
 195               ((nth 4 state)
 196                ;; point is in the middle of a block comment
 197                t )
 198               (t
 199                nil)))))
 200
 201
 202 (defun LilyPond-backward-over-blockcomments (lim)
 203   "Move point back to closest non-whitespace character not part of a block comment"
 204   (setq lastopen  (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
 205   (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
 206   (if lastopen
 207       (if lastclose
 208           (if (<= lastclose lastopen)
 209               (goto-char lastopen))
 210         (goto-char lastopen)))
 211   (skip-chars-backward " %\t\n\f"))
 212
 213
 214 (defun LilyPond-backward-over-linecomments (lim)
 215   "Move point back to the closest non-whitespace character not part of a line comment.
 216 Argument LIM limit."
 217   (let (opoint stop)
 218     (while (not stop)
 219       (skip-chars-backward " \t\n\f" lim)
 220       (setq opoint (point))
 221       (beginning-of-line)
 222       (search-forward "%" opoint 'move)
 223       (skip-chars-backward " \t%")
 224       (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
 225       (if stop (point)
 226         (beginning-of-line)))))
 227
 228
 229 (defun LilyPond-backward-to-noncomment (lim)
 230   "Move point back to closest non-whitespace character not part of a comment"
 231   (LilyPond-backward-over-linecomments lim)
 232   (LilyPond-backward-over-blockcomments lim))
 233
 234
 235 (defun LilyPond-calculate-indent-within-blockcomment ()
 236   "Return the indentation amount for line inside a block comment."
 237   (let (end percent-start)
 238     (save-excursion
 239       (beginning-of-line)
 240       (skip-chars-forward " \t")
 241       (skip-chars-backward " \t\n")
 242       (setq end (point))
 243       (beginning-of-line)
 244       (skip-chars-forward " \t")
 245       (and (re-search-forward "%{[ \t]*" end t)
 246            (goto-char (1+ (match-beginning 0))))
 247       (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
 248           (1+ (current-column))
 249         (current-column)))))
 250
 251
 252 ;; Key:   Type of bracket (character).
 253 ;; Value: Pair of regexps representing the corresponding open and close bracket"
 254 ;; () are treated specially (need to indent in Scheme but not in music), and []
 255 ;; are handled by the syntax table
 256
 257 (defconst LilyPond-parens-regexp-alist
 258   `( ( ?>  .  ("\\([^\\]\\|^\\)<" . "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>"))
 259      ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
 260      ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
 261      ;; also \> and \< are hairpins
 262      ( ?}  .  ("{" . "}"))
 263      ))
 264
 265
 266 (defconst LilyPond-parens-alist
 267   `( ( ?<  .  ?> )
 268      ( ?{  .  ?} )
 269      ( ?\(  .  ?\) )
 270      ))
 271
 272
 273 (defun LilyPond-matching-paren (bracket-type)
 274   "Returns the open corresponding to the close specified by bracket-type, or vice versa"
 275   (cond ( (memq bracket-type (mapcar 'car LilyPond-parens-alist))
 276           (cdr (assoc bracket-type LilyPond-parens-alist)) )
 277         ( (memq bracket-type (mapcar 'cdr LilyPond-parens-alist))
 278           (car (rassoc bracket-type LilyPond-parens-alist)) )
 279         nil))
 280
 281
 282 (defun LilyPond-beginning-of-containing-sexp (&optional bracket-type slur-paren-p)
 283   "Move point to the beginning of the deepest parenthesis pair enclosing point.
 284
 285 If the optional argument bracket-type, a character representing a
 286 close bracket such as ) or }, is specified, then the parenthesis pairs
 287 searched are limited to this type.
 288
 289 If the optional argument slur-paren-p is non-nil, then slur
 290 parentheses () are considered as matching pairs. Otherwise Scheme
 291 parentheses are considered to be matching pairs, but slurs are not.
 292 slur-paren-p defaults to nil.
 293 "
 294   (interactive)
 295   (let ( (level 1)
 296          (regexp-alist LilyPond-parens-regexp-alist)
 297          (oldpos (point) ) )
 298     (if (LilyPond-inside-scheme-p)
 299         (setq paren-regexp "(\\|)")
 300       (if slur-paren-p
 301           (setq regexp-alist (cons '( ?\) . ("(" . ")")) regexp-alist)))
 302       (if (memq bracket-type (mapcar 'car regexp-alist))
 303           (progn (setq paren-regexp (cdr (assoc bracket-type regexp-alist)))
 304                  (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
 305         (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
 306                                    (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
 307     (while (and (> level 0)
 308                 (re-search-backward paren-regexp nil t)
 309                 (setq match (char-before (match-end 0))))
 310       (if (not (save-excursion (goto-char (match-end 0))
 311                                (LilyPond-inside-string-or-comment-p)))
 312           (if (memq match '(?} ?> ?\)))
 313               (progn (setq level (1+ level))
 314                      (if (and (= match ?>)
 315                               (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\)>"))
 316                          (forward-char 1)))
 317             (progn (setq level (1- level))
 318                    (if (and (= match ?<)
 319                             (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\)<"))
 320                        (forward-char 1))))))
 321     (if (looking-at ".<\\|.>") (forward-char 1))
 322     (if (= level 0)
 323         (point)
 324       (progn (goto-char oldpos)
 325              nil))))
 326
 327
 328 (defun LilyPond-inside-scheme-p ()
 329   "Tests if point is inside embedded Scheme code"
 330   (interactive)
 331   (let ( (test-point (point))
 332          (level 0) )
 333     (save-excursion
 334       (if (or (and (/= (point) (point-max))
 335                    (= (char-after (point)) ?\()
 336                    (or (= (char-after (- (point) 1)) ?#)
 337                        (and (= (char-after (- (point) 2)) ?#)
 338                             (= (char-after (- (point) 1)) ?`))))
 339               (and (re-search-backward "#(\\|#`(" nil t)
 340                    (progn
 341                      (search-forward "(")
 342                      (setq level 1)
 343                      (while (and (> level 0)
 344                                  (re-search-forward "(\\|)" test-point t)
 345                                  (setq match (char-after (match-beginning 0)))
 346                                  (<= (point) test-point))
 347                        (if (= match ?\()
 348                            (setq level (1+ level))
 349                          (setq level (1- level))))
 350                      (> level 0))))
 351           t
 352         nil))))
 353
 354
 355 ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
 356 ;;; the Emacs distribution.
 357
 358 (defun LilyPond-blink-matching-open (bracket-type)
 359   "Move cursor momentarily to the beginning of the sexp before
 360 point. In lilypond files this is used for closing ), } and >, whereas the
 361 builtin 'blink-matching-open' is used for closing ],  which is in
 362 the syntax table"
 363   (interactive)
 364   (let ( (oldpos (point))
 365          (level 0)
 366          (mismatch) )
 367     (save-restriction
 368       (if blink-matching-paren-distance
 369           (narrow-to-region (max (point-min)
 370                                  (- (point) blink-matching-paren-distance))
 371                             oldpos)))
 372     (if (memq bracket-type '(?> ?}))
 373         ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
 374         (LilyPond-beginning-of-containing-sexp nil nil)
 375       ;; whereas ( ) slurs within music don't, so only need to search for ( )
 376       (LilyPond-beginning-of-containing-sexp bracket-type t))
 377     (setq blinkpos (point))
 378     (setq mismatch
 379           (or (null (LilyPond-matching-paren (char-after blinkpos)))
 380               (/= (char-after oldpos)
 381                   (LilyPond-matching-paren (char-after blinkpos)))))
 382     (if mismatch (progn (setq blinkpos nil)
 383                         (message "Mismatched parentheses")))
 384     (if blinkpos
 385         (if (pos-visible-in-window-p)
 386             (and blink-matching-paren-on-screen
 387                  (sit-for blink-matching-delay))
 388           (message
 389            "Matches %s"
 390            ;; Show what precedes the open in its line, if anything.
 391            (if (save-excursion
 392                  (skip-chars-backward " \t")
 393                  (not (bolp)))
 394                (buffer-substring (progn (beginning-of-line) (point))
 395                                  (1+ blinkpos))
 396              ;; Show what follows the open in its line, if anything.
 397              (if (save-excursion
 398                    (forward-char 1)
 399                    (skip-chars-forward " \t")
 400                    (not (eolp)))
 401                  (buffer-substring blinkpos
 402                                    (progn (end-of-line) (point)))
 403                ;; Otherwise show the previous nonblank line,
 404                ;; if there is one.
 405                (if (save-excursion
 406                      (skip-chars-backward "\n \t")
 407                      (not (bobp)))
 408                    (concat
 409                     (buffer-substring (progn
 410                                         (skip-chars-backward "\n \t")
 411                                         (beginning-of-line)
 412                                         (point))
 413                                       (progn (end-of-line)
 414                                              (skip-chars-backward " \t")
 415                                              (point)))
 416                     ;; Replace the newline and other whitespace with `...'.
 417                     "..."
 418                     (buffer-substring blinkpos (1+ blinkpos)))
 419                  ;; There is nothing to show except the char itself.
 420                  (buffer-substring blinkpos (1+ blinkpos))))))))
 421     (goto-char oldpos)))
 422
 423
 424 (defun LilyPond-electric-close-paren ()
 425   "Blink on the matching open paren when a > or ) is inserted"
 426   (interactive)
 427   (let ((oldpos (point)))
 428     (self-insert-command 1)
 429     (setq close-char (char-before (point)))
 430     (if (and blink-matching-paren
 431              (not (LilyPond-inside-string-or-comment-p))
 432              (save-excursion (re-search-backward
 433                               (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
 434                              (eq oldpos (1- (match-end 0)))))
 435         (progn (backward-char 1)
 436                (LilyPond-blink-matching-open close-char)
 437                (forward-char 1)))))
 438
 439
 440 ;;; TODO:
 441 ;;; emulate show-paren-mode