From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Leo Liu Newsgroups: gmane.emacs.bugs Subject: bug#14395: 24.3; [PATCH] new feature smie-highlight-matching-block Date: Thu, 16 May 2013 11:27:31 +0800 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1368674882 8803 80.91.229.3 (16 May 2013 03:28:02 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 16 May 2013 03:28:02 +0000 (UTC) Cc: 14395@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu May 16 05:28:00 2013 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UcorI-0004gb-4Y for geb-bug-gnu-emacs@m.gmane.org; Thu, 16 May 2013 05:28:00 +0200 Original-Received: from localhost ([::1]:56428 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UcorH-0005n3-E9 for geb-bug-gnu-emacs@m.gmane.org; Wed, 15 May 2013 23:27:59 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:39149) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UcorD-0005mn-KJ for bug-gnu-emacs@gnu.org; Wed, 15 May 2013 23:27:57 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UcorC-0003aC-Gf for bug-gnu-emacs@gnu.org; Wed, 15 May 2013 23:27:55 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:58411) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UcorC-0003a7-D1 for bug-gnu-emacs@gnu.org; Wed, 15 May 2013 23:27:54 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1UcorK-0005Ug-2O for bug-gnu-emacs@gnu.org; Wed, 15 May 2013 23:28:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Leo Liu Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 16 May 2013 03:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 14395 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 14395-submit@debbugs.gnu.org id=B14395.136867488021111 (code B ref 14395); Thu, 16 May 2013 03:28:02 +0000 Original-Received: (at 14395) by debbugs.gnu.org; 16 May 2013 03:28:00 +0000 Original-Received: from localhost ([127.0.0.1]:46769 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1UcorH-0005UR-Ph for submit@debbugs.gnu.org; Wed, 15 May 2013 23:28:00 -0400 Original-Received: from mail-da0-f45.google.com ([209.85.210.45]:50677) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1UcorE-0005UE-5r for 14395@debbugs.gnu.org; Wed, 15 May 2013 23:27:57 -0400 Original-Received: by mail-da0-f45.google.com with SMTP id w3so1369460dad.32 for <14395@debbugs.gnu.org>; Wed, 15 May 2013 20:27:42 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=x-received:from:to:cc:subject:references:face:date:in-reply-to :message-id:user-agent:mime-version:content-type; bh=7emrrDvKl7TfB7lwTaRhT0SilRwJP4asMMsCaIjPzCE=; b=z4gh+uS5hqjPvF/ErGSypsfRwyiybluMJnvREBncbJbKxzOAo+nL7ykN8yOofpVlsa XX7phVxqTzK/PrzDYKEf7/h9GmRawhbqDxApKSZXxVMs3kY3kpXPx7WSw8HMG1fFwYmd s9M6FiBNnTw/vv/wQt6Xn7DHeMk1Y8znLQ+VgSdTRvYL/Uy41AkEradthWuCzrmNzfIg EUBeYaYSD6+oQy+3fGZzpGQZEM2rgZcRFxRhnSdpT7ygQyazEUBXe/zE9YBWrqb88GYA JOOYruf0gM8eEgNbnkEMxyTee0+Eiha//+0YIevi2yb2gdo15WFaJ92X9BnC0C4k6Lr+ ISjw== X-Received: by 10.66.27.99 with SMTP id s3mr42235681pag.73.1368674862048; Wed, 15 May 2013 20:27:42 -0700 (PDT) Original-Received: from Zeuss-MacBook.local (li511-224.members.linode.com. [66.175.216.224]) by mx.google.com with ESMTPSA id uv1sm4993853pbc.16.2013.05.15.20.27.38 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Wed, 15 May 2013 20:27:41 -0700 (PDT) Face: iVBORw0KGgoAAAANSUhEUgAAACkAAAApAQAAAACAGz1bAAABKElEQVQYlWNg3NIt5FDPUPt7 4+X79Qyucz5/ugik+L2PBgKpyphaIK921q23QDnG0NBQoMr/vaWl9f8ZLL78uPv5PwN7RETfzXoG jhmFz27XM0RXmpuY/WfY+fv0Mc56BvFybfXA/wwL5t/wF61n2PU59axXPcOVzbmSW/8zrNt1benC /ww70hqUU/4zKCtrT9jwn8FhwynbufUMendE2aLqGRpdX9al1zM8eh17lKeeQcTMrdD5P8P3j/YT Q/8zXHSb7p1Qz/C4OM2JuZ7hgtI7K6AjqsMnf8j4z8C6xG1tw3+GqpqvsVn/GTzmpD9j/8/wP/oZ S/l/Bka+QO/g/wy15ueeFQL9N1O8mPU/g+umV3t1gdT0/1bTgHLqYVeXAlWKpMWt+w8Az82C9nHf X0cAAAAASUVORK5CYII= In-Reply-To: (Stefan Monnier's message of "Wed, 15 May 2013 22:31:47 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (OS X 10.8.3) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:74312 Archived-At: On 2013-05-16 10:31 +0800, Stefan Monnier wrote: >> +(define-minor-mode smie-highlight-matching-block-mode nil > > Please provide a docstring. Is the automatically-provided docstring good enough? New patch as follows. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index bbdd9f83..de91c21f 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1021,6 +1021,85 @@ (defun smie-blink-matching-open () (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 + (when (timerp smie--highlight-matching-block-timer) + (cancel-timer smie--highlight-matching-block-timer)) + (if smie-highlight-matching-block-mode + (setq smie--highlight-matching-block-timer + (run-with-idle-timer 0.2 t #'smie-highlight-matching-block)) + (when (timerp smie--highlight-matching-block-timer) + (cancel-timer smie--highlight-matching-block-timer)) + (setq smie--highlight-matching-block-timer nil))) + ;;; The indentation engine. (defcustom smie-indent-basic 4 @@ -1698,8 +1777,11 @@ (defun smie-setup (grammar rules-function &rest 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) + (if smie-highlight-matching-block-mode + (remove-hook 'post-self-insert-hook + #'smie-blink-matching-open 'local) + (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