Commit b128268e authored by Alan Mackenzie's avatar Alan Mackenzie
Browse files

Fontify CPP expressions correctly when starting in the middle of such a

construct.  Mainly for when jit-lock etc. starts a chunk here.

cc-fonts.el (c-font-lock-context): new buffer local variable.
(c-make-font-lock-search-form): new function, extracted from
c-make-font-lock-search-function.
(c-make-font-lock-search-function): Use the above function.
(c-make-font-lock-context-search-function): New function.
(c-cpp-matchers): Enhance the preprocessor expression case with the above
function
(c-font-lock-complex-decl-prepare):  Test for being in a CPP form which
takes an expression.

cc-langs.el (c-cpp-expr-intro-re): New lang-variable.
parent 11994f9b
......@@ -199,10 +199,16 @@
(set-face-foreground 'c-annotation-face "blue")
(eval-and-compile
;; We need the following functions during compilation since they're
;; called when the `c-lang-defconst' initializers are evaluated.
;; Define them at runtime too for the sake of derived modes.
;; We need the following definitions during compilation since they're
;; used when the `c-lang-defconst' initializers are evaluated. Define
;; them at runtime too for the sake of derived modes.
;; This indicates the "font locking context", and is set just before
;; fontification is done. If non-nil, it says, e.g., point starts
;; from within a #if preprocessor construct.
(defvar c-font-lock-context nil)
(make-variable-buffer-local 'c-font-lock-context)
(defmacro c-put-font-lock-face (from to face)
;; Put a face on a region (overriding any existing face) in the way
;; font-lock would do it. In XEmacs that means putting an
......@@ -283,6 +289,45 @@
nil)))))
res))))
(defun c-make-font-lock-search-form (regexp highlights)
;; Return a lisp form which will fontify every occurence of REGEXP
;; (a regular expression, NOT a function) between POINT and `limit'
;; with HIGHLIGHTS, a list of highlighters as specified on page
;; "Search-based Fontification" in the elisp manual.
`(while (re-search-forward ,regexp limit t)
(unless (progn
(goto-char (match-beginning 0))
(c-skip-comments-and-strings limit))
(goto-char (match-end 0))
,@(mapcar
(lambda (highlight)
(if (integerp (car highlight))
;; e.g. highlight is (1 font-lock-type-face t)
(progn
(unless (eq (nth 2 highlight) t)
(error
"The override flag must currently be t in %s"
highlight))
(when (nth 3 highlight)
(error
"The laxmatch flag may currently not be set in %s"
highlight))
`(save-match-data
(c-put-font-lock-face
(match-beginning ,(car highlight))
(match-end ,(car highlight))
,(elt highlight 1))))
;; highlight is an "ANCHORED HIGHLIGHER" of the form
;; (ANCHORED-MATCHER PRE-FORM POST-FORM SUBEXP-HIGHLIGHTERS...)
(when (nth 3 highlight)
(error "Match highlights currently not supported in %s"
highlight))
`(progn
,(nth 1 highlight)
(save-match-data ,(car highlight))
,(nth 2 highlight))))
highlights))))
(defun c-make-font-lock-search-function (regexp &rest highlights)
;; This function makes a byte compiled function that works much like
;; a matcher element in `font-lock-keywords'. It cuts out a little
......@@ -313,43 +358,101 @@
;; lambda more easily.
(byte-compile
`(lambda (limit)
(let (;; The font-lock package in Emacs is known to clobber
(let ( ;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
(cc-eval-when-compile
(boundp 'parse-sexp-lookup-properties))))
(while (re-search-forward ,regexp limit t)
(unless (progn
(goto-char (match-beginning 0))
(c-skip-comments-and-strings limit))
(goto-char (match-end 0))
,@(mapcar
(lambda (highlight)
(if (integerp (car highlight))
(progn
(unless (eq (nth 2 highlight) t)
(error
"The override flag must currently be t in %s"
highlight))
(when (nth 3 highlight)
(error
"The laxmatch flag may currently not be set in %s"
highlight))
`(save-match-data
(c-put-font-lock-face
(match-beginning ,(car highlight))
(match-end ,(car highlight))
,(elt highlight 1))))
(when (nth 3 highlight)
(error "Match highlights currently not supported in %s"
highlight))
`(progn
,(nth 1 highlight)
(save-match-data ,(car highlight))
,(nth 2 highlight))))
highlights))))
;; (while (re-search-forward ,regexp limit t)
;; (unless (progn
;; (goto-char (match-beginning 0))
;; (c-skip-comments-and-strings limit))
;; (goto-char (match-end 0))
;; ,@(mapcar
;; (lambda (highlight)
;; (if (integerp (car highlight))
;; (progn
;; (unless (eq (nth 2 highlight) t)
;; (error
;; "The override flag must currently be t in %s"
;; highlight))
;; (when (nth 3 highlight)
;; (error
;; "The laxmatch flag may currently not be set in %s"
;; highlight))
;; `(save-match-data
;; (c-put-font-lock-face
;; (match-beginning ,(car highlight))
;; (match-end ,(car highlight))
;; ,(elt highlight 1))))
;; (when (nth 3 highlight)
;; (error "Match highlights currently not supported in %s"
;; highlight))
;; `(progn
;; ,(nth 1 highlight)
;; (save-match-data ,(car highlight))
;; ,(nth 2 highlight))))
;; highlights)))
,(c-make-font-lock-search-form regexp highlights))
nil)))
(defun c-make-font-lock-context-search-function (normal &rest state-stanzas)
;; This function makes a byte compiled function that works much like
;; a matcher element in `font-lock-keywords', with the following
;; enhancement: the generated function will test for particular "font
;; lock contexts" at the start of the region, i.e. is this point in
;; the middle of some particular construct? if so the generated
;; function will first fontify the tail of the construct, before
;; going into the main loop and fontify full constructs up to limit.
;;
;; The generated function takes one parameter called `limit', and
;; will fontify the region between POINT and LIMIT.
;;
;; NORMAL is a list of the form (REGEXP HIGHLIGHTS .....), and is
;; used to fontify the "regular" bit of the region.
;; STATE-STANZAS is list of elements of the form (STATE LIM REGEXP
;; HIGHLIGHTS), each element coding one possible font lock context.
;; o - REGEXP is a font-lock regular expression (NOT a function),
;; o - HIGHLIGHTS is a list of zero or more highlighters as defined
;; on page "Search-based Fontification" in the elisp manual. As
;; yet (2009-06), they must have OVERRIDE set, and may not have
;; LAXMATCH set.
;;
;; o - STATE is the "font lock context" (e.g. in-cpp-expr) and is
;; not quoted.
;; o - LIM is a lisp form whose evaluation will yield the limit
;; position in the buffer for fontification by this stanza.
;;
;; This function does not do any hidden buffer changes, but the
;; generated functions will. (They are however used in places
;; covered by the font-lock context.)
;;
;; Note: Replace `byte-compile' with `eval' to debug the generated
;; lambda more easily.
(byte-compile
`(lambda (limit)
(let ( ;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
(cc-eval-when-compile
(boundp 'parse-sexp-lookup-properties))))
,@(mapcar
(lambda (stanza)
(let ((state (car stanza))
(lim (nth 1 stanza))
(regexp (nth 2 stanza))
(highlights (cdr (cddr stanza))))
`(if (eq c-font-lock-context ',state)
(let ((limit ,lim))
,(c-make-font-lock-search-form
regexp highlights)))))
state-stanzas)
,(c-make-font-lock-search-form (car normal) (cdr normal))
nil))))
; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
; '(progn
(def-edebug-spec c-fontify-types-and-refs let*)
......@@ -494,19 +597,24 @@ stuff. Used on level 1 and higher."
(c-lang-const c-cpp-expr-directives)))
(cef-re (c-make-keywords-re t
(c-lang-const c-cpp-expr-functions))))
`((,(c-make-font-lock-search-function
(concat noncontinued-line-end
(c-lang-const c-opt-cpp-prefix)
ced-re ; 1 + ncle-depth
;; Match the whole logical line to look
;; for the functions in.
"\\(\\\\\\(.\\|[\n\r]\\)\\|[^\n\r]\\)*")
`((let ((limit (match-end 0)))
(while (re-search-forward ,cef-re limit 'move)
(c-put-font-lock-face (match-beginning 1)
(match-end 1)
c-preprocessor-face-name)))
(goto-char (match-end ,(1+ ncle-depth)))))))))
`((,(c-make-font-lock-context-search-function
`(,(concat noncontinued-line-end
(c-lang-const c-opt-cpp-prefix)
ced-re ; 1 + ncle-depth
;; Match the whole logical line to look
;; for the functions in.
"\\(\\\\\\(.\\|[\n\r]\\)\\|[^\n\r]\\)*")
((let ((limit (match-end 0)))
(while (re-search-forward ,cef-re limit 'move)
(c-put-font-lock-face (match-beginning 1)
(match-end 1)
c-preprocessor-face-name)))
(goto-char (match-end ,(1+ ncle-depth)))))
`(in-cpp-expr
(save-excursion (c-end-of-macro) (point))
,cef-re
(1 c-preprocessor-face-name t)))))))
;; Fontify the directive names.
(,(c-make-font-lock-search-function
......@@ -759,6 +867,12 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-forward-syntactic-ws limit)
(c-font-lock-declarators limit t (eq prop 'c-decl-type-start))))
(setq c-font-lock-context ;; (c-guess-font-lock-context)
(save-excursion
(if (and c-cpp-expr-intro-re
(c-beginning-of-macro)
(looking-at c-cpp-expr-intro-re))
'in-cpp-expr)))
nil)
(defun c-font-lock-<>-arglists (limit)
......
......@@ -815,6 +815,16 @@ expression."
t (if (c-lang-const c-opt-cpp-prefix)
'("if" "elif")))
(c-lang-defconst c-cpp-expr-intro-re
"Regexp which matches the start of a CPP directive which contains an
expression, or nil if there aren't any in the language."
t (if (c-lang-const c-cpp-expr-directives)
(concat
(c-lang-const c-opt-cpp-prefix)
(c-make-keywords-re t (c-lang-const c-cpp-expr-directives)))))
(c-lang-defvar c-cpp-expr-intro-re
(c-lang-const c-cpp-expr-intro-re))
(c-lang-defconst c-cpp-expr-functions
"List of functions in cpp expressions."
t (if (c-lang-const c-opt-cpp-prefix)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment