procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* emacs-lisp/smie.el (smie-matching-block-highlight): New face.

Browse source 
(smie--highlight-matching-block-overlay)
(smie--highlight-matching-block-lastpos)
(smie--highlight-matching-block-timer): New variables.
(smie-highlight-matching-block): New function.
(smie-highlight-matching-block-mode): New minor mode. 
(smie-setup): Conditionally enable smie-blink-matching-open.

Fixes: debbugs:14395
This commit is contained in:
Leo Liu 2013-05-17 06:58:58 +08:00
parent 46cd302842
commit ebfe68e85a
2 changed files with 92 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

84
lisp/emacs-lisp/smie.el
View file

@ -1021,6 +1021,85 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
(let ((blink-matching-check-function #'smie-blink-matching-check))
(blink-matching-open))))))))
(defface smie-matching-block-highlight '((t (:inherit highlight)))
"Face used to highlight matching block."
:group 'smie)
(defvar-local smie--highlight-matching-block-overlay nil)
(defvar-local smie--highlight-matching-block-lastpos -1)
(defun smie-highlight-matching-block ()
(when (and smie-closer-alist
(/= (point) smie--highlight-matching-block-lastpos))
(unless (overlayp smie--highlight-matching-block-overlay)
(setq smie--highlight-matching-block-overlay
(make-overlay (point) (point))))
(setq smie--highlight-matching-block-lastpos (point))
(let ((beg-of-tok
(lambda (&optional start)
"Move to the beginning of current token at START."
(let* ((token)
(start (or start (point)))
(beg (progn
(funcall smie-backward-token-function)
(forward-comment (point-max))
(point)))
(end (progn
(setq token (funcall smie-forward-token-function))
(forward-comment (- (point)))
(point))))
(if (and (<= beg start) (<= start end)
(or (assoc token smie-closer-alist)
(rassoc token smie-closer-alist)))
(progn (goto-char beg) token)
(goto-char start)
nil))))
(highlight
(lambda (beg end)
(move-overlay smie--highlight-matching-block-overlay beg end)
(overlay-put smie--highlight-matching-block-overlay
'face 'smie-matching-block-highlight))))
(save-excursion
(condition-case nil
(if (nth 8 (syntax-ppss))
(overlay-put smie--highlight-matching-block-overlay 'face nil)
(let ((token
(or (funcall beg-of-tok)
(funcall beg-of-tok
(prog1 (point)
(funcall smie-forward-token-function))))))
(cond
((assoc token smie-closer-alist) ; opener
(forward-sexp 1)
(let ((end (point))
(closer (funcall smie-backward-token-function)))
(when (rassoc closer smie-closer-alist)
(funcall highlight (point) end))))
((rassoc token smie-closer-alist) ; closer
(funcall smie-forward-token-function)
(forward-sexp -1)
(let ((beg (point))
(opener (funcall smie-forward-token-function)))
(when (assoc opener smie-closer-alist)
(funcall highlight beg (point)))))
(t (overlay-put smie--highlight-matching-block-overlay
'face nil)))))
(scan-error
(overlay-put smie--highlight-matching-block-overlay 'face nil)))))))
(defvar smie--highlight-matching-block-timer nil)
;;;###autoload
(define-minor-mode smie-highlight-matching-block-mode nil
:global t :group 'smie
(when (timerp smie--highlight-matching-block-timer)
(cancel-timer smie--highlight-matching-block-timer))
(setq smie--highlight-matching-block-timer nil)
(when smie-highlight-matching-block-mode
(remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)
(setq smie--highlight-matching-block-timer
(run-with-idle-timer 0.2 t #'smie-highlight-matching-block))))
;;; The indentation engine.
(defcustom smie-indent-basic 4
@ -1701,8 +1780,9 @@ KEYWORDS are additional arguments, which can use the following keywords:
;; Only needed for interactive calls to blink-matching-open.
(set (make-local-variable 'blink-matching-check-function)
#'smie-blink-matching-check)
(add-hook 'post-self-insert-hook
#'smie-blink-matching-open 'append 'local)
(unless smie-highlight-matching-block-mode
(add-hook 'post-self-insert-hook
#'smie-blink-matching-open 'append 'local))
(set (make-local-variable 'smie-blink-matching-triggers)
(append smie-blink-matching-triggers
;; Rather than wait for SPC to blink, try to blink as