Mercurial > hg > xemacs-beta

comparison lisp/packages/mic-paren.el @ 26:441bb1e64a06 r19-15b96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 4103f0995bd7
children ec9a17fef872
comparison
equal deleted inserted replaced
25:383a494979f8 26:441bb1e64a06
1 ;;; mic-paren.el --- highlight matching paren. 1 ;;; mic-paren.el --- highlight matching parenthesises.
2 ;;; Version 1.2 - 96-09-19 2 ;;; Version 1.3.1 - 97-02-27
3 ;;; Copyright (C) 1996 Mikael Sjödin (mic@docs.uu.se) 3 ;;; Copyright (C) 1997 Mikael Sjödin (mic@docs.uu.se)
4 ;;; 4 ;;;
5 ;;; Author: Mikael Sjödin -- mic@docs.uu.se 5 ;;; Author: Mikael Sjödin -- mic@docs.uu.se
6 ;;; Additional code by: Vinicius Jose Latorre <vinicius@cpqd.br>
7 ;;; Steven L Baur <steve@altair.xemacs.org>
8 ;;;
6 ;;; Keywords: languages, faces 9 ;;; Keywords: languages, faces
7 ;;; 10 ;;;
8 ;;; This file is NOT part of GNU Emacs. 11 ;;; This file is NOT part of GNU Emacs.
9 ;;; You may however redistribute it and/or modify it under the terms of the GNU 12 ;;; You may however redistribute it and/or modify it under the terms of the GNU
10 ;;; General Public License as published by the Free Software Foundation; either 13 ;;; General Public License as published by the Free Software Foundation; either
32 ;;; o Put the following in your .emacs file: 35 ;;; o Put the following in your .emacs file:
33 ;;; (if window-system 36 ;;; (if window-system
34 ;;; (require 'mic-paren)) 37 ;;; (require 'mic-paren))
35 ;;; o Restart your Emacs. mic-paren is now installed and activated! 38 ;;; o Restart your Emacs. mic-paren is now installed and activated!
36 ;;; o To list the possible customisation enter `C-h f paren-activate' 39 ;;; o To list the possible customisation enter `C-h f paren-activate'
40 ;;;
37 41
38 ;;; ---------------------------------------------------------------------- 42 ;;; ----------------------------------------------------------------------
39 ;;; Long Description: 43 ;;; Long Description:
40 ;;; 44 ;;;
41 ;;; mic-paren.el is an extension to the packages paren.el and stig-paren.el for 45 ;;; mic-paren.el is an extension to the packages paren.el and stig-paren.el for
58 ;;; o Numerous options to control the behaviour and appearance of 62 ;;; o Numerous options to control the behaviour and appearance of
59 ;;; mic-paren.el. 63 ;;; mic-paren.el.
60 ;;; 64 ;;;
61 ;;; mic-paren.el is developed and tested under Emacs 19.28 - 19.34. It should 65 ;;; mic-paren.el is developed and tested under Emacs 19.28 - 19.34. It should
62 ;;; work on earlier and forthcoming Emacs versions. XEmacs compatibility has 66 ;;; work on earlier and forthcoming Emacs versions. XEmacs compatibility has
63 ;;; been provided by Steven L Baur <steve@altair.xemacs.org>. 67 ;;; been provided by Steven L Baur <steve@altair.xemacs.org>. Jan Dubois
68 ;;; (jaduboi@ibm.net) provided help to get mic-paren to work in OS/2.
64 ;;; 69 ;;;
65 ;;; This file can be obtained from http://www.docs.uu.se/~mic/emacs.html 70 ;;; This file can be obtained from http://www.docs.uu.se/~mic/emacs.html
71
72 ;;; ----------------------------------------------------------------------
73 ;;; Versions:
74 ;;;
75 ;;; v1.3.1 Some spelling corrected (from Vinicius Jose Latorre
76 ;;; <vinicius@cpqd.br> and Steven L Baur <steve@altair.xemacs.org>)
77 ;;;
78 ;;; v1.3 Added code from Vinicius Jose Latorre <vinicius@cpqd.br> to
79 ;;; highlight unmathced parenthesises (useful in minibuffer)
80 ;;;
81 ;;; v1.2.1 Fixed stuff to work with OS/2 emx-emacs
82 ;;; - checks if x-display-color-p is bound before calling it
83 ;;; - changed how X/Lucid Emacs is deteced
84 ;;; Added automatic load of the timer-feature (+ variable to disable
85 ;;; the loading)
66 86
67 ;;; ====================================================================== 87 ;;; ======================================================================
68 ;;; User Options: 88 ;;; User Options:
69 89
70 (defvar paren-priority nil 90 (defvar paren-priority nil
164 (defvar paren-dont-activate-on-load nil 184 (defvar paren-dont-activate-on-load nil
165 "*If non-nil mic-paren will not activate itself when loaded.") 185 "*If non-nil mic-paren will not activate itself when loaded.")
166 186
167 ;;; ------------------------------ 187 ;;; ------------------------------
168 188
169 (defvar paren-face (if (x-display-color-p) 'highlight 'underline) 189 (defvar paren-dont-load-timer (not (string-match "XEmacs\\|Lucid"
190 emacs-version))
191 "*If non-nil mic-paren will not try to load the timer-feature when loaded.
192
193 (I have no idea why Emacs user ever want to set this to non-nil but I hate
194 packages which loads/activates stuff I don't want to use so I provide this way
195 to prevent the loading if someone doesn't want timers to be loaded.)")
196
197 ;;; ------------------------------
198
199 (defvar paren-face (if (and (fboundp 'x-display-color-p)
200 (x-display-color-p))
201 'highlight 'underline)
170 "*Face to use for showing the matching parenthesis.") 202 "*Face to use for showing the matching parenthesis.")
171 203
172 ;;; ------------------------------ 204 ;;; ------------------------------
173 205
174 (defvar paren-mismatch-face (if (x-display-color-p) 206 (defvar paren-mismatch-face (if (and (fboundp 'x-display-color-p)
207 (x-display-color-p))
175 (let ((fn 'paren-mismatch-face)) 208 (let ((fn 'paren-mismatch-face))
176 (copy-face 'default fn) 209 (copy-face 'default fn)
177 (set-face-background fn "DeepPink") 210 (set-face-background fn "DeepPink")
178 fn) 211 fn)
179 'modeline) 212 'modeline)
180 "*Face to use when highlighting a mismatched parenthesis.") 213 "*Face to use when highlighting a mismatched parenthesis.")
181 214
215 ;;; ------------------------------
216
217 (defvar paren-no-match-face (if (x-display-color-p)
218 (let ((fn 'paren-no-match-face))
219 (copy-face 'default fn)
220 (set-face-background fn "yellow")
221 fn)
222 'default)
223 "*Face to use when highlighting an unmatched parenthesis.")
224
182 ;;; ====================================================================== 225 ;;; ======================================================================
183 ;;; User Functions: 226 ;;; User Functions:
184 227
185 ;; XEmacs compatibility (by Steven L Baur <steve@altair.xemacs.org>) 228 ;; XEmacs compatibility (mainly by Steven L Baur <steve@altair.xemacs.org>)
186 (eval-and-compile 229 (eval-and-compile
187 (if (fboundp 'make-extent) 230 (if (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
188 (progn 231 (progn
189 (fset 'mic-make-overlay 'make-extent) 232 (fset 'mic-make-overlay 'make-extent)
190 (fset 'mic-delete-overlay 'delete-extent) 233 (fset 'mic-delete-overlay 'delete-extent)
191 (fset 'mic-overlay-put 'set-extent-property) 234 (fset 'mic-overlay-put 'set-extent-property)
192 (defun mic-cancel-timer (timer) (delete-itimer timer)) 235 (defun mic-cancel-timer (timer) (delete-itimer timer))
193 (defun mic-run-with-idle-timer (secs repeat function &rest args) 236 (fset 'mic-run-with-idle-timer 'start-itimer)
194 (start-itimer "mic-paren-idle" function secs nil))
195 ) 237 )
196 (fset 'mic-make-overlay 'make-overlay) 238 (fset 'mic-make-overlay 'make-overlay)
197 (fset 'mic-delete-overlay 'delete-overlay) 239 (fset 'mic-delete-overlay 'delete-overlay)
198 (fset 'mic-overlay-put 'overlay-put) 240 (fset 'mic-overlay-put 'overlay-put)
199 (fset 'mic-cancel-timer 'cancel-timer) 241 (fset 'mic-cancel-timer 'cancel-timer)
364 (condition-case () 406 (condition-case ()
365 (setq open (scan-sexps (point) -1)) 407 (setq open (scan-sexps (point) -1))
366 (error nil)))) 408 (error nil))))
367 409
368 ;; If match found 410 ;; If match found
369 ;; highlight and/or print messages 411 ;; highlight expression and/or print messages
370 ;; else 412 ;; else
413 ;; highlight unmatched paren
371 ;; print no-match message 414 ;; print no-match message
372 ;; remove any old highlights
373 (if open 415 (if open
374 (let ((mismatch (/= (matching-paren (preceding-char)) 416 (let ((mismatch (/= (matching-paren (preceding-char))
375 (char-after open))) 417 (char-after open)))
376 (visible (pos-visible-in-window-p open))) 418 (visible (pos-visible-in-window-p open)))
377 ;; If highlight is appropriate 419 ;; If highlight is appropriate
418 (mic-paren-get-matching-open-text open))) 460 (mic-paren-get-matching-open-text open)))
419 ;; Ding if mismatch 461 ;; Ding if mismatch
420 (and mismatch 462 (and mismatch
421 paren-ding-unmatched 463 paren-ding-unmatched
422 (ding))) 464 (ding)))
465 (setq mic-paren-backw-overlay
466 (mic-make-overlay (1- (point)) (point)))
467 (mic-overlay-put mic-paren-backw-overlay
468 'face paren-no-match-face)
423 (and paren-message-no-match 469 (and paren-message-no-match
424 (not (window-minibuffer-p (selected-window))) 470 (not (window-minibuffer-p (selected-window)))
425 (message "No opening parenthesis found")) 471 (message "No opening parenthesis found"))
426 (and paren-message-no-match 472 (and paren-message-no-match
427 paren-ding-unmatched 473 paren-ding-unmatched
449 (+ (point) blink-matching-paren-distance)))) 495 (+ (point) blink-matching-paren-distance))))
450 (condition-case () 496 (condition-case ()
451 (setq close (scan-sexps (point) 1)) 497 (setq close (scan-sexps (point) 1))
452 (error nil)))) 498 (error nil))))
453 ;; If match found 499 ;; If match found
454 ;; highlight and/or print messages 500 ;; highlight expression and/or print messages
455 ;; else 501 ;; else
502 ;; highlight unmatched paren
456 ;; print no-match message 503 ;; print no-match message
457 ;; remove any old highlights
458 (if close 504 (if close
459 (let ((mismatch (/= (matching-paren (following-char)) 505 (let ((mismatch (/= (matching-paren (following-char))
460 (char-after (1- close)))) 506 (char-after (1- close))))
461 (visible (pos-visible-in-window-p close))) 507 (visible (pos-visible-in-window-p close)))
462 ;; If highlight is appropriate 508 ;; If highlight is appropriate
494 (mic-paren-get-matching-close-text close))) 540 (mic-paren-get-matching-close-text close)))
495 ;; Ding if mismatch 541 ;; Ding if mismatch
496 (and mismatch 542 (and mismatch
497 paren-ding-unmatched 543 paren-ding-unmatched
498 (ding))) 544 (ding)))
545 (setq mic-paren-forw-overlay
546 (mic-make-overlay (point) (1+ (point))))
547 (mic-overlay-put mic-paren-forw-overlay
548 'face paren-no-match-face)
499 (and paren-message-no-match 549 (and paren-message-no-match
500 (not (window-minibuffer-p (selected-window))) 550 (not (window-minibuffer-p (selected-window)))
501 (message "No closing parenthesis found")) 551 (message "No closing parenthesis found"))
502 (and paren-message-no-match 552 (and paren-message-no-match
503 paren-ding-unmatched 553 paren-ding-unmatched
561 611
562 612
563 ;;; ====================================================================== 613 ;;; ======================================================================
564 ;;; Initialisation when loading: 614 ;;; Initialisation when loading:
565 615
616 ;;; Try to load the timer feature if its not already loaded
617 (or paren-dont-load-timer
618 (featurep 'timer)
619 (condition-case ()
620 (require 'timer)
621 (error nil)))
622
566 623
567 (or paren-dont-activate-on-load 624 (or paren-dont-activate-on-load
568 (paren-activate)) 625 (paren-activate))
569 626
570 ;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic] 627 ;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic]