diff lisp/packages/mic-paren.el @ 72:b9518feda344 r20-0b31

Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 27bc7f280385
children bcdc7deadc19
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/mic-paren.el	Mon Aug 13 09:03:46 2007 +0200
@@ -0,0 +1,577 @@
+;;; mic-paren.el --- highlight matching paren.
+;;; Version 1.0 - 96-08-16
+;;; Copyright (C) 1996 Mikael Sjödin (mic@docs.uu.se)
+;;;
+;;; Author: Mikael Sjödin  --  mic@docs.uu.se
+;;; Keywords: languages, faces
+;;;
+;;; This file is NOT part of GNU Emacs.
+;;; You may however 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, or (at your option) any later version.
+;;;
+;;; mic-paren 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.
+
+;;; ----------------------------------------------------------------------
+;;; Short Description:
+;;;
+;;; Load this file and Emacs will display highlighting on whatever
+;;; parenthesis matches the one before or after point.  This is an extension to
+;;; the paren.el file distributed with Emacs.  The default behaviour is similar
+;;; to paren.el but try the authors favourite options:
+;;;   (setq paren-face 'bold)
+;;;   (setq paren-sexp-mode t)
+
+;;; ----------------------------------------------------------------------
+;;; Installation:
+;;;
+;;; o Place this file in a directory in your 'load-path.
+;;; o Put the following in your .emacs file:
+;;;     (if window-system
+;;;         (require 'mic-paren))
+;;; o Restart your Emacs. mic-paren is now installed and activated!
+;;; o To list the possible customisation enter `C-h f paren-activate'
+
+;;; ----------------------------------------------------------------------
+;;; Long Description:
+;;;
+;;; mic-paren.el is an extension to the packages paren.el and stig-paren.el for
+;;; Emacs.  When mic-paren is active (it is activated when loaded) Emacs normal
+;;; parenthesis matching is deactivated.  Instead parenthesis matching will be
+;;; performed as soon as the cursor is positioned at a parenthesis.  The
+;;; matching parenthesis (or the entire expression between the parenthesises)
+;;; is highlighted until the cursor is moved away from the parenthesis.
+;;; Features include:
+;;; o Both forward and backward parenthesis matching (_simultaneously_ if
+;;;   cursor is between two expressions).
+;;; o Indication of mismatched parenthesises.
+;;; o Option to select if only the matching parenthesis or the entire
+;;;   expression should be highlighted.
+;;; o Message describing the match when the matching parenthesis is
+;;;   off-screen. 
+;;; o Optional delayed highlighting (useful on slow systems), 
+;;; o Functions to activate/deactivate mic-paren.el is provided.
+;;; o Numerous options to control the behaviour and appearance of
+;;;   mic-paren.el. 
+;;;
+;;; mic-paren.el is developed and tested under Emacs 19.28 - 19.31.  It should
+;;; work on earlier and forthcoming Emacs versions.
+;;;
+;;; This file can be obtained from http://www.docs.uu.se/~mic/emacs.html
+
+;; Ported to XEmacs 15-September, 1996 Steve Baur <steve@miranova.com>
+;;; ======================================================================
+;;; User Options:
+
+(defvar paren-priority nil
+  "*Defines the behaviour of mic-paren when point is between a closing and an
+  opening parenthesis.
+
+A value of 'close means highlight the parenthesis matching the
+close-parenthesis before the point.
+
+A value of 'open means highlight the parenthesis matching the open-parenthesis
+after the point.
+
+Any other value means highlight both parenthesis matching the parenthesis
+beside the point.")
+
+
+;;; ------------------------------
+
+(defvar paren-sexp-mode nil
+  "*If nil only the matching parenthesis is highlighted.
+If non-nil the whole s-expression between the matching parenthesis is
+highlighted.")
+
+;;; ------------------------------
+
+(defvar paren-highlight-at-point t
+  "*If non-nil and point is after a close parenthesis, both the close and
+open parenthesis is highlighted. If nil, only the open parenthesis is
+highlighted.")
+
+;;; ------------------------------
+
+(defvar paren-highlight-offscreen nil
+  "*If non-nil stig-paren will highlight text which is not visible in the
+current buffer.  
+
+This is useful if you regularly display the current buffer in multiple windows
+or frames. For instance if you use follow-mode (by andersl@csd.uu.se), however
+it may slow down your Emacs.
+
+(This variable is ignored (treated as non-nil) if you set paren-sexp-mode to
+non-nil.)")
+
+;;; ------------------------------
+
+(defvar paren-message-offscreen t
+  "*Display message if matching parenthesis is off-screen.")
+
+;;; ------------------------------
+
+(defvar paren-message-no-match t
+  "*Display message if no matching parenthesis is found.")
+
+;;; ------------------------------
+
+(defvar paren-ding-unmatched nil
+  "*Make noise if the cursor is at an unmatched parenthesis or no matching
+parenthesis is found.
+
+Even if nil, typing an unmatched parenthesis produces a ding.")
+
+;;; ------------------------------
+
+(defvar paren-delay nil
+  "*This variable controls when highlighting is done.  The variable has
+different meaning in different versions of Emacs.
+
+In Emacs 19.29 and below: 
+  This variable is ignored.
+
+In Emacs 19.30:
+  A value of nil will make highlighting happen immediately (this may slow down
+  your Emacs if running on a slow system).  Any non-nil value will delay
+  highlighting for the time specified by post-command-idle-delay.  
+
+In Emacs 19.31 and above:
+  A value of nil will make highlighting happen immediately (this may slow down
+  your Emacs if running on a slow system).  If not nil, the value should be a
+  number (possible a floating point number if your Emacs support floating point
+  numbers).  The number is the delay before mic-paren performs highlighting.
+
+If you change this variable when mic-paren is active you have to re-activate
+(with M-x paren-activate) mic-paren for the change to take effect.")
+
+
+;;; ------------------------------
+
+(defvar paren-dont-touch-blink nil
+  "*If non-nil mic-paren will not change the value of blink-matching-paren when
+activated of deactivated.
+
+If nil mic-paren turns of blinking when activated and turns on blinking when
+deactivated.")
+
+;;; ------------------------------
+
+(defvar paren-dont-activate-on-load nil
+ "*If non-nil mic-paren will not activate itself when loaded.")
+
+;;; ------------------------------
+
+(defvar paren-face (if (x-display-color-p) 'highlight 'underline)
+  "*Face to use for showing the matching parenthesis.")
+
+;;; ------------------------------
+
+(defvar paren-mismatch-face (if (x-display-color-p)
+				(let ((fn 'paren-mismatch-face))
+				  (copy-face 'default fn)
+				  (set-face-background fn "DeepPink")
+				  fn)
+			      'modeline)
+  "*Face to use when highlighting a mismatched parenthesis.")
+
+;;; ======================================================================
+;;; User Functions:
+
+;; XEmacs compatibility
+(eval-and-compile
+  (if (fboundp 'make-extent)
+      (progn
+	(fset 'mic-make-overlay 'make-extent)
+	(fset 'mic-delete-overlay 'delete-extent)
+	(fset 'mic-overlay-put 'set-extent-property)
+	(defun mic-cancel-timer (timer) (delete-itimer timer))
+	(defun mic-run-with-idle-timer (secs repeat function &rest args)
+	  (start-itimer "mic-paren-idle" function secs nil))
+	)
+    (fset 'mic-make-overlay 'make-overlay)
+    (fset 'mic-delete-overlay 'delete-overlay)
+    (fset 'mic-overlay-put 'overlay-put)
+    (fset 'mic-cancel-timer 'cancel-timer)
+    (fset 'mic-run-with-idle-timer 'run-with-idle-timer)
+    ))
+
+
+(defun paren-activate ()
+  "Activates mic-paren parenthesis highlighting.
+paren-activate deactivates the paren.el and stig-paren.el packages if they are
+active 
+Options:
+  paren-priority
+  paren-sexp-mode
+  paren-highlight-at-point
+  paren-highlight-offscreen
+  paren-message-offscreen
+  paren-message-no-match
+  paren-ding-unmatched
+  paren-delay
+  paren-dont-touch-blink
+  paren-dont-activate-on-load
+  paren-face
+  paren-mismatch-face"
+  (interactive)
+  ;; Deactivate mic-paren.el (To remove redundant hooks)
+  (paren-deactivate)
+  ;; Deactivate paren.el if loaded
+  (if (boundp 'post-command-idle-hook)
+      (remove-hook 'post-command-idle-hook 'show-paren-command-hook))
+  (remove-hook 'post-command-hook 'show-paren-command-hook)
+  (and (boundp 'show-paren-overlay)
+       show-paren-overlay
+       (mic-delete-overlay show-paren-overlay))
+  (and (boundp 'show-paren-overlay-1)
+       show-paren-overlay-1
+       (mic-delete-overlay show-paren-overlay-1))
+  ;; Deactivate stig-paren.el if loaded
+  (if (boundp 'post-command-idle-hook)
+      (remove-hook 'post-command-idle-hook 'stig-paren-command-hook))
+  (remove-hook 'post-command-hook 'stig-paren-command-hook)
+  (remove-hook 'post-command-hook 'stig-paren-safe-command-hook)
+  (remove-hook 'pre-command-hook 'stig-paren-delete-overlay)
+  ;; Deactivate Emacs standard parenthesis blinking
+  (or paren-dont-touch-blink
+      (setq blink-matching-paren nil))
+
+  (cond
+	;; If timers are available use them
+	;; (Emacs 19.31 and above)
+	((or (featurep 'timer) (featurep 'itimer))
+	 (if (numberp paren-delay)
+	     (setq mic-paren-idle-timer 
+		   (mic-run-with-idle-timer paren-delay t
+					    'mic-paren-command-idle-hook))
+	   (add-hook 'post-command-hook 'mic-paren-command-hook)))
+       ;; If the idle hook exists assume it is functioning and use it 
+       ;; (Emacs 19.30)
+       ((and (boundp 'post-command-idle-hook) 
+	     (boundp 'post-command-idle-delay))
+	(if paren-delay
+	    (add-hook 'post-command-idle-hook 'mic-paren-command-idle-hook)
+	  (add-hook 'post-command-hook 'mic-paren-command-hook)))
+       ;; Check if we (at least) have a post-comand-hook, and use it
+       ;; (Emacs 19.29 and below)
+       ((boundp 'post-command-hook) 
+	(add-hook 'post-command-hook 'mic-paren-command-hook))
+       ;; Not possible to install mic-paren hooks
+       (t (error "Cannot activate mic-paren in this Emacs version"))))
+
+
+
+(defun paren-deactivate ()
+  "Deactivates mic-paren parenthesis highlighting"
+  (interactive)
+  ;; Deactivate (don't bother to check where/if mic-paren is acivte, just
+  ;; delete all possible hooks and timers)
+  (if (boundp 'post-command-idle-hook)
+      (remove-hook 'post-command-idle-hook 'mic-paren-command-idle-hook))
+  (if mic-paren-idle-timer
+      (mic-cancel-timer mic-paren-idle-timer))
+  (remove-hook 'post-command-hook 'mic-paren-command-hook)
+
+  ;; Remove any old highlighs
+  (mic-delete-overlay mic-paren-backw-overlay)
+  (mic-delete-overlay mic-paren-point-overlay)
+  (mic-delete-overlay mic-paren-forw-overlay)
+
+  ;; Reactivate Emacs standard parenthesis blinking
+  (or paren-dont-touch-blink
+      (setq blink-matching-paren t))
+  )
+
+;;; ======================================================================
+;;; Internal variables:
+
+(defvar mic-paren-backw-overlay (mic-make-overlay (point-min) (point-min))
+  "Overlay for the open-paren which matches the close-paren before
+point. When in sexp-mode this is the overlay for the expression before point.")
+
+(defvar mic-paren-point-overlay (mic-make-overlay (point-min) (point-min))
+  "Overlay for the close-paren before point.
+(Not used when is sexp-mode.)")
+
+(defvar mic-paren-forw-overlay (mic-make-overlay (point-min) (point-min))
+  "Overlay for the close-paren which matches the open-paren after
+point. When in sexp-mode this is the overlay for the expression after point.")
+
+(defvar mic-paren-idle-timer nil
+  "Idle-timer.  Used only in Emacs 19.31 and above (and if paren-delay is nil)")
+
+
+
+
+;;; ======================================================================
+;;; Internal function:
+
+
+
+(defun mic-paren-command-hook ()
+  (or executing-kbd-macro
+      (input-pending-p)			;[This might cause trouble since the
+                                        ; function is unreliable]
+      (condition-case paren-error
+	  (mic-paren-highligt)
+	(error 
+	 (if (not (window-minibuffer-p (selected-window)))
+	     (message "mic-paren catched error (please report): %s"
+		      paren-error))))))
+
+(defun mic-paren-command-idle-hook ()
+  (condition-case paren-error
+      (mic-paren-highligt)
+    (error 
+     (if (not (window-minibuffer-p (selected-window)))
+	 (message "mic-paren catched error (please report): %s" 
+		  paren-error)))))
+
+
+(defun mic-paren-highligt ()
+  "The main-function of mic-paren. Does all highlighting, dinging, messages,
+cleaning-up."
+  ;; Remove any old highlighting
+  (mic-delete-overlay mic-paren-forw-overlay)
+  (mic-delete-overlay mic-paren-point-overlay)
+  (mic-delete-overlay mic-paren-backw-overlay)
+
+  ;; Handle backward highlighting (when after a close-paren):
+  ;; If positioned after a close-paren, and
+  ;;    not before an open-paren when priority=open, and
+  ;;    the close-paren is not escaped then
+  ;;      perform highlighting
+  ;; else
+  ;;      remove any old backward highlights
+  (if (and (eq (char-syntax (preceding-char)) ?\))
+	   (not (and (eq (char-syntax (following-char)) ?\()
+		     (eq paren-priority 'open)))
+	   (paren-evenp (paren-backslashes-before-char (1- (point)))))
+       (let (open)
+	 ;; Find the position for the open-paren
+	 (save-excursion
+	   (save-restriction
+	     (if blink-matching-paren-distance
+		 (narrow-to-region 
+		  (max (point-min)
+		       (- (point) blink-matching-paren-distance))
+		  (point-max)))
+	     (condition-case ()
+		 (setq open (scan-sexps (point) -1))
+	       (error nil))))
+
+	 ;; If match found
+	 ;;    highlight and/or print messages
+	 ;; else
+	 ;;    print no-match message
+	 ;;    remove any old highlights
+	 (if open
+	     (let ((mismatch (/= (matching-paren (preceding-char)) 
+				 (char-after open)))
+		   (visible (pos-visible-in-window-p open)))
+	       ;; If highlight is appropriate
+	       ;;    highligt
+	       ;; else
+	       ;;    remove any old highlight
+	       (if (or visible paren-highlight-offscreen paren-sexp-mode)
+		   ;; If sexp-mode
+		   ;;    highlight sexp
+		   ;; else
+		   ;;    highlight the two parens
+		   (if paren-sexp-mode
+		       (progn
+			 (setq mic-paren-backw-overlay
+			       (mic-make-overlay open (point)))
+			 (if mismatch
+			     (mic-overlay-put mic-paren-backw-overlay 
+					      'face paren-mismatch-face)
+			   (mic-overlay-put mic-paren-backw-overlay 
+					    'face paren-face)))
+		     (setq mic-paren-backw-overlay
+			   (mic-make-overlay open (1+ open)))
+		     (and paren-highlight-at-point
+			  (setq mic-paren-point-overlay
+				(mic-make-overlay (1- (point)) (point))))
+		     (if mismatch
+			 (progn
+			   (mic-overlay-put mic-paren-backw-overlay 
+					    'face paren-mismatch-face)
+			   (and paren-highlight-at-point
+				(mic-overlay-put mic-paren-point-overlay 
+						 'face paren-mismatch-face)))
+		       (mic-overlay-put mic-paren-backw-overlay 
+					'face paren-face)
+		       (and paren-highlight-at-point 
+			    (mic-overlay-put mic-paren-point-overlay 
+					     'face paren-face)))))
+	       ;; Print messages if match is offscreen
+	       (and paren-message-offscreen
+		    (not visible)
+		    (not (window-minibuffer-p (selected-window)))
+		    (message "%s %s" 
+			     (if mismatch "MISMATCH:" "Matches")
+			     (mic-paren-get-matching-open-text open)))
+	       ;; Ding if mismatch
+	       (and mismatch
+		    paren-ding-unmatched
+		    (ding)))
+	   (and paren-message-no-match
+		(not (window-minibuffer-p (selected-window)))
+		(message "No opening parenthesis found"))
+	   (and paren-message-no-match
+		paren-ding-unmatched
+		(ding)))))
+
+  ;; Handle forward highlighting (when before an open-paren):
+  ;; If positioned before an open-paren, and
+  ;;    not after a close-paren when priority=close, and
+  ;;    the open-paren is not escaped then
+  ;;      perform highlighting
+  ;; else
+  ;;      remove any old forward highlights
+  (if (and (eq (char-syntax (following-char)) ?\()
+	   (not (and (eq (char-syntax (preceding-char)) ?\))
+		     (eq paren-priority 'close)))
+	   (paren-evenp (paren-backslashes-before-char (point))))
+       (let (close)
+	 ;; Find the position for the close-paren
+	 (save-excursion
+	   (save-restriction
+	     (if blink-matching-paren-distance
+		 (narrow-to-region 
+		  (point-min)
+		  (min (point-max)
+		       (+ (point) blink-matching-paren-distance))))
+      	     (condition-case ()
+		 (setq close (scan-sexps (point) 1))
+	       (error nil))))
+	 ;; If match found
+	 ;;    highlight and/or print messages
+	 ;; else
+	 ;;    print no-match message
+	 ;;    remove any old highlights
+	 (if close
+	     (let ((mismatch (/= (matching-paren (following-char)) 
+				 (char-after (1- close))))
+		   (visible (pos-visible-in-window-p close)))
+	       ;; If highlight is appropriate
+	       ;;    highligt
+	       ;; else
+	       ;;    remove any old highlight
+	       (if (or visible paren-highlight-offscreen paren-sexp-mode)
+		   ;; If sexp-mode
+		   ;;    highlight sexp
+		   ;; else
+		   ;;    highlight the two parens
+		   (if paren-sexp-mode
+		       (progn
+			 (setq mic-paren-forw-overlay
+			       (mic-make-overlay (point) close))
+			 (if mismatch
+			     (mic-overlay-put mic-paren-forw-overlay 
+					      'face paren-mismatch-face)
+			   (mic-overlay-put mic-paren-forw-overlay 
+					    'face paren-face)))
+		     (setq mic-paren-forw-overlay
+			   (mic-make-overlay (1- close) close))
+		     (if mismatch
+			 (mic-overlay-put mic-paren-forw-overlay 
+					  'face paren-mismatch-face)
+		       (mic-overlay-put mic-paren-forw-overlay 
+					'face paren-face))))
+
+	       ;; Print messages if match is offscreen
+	       (and paren-message-offscreen
+		    (not visible)
+		    (not (window-minibuffer-p (selected-window)))
+		    (message "%s %s" 
+			     (if mismatch "MISMATCH:" "Matches")
+			     (mic-paren-get-matching-close-text close)))
+	       ;; Ding if mismatch
+	       (and mismatch
+		    paren-ding-unmatched
+		    (ding)))
+	   (and paren-message-no-match
+		(not (window-minibuffer-p (selected-window)))
+		(message "No closing parenthesis found"))
+	   (and paren-message-no-match
+		paren-ding-unmatched
+		(ding))))))
+
+;;; --------------------------------------------------
+
+(defun mic-paren-get-matching-open-text (open)
+  "Returns a string with the context around OPEN-paren."
+  ;; If there's stuff on this line preceding the paren, then display text from
+  ;; beginning of line to paren.
+  ;;
+  ;; If, however, the paren is at the beginning of a line, then skip whitespace
+  ;; forward and display text from paren to end of the next line containing
+  ;; non-space text.
+  ;;
+  ;; (Same as in stig-paren.el)
+  (save-excursion
+    (goto-char open)
+    (if (save-excursion
+	  (skip-chars-backward " \t")
+	  (not (bolp)))
+	(progn
+	  (beginning-of-line)
+	  (concat (buffer-substring (point) (1+ open)) "..."))
+      (forward-char 1)			;From the beginning-of-line
+      (skip-chars-forward "\n \t")
+      (end-of-line)
+      (buffer-substring open (point)))))
+
+
+(defun mic-paren-get-matching-close-text (close)
+  "Returns a string with the context around CLOSE-paren."
+  ;; The whole line up until the close-paren with "..." appended if there are
+  ;; more text after the close-paren
+  (save-excursion
+    (goto-char close)
+    (beginning-of-line)
+    (concat
+     (buffer-substring (point) close)
+     (progn 
+       (goto-char close)
+       (if (looking-at "[ \t]*$")
+	   ""
+	 "...")))))
+  
+
+(defun paren-evenp (number)
+  "Returns t if NUMBER is an even number, nil otherwise"
+  (eq 0 (% number 2)))
+
+(defun paren-backslashes-before-char (pnt)
+  (setq pnt (1- pnt))
+  (let ((n 0))
+    (while (and (>= pnt (point-min))
+		(eq (char-syntax (char-after pnt)) ?\\))
+      (setq n (1+ n))
+      (setq pnt (1- pnt)))
+    n))
+
+    
+
+;;; ======================================================================
+;;; Initialisation when loading:
+
+
+(or paren-dont-activate-on-load
+    (paren-activate))
+
+;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic]
+(add-hook 'window-setup-hook
+	  (function (lambda ()
+		      (and window-system
+			   (not paren-dont-activate-on-load)
+			   (paren-activate)))))
+
+(provide 'mic-paren)
+(provide 'paren)