xemacs-beta: lisp/packages/font-lock.el comparison

comparison lisp/packages/font-lock.el @ 30:ec9a17fef872 r19-15b98

Import from CVS: tag r19-15b98

author	cvs
date	Mon, 13 Aug 2007 08:52:29 +0200
parents	441bb1e64a06
children	1a767b41a199

comparison

equal deleted inserted replaced

-:7976500f47f9
+:ec9a17fef872
 ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Amdahl Corporation.
 ;; Copyright (C) 1996 Ben Wing.
 ;; Author: Jamie Zawinski <jwz@lucid.com>, for the LISPM Preservation Society.
+;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
 ;; Then (partially) synched with FSF 19.30, leading to:
 ;; Next Author: RMS
 ;; Next Author: Simon Marshall <simon@gnu.ai.mit.edu>
 ;; Latest XEmacs Author: Ben Wing
 ;; Maintainer: FSF (well, maybe)
 MATCHER
 (MATCHER . MATCH)
 (MATCHER . FACENAME)
 (MATCHER . HIGHLIGHT)
 (MATCHER HIGHLIGHT ...)
+(eval . FORM)
 where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED.
+FORM is an expression, whose value should be a keyword element,
+evaluated when the keyword is (first) used in a buffer.  This feature
+can be used to provide a keyword that can only be generated when Font
+Lock mode is actually turned on.
 For highlighting single items, typically only MATCH-HIGHLIGHT is required.
-However, if an item or (typically) items is to be hightlighted following the
+However, if an item or (typically) items is to be highlighted following the
 instance of another item (the anchor) then MATCH-ANCHORED may be required.
 MATCH-HIGHLIGHT should be of the form:
 (MATCH FACENAME OVERRIDE LAXMATCH)
 ;;; extents, or resizing existing ones.
 ;;;
 ;;; Each time a modification happens to a line, we re-fontify the entire line.
 ;;; We do this by first removing the extents (text properties) on the line,
 ;;; and then doing the syntactic and keyword passes again on that line.  (More
-;;; generally, each modified region is extended to include the preceeding and
+;;; generally, each modified region is extended to include the preceding and
 ;;; following BOL or EOL.)
 ;;;
 ;;; This means that, as the user types, we repeatedly go back to the beginning
 ;;; of the line, doing more work the longer the line gets.  This doesn't cost
 ;;; much in practice, and if we don't, then we incorrectly fontify things when,
 		     'font-lock-after-change-function nil t)
 	   (add-hook 'pre-idle-hook 'font-lock-pre-idle-hook))
 	  (t
 	   (remove-hook 'after-change-functions
 			'font-lock-after-change-function t)
+	   (setq font-lock-defaults-computed nil
+		 font-lock-keywords nil)
 	   ;; We have no business doing this here, since
 	   ;; pre-idle-hook is global.	Other buffers may
 	   ;; still be in font-lock mode.  -dkindred@cs.cmu.edu
 	   ;; (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook)
 	   ))
 (save-excursion (end-of-line) (setq limit (min limit (point))))
 ;; Evaluate PRE-MATCH-FORM.
 (eval (nth 1 keywords))
 (save-match-data
 ;; Find an occurrence of `matcher' before `limit'.
-(if (and (not (stringp matcher))
-	       (not (functionp matcher))
-	       (boundp matcher))
-	  (setq matcher (symbol-value matcher)))
 (while (if (stringp matcher)
 		 (re-search-forward matcher limit t)
 	       (funcall matcher limit))
 	;; Apply each highlight to this instance of `matcher'.
 	(setq highlights lowdarks)
 	(if loudly (message "Fontifying %s... (regexps..%s)" bufname
 			    (make-string (setq count (1+ count)) ?.)))
 	;;
 	;; Find an occurrence of `matcher' from `start' to `end'.
 	(setq keyword (car keywords) matcher (car keyword))
-	(if (and (not (stringp matcher))
-		 (not (functionp matcher))
-		 (boundp matcher))
-	    (setq matcher (symbol-value matcher)))
 	(goto-char start)
 	(while (and (< (point) end)
 		    (if (stringp matcher)
 			(re-search-forward matcher end t)
 		      (funcall matcher end)))
 ;; If the buffer has just been reverted, normally that turns off
 ;; Font Lock mode.  So turn the mode back on if necessary.
 (defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
 (defun font-lock-compile-keywords (&optional keywords)
 ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD
 ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string.
 (let ((keywords (or keywords font-lock-keywords)))
 (setq font-lock-keywords
 (if (eq (car-safe keywords) t)
 	 keywords
-(cons t
+(cons t (mapcar 'font-lock-compile-keyword keywords))))))
-	(mapcar
-	 (function (lambda (item)
+(defun font-lock-compile-keyword (keyword)
-	    (cond ((nlistp item)
+(cond ((nlistp keyword)		; Just MATCHER
-		   (list item '(0 font-lock-keyword-face)))
+	 (list keyword '(0 font-lock-keyword-face)))
-		  ((numberp (cdr item))
+	((eq (car keyword) 'eval)	; Specified (eval . FORM)
-		   (list (car item) (list (cdr item) 'font-lock-keyword-face)))
+	 (font-lock-compile-keyword (eval (cdr keyword))))
-		  ((symbolp (cdr item))
+	((numberp (cdr keyword))	; Specified (MATCHER . MATCH)
-		   (list (car item) (list 0 (cdr item))))
+	 (list (car keyword) (list (cdr keyword) 'font-lock-keyword-face)))
-		  ((nlistp (nth 1 item))
+	((symbolp (cdr keyword))	; Specified (MATCHER . FACENAME)
-		   (list (car item) (cdr item)))
+	 (list (car keyword) (list 0 (cdr keyword))))
-		  (t
+	((nlistp (nth 1 keyword))	; Specified (MATCHER . HIGHLIGHT)
-		   item))))
+	 (list (car keyword) (cdr keyword)))
-	 keywords))))))
+	(t				; Hopefully (MATCHER HIGHLIGHT ...)
+	 keyword)))
 (defun font-lock-choose-keywords (keywords level)
 ;; Return LEVELth element of KEYWORDS.  A LEVEL of nil is equal to a
 ;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
 (let ((level (if (not (consp level))

Mercurial > hg > xemacs-beta

comparison lisp/packages/font-lock.el @ 30:ec9a17fef872 r19-15b98