X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lilypond-indent.el;h=4626646d06a7139dd40c96cb843cdf71dc8ceae9;hb=f120ad5d2b42aa7078d248df3213f6520ddc165b;hp=3a10a11ed6912e7b1f878f552f7a56a7a37d23e0;hpb=f7133fb1c001b9ba924d2cdc0ed3765193b66245;p=lilypond.git diff --git a/lilypond-indent.el b/lilypond-indent.el index 3a10a11ed6..4626646d06 100644 --- a/lilypond-indent.el +++ b/lilypond-indent.el @@ -1,13 +1,18 @@ ;;; lilypond-indent.el --- Auto-indentation for lilypond code ;;; +;;; Heikki Junes +;;; * ond-char paren matching is handled by context dependent syntax tables +;;; * match two-char slurs '\( ... \)' and '\[ ... \]' separately. +;;; * adopt Emacs' f90-comment-region + ;;; Chris Jackson ;;; some code is taken from ESS (Emacs Speaks Statistics) S-mode by A.J.Rossini ;;; Variables for customising indentation style ;;; TODO: -;;; * emulate show-paren-mode -;;; * separate '('- and ')'-slurs from '\('- and '\)'-slurs. +;;; * currently, in bracket matching one may need a non-bracket +;;; chararacter between the bracket characters, like ( ( ) ) (defcustom LilyPond-indent-level 4 "*Indentation of lilypond statements with respect to containing block.") @@ -17,11 +22,15 @@ Compares with other text in same context.") (defcustom LilyPond-angle-offset 0 - "*Extra indentation for open angled brackets . + "*Extra indentation for open angled brackets. +Compares with other text in same context.") + +(defcustom LilyPond-square-offset 0 + "*Extra indentation for open square brackets. Compares with other text in same context.") (defcustom LilyPond-scheme-paren-offset 0 - "*Extra indentation for open scheme parens . + "*Extra indentation for open scheme parens. Compares with other text in same context.") (defcustom LilyPond-close-brace-offset 0 @@ -30,12 +39,37 @@ Compares with other text in same context.") (defcustom LilyPond-close-angle-offset 0 "*Extra indentation for closing angle brackets.") +(defcustom LilyPond-close-square-offset 0 + "*Extra indentation for closing square 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.") +(defcustom LilyPond-comment-region "%%$" + "*String inserted by \\[LilyPond-comment-region]\ + at start of each line in region.") + +(defun LilyPond-comment-region (beg-region end-region) + "Comment/uncomment every line in the region. +Insert LilyPond-comment-region at the beginning of every line in the region +or, if already present, remove it." + (interactive "*r") + (let ((end (make-marker))) + (set-marker end end-region) + (goto-char beg-region) + (beginning-of-line) + (if (looking-at (regexp-quote LilyPond-comment-region)) + (delete-region (point) (match-end 0)) + (insert LilyPond-comment-region)) + (while (and (zerop (forward-line 1)) + (< (point) (marker-position end))) + (if (looking-at (regexp-quote LilyPond-comment-region)) + (delete-region (point) (match-end 0)) + (insert LilyPond-comment-region))) + (set-marker end nil))) (defun LilyPond-calculate-indent () "Return appropriate indentation for current line as lilypond code. @@ -46,7 +80,7 @@ Returns nil if line starts inside a string" (let ((indent-point (point)) (case-fold-search nil) state) - (setq containing-sexp (save-excursion (LilyPond-beginning-of-containing-sexp))) + (setq containing-sexp (save-excursion (LilyPond-scan-containing-sexp))) (beginning-of-defun) (while (< (point) indent-point) (setq state (parse-partial-sexp (point) indent-point 0))) @@ -102,6 +136,8 @@ Returns nil if line starts inside a string" LilyPond-brace-offset) ((= (following-char) ?<) LilyPond-angle-offset) + ((= (following-char) ?[) + LilyPond-square-offset) ((= (following-char) ?\)) LilyPond-scheme-paren-offset) (t @@ -112,7 +148,6 @@ Returns nil if line starts inside a string" (current-indentation))))))))) - (defun LilyPond-indent-line () "Indent current line as lilypond code. Return the amount the indentation changed by." @@ -139,12 +174,16 @@ Return the amount the indentation changed by." (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-square-offset LilyPond-indent-level)))) ((and (= (following-char) ?\)) (LilyPond-inside-scheme-p)) (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-square-offset))) ((and (= (following-char) ?\() (LilyPond-inside-scheme-p)) (setq indent (+ indent LilyPond-scheme-paren-offset))) )))) @@ -254,36 +293,43 @@ Argument LIM limit." ;; Key: Type of bracket (character). -;; Value: Pair of regexps representing the corresponding open and close bracket" -;; () are treated specially (need to indent in Scheme but not in music), and [] -;; are handled by the syntax table +;; Value: Pair of regexps representing the corresponding open and close bracket +;; () are treated specially (need to indent in Scheme but not in music) (defconst LilyPond-parens-regexp-alist - `( ( ?> . ("\\([^\\]\\|^\\)<" . "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>")) + `( ( ?> . ("\\([^\\]\\|^\\)<" . "\\([^ \\n\\t_^-]\\|[_^-][-^]\\|\\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 + ;; duh .. a single '>', as in chords '<< ... >>', was not matched here ( ?} . ("{" . "}")) + ;; ligatures '\[ ... \]' are skipped in the following expression + ( ?] . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]")) + ( "\\]" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][[]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][]]")) + ( "\\)" . ("\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][(]" . "\\([^\\]\\|^\\)\\([\\][\\]\\)*[\\][)]")) )) (defconst LilyPond-parens-alist `( ( ?< . ?> ) ( ?{ . ?} ) + ( ?[ . ?] ) + ( "\\[" . "\\]" ) ( ?\( . ?\) ) + ( "\\(" . "\\)" ) )) (defun LilyPond-matching-paren (bracket-type) "Returns the open corresponding to the close specified by bracket-type, or vice versa" - (cond ( (memq bracket-type (mapcar 'car LilyPond-parens-alist)) + (cond ( (member bracket-type (mapcar 'car LilyPond-parens-alist)) (cdr (assoc bracket-type LilyPond-parens-alist)) ) - ( (memq bracket-type (mapcar 'cdr LilyPond-parens-alist)) + ( (member bracket-type (mapcar 'cdr LilyPond-parens-alist)) (car (rassoc bracket-type LilyPond-parens-alist)) ) nil)) -(defun LilyPond-beginning-of-containing-sexp (&optional bracket-type slur-paren-p) +(defun LilyPond-scan-containing-sexp (&optional bracket-type slur-paren-p dir) "Move point to the beginning of the deepest parenthesis pair enclosing point. If the optional argument bracket-type, a character representing a @@ -295,34 +341,82 @@ parentheses () are considered as matching pairs. Otherwise Scheme parentheses are considered to be matching pairs, but slurs are not. slur-paren-p defaults to nil. " - (interactive) - (let ( (level 1) +;;; An user does not call this function directly, or by a key sequence. + ;; (interactive) + (let ( (level (if (not (eq dir 1)) 1 -1)) (regexp-alist LilyPond-parens-regexp-alist) - (oldpos (point) ) ) + (oldpos (point)) + (assoc-bracket-type (if (not (eq dir 1)) bracket-type (LilyPond-matching-paren bracket-type)))) + (if (LilyPond-inside-scheme-p) (setq paren-regexp "(\\|)") (if slur-paren-p - (setq regexp-alist (cons '( ?\) . ("(" . ")")) regexp-alist))) - (if (memq bracket-type (mapcar 'car regexp-alist)) - (progn (setq paren-regexp (cdr (assoc bracket-type regexp-alist))) + ;; expressional slurs '\( ... \)' are not taken into account + (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" . "\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist))) + (if (member assoc-bracket-type (mapcar 'car regexp-alist)) + (progn (setq paren-regexp (cdr (assoc assoc-bracket-type regexp-alist))) (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp)))) (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|" (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|"))))) - (while (and (> level 0) - (re-search-backward paren-regexp nil t) + ;; match concurrent one-char opening and closing slurs + (if (and (eq dir 1) + (not (sequencep bracket-type)) + (eq (char-syntax (char-after oldpos)) ?\() + (not (eq (char-after oldpos) ?<))) + ;; anyway do not count open slur, since already level = -1 + (progn (forward-char 1) + (if (eq (following-char) + (LilyPond-matching-paren (char-after oldpos))) + ;; matching char found, go after it and set level = 0 + (progn (forward-char 1) + (setq level 0))))) + ;; browse the code until matching slur is found, or report mismatch + (while (and (if (not (eq dir 1)) + (> level 0) + (< level 0)) + ;; dir tells whether to search backward or forward + (if (not (eq dir 1)) + (re-search-backward paren-regexp nil t) + (re-search-forward paren-regexp nil t)) + ;; note: in case of two-char bracket only latter is compared (setq match (char-before (match-end 0)))) - (if (not (save-excursion (goto-char (match-end 0)) +;;; (message "%d" level) (sit-for 0 300) + (if (not (save-excursion (goto-char (match-end 0)) + ;; skip over strings and comments (LilyPond-inside-string-or-comment-p))) - (if (memq match '(?} ?> ?\))) + (if (memq match '(?} ?> ?] ?\))) + ;; count closing brackets (progn (setq level (1+ level)) + ;; slurs may be close to each other, e.g., + ;; a single '>' was not matched .. need to be corrected + (if (and (eq dir 1) (eq (char-after (match-end 0)) match)) + (if (/= level 0) + (progn + (setq level (1+ level)) + (forward-char 1)))) +;;; (message "%d %c" level match) (sit-for 0 300) + ;; hmm.. (if (and (= match ?>) - (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\)>")) + (looking-at ".\\s-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>")) (forward-char 1))) + ;; count opening brackets (progn (setq level (1- level)) +;;; (message "%d %c" level match) (sit-for 0 300) + ;; hmm.. (if (and (= match ?<) - (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\)<")) + (looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<")) (forward-char 1)))))) - (if (looking-at ".<\\|.>") (forward-char 1)) + ;; jump to the matching slur + (if (not (eq dir 1)) + (progn + (if (sequencep bracket-type) + ;; match the latter char in two-char brackets + (if (looking-at "..[][)(]") (forward-char 1))) + ;; if the following char is not already a slur + (if (and (not (looking-at "[)(]")) + ;; match the slur which follows + (looking-at ".[][><)(]")) (forward-char 1))) + (backward-char 1)) (if (= level 0) (point) (progn (goto-char oldpos) @@ -331,7 +425,8 @@ slur-paren-p defaults to nil. (defun LilyPond-inside-scheme-p () "Tests if point is inside embedded Scheme code" - (interactive) +;;; An user does not call this function directly, or by a key sequence. + ;; (interactive) (let ( (test-point (point)) (level 0) ) (save-excursion @@ -359,25 +454,40 @@ slur-paren-p defaults to nil. ;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in ;;; the Emacs distribution. -(defun LilyPond-blink-matching-open (bracket-type) +(defun LilyPond-blink-matching-paren (&optional dir) "Move cursor momentarily to the beginning of the sexp before -point. In lilypond files this is used for closing ), } and >, whereas the -builtin 'blink-matching-open' is used for closing ], which is in -the syntax table" - (interactive) +point. In lilypond files this is used for closing ), ], } and >, whereas the +builtin 'blink-matching-open' is not used. In syntax table, see +`lilypond-font-lock.el', all brackets are punctuation characters." +;;; An user does not call this function directly, or by a key sequence. + ;; (interactive) (let ( (oldpos (point)) (level 0) (mismatch) ) - (save-restriction - (if blink-matching-paren-distance - (narrow-to-region (max (point-min) - (- (point) blink-matching-paren-distance)) - oldpos))) - (if (memq bracket-type '(?> ?})) + (if (not (or (equal this-command 'LilyPond-electric-close-paren) + (eq dir 1))) + (goto-char (setq oldpos (- oldpos 1)))) + ;; Test if a ligature \] or expressional slur \) was encountered + (setq bracket-type (char-after (point))) + (setq char-before-bracket-type nil) + (if (memq bracket-type '(?] ?\) ?[ ?\()) + (progn + (setq np -1) + (while (eq (char-before (- (point) (setq np (+ np 1)))) ?\\) + (setq char-before-bracket-type (if char-before-bracket-type nil ?\\))) + (if (eq char-before-bracket-type ?\\) + (setq bracket-type (string char-before-bracket-type bracket-type))))) + (when blink-matching-paren-distance + (narrow-to-region + (max (point-min) (- (point) blink-matching-paren-distance)) + (min (point-max) (+ (point) blink-matching-paren-distance)))) + (if (and (equal this-command 'LilyPond-electric-close-paren) + (memq bracket-type '(?> ?} ?< ?{))) ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types - (LilyPond-beginning-of-containing-sexp nil nil) + (LilyPond-scan-containing-sexp nil nil dir) ;; whereas ( ) slurs within music don't, so only need to search for ( ) - (LilyPond-beginning-of-containing-sexp bracket-type t)) + ;; use same mechanism for [ ] slurs + (LilyPond-scan-containing-sexp bracket-type t dir)) (setq blinkpos (point)) (setq mismatch (or (null (LilyPond-matching-paren (char-after blinkpos))) @@ -385,7 +495,8 @@ the syntax table" (LilyPond-matching-paren (char-after blinkpos))))) (if mismatch (progn (setq blinkpos nil) (message "Mismatched parentheses"))) - (if blinkpos + (if (and blinkpos + (equal this-command 'LilyPond-electric-close-paren)) (if (pos-visible-in-window-p) (and blink-matching-paren-on-screen (sit-for blink-matching-delay)) @@ -422,20 +533,34 @@ the syntax table" (buffer-substring blinkpos (1+ blinkpos))) ;; There is nothing to show except the char itself. (buffer-substring blinkpos (1+ blinkpos)))))))) - (goto-char oldpos))) + (if (not (equal this-command 'LilyPond-electric-close-paren)) + (goto-char (setq oldpos (+ oldpos 1))) + (goto-char oldpos)) + (if (not (eq dir 1)) + blinkpos + (+ blinkpos 1)))) (defun LilyPond-electric-close-paren () - "Blink on the matching open paren when a > or ) is inserted" + "Blink on the matching open paren when a >, ), } or ] is inserted" (interactive) (let ((oldpos (point))) (self-insert-command 1) - (setq close-char (char-before (point))) - (if (and blink-matching-paren - (not (LilyPond-inside-string-or-comment-p)) - (save-excursion (re-search-backward - (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t) - (eq oldpos (1- (match-end 0))))) - (progn (backward-char 1) - (LilyPond-blink-matching-open close-char) - (forward-char 1))))) + ;; Refontify buffer if a block-comment-ender '%}' is inserted + (if (and (eq (char-before (point)) ?}) + (eq (char-before (- (point) 1)) ?%)) + (font-lock-fontify-buffer) + ;; Match paren if the cursor is not inside string or comment. + (if (and blink-matching-paren + (not (LilyPond-inside-string-or-comment-p)) + (save-excursion (re-search-backward + (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t) + (eq oldpos (1- (match-end 0))))) + (progn (backward-char 1) + (LilyPond-blink-matching-paren) + (forward-char 1)))))) + +(defun LilyPond-scan-sexps (pos dir) + "This function is redefined to be used in Emacs' show-paren-function and +in XEmacs' paren-highlight." + (LilyPond-blink-matching-paren dir))