;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
;; Keywords: faces files
-;; Version: 3.12.01
+;; Version: 3.12.02
;;; This file is part of GNU Emacs.
;; - Made `fast-lock-cache-data' simplify calls of `font-lock-compile-keywords'
;; 3.12--3.13:
;; - Removed `byte-*' variables from `eval-when-compile' (Erik Naggum hint)
+;; - Changed structure of cache to include `font-lock-syntactic-keywords'
+;; - Made `fast-lock-save-cache-1' save syntactic fontification data
+;; - Made `fast-lock-cache-data' take syntactic fontification data
+;; - 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
\f
;;; Code:
; "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.12.01"
+; (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.12.02"
; '(fast-lock-cache-directories fast-lock-minimum-size
; fast-lock-save-others fast-lock-save-events fast-lock-save-faces
; fast-lock-verbose)
\f
;; Font Lock Cache Processing Functions:
+;; The version 3 format of the cache is:
+;;
+;; (fast-lock-cache-data VERSION TIMESTAMP
+;; font-lock-syntactic-keywords SYNTACTIC-PROPERTIES
+;; font-lock-keywords FACE-PROPERTIES)
+
(defun fast-lock-save-cache-1 (file timestamp)
- ;; Save the FILE with the TIMESTAMP as:
- ;; (fast-lock-cache-data Version=2 TIMESTAMP font-lock-keywords PROPERTIES).
+ ;; Save the FILE with the TIMESTAMP plus fontification data.
;; Returns non-nil if a save was attempted to a writable cache file.
(let ((tpbuf (generate-new-buffer " *fast-lock*"))
(verbose (if (numberp fast-lock-verbose)
(if verbose (message "Saving %s font lock cache..." (buffer-name)))
(condition-case nil
(save-excursion
- (print (list 'fast-lock-cache-data 2
+ (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)
;; We return non-nil regardless of whether a failure occurred.
saved))
-(defun fast-lock-cache-data (version timestamp keywords properties
+(defun fast-lock-cache-data (version timestamp
+ syntactic-keywords syntactic-properties
+ keywords face-properties
&rest ignored)
- ;; Change from (HIGH LOW) for back compatibility. Remove for version 3!
- (when (consp (cdr-safe timestamp))
- (setcdr timestamp (nth 1 timestamp)))
- ;; Compile `font-lock-keywords' and KEYWORDS in case one is and one isn't.
- (setq font-lock-keywords (font-lock-compile-keywords font-lock-keywords)
+ ;; Find value of syntactic keywords in case it is a symbol.
+ (setq font-lock-syntactic-keywords (font-lock-eval-keywords
+ font-lock-syntactic-keywords))
+ ;; Compile all keywords in case some are and some aren't.
+ (setq font-lock-syntactic-keywords (font-lock-compile-keywords
+ font-lock-syntactic-keywords)
+ syntactic-keywords (font-lock-compile-keywords syntactic-keywords)
+
+ font-lock-keywords (font-lock-compile-keywords font-lock-keywords)
keywords (font-lock-compile-keywords keywords))
- ;; Use the Font Lock cache PROPERTIES if we're using cache VERSION format 2,
- ;; the current buffer's file timestamp matches the TIMESTAMP, and the current
- ;; buffer's font-lock-keywords are the same as KEYWORDS.
+ ;; Use the Font Lock cache SYNTACTIC-PROPERTIES and FACE-PROPERTIES if we're
+ ;; using cache VERSION format 3, the current buffer's file timestamp matches
+ ;; the TIMESTAMP, the current buffer's `font-lock-syntactic-keywords' are the
+ ;; same as SYNTACTIC-KEYWORDS, and the current buffer's `font-lock-keywords'
+ ;; are the same as KEYWORDS.
(let ((buf-timestamp (visited-file-modtime))
(verbose (if (numberp fast-lock-verbose)
(> (buffer-size) fast-lock-verbose)
fast-lock-verbose))
(loaded t))
- (if (or (/= version 2)
+ (if (or (/= version 3)
(buffer-modified-p)
(not (equal timestamp buf-timestamp))
+ (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-set-face-properties properties)
+ (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")
;; This is fast, but fails if adjacent characters have different `face' text
;; properties. Maybe that's why I dropped it in the first place?
;(defun fast-lock-get-face-properties ()
-; "Return a list of all `face' text properties in the current buffer.
+; "Return a list of `face' text properties in the current buffer.
;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
;where VALUE is a `face' property value and STARTx and ENDx are positions."
; (save-restriction
;; This is slow, but copes if adjacent characters have different `face' text
;; properties, but fails if they are lists.
;(defun fast-lock-get-face-properties ()
-; "Return a list of all `face' text properties in the current buffer.
+; "Return a list of `face' text properties in the current buffer.
;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
;where VALUE is a `face' property value and STARTx and ENDx are positions.
;Only those `face' VALUEs in `fast-lock-save-faces' are returned."
; properties)))
(defun fast-lock-get-face-properties ()
- "Return a list of all `face' text properties in the current buffer.
+ "Return a list of `face' text properties in the current buffer.
Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
where VALUE is a `face' property value and STARTx and ENDx are positions."
(save-restriction
(setq start (text-property-not-all end (point-max) 'face nil)))
properties)))
-(defun fast-lock-set-face-properties (properties)
- "Set all `face' text properties to PROPERTIES in the current buffer.
-Any existing `face' text properties are removed first.
-See `fast-lock-get-face-properties' for the format of PROPERTIES."
+(defun fast-lock-get-syntactic-properties ()
+ "Return a list of `syntax-table' text properties in the current buffer.
+See `fast-lock-get-face-properties'."
+ (save-restriction
+ (widen)
+ (let ((start (text-property-not-all (point-min) (point-max) 'syntax-table
+ nil))
+ end properties value cell)
+ (while start
+ (setq end (next-single-property-change start 'syntax-table nil
+ (point-max))
+ value (get-text-property start 'syntax-table))
+ ;; Make, or add to existing, list of regions with same `syntax-table'.
+ (if (setq cell (assoc value properties))
+ (setcdr cell (cons start (cons end (cdr cell))))
+ (push (list value start end) properties))
+ (setq start (text-property-not-all end (point-max) 'syntax-table nil)))
+ properties)))
+
+(defun fast-lock-add-properties (syntactic-properties face-properties)
+ "Add `syntax-table' and `face' text properties to the current buffer.
+Any existing `syntax-table' and `face' text properties are removed first.
+See `fast-lock-get-face-properties'."
(save-buffer-state (plist regions)
(save-restriction
(widen)
(font-lock-unfontify-region (point-min) (point-max))
- (while properties
- (setq plist (list 'face (car (car properties)))
- regions (cdr (car properties))
- properties (cdr properties))
- ;; Set the `face' property for each start/end region.
+ ;;
+ ;; Set the `syntax-table' property for each start/end region.
+ (while syntactic-properties
+ (setq plist (list 'syntax-table (car (car syntactic-properties)))
+ regions (cdr (car syntactic-properties))
+ syntactic-properties (cdr syntactic-properties))
+ (while regions
+ (add-text-properties (nth 0 regions) (nth 1 regions) plist)
+ (setq regions (nthcdr 2 regions))))
+ ;;
+ ;; Set the `face' property for each start/end region.
+ (while face-properties
+ (setq plist (list 'face (car (car face-properties)))
+ regions (cdr (car face-properties))
+ face-properties (cdr face-properties))
(while regions
- (set-text-properties (nth 0 regions) (nth 1 regions) plist)
+ (add-text-properties (nth 0 regions) (nth 1 regions) plist)
(setq regions (nthcdr 2 regions)))))))
\f
;; Functions for XEmacs:
;; It would be better to use XEmacs' `map-extents' over extents with a
;; `font-lock' property, but `face' properties are on different extents.
(defun fast-lock-get-face-properties ()
- "Return a list of all `face' text properties in the current buffer.
+ "Return a list of `face' text properties in the current buffer.
Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
where VALUE is a `face' property value and STARTx and ENDx are positions.
Only those `face' VALUEs in `fast-lock-save-faces' are returned."
nil))))
properties)))
;;
+ ;; XEmacs does not support the `syntax-table' text property.
+ (defalias 'fast-lock-get-syntactic-properties
+ 'ignore)
+ ;;
;; Make extents just like XEmacs' font-lock.el does.
- (defun fast-lock-set-face-properties (properties)
- "Set all `face' text properties to PROPERTIES in the current buffer.
+ (defun fast-lock-add-properties (syntactic-properties face-properties)
+ "Set `face' text properties in the current buffer.
Any existing `face' text properties are removed first.
-See `fast-lock-get-face-properties' for the format of PROPERTIES."
+See `fast-lock-get-face-properties'."
(save-restriction
(widen)
(font-lock-unfontify-region (point-min) (point-max))
- (while properties
- (let ((face (car (car properties)))
- (regions (cdr (car properties))))
- ;; Set the `face' property, etc., for each start/end region.
+ ;; Set the `face' property, etc., for each start/end region.
+ (while face-properties
+ (let ((face (car (car face-properties)))
+ (regions (cdr (car face-properties))))
(while regions
(font-lock-set-face (nth 0 regions) (nth 1 regions) face)
(setq regions (nthcdr 2 regions)))
- (setq properties (cdr properties))))))
+ (setq face-properties (cdr face-properties))))
+ ;; XEmacs does not support the `syntax-table' text property.
+ ))
;;
;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook.
(add-hook 'font-lock-after-fontify-buffer-hook
'fast-lock-after-fontify-buffer))
+(unless (boundp 'font-lock-syntactic-keywords)
+ (defvar font-lock-syntactic-keywords nil))
+
(unless (boundp 'font-lock-inhibit-thing-lock)
- (defvar font-lock-inhibit-thing-lock nil
- "List of Font Lock mode related modes that should not be turned on."))
+ (defvar font-lock-inhibit-thing-lock nil))
+
+(unless (fboundp 'font-lock-compile-keywords)
+ (defalias 'font-lock-compile-keywords 'identity))
+
+(unless (fboundp 'font-lock-eval-keywords)
+ (defun font-lock-eval-keywords (keywords)
+ (if (symbolp keywords)
+ (font-lock-eval-keywords (if (fboundp keywords)
+ (funcall keywords)
+ (eval keywords)))
+ keywords)))
(unless (fboundp 'font-lock-value-in-major-mode)
(defun font-lock-value-in-major-mode (alist)
- ;; Return value in ALIST for `major-mode'.
(if (consp alist)
(cdr (or (assq major-mode alist) (assq t alist)))
alist)))
-
-(unless (fboundp 'font-lock-compile-keywords)
- (defalias 'font-lock-compile-keywords 'identity))
\f
;; Install ourselves:
projects / emacs.git / commitdiff