;;; lilypond-indent.el --- Auto-indentation for lilypond code
;;;
;;; Heikki Junes <hjunes@cc.hut.fi>
-;;; * introduce Lilypond-show-paren-function for Emacs and
-;;; Lilypond-paren-highlight for XEmacs
+;;; * ond-char paren matching is handled by context dependent syntax tables
;;; * match two-char slurs '\( ... \)' and '\[ ... \]' separately.
;;; * adopt Emacs' f90-comment-region
;;; TODO:
;;; * currently, in bracket matching one may need a non-bracket
;;; chararacter between the bracket characters, like ( ( ) )
-;;; * in syntax-highlighting slurs are not always highlighted the right way
-;;; e.g. opening slurs are found found better in "#( ( ) ( ) )" than
-;;; opening slurs
-;;; * Mouse double-clicks should use LilyPond-scan-sexps for slur matching.
(defcustom LilyPond-indent-level 4
"*Indentation of lilypond statements with respect to containing block.")
"This function is redefined to be used in Emacs' show-paren-function and
in XEmacs' paren-highlight."
(LilyPond-blink-matching-paren dir))
-
-;;; From Emacs' paren.el, with minimal changes (see "LilyPond"-lines)
-;; Find the place to show, if there is one,
-;; and show it until input arrives.
-(defun LilyPond-show-paren-function ()
- (if LilyPond-show-paren-mode
- (let (pos dir mismatch face (oldpos (point)))
- (cond ((eq (char-syntax (preceding-char)) ?\))
- (setq dir -1))
- ((eq (char-syntax (following-char)) ?\()
- (setq dir 1)))
- ;;
- ;; Find the other end of the sexp.
- (when (and dir
- (not (LilyPond-inside-string-or-comment-p)))
- (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.
- (condition-case ()
- (setq pos (LilyPond-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-syntax (char-after beg)) ?\$)
- (setq mismatch
- (not (eq (char-before end)
- ;; This can give nil.
- (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))))
-
-;;; From XEmacs' paren.el, with minimal changes (see "LilyPond"-lines)
-;; Find the place to show, if there is one,
-;; and show it until input arrives.
-(defun LilyPond-paren-highlight ()
- "This highlights matching parentheses.
-
-See the variables:
- paren-message-offscreen use modeline when matching paren is offscreen?
- paren-ding-unmatched make noise when passing over mismatched parens?
- paren-mode 'blink-paren, 'paren, or 'sexp
- blink-matching-paren-distance maximum distance to search for parens.
-
-and the following faces:
- paren-match, paren-mismatch, paren-blink-off"
-
- ;; I suppose I could check here to see if a keyboard macro is executing,
- ;; but I did a quick empirical check and couldn't tell that there was any
- ;; difference in performance
-
- (let ((oldpos (point))
- (pface nil) ; face for paren...nil kills the overlay
- (dir (and paren-mode
- (not (input-pending-p))
- (not executing-kbd-macro)
- (cond ((eq (char-syntax (preceding-char)) ?\))
- -1)
- ((eq (char-syntax (following-char)) ?\()
- 1))))
- pos mismatch)
-
- (save-excursion
- (if (or (not dir)
- (LilyPond-inside-string-or-comment-p)
- (not (save-restriction
- ;; Determine the range within which to look for a match.
- (if 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.
- (condition-case nil
- (setq pos (LilyPond-scan-sexps (point) dir))
- ;; NOTE - if blink-matching-paren-distance is set,
- ;; then we can have spurious unmatched parens.
- (error (paren-maybe-ding)
- nil)))))
-
- ;; do nothing if we didn't find a matching paren...
- nil
-
- ;; See if the "matching" paren is the right kind of paren
- ;; to match the one we started at.
- (let ((beg (min pos oldpos)) (end (max pos oldpos)))
- (setq mismatch
- (and (/= (char-syntax (char-after beg)) ?\\)
- (/= (char-syntax (char-after beg)) ?\$)
- ;; XEmacs change
- (matching-paren (char-after beg))
- (/= (char-after (1- end))
- (matching-paren (char-after beg)))))
- (if (eq paren-mode 'sexp)
- (setq paren-extent (make-extent beg end))))
- (and mismatch
- (paren-maybe-ding))
- (setq pface (if mismatch
- 'paren-mismatch
- 'paren-match))
- (and (memq paren-mode '(blink-paren paren))
- (setq paren-extent (make-extent (- pos dir) pos)))
-
- (if (and paren-message-offscreen
- (eq dir -1)
- (not (current-message))
- (not (window-minibuffer-p (selected-window)))
- (not (pos-visible-in-window-safe pos)))
- (paren-describe-match pos mismatch))
-
- ;; put the right face on the extent
- (cond (pface
- (set-extent-face paren-extent pface)
- (set-extent-priority paren-extent 100) ; want this to be high
- (and (eq paren-mode 'blink-paren)
- (setq paren-blink-on-face pface
- paren-n-blinks 0
- paren-timeout-id
- (and paren-blink-interval
- (add-timeout paren-blink-interval
- 'paren-blink-timeout
- nil
- paren-blink-interval))))))
- ))))
-
-(if (not (string-match "XEmacs\\|Lucid" emacs-version))
-;;; EMACS' Lilypond-show-paren-mode definition
-(define-minor-mode LilyPond-show-paren-mode
- "Toggle Show Paren mode.
-With prefix ARG, turn Show Paren mode on if and only if ARG is positive.
-Returns the new status of Show Paren mode (non-nil means on).
-
-When Show Paren mode is enabled, any matching parenthesis is highlighted
-in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
- :global t :group 'LilyPond-paren-showing
- ;; Turn off the usual paren-matching method
- ;; when this one is turned on.
- (if (local-variable-p 'LilyPond-show-paren-mode)
- (make-local-variable 'blink-matching-paren-on-screen)
- (kill-local-variable 'blink-matching-paren-on-screen))
- (setq blink-matching-paren-on-screen (not LilyPond-show-paren-mode))
- ;; Now enable or disable the mechanism.
- ;; First get rid of the old idle timer.
- (if show-paren-idle-timer
- (cancel-timer show-paren-idle-timer))
- (if (boundp 'LilyPond-show-paren-idle-timer)
- (cancel-timer LilyPond-show-paren-idle-timer))
- (setq LilyPond-show-paren-idle-timer nil)
- ;; If show-paren-mode is enabled in some buffer now,
- ;; set up a new timer.
- (when (memq t (mapcar (lambda (buffer)
- (or (with-current-buffer buffer
- show-paren-mode)
- (with-current-buffer buffer
- LilyPond-show-paren-mode)))
- (buffer-list)))
- (setq LilyPond-show-paren-idle-timer (run-with-idle-timer
- show-paren-delay t
- 'LilyPond-show-paren-function)))
- (unless show-paren-mode
- (and show-paren-overlay
- (eq (overlay-buffer show-paren-overlay) (current-buffer))
- (delete-overlay show-paren-overlay))
- (and show-paren-overlay-1
- (eq (overlay-buffer show-paren-overlay-1) (current-buffer))
- (delete-overlay show-paren-overlay-1))))
-;;; XEMACS' Lilypond-paren-set-mode definition
-(defun LilyPond-paren-set-mode (arg &optional quiet)
- "Cycles through possible values for `paren-mode', force off with negative arg.
-When called from lisp, a symbolic value for `paren-mode' can be passed directly.
-See also `paren-mode' and `paren-highlight'."
- (interactive "P")
- ;; kill off the competition, er, uh, eliminate redundancy...
- (setq post-command-hook (delq 'show-paren-command-hook post-command-hook))
- (setq pre-command-hook (delq 'blink-paren-pre-command pre-command-hook))
- (setq post-command-hook (delq 'blink-paren-post-command post-command-hook))
-
- (let* ((paren-modes '(blink-paren paren sexp))
- (paren-next-modes (cons nil (append paren-modes (list nil)))))
- (setq paren-mode (if (and (numberp arg) (< arg 0))
- nil ; turn paren highlighting off
- (cond ((and arg (symbolp arg)) arg)
- ((and (numberp arg) (> arg 0))
- (nth (1- arg) paren-modes))
- ((numberp arg) nil)
- (t (car (cdr (memq paren-mode
- paren-next-modes)))))
- )))
- (cond (paren-mode
- (add-hook 'post-command-hook 'LilyPond-paren-highlight)
- (add-hook 'pre-command-hook 'paren-nuke-extent)
- (setq blink-matching-paren nil))
- ((not (local-variable-p 'paren-mode (current-buffer)))
- (remove-hook 'post-command-hook 'LilyPond-paren-highlight)
- (remove-hook 'pre-command-hook 'paren-nuke-extent)
- (paren-nuke-extent) ; overkill
- (setq blink-matching-paren t)
- ))
- (or quiet (message "Paren mode is %s" (or paren-mode "OFF"))))
-)
projects / lilypond.git / blobdiff