+(defun wisi-extend-action (number)
+ "Extend text of cache at token NUMBER to cover all of token NUMBER.
+Also override token with new token."
+ (let* ((token-region (aref wisi-tokens (1- number)));; wisi-tokens is let-bound in wisi-parse-reduce
+ (token (car token-region))
+ (region (cdr token-region))
+ cache)
+
+ (when region
+ (setq cache (wisi-get-cache (car region)))
+ (setf (wisi-cache-last cache) (- (cdr region) (car region)))
+ (setf (wisi-cache-token cache) token)
+ )
+ ))
+
+(defun wisi-face-action-1 (face region &optional no-override)
+ "Apply FACE to REGION. If NO-OVERRIDE is non-nil, don't override existing face."
+ (when region
+ ;; We allow overriding a face property, because we don't want to
+ ;; delete them in wisi-invalidate (see comments there). On the
+ ;; other hand, it can be an error, so keep this debug
+ ;; code. However, note that font-lock-face properties must be
+ ;; removed first, or the buffer must be fresh (never parsed).
+ ;;
+ ;; Grammar sets no-override when a higher-level production might
+ ;; override a face in a lower-level production; that's not an
+ ;; error.
+ (let (cur-face
+ (do-set t))
+ (when (or no-override
+ (> wisi-debug 1))
+ (setq cur-face (get-text-property (car region) 'font-lock-face))
+ (if cur-face
+ (if no-override
+ (setq do-set nil)
+ (message "%s:%d overriding face %s with %s on '%s'"
+ (buffer-file-name)
+ (line-number-at-pos (car region))
+ face
+ cur-face
+ (buffer-substring-no-properties (car region) (cdr region))))
+
+ ))
+ (when do-set
+ (with-silent-modifications
+ (add-text-properties
+ (car region) (cdr region)
+ (list
+ 'font-lock-face face
+ 'fontified t))))
+ )))
+
+(defun wisi-face-action (pairs &optional no-override)
+ "Cache face information in text properties of tokens.
+Intended as a grammar non-terminal action.
+
+PAIRS is a vector of the form [token-number face token-number face ...]
+token-number may be an integer, or a vector [integer token_id token_id ...]
+
+For an integer token-number, apply face to the first cached token
+in the range covered by wisi-tokens[token-number]. If there are
+no cached tokens, apply face to entire wisi-tokens[token-number]
+region.
+
+For a vector token-number, apply face to the first cached token
+in the range matching one of token_id covered by
+wisi-tokens[token-number].
+
+If NO-OVERRIDE is non-nil, don't override existing face."
+ (let (number region face (tokens nil) cache (i 0) (j 1))
+ (while (< i (length pairs))
+ (setq number (aref pairs i))
+ (setq face (aref pairs (setq i (1+ i))))
+ (cond
+ ((integerp number)
+ (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is let-bound in wisi-parse-reduce
+ (when region
+ (save-excursion
+ (goto-char (car region))
+ (setq cache (or (wisi-get-cache (point))
+ (wisi-forward-cache)))
+ (if (< (point) (cdr region))
+ (when cache
+ (wisi-face-action-1 face (wisi-cache-region cache) no-override))
+
+ ;; no caches in region; just apply face to region
+ (wisi-face-action-1 face region no-override))
+ )))
+
+ ((vectorp number)
+ (setq region (cdr (aref wisi-tokens (1- (aref number 0)))))
+ (when region
+ (while (< j (length number))
+ (setq tokens (cons (aref number j) tokens))
+ (setq j (1+ j)))
+ (save-excursion
+ (goto-char (car region))
+ (setq cache (wisi-forward-find-token tokens (cdr region) t))
+ ;; might be looking for IDENTIFIER in name, but only have "*".
+ (when cache
+ (wisi-face-action-1 face (wisi-cache-region cache) no-override))
+ )))
+ )
+ (setq i (1+ i))
+
+ )))
+
+(defun wisi-face-list-action (pairs &optional no-override)
+ "Cache face information in text properties of tokens.
+Intended as a grammar non-terminal action.
+
+PAIRS is a vector of the form [token-number face token-number face ...]
+token-number is an integer. Apply face to all cached tokens
+in the range covered by wisi-tokens[token-number].
+
+If NO-OVERRIDE is non-nil, don't override existing face."
+ (let (number region face cache (i 0))
+ (while (< i (length pairs))
+ (setq number (aref pairs i))
+ (setq face (aref pairs (setq i (1+ i))))
+ (setq region (cdr (aref wisi-tokens (1- number))));; wisi-tokens is let-bound in wisi-parse-reduce
+ (when region
+ (save-excursion
+ (goto-char (car region))
+ (setq cache (or (wisi-get-cache (point))
+ (wisi-forward-cache)))
+ (while (<= (point) (cdr region))
+ (when cache
+ (wisi-face-action-1 face (wisi-cache-region cache) no-override))
+ (setq cache (wisi-forward-cache))
+ )))
+
+ (setq i (1+ i))
+
+ )))
+