(eval-when-compile (require 'cl-lib))
-(defvar font-lock-beginning-of-syntax-function)
-
;;; Applying syntax-table properties where needed.
(defvar syntax-propertize-function nil
(point-max))))
(cons beg end))
-(defvar syntax-propertize--done -1
- "Position up to which syntax-table properties have been set.")
-(make-variable-buffer-local 'syntax-propertize--done)
-
(defun syntax-propertize--shift-groups (re n)
(replace-regexp-in-string
"\\\\(\\?\\([0-9]+\\):"
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS."
- (when (and syntax-propertize-function
- (< syntax-propertize--done pos))
- ;; (message "Needs to syntax-propertize from %s to %s"
- ;; syntax-propertize--done pos)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (save-excursion
- (with-silent-modifications
- (let* ((start (max syntax-propertize--done (point-min)))
- (end (max pos
- (min (point-max)
- (+ start syntax-propertize-chunk-size))))
- (funs syntax-propertize-extend-region-functions))
- (while funs
- (let ((new (funcall (pop funs) start end)))
- (if (or (null new)
- (and (>= (car new) start) (<= (cdr new) end)))
- nil
- (setq start (car new))
- (setq end (cdr new))
- ;; If there's been a change, we should go through the
- ;; list again since this new position may
- ;; warrant a different answer from one of the funs we've
- ;; already seen.
- (unless (eq funs
- (cdr syntax-propertize-extend-region-functions))
- (setq funs syntax-propertize-extend-region-functions)))))
- ;; Move the limit before calling the function, so the function
- ;; can use syntax-ppss.
- (setq syntax-propertize--done end)
- ;; (message "syntax-propertizing from %s to %s" start end)
- (remove-text-properties start end
- '(syntax-table nil syntax-multiline nil))
- (funcall syntax-propertize-function start end))))))
+ (when (< syntax-propertize--done pos)
+ (if (null syntax-propertize-function)
+ (setq syntax-propertize--done (max (point-max) pos))
+ ;; (message "Needs to syntax-propertize from %s to %s"
+ ;; syntax-propertize--done pos)
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (save-excursion
+ (with-silent-modifications
+ (make-local-variable 'syntax-propertize--done) ;Just in case!
+ (let* ((start (max (min syntax-propertize--done (point-max))
+ (point-min)))
+ (end (max pos
+ (min (point-max)
+ (+ start syntax-propertize-chunk-size))))
+ (funs syntax-propertize-extend-region-functions))
+ (while funs
+ (let ((new (funcall (pop funs) start end))
+ ;; Avoid recursion!
+ (syntax-propertize--done most-positive-fixnum))
+ (if (or (null new)
+ (and (>= (car new) start) (<= (cdr new) end)))
+ nil
+ (setq start (car new))
+ (setq end (cdr new))
+ ;; If there's been a change, we should go through the
+ ;; list again since this new position may
+ ;; warrant a different answer from one of the funs we've
+ ;; already seen.
+ (unless (eq funs
+ (cdr syntax-propertize-extend-region-functions))
+ (setq funs syntax-propertize-extend-region-functions)))))
+ ;; Move the limit before calling the function, so the function
+ ;; can use syntax-ppss.
+ (setq syntax-propertize--done end)
+ ;; (message "syntax-propertizing from %s to %s" start end)
+ (remove-text-properties start end
+ '(syntax-table nil syntax-multiline nil))
+ ;; Avoid recursion!
+ (let ((syntax-propertize--done most-positive-fixnum))
+ (funcall syntax-propertize-function start end))))))))
+
+;;; Link syntax-propertize with syntax.c.
+
+(defvar syntax-propertize-chunks
+ ;; We're not sure how far we'll go. In my tests, using chunks of 20000
+ ;; brings to overhead to something negligible. Passing ‘charpos’ directly
+ ;; also works (basically works line-by-line) but results in an overhead which
+ ;; I thought was a bit too high (like around 50%).
+ 2000)
+
+(defun internal--syntax-propertize (charpos)
+ ;; FIXME: Called directly from C.
+ (syntax-propertize (min (+ syntax-propertize-chunks charpos) (point-max))))
;;; Incrementally compute and memoize parser state.
;; - The function might be slow.
;; - If this function almost always finds a safe nearby spot,
;; the cache won't be populated, so consulting it is cheap.
- (when (and (not syntax-begin-function)
- (boundp 'font-lock-beginning-of-syntax-function)
- font-lock-beginning-of-syntax-function)
- (set (make-local-variable 'syntax-begin-function)
- font-lock-beginning-of-syntax-function))
(when (and syntax-begin-function
(progn (goto-char pos)
(funcall syntax-begin-function)
;; (defun buffer-syntactic-context (&optional buffer)
;; "Syntactic context at point in BUFFER.
-;; Either of `string', `comment' or `nil'.
+;; Either of `string', `comment' or nil.
;; This is an XEmacs compatibility function."
;; (with-current-buffer (or buffer (current-buffer))
;; (syntax-ppss-context (syntax-ppss))))