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

comparison lisp/font-lock.el @ 404:2f8bb876ab1d r21-2-32

Import from CVS: tag r21-2-32

author	cvs
date	Mon, 13 Aug 2007 11:16:07 +0200
parents	a86b2b5e0111
children	b8cc9ab3f761

comparison

equal deleted inserted replaced

-:9f011ab08d48
+:2f8bb876ab1d
 font-lock-type-face
 font-lock-reference-face
 font-lock-preprocessor-face
 font-lock-warning-face))
-;; #### There should be an emulation for the old font-lock-use-*
-;; settings!
 (defface font-lock-comment-face
 '((((class color) (background dark)) (:foreground "gray80"))
+;; blue4 is hardly different from black on windows.
+(((class color) (background light) (type mswindows)) (:foreground "blue"))
 (((class color) (background light)) (:foreground "blue4"))
 (((class grayscale) (background light))
 (:foreground "DimGray" :bold t :italic t))
 (((class grayscale) (background dark))
 (:foreground "LightGray" :bold t :italic t))
 on the major mode's symbol."
 :group 'font-lock-faces)
 (defface font-lock-keyword-face
 '((((class color) (background dark)) (:foreground "cyan"))
+;; red4 is hardly different from black on windows.
+(((class color) (background light) (type mswindows)) (:foreground "red"))
 (((class color) (background light)) (:foreground "red4"))
 (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
 (t (:bold t)))
 "Font Lock mode face used to highlight keywords."
 :group 'font-lock-faces)
 (defface font-lock-function-name-face
 '((((class color) (background dark)) (:foreground "aquamarine"))
+;; brown4 is hardly different from black on windows.
+;; I changed it to red because IMO it's pointless and ugly to
+;; use a million slightly different colors for niggly syntactic
+;; differences. --ben
+(((class color) (background light) (type mswindows)) (:foreground "red"))
 (((class color) (background light)) (:foreground "brown4"))
 (t (:bold t :underline t)))
 "Font Lock mode face used to highlight function names."
 :group 'font-lock-faces)
 	   (cond (font-lock-fontified
 		  nil)
 		 ((or (null maximum-size) (<= (buffer-size) maximum-size))
 		  (font-lock-fontify-buffer))
 		 (font-lock-verbose
-		  (lmessage 'command "Fontifying %s... buffer too big."
+		  (lprogress-display 'font-lock
-		    (buffer-name)))))
+			     "Fontifying %s... buffer too big." 'abort
+			     (buffer-name)))))
 	  (font-lock-fontified
 	   (setq font-lock-fontified nil)
 	   (remove-hook 'before-revert-hook 'font-lock-revert-setup t)
 	   (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t)
 	   (font-lock-unfontify-region (point-min) (point-max))
 ;; the interrupt character at inopportune times.
 ;;
 (condition-case nil
 	(save-excursion
 	  (font-lock-fontify-region (point-min) (point-max)))
-(quit
+(t
 (setq aborted t)))
 (or was-on		; turn it off if it was off.
 	(let ((font-lock-fontified nil)) ; kludge to prevent defontification
 	  (font-lock-mode 0)))
 (set (make-local-variable 'font-lock-fontified) t)
 (when (and aborted font-lock-verbose)
-	(lmessage 'command  "Fontifying %s... aborted." (buffer-name))))
+(lprogress-display 'font-lock "Fontifying %s... aborted." 'abort (buffer-name))))
 (run-hooks 'font-lock-after-fontify-buffer-hook))
 (defun font-lock-default-unfontify-buffer ()
 (font-lock-unfontify-region (point-min) (point-max))
 (set (make-local-variable 'font-lock-fontified) nil))
 ;	  (font-lock-fontify-keywords-region beg end))
 (defun font-lock-default-unfontify-region (beg end &optional maybe-loudly)
 (when (and maybe-loudly font-lock-verbose
 	     (>= (- end beg) font-lock-message-threshold))
-(lmessage 'progress "Fontifying %s..." (buffer-name)))
+(lprogress-display 'font-lock "Fontifying %s..." 0 (buffer-name)))
 (let ((modified (buffer-modified-p))
 	(buffer-undo-list t) (inhibit-read-only t)
 	buffer-file-name buffer-file-truename)
 (font-lock-remove-face beg end)
 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))
 START should be at the beginning of a line."
 (if font-lock-keywords-only
 nil
 (when (and font-lock-verbose
 	       (>= (- end start) font-lock-message-threshold))
-(lmessage 'progress "Fontifying %s... (syntactically...)"
+(lprogress-display 'font-lock "Fontifying %s... (syntactically)" 5
-	(buffer-name)))
+		 (buffer-name)))
 (font-lock-unfontify-region start end loudly)
 (goto-char start)
 (if (> end (point-max)) (setq end (point-max)))
 (let ((lisp-like (font-lock-lisp-like major-mode)))
 (syntactically-sectionize
 		     (>= (- end start) font-lock-message-threshold))))
 (let ((case-fold-search font-lock-keywords-case-fold-search)
 	  (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
 			     font-lock-keywords
 			   (font-lock-compile-keywords))))
-	  (bufname (buffer-name)) (count 0)
+	  (bufname (buffer-name)) (count 5)
 	  keyword matcher highlights)
 ;;
 ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
 (while keywords
-	(when loudly (lmessage 'progress "Fontifying %s... (regexps..%s)"
+	(when loudly (lprogress-display 'font-lock "Fontifying %s... (regexps)"
-		       bufname
+				(setq count (+ count 5)) bufname))
-		       (make-string (setq count (1+ count)) ?.)))
 	;;
 	;; Find an occurrence of `matcher' from `start' to `end'.
 	(setq keyword (car keywords) matcher (car keyword))
 	(goto-char start)
 	(while (and (< (point) end)
 		  ;; expressions.
 		  (and end (goto-char end)))
 	      (font-lock-fontify-anchored-keywords (car highlights) end))
 	    (setq highlights (cdr highlights))))
 	(setq keywords (cdr keywords))))
-(if loudly (lmessage 'progress "Fontifying %s... done." (buffer-name)))))
+(if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name)))))
 ;; Various functions.
 ;; Turn off other related packages if they're on.  I prefer a hook. --sm.
 	 (fast-lock-after-fontify-buffer))
 	((and (boundp 'lazy-lock-mode) lazy-lock-mode)
 	 (lazy-lock-after-fontify-buffer))))
 ;; If the buffer is about to be reverted, it won't be fontified afterward.
-(defun font-lock-revert-setup ()
+;(defun font-lock-revert-setup ()
-(setq font-lock-fontified nil))
+;  (setq font-lock-fontified nil))
 ;; If the buffer has just been reverted, normally that turns off
 ;; Font Lock mode.  So turn the mode back on if necessary.
 ;; sb 1999-03-03 -- The above comment no longer appears to be operative as
 ;; the first call to normal-mode *will* restore the font-lock state and
 ;; this call forces a second font-locking to occur when reverting a buffer,
 ;; which is wasteful at best.
-;(defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
+;;(defun font-lock-revert-cleanup ())
-(defun font-lock-revert-cleanup ())
+;; <andy@xemacs.org> 12-10-99. This still does not work right, I think
+;; after change functions will still get us. The simplest thing to do
+;; is unconditionally turn-off font-lock before revert (and thus nuke
+;; all hooks) and then turn it on again afterwards. This also happens
+;; to be much faster because fontifying from scratch is better than
+;; trying to do incremental changes for the whole buffer.
+(defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
+(defalias 'font-lock-revert-setup 'turn-off-font-lock)
 ;; Various functions.
 (defun font-lock-compile-keywords (&optional keywords)

Mercurial > hg > xemacs-beta

comparison lisp/font-lock.el @ 404:2f8bb876ab1d r21-2-32