# HG changeset patch # User Simon Marshall # Date 864889296 0 # Node ID 12fc8bc96c58c1593d51beed884392e66a728790 # Parent 85119f3199716ce5662ffd6ce0561c98e8eabf60 Update for syntax-table text properties. fast-lock.el now saves and restores them. diff -r 85119f319971 -r 12fc8bc96c58 lisp/fast-lock.el --- a/lisp/fast-lock.el Thu May 29 06:57:11 1997 +0000 +++ b/lisp/fast-lock.el Thu May 29 07:01:36 1997 +0000 @@ -4,7 +4,7 @@ ;; Author: Simon Marshall ;; Keywords: faces files -;; Version: 3.12.01 +;; Version: 3.12.02 ;;; This file is part of GNU Emacs. @@ -166,6 +166,12 @@ ;; - 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 ;;; Code: @@ -213,7 +219,7 @@ ; "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) @@ -541,9 +547,14 @@ ;; 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) @@ -553,8 +564,10 @@ (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) @@ -571,30 +584,39 @@ ;; 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") @@ -608,7 +630,7 @@ ;; 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 @@ -628,7 +650,7 @@ ;; 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." @@ -648,7 +670,7 @@ ; 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 @@ -666,21 +688,50 @@ (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 - (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)))) + ;; + ;; 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 + (add-text-properties (nth 0 regions) (nth 1 regions) plist) (setq regions (nthcdr 2 regions))))))) ;; Functions for XEmacs: @@ -690,7 +741,7 @@ ;; 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." @@ -713,40 +764,55 @@ 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)) ;; Install ourselves: