XEmacs 21.2.32 "Kastor & Polydeukes".
[chise/xemacs-chise.git.1] / lisp / font-lock.el
index b942db4..d5e26d8 100644 (file)
@@ -584,11 +584,10 @@ This is normally set via `font-lock-defaults'.")
     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))
@@ -620,6 +619,8 @@ on the major mode's symbol."
 
 (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))
@@ -629,6 +630,11 @@ on the major mode's symbol."
 
 (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."
@@ -834,8 +840,9 @@ See the variable `font-lock-keywords' for customization."
                 ((or (null maximum-size) (<= (buffer-size) maximum-size))
                  (font-lock-fontify-buffer))
                 (font-lock-verbose
-                 (lmessage 'command "Fontifying %s... buffer too big."
-                   (buffer-name)))))
+                 (lprogress-display 'font-lock
+                            "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)
@@ -996,7 +1003,7 @@ This can take a while for large buffers."
     (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.
@@ -1004,7 +1011,7 @@ This can take a while for large buffers."
          (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 ()
@@ -1043,7 +1050,7 @@ This can take a while for large buffers."
 (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)
@@ -1305,8 +1312,8 @@ START should be at the beginning of a line."
       nil
     (when (and font-lock-verbose
               (>= (- end start) font-lock-message-threshold))
-      (lmessage 'progress "Fontifying %s... (syntactically...)"
-       (buffer-name)))
+      (lprogress-display 'font-lock "Fontifying %s... (syntactically)" 5
+                (buffer-name)))
     (font-lock-unfontify-region start end loudly)
     (goto-char start)
     (if (> end (point-max)) (setq end (point-max)))
@@ -1493,14 +1500,13 @@ START should be at the beginning of a line."
          (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)"
-                      bufname
-                      (make-string (setq count (1+ count)) ?.)))
+       (when loudly (lprogress-display 'font-lock "Fontifying %s... (regexps)"
+                               (setq count (+ count 5)) bufname))
        ;;
        ;; Find an occurrence of `matcher' from `start' to `end'.
        (setq keyword (car keywords) matcher (car keyword))
@@ -1523,7 +1529,7 @@ START should be at the beginning of a line."
              (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)))))
 
 \f
 ;; Various functions.
@@ -1548,17 +1554,26 @@ START should be at the beginning of a line."
         (lazy-lock-after-fontify-buffer))))
 
 ;; If the buffer is about to be reverted, it won't be fontified afterward.
-(defun font-lock-revert-setup ()
-  (setq font-lock-fontified nil))
+;(defun font-lock-revert-setup ()
+;  (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 ())
+;; which is wasteful at best. 
+;;(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)
 
 \f
 ;; Various functions.