Some fixes to follow coding conventions in files maintained by FSF.
[bpt/emacs.git] / lisp / fast-lock.el
index 0268a1e..bc32f31 100644 (file)
@@ -1,12 +1,13 @@
-;;; fast-lock.el --- Automagic text properties caching for fast Font Lock mode.
+;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
 
-;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
 
-;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
+;; Author: Simon Marshall <simon@gnu.org>
+;; Maintainer: FSF
 ;; Keywords: faces files
-;; Version: 3.13
+;; Version: 3.14
 
-;;; This file is part of GNU Emacs.
+;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; - Added `fast-lock-get-syntactic-properties'
 ;; - Renamed `fast-lock-set-face-properties' to `fast-lock-add-properties'
 ;; - Made `fast-lock-add-properties' add syntactic and face fontification data
+;; 3.13--3.14:
+;; - Made `fast-lock-cache-name' cope with `windowsnt' (Geoff Voelker fix)
+;; - Made `fast-lock-verbose' use `other' widget (Andreas Schwab fix)
+;; - Used `with-temp-message' where possible to make messages temporary.
 \f
 ;;; Code:
 
               faces)))))
   ;;
   ;; We use this for compatibility with a future Emacs.
+  (or (fboundp 'with-temp-message)
+      (defmacro with-temp-message (message &rest body)
+       (` (let ((temp-message (, message)) current-message)
+            (unwind-protect
+                (progn
+                  (when temp-message
+                    (setq current-message (current-message))
+                    (message temp-message))
+                  (,@ body))
+              (when temp-message
+                (message current-message)))))))
+  ;;
+  ;; We use this for compatibility with a future Emacs.
   (or (fboundp 'defcustom)
       (defmacro defcustom (symbol value doc &rest args) 
        (` (defvar (, symbol) (, value) (, doc))))))
 ;  "Submit via mail a bug report on fast-lock.el."
 ;  (interactive)
 ;  (let ((reporter-prompt-for-summary-p t))
-;    (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.13"
+;    (reporter-submit-bug-report "simon@gnu.org" "fast-lock 3.14"
 ;     '(fast-lock-cache-directories fast-lock-minimum-size
 ;       fast-lock-save-others fast-lock-save-events fast-lock-save-faces
 ;       fast-lock-verbose)
 \f
 ;; User Variables:
 
-(defcustom fast-lock-minimum-size (* 25 1024)
+(defcustom fast-lock-minimum-size 25600
   "*Minimum size of a buffer for cached fontification.
 Only buffers more than this can have associated Font Lock cache files saved.
 If nil, means cache files are never created.
@@ -306,7 +324,7 @@ Font Lock cache files saved.  Ownership may be unknown for networked files."
   "*If non-nil, means show status messages for cache processing.
 If a number, only buffers greater than this size have processing messages."
   :type '(choice (const :tag "never" nil)
-                (const :tag "always" t)
+                (other :tag "always" t)
                 (integer :tag "size"))
   :group 'fast-lock)
 
@@ -535,7 +553,7 @@ See `fast-lock-cache-directory'."
       (concat buffer-file-name ".flc")
     (let* ((bufile (expand-file-name buffer-file-truename))
           (chars-alist
-           (if (eq system-type 'emx)
+           (if (memq system-type '(emx windows-nt))
                '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;)))
              '((?/ . (?#)) (?# . (?# ?#)))))
           (mapchars
@@ -561,26 +579,28 @@ See `fast-lock-cache-directory'."
                     (> (buffer-size) fast-lock-verbose)
                   fast-lock-verbose))
        (saved t))
-    (if verbose (message "Saving %s font lock cache..." (buffer-name)))
-    (condition-case nil
-       (save-excursion
-         (print (list 'fast-lock-cache-data 3
-                      (list 'quote timestamp)
-                      (list 'quote font-lock-syntactic-keywords)
-                      (list 'quote (fast-lock-get-syntactic-properties))
-                      (list 'quote font-lock-keywords)
-                      (list 'quote (fast-lock-get-face-properties)))
-                tpbuf)
-         (set-buffer tpbuf)
-         (write-region (point-min) (point-max) file nil 'quietly)
-         (setq fast-lock-cache-timestamp timestamp
-               fast-lock-cache-filename file))
-      (error (setq saved 'error)) (quit (setq saved 'quit)))
-    (kill-buffer tpbuf)
-    (if verbose (message "Saving %s font lock cache...%s" (buffer-name)
-                        (cond ((eq saved 'error) "failed")
-                              ((eq saved 'quit) "aborted")
-                              (t "done"))))
+    (with-temp-message
+       (when verbose
+         (format "Saving %s font lock cache..." (buffer-name)))
+      (condition-case nil
+         (save-excursion
+           (print (list 'fast-lock-cache-data 3
+                        (list 'quote timestamp)
+                        (list 'quote font-lock-syntactic-keywords)
+                        (list 'quote (fast-lock-get-syntactic-properties))
+                        (list 'quote font-lock-keywords)
+                        (list 'quote (fast-lock-get-face-properties)))
+                  tpbuf)
+           (set-buffer tpbuf)
+           (write-region (point-min) (point-max) file nil 'quietly)
+           (setq fast-lock-cache-timestamp timestamp
+                 fast-lock-cache-filename file))
+       (error (setq saved 'error)) (quit (setq saved 'quit)))
+      (kill-buffer tpbuf))
+    (cond ((eq saved 'quit)
+          (message "Saving %s font lock cache...quit" (buffer-name)))
+         ((eq saved 'error)
+          (message "Saving %s font lock cache...failed" (buffer-name))))
     ;; We return non-nil regardless of whether a failure occurred.
     saved))
 
@@ -615,14 +635,16 @@ See `fast-lock-cache-directory'."
            (not (equal syntactic-keywords font-lock-syntactic-keywords))
            (not (equal keywords font-lock-keywords)))
        (setq loaded nil)
-      (if verbose (message "Loading %s font lock cache..." (buffer-name)))
-      (condition-case nil
-         (fast-lock-add-properties syntactic-properties face-properties)
-       (error (setq loaded 'error)) (quit (setq loaded 'quit)))
-      (if verbose (message "Loading %s font lock cache...%s" (buffer-name)
-                          (cond ((eq loaded 'error) "failed")
-                                ((eq loaded 'quit) "aborted")
-                                (t "done")))))
+      (with-temp-message
+         (when verbose
+           (format "Loading %s font lock cache..." (buffer-name)))
+       (condition-case nil
+           (fast-lock-add-properties syntactic-properties face-properties)
+         (error (setq loaded 'error)) (quit (setq loaded 'quit))))
+      (cond ((eq loaded 'quit)
+            (message "Loading %s font lock cache...quit" (buffer-name)))
+           ((eq loaded 'error)
+            (message "Loading %s font lock cache...failed" (buffer-name)))))
     (setq font-lock-fontified (eq loaded t)
          fast-lock-cache-timestamp (and (eq loaded t) timestamp))))
 \f
@@ -814,6 +836,10 @@ See `fast-lock-get-face-properties'."
     (if (consp alist)
        (cdr (or (assq major-mode alist) (assq t alist)))
       alist)))
+
+(unless (fboundp 'current-message)
+  (defun current-message ()
+    ""))
 \f
 ;; Install ourselves: