-;;; syntax.el --- helper functions to find syntactic context
+;;; syntax.el --- helper functions to find syntactic context -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
;; Note: PPSS stands for `parse-partial-sexp state'
-(eval-when-compile (require 'cl))
-
-(defvar font-lock-beginning-of-syntax-function)
+(eval-when-compile (require 'cl-lib))
;;; Applying syntax-table properties where needed.
;; have to flush that cache between each function, and we couldn't use
;; syntax-ppss-flush-cache since that would not only flush the cache but also
;; reset syntax-propertize--done which should not be done in this case).
- "Mode-specific function to apply the syntax-table properties.
-Called with 2 arguments: START and END.
-This function can call `syntax-ppss' on any position before END, but it
-should not call `syntax-ppss-flush-cache', which means that it should not
-call `syntax-ppss' on some position and later modify the buffer on some
-earlier position.")
+ "Mode-specific function to apply `syntax-table' text properties.
+It is the work horse of `syntax-propertize', which is called by things like
+Font-Lock and indentation.
+
+It is given two arguments, START and END: the start and end of the text to
+which `syntax-table' might need to be applied. Major modes can use this to
+override the buffer's syntax table for special syntactic constructs that
+cannot be handled just by the buffer's syntax-table.
+
+The specified function may call `syntax-ppss' on any position
+before END, but it should not call `syntax-ppss-flush-cache',
+which means that it should not call `syntax-ppss' on some
+position and later modify the buffer on some earlier position.")
(defvar syntax-propertize-chunk-size 500)
(setq beg (or (previous-single-property-change beg 'syntax-multiline)
(point-min))))
;;
- (when (get-text-property end 'font-lock-multiline)
+ (when (get-text-property end 'syntax-multiline)
(setq end (or (text-property-any end (point-max)
'syntax-multiline 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]+\\):"
The return value is an object that can be passed as a rule to
`syntax-propertize-rules'.
I.e. this is useful only when you want to share rules among several
-syntax-propertize-functions."
+`syntax-propertize-function's."
(declare (debug syntax-propertize-rules))
;; Precompile? Yeah, right!
;; Seriously, tho, this is a macro for 2 reasons:
;; If there's more than 1 rule, and the rule want to apply
;; highlight to match 0, create an extra group to be able to
;; tell when *this* match 0 has succeeded.
- (incf offset)
+ (cl-incf offset)
(setq re (concat "\\(" re "\\)")))
(setq re (syntax-propertize--shift-groups re offset))
(let ((code '())
(setq offset 0)))
;; Now construct the code for each subgroup rules.
(dolist (case (cdr rule))
- (assert (null (cddr case)))
+ (cl-assert (null (cddr case)))
(let* ((gn (+ offset (car case)))
(action (nth 1 case))
(thiscode
(if syntax
(put-text-property
mb me 'syntax-table syntax))))))))
-
+
(if (or (not (cddr rule)) (zerop gn))
(setq code (nconc (nreverse thiscode) code))
(push `(if (match-beginning ,gn)
code))))
(push (cons condition (nreverse code))
branches))
- (incf offset (regexp-opt-depth orig-re))
+ (cl-incf offset (regexp-opt-depth orig-re))
re))
rules
"\\|")))
"Propertize for syntax in START..END using font-lock syntax.
KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
The return value is a function suitable for `syntax-propertize-function'."
- (lexical-let ((keywords keywords))
- (lambda (start end)
- (with-no-warnings
- (let ((font-lock-syntactic-keywords keywords))
- (font-lock-fontify-syntactic-keywords-region start end)
- ;; In case it was eval'd/compiled.
- (setq keywords font-lock-syntactic-keywords))))))
+ (lambda (start end)
+ (with-no-warnings
+ (let ((font-lock-syntactic-keywords keywords))
+ (font-lock-fontify-syntactic-keywords-region start end)
+ ;; In case it was eval'd/compiled.
+ (setq keywords font-lock-syntactic-keywords)))))
(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.
(defun syntax-ppss (&optional pos)
"Parse-Partial-Sexp State at POS, defaulting to point.
The returned value is the same as that of `parse-partial-sexp'
-run from point-min to POS except that values at positions 2 and 6
+run from `point-min' to POS except that values at positions 2 and 6
in the returned list (counting from 0) cannot be relied upon.
-Point is at POS when this function returns."
+Point is at POS when this function returns.
+
+It is necessary to call `syntax-ppss-flush-cache' explicitly if
+this function is called while `before-change-functions' is
+temporarily let-bound, or if the buffer is modified without
+running the hook."
;; Default values.
(unless pos (setq pos (point)))
(syntax-propertize pos)
(* 2 (/ (cdr (aref syntax-ppss-stats 5))
(1+ (car (aref syntax-ppss-stats 5)))))))
(progn
- (incf (car (aref syntax-ppss-stats 0)))
- (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
+ (cl-incf (car (aref syntax-ppss-stats 0)))
+ (cl-incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
(parse-partial-sexp old-pos pos nil nil old-ppss))
(cond
(setq pt-min (or (syntax-ppss-toplevel-pos old-ppss)
(nth 2 old-ppss)))
(<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
- (incf (car (aref syntax-ppss-stats 1)))
- (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
+ (cl-incf (car (aref syntax-ppss-stats 1)))
+ (cl-incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
(setq ppss (parse-partial-sexp pt-min pos)))
;; The OLD-* data can't be used. Consult the cache.
(t
;; Use the best of OLD-POS and CACHE.
(if (or (not old-pos) (< old-pos pt-min))
(setq pt-best pt-min ppss-best ppss)
- (incf (car (aref syntax-ppss-stats 4)))
- (incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
+ (cl-incf (car (aref syntax-ppss-stats 4)))
+ (cl-incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
(setq pt-best old-pos ppss-best old-ppss))
;; Use the `syntax-begin-function' if available.
;; - 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)
(not (memq (get-text-property (point) 'face)
'(font-lock-string-face font-lock-doc-face
font-lock-comment-face))))
- (incf (car (aref syntax-ppss-stats 5)))
- (incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
+ (cl-incf (car (aref syntax-ppss-stats 5)))
+ (cl-incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
(setq pt-best (point) ppss-best nil))
(cond
;; Quick case when we found a nearby pos.
((< (- pos pt-best) syntax-ppss-max-span)
- (incf (car (aref syntax-ppss-stats 2)))
- (incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
+ (cl-incf (car (aref syntax-ppss-stats 2)))
+ (cl-incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
(setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
;; Slow case: compute the state from some known position and
;; populate the cache so we won't need to do it again soon.
(t
- (incf (car (aref syntax-ppss-stats 3)))
- (incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
+ (cl-incf (car (aref syntax-ppss-stats 3)))
+ (cl-incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
;; If `pt-min' is too far, add a few intermediate entries.
(while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
(setq ppss (parse-partial-sexp
pt-min (setq pt-min (/ (+ pt-min pos) 2))
nil nil ppss))
- (let ((pair (cons pt-min ppss)))
- (if cache-pred
- (push pair (cdr cache-pred))
- (push pair syntax-ppss-cache))))
+ (push (cons pt-min ppss)
+ (if cache-pred (cdr cache-pred) syntax-ppss-cache)))
;; Compute the actual return value.
(setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
;; (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))))