X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lilypond-indent.el;h=4626646d06a7139dd40c96cb843cdf71dc8ceae9;hb=51b0a39e4bd7c86c3ca4ae299192bd085e48d032;hp=10f43c65c0b00436ddc8f5a043c6382f3416dda0;hpb=82461fc28a3a15e4f40c874a7236a8b53c77ccc2;p=lilypond.git diff --git a/lilypond-indent.el b/lilypond-indent.el index 10f43c65c0..4626646d06 100644 --- a/lilypond-indent.el +++ b/lilypond-indent.el @@ -1,7 +1,9 @@ ;;; lilypond-indent.el --- Auto-indentation for lilypond code ;;; ;;; Heikki Junes -;;; show-paren-function was taken and then modified from FSF Emacs paren.el +;;; * 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 @@ -9,12 +11,8 @@ ;;; Variables for customising indentation style ;;; TODO: -;;; * emulate show-paren-mode, i.e., highlight the matching bracket if -;;; - the cursor is on the matching opening bracket -;;; - the cursor is after the matching closing bracket -;;; * separate '('- and ')'-slurs from '\('- and '\)'-slurs. -;;; * separate '['- and ']'-slurs from '\['- and '\]'-slurs. -;;; * currently, brackets may need a non-bracket char between ( ( ) ) +;;; * 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.") @@ -24,15 +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 . + "*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 @@ -50,6 +48,28 @@ Compares with other text in same context.") (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. @@ -60,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))) @@ -128,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." @@ -278,10 +297,11 @@ Argument LIM limit." ;; () 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 ( ?] . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)[[]" . "\\([^\\]\\([\\][\\]\\)*\\|^\\)[]]")) @@ -309,7 +329,7 @@ Argument LIM limit." 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 @@ -323,37 +343,80 @@ slur-paren-p defaults to nil. " ;;; An user does not call this function directly, or by a key sequence. ;; (interactive) - (let ( (level 1) + (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 ;; expressional slurs '\( ... \)' are not taken into account (setq regexp-alist (cons '( ?\) . ("\\([^\\]\\([\\][\\]\\)*\\|^\\)(" . "\\([^\\]\\([\\][\\]\\)*\\|^\\))")) regexp-alist))) - (if (member bracket-type (mapcar 'car regexp-alist)) - (progn (setq paren-regexp (cdr (assoc bracket-type 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 '(?} ?> ?] ?\))) + ;; 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-+>\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)>")) (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-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\|[][]\\)<")) (forward-char 1)))))) ;; jump to the matching slur - (if (sequencep bracket-type) - (if (looking-at "..[][)(]") (forward-char 1))) - (if (looking-at ".[][><)(]") (forward-char 1)) + (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) @@ -391,7 +454,7 @@ 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 () +(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 not used. In syntax table, see @@ -401,31 +464,30 @@ builtin 'blink-matching-open' is not used. In syntax table, see (let ( (oldpos (point)) (level 0) (mismatch) ) + (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 '(?] ?\))) + (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 ?\\) - (if (eq bracket-type ?]) - (message "matching ligatures \\[ ... \\]") - (message "matching slurs \\( ... \\)"))) - (if (eq char-before-bracket-type ?\\) - (setq bracket-type (string char-before-bracket-type bracket-type))) - (save-restriction - (if blink-matching-paren-distance - (narrow-to-region (max (point-min) - (- (point) blink-matching-paren-distance)) - oldpos))) - (if (memq bracket-type '(?> ?})) + (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 ( ) ;; use same mechanism for [ ] slurs - (LilyPond-beginning-of-containing-sexp bracket-type t)) + (LilyPond-scan-containing-sexp bracket-type t dir)) (setq blinkpos (point)) (setq mismatch (or (null (LilyPond-matching-paren (char-after blinkpos))) @@ -433,7 +495,8 @@ builtin 'blink-matching-open' is not used. In syntax table, see (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)) @@ -470,7 +533,12 @@ builtin 'blink-matching-open' is not used. In syntax table, see (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 () @@ -478,121 +546,21 @@ builtin 'blink-matching-open' is not used. In syntax table, see (interactive) (let ((oldpos (point))) (self-insert-command 1) - (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) - (forward-char 1))))) - -;; Find the place to show, if there is one, -;; and show it until input arrives. -(defun LilyPond-show-paren-function () - (if show-paren-mode - (let (pos dir mismatch face (oldpos (point))) - (cond ((memq (preceding-char) '(?\) ?\] ?} ?>)) - (setq dir -1)) - ((memq (following-char) '(?\( ?\[ ?{ ?<)) - (setq dir 1))) - ;; - ;; Find the other end of the sexp. - (when dir - (save-excursion - (save-restriction - ;; Determine the range within which to look for a match. - (when blink-matching-paren-distance - (narrow-to-region - (max (point-min) (- (point) blink-matching-paren-distance)) - (min (point-max) (+ (point) blink-matching-paren-distance)))) - ;; Scan across one sexp within that range. - ;; Errors or nil mean there is a mismatch. - ;;; NOTE: HERE IT IS VERY MUCH WRONG - ;;; ONE CANNOT USE scan-sexps BECAUSE - ;;; BRACKETS ARE NOT IN THE SYNTAX TABLE. - ;;; HENCE BY REPLACING THE FOLLOWING IT WILL WORK. - (condition-case () - (setq pos (scan-sexps (point) dir)) - (error (setq pos t mismatch t))) - ;; If found a "matching" paren, see if it is the right - ;; kind of paren to match the one we started at. - (when (integerp pos) - (let ((beg (min pos oldpos)) (end (max pos oldpos))) - (when (/= (char-after beg) ?\$) - (setq mismatch - (not (eq (char-before end) - ;; This can give nil. - (LilyPond-matching-paren (char-after beg))))))))))) - ;; - ;; Highlight the other end of the sexp, or unhighlight if none. - (if (not pos) - (progn - ;; If not at a paren that has a match, - ;; turn off any previous paren highlighting. - (and show-paren-overlay (overlay-buffer show-paren-overlay) - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) - (delete-overlay show-paren-overlay-1))) - ;; - ;; Use the correct face. - (if mismatch - (progn - (if show-paren-ring-bell-on-mismatch - (beep)) - (setq face 'show-paren-mismatch-face)) - (setq face 'show-paren-match-face)) - ;; - ;; If matching backwards, highlight the closeparen - ;; before point as well as its matching open. - ;; If matching forward, and the openparen is unbalanced, - ;; highlight the paren at point to indicate misbalance. - ;; Otherwise, turn off any such highlighting. - (if (and (= dir 1) (integerp pos)) - (when (and show-paren-overlay-1 - (overlay-buffer show-paren-overlay-1)) - (delete-overlay show-paren-overlay-1)) - (let ((from (if (= dir 1) - (point) - (forward-point -1))) - (to (if (= dir 1) - (forward-point 1) - (point)))) - (if show-paren-overlay-1 - (move-overlay show-paren-overlay-1 from to (current-buffer)) - (setq show-paren-overlay-1 (make-overlay from to))) - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay-1 'priority show-paren-priority) - (overlay-put show-paren-overlay-1 'face face))) - ;; - ;; Turn on highlighting for the matching paren, if found. - ;; If it's an unmatched paren, turn off any such highlighting. - (unless (integerp pos) - (delete-overlay show-paren-overlay)) - (let ((to (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - (point) - pos)) - (from (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - pos - (save-excursion - (goto-char pos) - (forward-point (- dir)))))) - (if show-paren-overlay - (move-overlay show-paren-overlay from to (current-buffer)) - (setq show-paren-overlay (make-overlay from to)))) - ;; - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay 'priority show-paren-priority) - (overlay-put show-paren-overlay 'face face))) - ;; show-paren-mode is nil in this buffer. - (and show-paren-overlay - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 - (delete-overlay show-paren-overlay-1)))) - -;; uncomment the following line to test show-paren-function -;(defun show-paren-function () (LilyPond-show-paren-function)) + ;; 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))