Mercurial > hg > xemacs-beta

comparison lisp/packages/mic-paren.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 4103f0995bd7
children cf808b4c4290
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
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 - 97-02-25
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 Added code from Vinicius Jose Latorre <vinicius@cpqd.br> to
76 ;;; highlight unmathced parenthesises (useful in minibuffer)
77 ;;;
78 ;;; v1.2.1 Fixed stuff to work with OS/2 emx-emacs
79 ;;; - checks if x-display-color-p is bound before calling it
80 ;;; - changed how X/Lucid Emacs is deteced
81 ;;; Added automatic load of the timer-feature (+ variable to disable
82 ;;; the loading)
66 83
67 ;;; ====================================================================== 84 ;;; ======================================================================
68 ;;; User Options: 85 ;;; User Options:
69 86
70 (defvar paren-priority nil 87 (defvar paren-priority nil
164 (defvar paren-dont-activate-on-load nil 181 (defvar paren-dont-activate-on-load nil
165 "*If non-nil mic-paren will not activate itself when loaded.") 182 "*If non-nil mic-paren will not activate itself when loaded.")
166 183
167 ;;; ------------------------------ 184 ;;; ------------------------------
168 185
169 (defvar paren-face (if (x-display-color-p) 'highlight 'underline) 186 (defvar paren-dont-load-timer (not (string-match "XEmacs\\|Lucid"
187 emacs-version))
188 "*If non-nil mic-paren will not try to load the timer-feature when loaded.
189
190 (I have no idea why you'd ever want to set this to non-nil but I hate packages
191 which loads/activates stuff I don't want to use so I provide this way to prevent
192 the loading if someone doesn't want timers to be loaded.)")
193
194 ;;; ------------------------------
195
196 (defvar paren-face (if (and (fboundp 'x-display-color-p)
197 (x-display-color-p))
198 'highlight 'underline)
170 "*Face to use for showing the matching parenthesis.") 199 "*Face to use for showing the matching parenthesis.")
171 200
172 ;;; ------------------------------ 201 ;;; ------------------------------
173 202
174 (defvar paren-mismatch-face (if (x-display-color-p) 203 (defvar paren-mismatch-face (if (and (fboundp 'x-display-color-p)
204 (x-display-color-p))
175 (let ((fn 'paren-mismatch-face)) 205 (let ((fn 'paren-mismatch-face))
176 (copy-face 'default fn) 206 (copy-face 'default fn)
177 (set-face-background fn "DeepPink") 207 (set-face-background fn "DeepPink")
178 fn) 208 fn)
179 'modeline) 209 'modeline)
180 "*Face to use when highlighting a mismatched parenthesis.") 210 "*Face to use when highlighting a mismatched parenthesis.")
181 211
212 ;;; ------------------------------
213
214 (defvar paren-no-match-face (if (x-display-color-p)
215 (let ((fn 'paren-no-match-face))
216 (copy-face 'default fn)
217 (set-face-background fn "yellow")
218 fn)
219 'default)
220 "*Face to use when highlighting an unmatched parenthesis.")
221
182 ;;; ====================================================================== 222 ;;; ======================================================================
183 ;;; User Functions: 223 ;;; User Functions:
184 224
185 ;; XEmacs compatibility (by Steven L Baur <steve@altair.xemacs.org>) 225 ;; XEmacs compatibility (mainly by Steven L Baur <steve@altair.xemacs.org>)
186 (eval-and-compile 226 (eval-and-compile
187 (if (fboundp 'make-extent) 227 (if (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
188 (progn 228 (progn
189 (fset 'mic-make-overlay 'make-extent) 229 (fset 'mic-make-overlay 'make-extent)
190 (fset 'mic-delete-overlay 'delete-extent) 230 (fset 'mic-delete-overlay 'delete-extent)
191 (fset 'mic-overlay-put 'set-extent-property) 231 (fset 'mic-overlay-put 'set-extent-property)
192 (defun mic-cancel-timer (timer) (delete-itimer timer)) 232 (defun mic-cancel-timer (timer) (delete-itimer timer))
193 (defun mic-run-with-idle-timer (secs repeat function &rest args) 233 (fset 'mic-run-with-idle-timer 'start-itimer)
194 (start-itimer "mic-paren-idle" function secs nil))
195 ) 234 )
196 (fset 'mic-make-overlay 'make-overlay) 235 (fset 'mic-make-overlay 'make-overlay)
197 (fset 'mic-delete-overlay 'delete-overlay) 236 (fset 'mic-delete-overlay 'delete-overlay)
198 (fset 'mic-overlay-put 'overlay-put) 237 (fset 'mic-overlay-put 'overlay-put)
199 (fset 'mic-cancel-timer 'cancel-timer) 238 (fset 'mic-cancel-timer 'cancel-timer)
316 (defun mic-paren-command-hook () 355 (defun mic-paren-command-hook ()
317 (or executing-kbd-macro 356 (or executing-kbd-macro
318 (input-pending-p) ;[This might cause trouble since the 357 (input-pending-p) ;[This might cause trouble since the
319 ; function is unreliable] 358 ; function is unreliable]
320 (condition-case paren-error 359 (condition-case paren-error
321 (mic-paren-highlight) 360 (mic-paren-highligt)
322 (error 361 (error
323 (if (not (window-minibuffer-p (selected-window))) 362 (if (not (window-minibuffer-p (selected-window)))
324 (message "mic-paren catched error (please report): %s" 363 (message "mic-paren catched error (please report): %s"
325 paren-error)))))) 364 paren-error))))))
326 365
327 (defun mic-paren-command-idle-hook () 366 (defun mic-paren-command-idle-hook ()
328 (condition-case paren-error 367 (condition-case paren-error
329 (mic-paren-highlight) 368 (mic-paren-highligt)
330 (error 369 (error
331 (if (not (window-minibuffer-p (selected-window))) 370 (if (not (window-minibuffer-p (selected-window)))
332 (message "mic-paren catched error (please report): %s" 371 (message "mic-paren catched error (please report): %s"
333 paren-error))))) 372 paren-error)))))
334 373
335 374
336 (defun mic-paren-highlight () 375 (defun mic-paren-highligt ()
337 "The main-function of mic-paren. Does all highlighting, dinging, messages, 376 "The main-function of mic-paren. Does all highlighting, dinging, messages,
338 cleaning-up." 377 cleaning-up."
339 ;; Remove any old highlighting 378 ;; Remove any old highlighting
340 (mic-delete-overlay mic-paren-forw-overlay) 379 (mic-delete-overlay mic-paren-forw-overlay)
341 (mic-delete-overlay mic-paren-point-overlay) 380 (mic-delete-overlay mic-paren-point-overlay)
364 (condition-case () 403 (condition-case ()
365 (setq open (scan-sexps (point) -1)) 404 (setq open (scan-sexps (point) -1))
366 (error nil)))) 405 (error nil))))
367 406
368 ;; If match found 407 ;; If match found
369 ;; highlight and/or print messages 408 ;; highlight expression and/or print messages
370 ;; else 409 ;; else
410 ;; highlight unmatched paren
371 ;; print no-match message 411 ;; print no-match message
372 ;; remove any old highlights
373 (if open 412 (if open
374 (let ((mismatch (/= (matching-paren (preceding-char)) 413 (let ((mismatch (/= (matching-paren (preceding-char))
375 (char-after open))) 414 (char-after open)))
376 (visible (pos-visible-in-window-p open))) 415 (visible (pos-visible-in-window-p open)))
377 ;; If highlight is appropriate 416 ;; If highlight is appropriate
378 ;; highlight 417 ;; highligt
379 ;; else 418 ;; else
380 ;; remove any old highlight 419 ;; remove any old highlight
381 (if (or visible paren-highlight-offscreen paren-sexp-mode) 420 (if (or visible paren-highlight-offscreen paren-sexp-mode)
382 ;; If sexp-mode 421 ;; If sexp-mode
383 ;; highlight sexp 422 ;; highlight sexp
418 (mic-paren-get-matching-open-text open))) 457 (mic-paren-get-matching-open-text open)))
419 ;; Ding if mismatch 458 ;; Ding if mismatch
420 (and mismatch 459 (and mismatch
421 paren-ding-unmatched 460 paren-ding-unmatched
422 (ding))) 461 (ding)))
462 (setq mic-paren-backw-overlay
463 (mic-make-overlay (1- (point)) (point)))
464 (mic-overlay-put mic-paren-backw-overlay
465 'face paren-no-match-face)
423 (and paren-message-no-match 466 (and paren-message-no-match
424 (not (window-minibuffer-p (selected-window))) 467 (not (window-minibuffer-p (selected-window)))
425 (message "No opening parenthesis found")) 468 (message "No opening parenthesis found"))
426 (and paren-message-no-match 469 (and paren-message-no-match
427 paren-ding-unmatched 470 paren-ding-unmatched
449 (+ (point) blink-matching-paren-distance)))) 492 (+ (point) blink-matching-paren-distance))))
450 (condition-case () 493 (condition-case ()
451 (setq close (scan-sexps (point) 1)) 494 (setq close (scan-sexps (point) 1))
452 (error nil)))) 495 (error nil))))
453 ;; If match found 496 ;; If match found
454 ;; highlight and/or print messages 497 ;; highlight expression and/or print messages
455 ;; else 498 ;; else
499 ;; highligt unmatched paren
456 ;; print no-match message 500 ;; print no-match message
457 ;; remove any old highlights
458 (if close 501 (if close
459 (let ((mismatch (/= (matching-paren (following-char)) 502 (let ((mismatch (/= (matching-paren (following-char))
460 (char-after (1- close)))) 503 (char-after (1- close))))
461 (visible (pos-visible-in-window-p close))) 504 (visible (pos-visible-in-window-p close)))
462 ;; If highlight is appropriate 505 ;; If highlight is appropriate
463 ;; highlight 506 ;; highligt
464 ;; else 507 ;; else
465 ;; remove any old highlight 508 ;; remove any old highlight
466 (if (or visible paren-highlight-offscreen paren-sexp-mode) 509 (if (or visible paren-highlight-offscreen paren-sexp-mode)
467 ;; If sexp-mode 510 ;; If sexp-mode
468 ;; highlight sexp 511 ;; highlight sexp
494 (mic-paren-get-matching-close-text close))) 537 (mic-paren-get-matching-close-text close)))
495 ;; Ding if mismatch 538 ;; Ding if mismatch
496 (and mismatch 539 (and mismatch
497 paren-ding-unmatched 540 paren-ding-unmatched
498 (ding))) 541 (ding)))
542 (setq mic-paren-forw-overlay
543 (mic-make-overlay (point) (1+ (point))))
544 (mic-overlay-put mic-paren-forw-overlay
545 'face paren-no-match-face)
499 (and paren-message-no-match 546 (and paren-message-no-match
500 (not (window-minibuffer-p (selected-window))) 547 (not (window-minibuffer-p (selected-window)))
501 (message "No closing parenthesis found")) 548 (message "No closing parenthesis found"))
502 (and paren-message-no-match 549 (and paren-message-no-match
503 paren-ding-unmatched 550 paren-ding-unmatched
561 608
562 609
563 ;;; ====================================================================== 610 ;;; ======================================================================
564 ;;; Initialisation when loading: 611 ;;; Initialisation when loading:
565 612
613 ;;; Try to load the timer feature if its not already loaded
614 (or paren-dont-load-timer
615 (featurep 'timer)
616 (condition-case ()
617 (require 'timer)
618 (error nil)))
619
566 620
567 (or paren-dont-activate-on-load 621 (or paren-dont-activate-on-load
568 (paren-activate)) 622 (paren-activate))
569 623
570 ;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic] 624 ;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic]