Emacs mode indentation

[Chris Jackson]

OK - The code below is a first attempt at indentation for lilypond-mode.

It 
* does the sensible thing with blocks of music contained within
parentheses and nested parentheses. 
* takes account of accented notes ( -> ), fontifying them properly
and not treating them as closing <.
* indents inline scheme parentheses ( ) but ignores musical phrase marks
* indents and fontifies block-comments properly, and allows three levels
of line-comment (like in lisp-mode)
* can be customised by setting variables controlling placement of
opening and closing {, < or (.

However... 

The problem with the accents / phrase marks is that the standard Emacs
syntax table is not able to deal with regexps as parenthesis-pairs, just
single characters. So you cant tell a syntax table to ignore a -> when
looking for a closing angle bracket. My cumbersome solution here is to
remove matching of <> and () from the syntax table entry, and write my
own lisp equivalent of the Emacs internal 'parse-partial-sexp' C code,
which finds the level of parenthesis-nesting containing the point you
want to indent.  This breaks the 'blinking' an on opening < when you
insert a closing >.

As a result, this code is *very slow*, especially for indenting big
blocks of text at once at the bottom of a source file... But it's OK for
indenting single lines as you type. 

Bugreports / alternative ideas welcome.

(note there's a new file - lilypond-indent.el)
-- 
chris

-- 
diff -purN lilypond-1.5.28/AUTHORS.txt lilypond-1.5.28-new/AUTHORS.txt
--- lilypond-1.5.28/AUTHORS.txt Sat Dec 29 20:22:33 2001
+++ lilypond-1.5.28-new/AUTHORS.txt     Wed Jan 23 23:07:10 2002
@@ -27,6 +27,9 @@ list is alphabetically ordered.
 
    * Bjoern Jacke <address@hidden>     German glossary stuff.
 
+   * Chris Jackson <address@hidden> Emacs mode indentation,
+     directed arpeggios
+
    * Neil Jerram <address@hidden>.      parts of
      Documentation/Vocab*
 
diff -purN lilypond-1.5.28/lilypond-font-lock.el 
lilypond-1.5.28-new/lilypond-font-lock.el
--- lilypond-1.5.28/lilypond-font-lock.el       Sun Nov 18 00:08:12 2001
+++ lilypond-1.5.28-new/lilypond-font-lock.el   Wed Jan 23 23:11:08 2002
@@ -24,9 +24,7 @@
 ;;
 
 ;; TODO:
-;;   - should handle block comments too.
 ;;   - handle lexer modes (\header, \melodic, \lyric) etc.
-;;   - indentation
 
 (defconst LilyPond-font-lock-keywords
   (let* ((keywords '( ; need special order due to over[lapping] of words
@@ -131,7 +129,13 @@
 ;; highlight keywords
       (cons (concat "\\([_^]?\\(" kwregex "\\)\\)+\\($\\|[] \t(~{}>\\\\]\\)") 
'(0 font-lock-keyword-face t))
 
-      '("\\([][><}{]\\)" 0 font-lock-warning-face t)
+;; highlight bracketing constructs
+      '("\\([][}{]\\)" 0 font-lock-warning-face t)
+;; these regexps allow angle-brackets to be highlighted,
+;; but leave accented notes, e.g. a b c->, alone
+      '("[^\\]\\(<\\)" 1 font-lock-warning-face t)
+      '("[_^-]\\s-*[-^]\\s-*\\(>\\)" 1 font-lock-warning-face t)
+      '("[^\\t\\n _^-]\\s-*\\(>\\)" 1 font-lock-warning-face t)
 
       '("\\([(~)]\\|\\\\<\\|\\\\!\\|\\\\>\\)" 0 font-lock-builtin-face t)
 
@@ -158,24 +162,21 @@
   (mapcar (function
           (lambda (x) (modify-syntax-entry
                        (car x) (cdr x) LilyPond-mode-syntax-table)))
-         '(( ?\( . "()" ) ( ?\) . ")(" )   ; need matching parens for inline 
lisp
-           ( ?\[ . "." ) ( ?\] . "." )
-           ( ?\{ . "(}" ) ( ?\} . "){" )
-           ( ?\< . "(>" )( ?\> . ")>") 
+         '(( ?\( . "." ) ( ?\) . "." ) 
+           ( ?\[ . "." ) ( ?\] . "." )
+           ( ?\{  .  "(}2b" )
+           ( ?\}  .  "){4b" )
+           ( ?\< . "." )( ?\> . ".") 
            ( ?\$ . "." ) ( ?\% . "." ) ( ?\& . "." )
-           ( ?\* . "." ) ( ?\+ . "." ) ( ?\- . "." )
+           ( ?\* . "." ) ( ?\+ . "." )
            ( ?\/ . "." )  ( ?\= . "." )
            ( ?\| . "." ) (?\\ . "\\" )
-           ( ?\_ . "." )       
+           ( ?\- . "." ) ( ?\_ . "." ) ( ?\^ . "." )
            ( ?\' . "w")        
            ( ?\" . "\"" )
-           ( ?\% . "<")
+           ( ?\%  .  ". 1b3b" )
            ( ?\n . ">")
-
-; FIXME
-;          ( ?%  .  ". 124b" )
-;          ( ?{  .  ". 23" )
+           ( ?\r . ">")
            ))
-
-  )    
+  )
 
diff -purN lilypond-1.5.28/lilypond-indent.el 
lilypond-1.5.28-new/lilypond-indent.el
--- lilypond-1.5.28/lilypond-indent.el  Thu Jan  1 01:00:00 1970
+++ lilypond-1.5.28-new/lilypond-indent.el      Wed Jan 23 22:14:52 2002
@@ -0,0 +1,381 @@
+;;; lilypond-indent.el --- Auto-indentation for lilypond code
+;;;
+;;; Chris Jackson <address@hidden>
+;;; some code is taken from ESS (Emacs Speaks Statistics) S-mode by 
A.J.Rossini <address@hidden>
+
+;;; Variables for customising indentation style
+
+(defcustom LilyPond-indent-level 4
+  "*Indentation of lilypond statements with respect to containing block.")
+
+(defcustom LilyPond-brace-offset 0
+  "*Extra indentation for open braces.
+Compares with other text in same context.")
+
+(defcustom LilyPond-angle-offset 0
+  "*Extra indentation for open angled brackets .
+Compares with other text in same context.")
+
+(defcustom LilyPond-scheme-paren-offset 0
+  "*Extra indentation for open scheme parens .
+Compares with other text in same context.")
+
+(defcustom LilyPond-close-brace-offset 0
+  "*Extra indentation for closing braces.")
+
+(defcustom LilyPond-close-angle-offset 0
+  "*Extra indentation for closing angle brackets.")
+
+(defcustom LilyPond-close-scheme-paren-offset 0
+  "*Extra indentation for closing scheme parens.")
+
+(defcustom LilyPond-fancy-comments t
+  "*Non-nil means distiguish between %, %%, and %%% for indentation.")
+
+
+(defun LilyPond-calculate-indent ()
+  "Return appropriate indentation for current line as lilypond code.
+In usual case returns an integer: the column to indent to.
+Returns nil if line starts inside a string"
+  (save-excursion
+    (beginning-of-line)
+    (let ((indent-point (point))
+         (case-fold-search nil)
+         state)
+      (setq containing-sexp (save-excursion 
(LilyPond-beginning-of-containing-sexp)))
+      (beginning-of-defun)
+      (while (< (point) indent-point)
+       (setq state (parse-partial-sexp (point) indent-point 0))
+                                       ;(setq containing-sexp (car (cdr 
state)))
+       )
+      (cond ((nth 3 state) 
+            ;; point is in the middle of a string 
+            nil)
+           ((nth 4 state)
+            ;; point is in the middle of a block comment
+            (LilyPond-calculate-indent-within-blockcomment))
+           ((null containing-sexp)
+            ;; Line is at top level - no indent
+            (beginning-of-line)
+            0)
+           (t
+            ;; Find previous non-comment character.
+            (goto-char indent-point)
+            (LilyPond-backward-to-noncomment containing-sexp)
+            ;; Now we get the answer.
+            ;; Position following last unclosed open.
+            (goto-char containing-sexp)
+            (or
+             ;; Is line first statement after an open brace or bracket?
+             ;; If no, find that first statement and indent like it.
+             (save-excursion
+               (forward-char 1)
+               ;; Skip over comments following open brace.
+               (skip-chars-forward " \t\n")
+               (cond ((looking-at "%{")
+                      (while  (progn 
+                                (and (not (looking-at "%}"))
+                                     (< (point) (point-max))))
+                        (forward-line 1)
+                        (skip-chars-forward " \t\n"))
+                      (forward-line 1)
+                      (skip-chars-forward " \t\n"))
+                     ((looking-at "%")
+                      (while (progn (skip-chars-forward " \t\n")
+                                    (looking-at "%"))
+                        (forward-line 1))))
+               ;; The first following code counts
+               ;; if it is before the line we want to indent.
+               (and (< (point) indent-point)
+                    (current-column)))
+             ;; If no previous statement,
+             ;; indent it relative to line brace is on.
+             ;; For open brace in column zero, don't let statement
+             ;; start there too.  If LilyPond-indent-level is zero, use
+             ;; LilyPond-brace-offset instead
+             (+ (if (and (bolp) (zerop LilyPond-indent-level))
+                    (cond ((= (following-char) ?{) 
+                           LilyPond-brace-offset)
+                          ((= (following-char) ?<) 
+                           LilyPond-angle-offset)
+                          ((= (following-char) ?\))
+                           LilyPond-scheme-paren-offset)
+                          (t
+                           0))
+                  LilyPond-indent-level)
+                (progn
+                  (skip-chars-backward " \t")
+                  (current-indentation)))))))))
+
+
+
+(defun LilyPond-indent-line ()
+  "Indent current line as lilypond code.
+Return the amount the indentation changed by."
+  (let ((indent (LilyPond-calculate-indent))
+       beg shift-amt
+       (case-fold-search nil)
+       (pos (- (point-max) (point))))
+    (beginning-of-line)
+    (setq beg (point))
+    (cond ((eq indent nil)
+          (setq indent (current-indentation)))
+         (t
+          (skip-chars-forward " \t")
+          (if (and LilyPond-fancy-comments (looking-at "%%%\\|%{\\|%}"))
+              (setq indent 0))
+          (if (and LilyPond-fancy-comments
+                   (looking-at "%")
+                   (not (looking-at "%%\\|%{\\|%}")))
+              (setq indent comment-column)
+            (if (eq indent t) (setq indent 0))
+            (if (listp indent) (setq indent (car indent)))
+            (cond
+             ((= (following-char) ?})
+              (setq indent  (- (+ indent LilyPond-close-brace-offset) 
LilyPond-indent-level)))
+             ((= (following-char) ?>)
+              (setq indent  (- (+ indent LilyPond-close-angle-offset) 
LilyPond-indent-level)))
+             ((= (following-char) ?\))
+              (setq indent  (- (+ indent LilyPond-close-scheme-paren-offset) 
LilyPond-indent-level)))
+             ((= (following-char) ?{)
+              (setq indent (+ indent LilyPond-brace-offset)))
+             ((= (following-char) ?<)
+              (setq indent (+ indent LilyPond-angle-offset)))
+             ((= (following-char) ?\()
+              (setq indent (+ indent LilyPond-scheme-paren-offset)))
+             ))))
+    (skip-chars-forward " \t")
+    (setq shift-amt (- indent (current-column)))
+    (if (zerop shift-amt)
+       (if (> (- (point-max) pos) (point))
+           (goto-char (- (point-max) pos)))
+      (delete-region beg (point))
+      (indent-to indent)
+      ;; If initial point was within line's indentation,
+      ;; position after the indentation.
+      ;; Else stay at same point in text.
+      (if (> (- (point-max) pos) (point))
+         (goto-char (- (point-max) pos))))
+    shift-amt))
+
+
+(defun LilyPond-inside-comment-p ()
+  "Return non-nil if point is inside a line or block comment"
+  (setq this-point (point))
+  (or (save-excursion (beginning-of-line)
+                     (skip-chars-forward " \t")
+                     (looking-at "%"))
+      (save-excursion 
+       ;; point is in the middle of a block comment
+       (setq lastopen  (save-excursion (re-search-backward "%{[ \\t]*" 
(point-min) t)))
+       (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" 
(point-min) t)))
+       (if (or (and (= (char-before) ?%) (= (char-after) ?{))
+               (and (= (char-after)  ?%) (= (char-after (1+ (point))) ?{)))
+           (setq lastopen (save-excursion (backward-char) (point))))
+       (and 
+        lastopen
+        (or (not lastclose)
+            (<= lastclose lastopen))))
+      ))
+
+
+(defun LilyPond-inside-string-or-comment-p ()
+  "Test if point is inside a string or a comment"
+  (setq this-point (point))
+  (or (save-excursion (beginning-of-line)
+                     (skip-chars-forward " \t")
+                     (looking-at "%"))
+      (save-excursion 
+       (beginning-of-defun)
+       (while (< (point) this-point)
+         (setq state (parse-partial-sexp (point) this-point 0)))
+       (cond ((nth 3 state) 
+              ;; point is in the middle of a string 
+              t )
+             ((nth 4 state)
+              ;; point is in the middle of a block comment
+              t ) 
+             (t
+              nil)))))
+
+
+(defun LilyPond-backward-over-blockcomments (lim)
+  "Move point back to closest non-whitespace character not part of a block 
comment"
+  (setq lastopen  (save-excursion (re-search-backward "%{[ \\t]*" lim t)))
+  (setq lastclose (save-excursion (re-search-backward "%}[ \\t]*" lim t)))
+  (if lastopen
+      (if lastclose
+         (if (<= lastclose lastopen)
+             (goto-char lastopen))
+       (goto-char lastopen)))
+  (skip-chars-backward " %\t\n\f"))
+
+
+(defun LilyPond-backward-over-linecomments (lim)
+  "Move point back to the closest non-whitespace character not part of a line 
comment.
+Argument LIM limit."
+  (let (opoint stop)
+    (while (not stop)
+      (skip-chars-backward " \t\n\f" lim)
+      (setq opoint (point))
+      (beginning-of-line)
+      (search-forward "%" opoint 'move)
+      (skip-chars-backward " \t%")
+      (setq stop (or (/= (preceding-char) ?\n) (<= (point) lim)))
+      (if stop (point)
+       (beginning-of-line)))))
+
+(defun LilyPond-backward-to-noncomment (lim)
+  "Move point back to closest non-whitespace character not part of a comment"
+  (LilyPond-backward-over-linecomments lim)
+  (LilyPond-backward-over-blockcomments lim))
+
+
+(defun LilyPond-calculate-indent-within-blockcomment ()
+  "Return the indentation amount for line inside a block comment."
+  (let (end percent-start)
+    (save-excursion
+      (beginning-of-line)
+      (skip-chars-forward " \t")
+      (skip-chars-backward " \t\n")
+      (setq end (point))
+      (beginning-of-line)
+      (skip-chars-forward " \t")
+      (and (re-search-forward "%{[ \t]*" end t)
+          (goto-char (1+ (match-beginning 0))))
+      (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\%))
+         (1+ (current-column))
+       (current-column)))))
+
+(defconst LilyPond-parens-alist
+  `(("{" . "}")
+    ("(" . ")")
+    ("<" .  ">")))
+
+(defconst LilyPond-parens-regexp-alist
+  `(("{" . "}")
+    ("(" . ")")
+    ("[^\\]<" .  "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>")))
+;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
+;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
+;; also \> and \< are hairpins
+
+;; This ensures that something like 'foo = \notes {' is treated as the 
beginning of a defun
+(setq defun-prompt-regexp "\w+\\s-*=.*")
+
+(defun LilyPond-beginning-of-containing-sexp ()
+  "Move point to the opening of the syntactic parenthesis pair which contains 
point.
+Ignores parenthesis within comments, and does not count accented notes, e.g 
aes->, as 
+closing parentheses"
+  (interactive)
+  (let ((parse-point (point)) ;; Point whose containing expression we want to 
locate
+       (nest-level 0)        ;; Current nesting depth 
+       (scheme-nest-level 0) ;; Depth of Scheme parentheses ( () ) enclosing 
point
+       (finished nil)        ;; Have we located the expression containing 
point yet? 
+       (found-nest-level 0)  ;; Nest level we are looking for
+       (level-starts (list (point-min))) ;; List of open-bracket positions for 
the hierarchy of nest levels enclosing point
+       (sexp-types (list 0)) ;; Corresponding list of hierarchy of types of 
bracket eg ( { <  enclosing point
+       (inside-scheme nil))  ;; Are we currently in embedded Scheme 
+    (beginning-of-defun)
+    (while (not finished)
+      (save-excursion
+       ;; Search forward for the nearest opening bracket 
+       (setq done nil)
+       (if (looking-at "{\\|<") 
+           ;; We are already at the nearest opening bracket 
+           ;; Need this bit as searching forward for the 2-character regexp 
"[^\\]<" won't work.
+           (progn (setq nextopen (point))
+                  (setq nextopen-char (char-after (point))))
+         (while (not done)
+           (if (re-search-forward (mapconcat 'car LilyPond-parens-regexp-alist 
"\\|") nil t)  
+               (progn (setq match-loc (match-end 0))
+                      ;; If bracket is in a comment then search again
+                      (if (not (LilyPond-inside-string-or-comment-p))
+                          (progn 
+                            ;; If bracket is a ( and we are not in embedded 
scheme, then search again
+                            ;; We don't include phrasemarks/slurs as 
parenthesis pairs
+                            (if (and (= (char-before (point)) ?\()
+                                     (= scheme-nest-level 0) 
+                                     ;; Embedded scheme brackets begin with a 
#( or a #`(
+                                     (or (= (char-before (- (point) 1)) ?#)
+                                         (and (= (char-before (- (point) 2)) 
?#)
+                                              (= (char-before (- (point) 1)) 
?`))))
+                                (setq inside-scheme t))
+                            ;; Otherwise we've found a { or a <. Record its 
position.
+                            (if (or inside-scheme (not (= (char-before 
(point)) ?\())) 
+                                (progn (setq nextopen (- match-loc 1))
+                                       (setq nextopen-char (char-before 
(point)))
+                                       (setq done t))))))
+             (setq nextopen (point-max))
+             (setq done t)))))
+      (save-excursion 
+       ;; Search forward for the nearest closing bracket 
+       (setq done nil)
+       (skip-chars-forward " \t\n") 
+       (if (looking-at ">")
+           ;; We are already at the nearest opening bracket 
+           ;; Need this bit as searching forward for a the 3-4 character 
regexp including whitespace won't work.
+           (progn (setq nextclose (point))
+                  (setq nextclose-char (char-after (point))))
+         (while (not done)
+           (if (re-search-forward (mapconcat 'cdr LilyPond-parens-regexp-alist 
"\\|") nil t)  
+               (progn (setq match-loc (match-end 0))
+                      ;; If bracket is inside a comment then search again
+                      (if (not (LilyPond-inside-string-or-comment-p))
+                          (progn 
+                            ;; If bracket is a ) and we are not in embedded 
scheme, then search again
+                          (if (or (and (< nextopen (point)) inside-scheme)
+                                  (> scheme-nest-level 0)
+                                  (not (= (char-before (point)) ?\))))
+                              (progn (setq nextclose (- match-loc 1))
+                                     (setq nextclose-char (char-before 
(point)))
+                                     (setq done t))))))
+             (setq nextclose (point-max))
+             (setq done t)))))
+      (cond ((= nextclose (point-max))
+            ;; If there are no more closing brackets, then we are done and 
point is at top level.
+            (setq finished t)
+            (setq nest-level 0))
+           ((< nextclose nextopen)
+            ;; If next closing bracket is earlier then next open, 
+            ;; then go to the closing bracket. We are closing a currently-open 
nest level.
+            (if (<= parse-point nextclose);; if point is inside that nest 
level, then we are done. 
+                (progn (setq found-nest-level nest-level)
+                       (setq finished t))
+              (progn (goto-char nextclose) 
+                     (forward-char 1)
+                     (setq matching-open (nth nest-level (reverse sexp-types)))
+                   ;;; Warn if our close bracket and its matching open bracket 
are of different types
+                     (if (and (/= matching-open ?\()
+                              (/= nextclose-char (string-to-char (cdr (assoc 
(string matching-open) LilyPond-parens-alist)))))
+                         (message "Warning: Unbalanced parentheses"))
+                   ;;; Move back to a higher nesting level
+                     (setq nest-level (1- nest-level))
+                     (if (and (= nextclose-char ?\))  inside-scheme)
+                         (setq scheme-nest-level (1- scheme-nest-level)))
+                     (if (eq scheme-nest-level 0) (setq inside-scheme nil));; 
We are leaving a piece of inline Scheme
+                     (setq level-starts (cdr level-starts));; Forget the 
starting position of the just-closed nest level
+                     (setq sexp-types (cdr sexp-types))
+                     )))
+           (t 
+            ;; If next open bracket is earlier than next close bracket, 
+            ;; then go to the open bracket
+            (if (<= parse-point nextopen)
+                (progn (setq found-nest-level nest-level)
+                       (setq finished t))
+              (progn
+                (goto-char nextopen)       
+                (forward-char 1)
+                (setq nest-level (1+ nest-level))  ;;; Descend into a further 
nesting level 
+                (setq level-starts (cons nextopen level-starts));; Record the 
starting position of this nest level
+                (if (= nextopen-char  ?\()
+                    (setq scheme-nest-level (1+ scheme-nest-level)))
+                (setq sexp-types (cons nextopen-char sexp-types)))))))
+    ;; Get the open-bracket position corresponding to the located nest level 
and go there.
+    (setq beginning (nth found-nest-level (nreverse level-starts))) 
+    (goto-char beginning)
+    (if (= beginning 1);; Return nil if point is at top level
+    nil
+    beginning)))
+
diff -purN lilypond-1.5.28/lilypond-mode.el lilypond-1.5.28-new/lilypond-mode.el
--- lilypond-1.5.28/lilypond-mode.el    Mon Dec 17 09:11:42 2001
+++ lilypond-1.5.28-new/lilypond-mode.el        Wed Jan 23 22:28:58 2002
@@ -633,7 +633,7 @@ LilyPond-xdvi-command\t\tcommand to disp
   (setq block-comment-end   "%}")
 
   (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'indent-relative-maybe)
+  (setq indent-line-function 'LilyPond-indent-line)
  
     (set-syntax-table LilyPond-mode-syntax-table)
   (setq major-mode 'LilyPond-mode)