;;;; -*- mode:emacs-lisp;coding:utf-8 -*- ;;;;**************************************************************************** ;;;;FILE: pjb-blink.el ;;;;LANGUAGE: emacs lisp ;;;;SYSTEM: POSIX ;;;;USER-INTERFACE: NONE ;;;;DESCRIPTION ;;;; ;;;; Alternate blinking parens. ;;;; ;;;;AUTHORS ;;;; <PJB> Pascal Bourguignon <pjb@informatimago.com> ;;;;MODIFICATIONS ;;;; 2005-09-20 <PJB> Created. ;;;;BUGS ;;;;LEGAL ;;;; GPL ;;;; ;;;; Copyright Pascal Bourguignon 2005 - 2011 ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU General Public License ;;;; as published by the Free Software Foundation; either version ;;;; 2 of the License, or (at your option) any later version. ;;;; ;;;; This program is distributed in the hope that it will be ;;;; useful, but WITHOUT ANY WARRANTY; without even the implied ;;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;;;; PURPOSE. See the GNU General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU General Public ;;;; License along with this program; if not, write to the Free ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; Boston, MA 02111-1307 USA ;;;;**************************************************************************** (defun blink (start end) (set-mark start) (goto-char (1+ end))) (defun unblink (start end) "Nothing to do") ;; Another implementation of blink and unblink could set the face, ;; or put some overlay on the region or on the start and end characters. (defun blink-matching-open-and-close () "Move cursor momentarily to the beginning of the sexp before point." (interactive) (let ((close-point (1- (point)))) (and (> (point) (1+ (point-min))) blink-matching-paren ;; Verify an even number of quoting characters precede the close. (= 1 (logand 1 (- (point) (save-excursion (forward-char -1) (skip-syntax-backward "/\\") (point))))) (let* ((oldpos (point)) (blinkpos) (mismatch) matching-paren) (save-excursion (save-restriction (if blink-matching-paren-distance (narrow-to-region (max (point-min) (- (point) blink-matching-paren-distance)) oldpos)) (condition-case () (let ((parse-sexp-ignore-comments (and parse-sexp-ignore-comments (not blink-matching-paren-dont-ignore-comments)))) (setq blinkpos (scan-sexps oldpos -1))) (error nil))) (and blinkpos ;; Not syntax '$'. (not (eq (syntax-class (syntax-after blinkpos)) 8)) (setq matching-paren (let ((syntax (syntax-after blinkpos))) (and (consp syntax) (eq (syntax-class syntax) 4) (cdr syntax))) mismatch (or (null matching-paren) (/= (char-after (1- oldpos)) matching-paren)))) (if mismatch (setq blinkpos nil)) (if blinkpos ;; Don't log messages about paren matching. (let (message-log-max) (blink blinkpos close-point) (if (pos-visible-in-window-p) (and blink-matching-paren-on-screen (sit-for blink-matching-delay)) (goto-char blinkpos) (message "Matches %s" ;; Show what precedes the open in its line, if anything. (if (save-excursion (skip-chars-backward " \t") (not (bolp))) (buffer-substring (progn (beginning-of-line) (point)) (1+ blinkpos)) ;; Show what follows the open in its line, if anything. (if (save-excursion (forward-char 1) (skip-chars-forward " \t") (not (eolp))) (buffer-substring blinkpos (progn (end-of-line) (point))) ;; Otherwise show the previous nonblank line, ;; if there is one. (if (save-excursion (skip-chars-backward "\n \t") (not (bobp))) (concat (buffer-substring (progn (skip-chars-backward "\n \t") (beginning-of-line) (point)) (progn (end-of-line) (skip-chars-backward " \t") (point))) ;; Replace the newline and other whitespace with `...'. "..." (buffer-substring blinkpos (1+ blinkpos))) ;; There is nothing to show except the char itself. (buffer-substring blinkpos (1+ blinkpos))))))) (unblink blinkpos close-point)) (cond (mismatch (message "Mismatched parentheses")) ((not blink-matching-paren-distance) (message "Unmatched parenthesis"))))))))) (setf blink-paren-function (function blink-matching-open-and-close))