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 (defconst LilyPond-parens-regexp-alist
 253   `(("[^\\]<" .  "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>")
 254     ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
 255     ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
 256     ;; also \> and \< are hairpins
 257     ("{" . "}")))
 258
 259
 260 (defconst LilyPond-parens-combined-regexp
 261   (concat (mapconcat 'car LilyPond-parens-regexp-alist "\\|")
 262           "\\|"
 263           (mapconcat 'cdr LilyPond-parens-regexp-alist "\\|")))
 264
 265
 266 (defun LilyPond-beginning-of-containing-sexp ()
 267   "Move point to the beginning of the deepest parenthesis pair enclosing point."
 268   (interactive)
 269   (let ((level 1))
 270     (if (LilyPond-inside-scheme-p)
 271         (setq paren-regexp "(\\|)" inside-scheme t)
 272       (setq paren-regexp LilyPond-parens-combined-regexp inside-scheme nil))
 273     (while (and (> level 0)
 274                 (re-search-backward paren-regexp nil t)
 275                 (setq match (char-before (match-end 0))))
 276       (if (not (save-excursion (goto-char (match-end 0))
 277                                (LilyPond-inside-string-or-comment-p)))
 278           (if (memq match '(?} ?> ?\)))
 279               (progn (setq level (1+ level))
 280                      (if (and (= match ?>)
 281                               (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\)>"))
 282                          (forward-char 1)))
 283             (progn (setq level (1- level))
 284                    (if (and (= match ?<)
 285                             (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\)<"))
 286                        (forward-char 1))))))
 287     (if (looking-at ".<\\|.>") (forward-char 1))
 288     (if (/= level 1)
 289         (point)
 290       nil)))
 291
 292
 293 (defun LilyPond-inside-scheme-p ()
 294   "Tests if point is inside embedded Scheme code"
 295   (interactive)
 296   (let ( (test-point (point))
 297          (level 0) )
 298     (save-excursion
 299       (if (or (and (= (char-after (point)) ?\()
 300                    (or (= (char-after (- (point) 1)) ?#)
 301                        (and (= (char-after (- (point) 2)) ?#)
 302                             (= (char-after (- (point) 1)) ?`))))
 303               (and (re-search-backward "#(\\|#`(" nil t)
 304                    (progn
 305                      (search-forward "(")
 306                      (setq level 1)
 307                      (while (and (> level 0)
 308                                  (re-search-forward "(\\|)" test-point t)
 309                                  (setq match (char-after (match-beginning 0)))
 310                                  (<= (point) test-point))
 311                        (if (= match ?\()
 312                            (setq level (1+ level))
 313                          (setq level (1- level))))
 314                      (> level 0))))
 315           t
 316         nil))))