[Emacs-diffs] /srv/bzr/emacs/trunk r105504: Fontify CPP expressions correctly when starting in the middle of such a

[Alan Mackenzie]

------------------------------------------------------------
revno: 105504 [merge]
committer: Alan Mackenzie <address@hidden>
branch nick: trunk
timestamp: Sat 2011-08-20 15:23:04 +0000
message:
  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.
modified:
  lisp/ChangeLog
  lisp/progmodes/cc-fonts.el
  lisp/progmodes/cc-langs.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-08-20 10:02:04 +0000
+++ b/lisp/ChangeLog    2011-08-20 14:54:21 +0000
@@ -1,3 +1,22 @@
+2011-08-20  Alan Mackenzie  <address@hidden>
+
+       * Fontify CPP expressions correctly when starting in the middle of
+       such a construct.  Mainly for when jit-lock etc. starts a chunk
+       here.
+
+       * progmodes/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.
+
+       * progmodes/cc-langs.el (c-cpp-expr-intro-re): New lang-variable.
+
 2011-08-20  Martin Rudalics  <address@hidden>
 
        * window.el (display-buffer-reuse-window)

=== modified file 'lisp/progmodes/cc-fonts.el'
--- a/lisp/progmodes/cc-fonts.el        2011-07-26 19:18:40 +0000
+++ b/lisp/progmodes/cc-fonts.el        2011-08-20 14:43:33 +0000
@@ -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 @@
                                  (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 @@
       (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)

=== modified file 'lisp/progmodes/cc-langs.el'
--- a/lisp/progmodes/cc-langs.el        2011-07-26 19:18:40 +0000
+++ b/lisp/progmodes/cc-langs.el        2011-08-20 14:43:33 +0000
@@ -815,6 +815,16 @@
   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)