[Emacs-diffs] /srv/bzr/emacs/trunk r106889: Eliminate sluggishness and hangs in fontification of "semicolon deserts".

[Alan Mackenzie]

------------------------------------------------------------
revno: 106889 [merge]
committer: Alan Mackenzie <address@hidden>
branch nick: trunk
timestamp: Wed 2012-01-18 18:15:25 +0000
message:
  Eliminate sluggishness and hangs in fontification of "semicolon deserts".
modified:
  lisp/ChangeLog
  lisp/progmodes/cc-cmds.el
  lisp/progmodes/cc-engine.el
  lisp/progmodes/cc-fonts.el
  lisp/progmodes/cc-mode.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-01-18 01:33:19 +0000
+++ b/lisp/ChangeLog    2012-01-18 13:39:32 +0000
@@ -1,3 +1,27 @@
+2012-01-18  Alan Mackenzie  <address@hidden>
+
+       Eliminate sluggishness and hangs in fontification of "semicolon
+       deserts".
+
+       * progmodes/cc-engine.el (c-state-nonlit-pos-interval): change
+       value 10000 -> 3000.
+       (c-state-safe-place): Reformulate so it doesn't stack up an
+       infinite number of wrong entries in c-state-nonlit-pos-cache.
+       (c-determine-limit-get-base, c-determine-limit): New functions to
+       determine backward search limits disregarding literals.
+       (c-find-decl-spots): Amend commenting.
+       (c-cheap-inside-bracelist-p): New function which detects "={".
+
+       * progmodes/cc-fonts.el
+       (c-make-font-lock-BO-decl-search-function): Give a limit to a
+       backward search.
+       (c-font-lock-declarations): Fix an occurrence of point being
+       undefined.  Check additionally for point being in a bracelist or
+       near a macro invocation without a semicolon so as to avoid a
+       fruitless time consuming search for a declarator.  Give a more
+       precise search limit for declarators using the new
+       c-determine-limit.
+
 2012-01-18  Glenn Morris  <address@hidden>
 
        * files.el (auto-mode-alist, inhibit-first-line-modes-regexps)

=== modified file 'lisp/progmodes/cc-cmds.el'
--- a/lisp/progmodes/cc-cmds.el 2012-01-05 09:46:05 +0000
+++ b/lisp/progmodes/cc-cmds.el 2012-01-13 10:59:27 +0000
@@ -4382,11 +4382,8 @@
   (let ((fill-paragraph-function
         ;; Avoid infinite recursion.
         (if (not (eq fill-paragraph-function 'c-fill-paragraph))
-            fill-paragraph-function))
-       (start-point (point-marker)))
-    (c-mask-paragraph
-     t nil (lambda () (fill-region-as-paragraph (point-min) (point-max) arg)))
-    (goto-char start-point))
+            fill-paragraph-function)))
+    (c-mask-paragraph t nil 'fill-paragraph arg))
   ;; Always return t.  This has the effect that if filling isn't done
   ;; above, it isn't done at all, and it's therefore effectively
   ;; disabled in normal code.

=== modified file 'lisp/progmodes/cc-engine.el'
--- a/lisp/progmodes/cc-engine.el       2012-01-11 22:21:44 +0000
+++ b/lisp/progmodes/cc-engine.el       2012-01-18 13:19:31 +0000
@@ -2074,7 +2074,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; We maintain a simple cache of positions which aren't in a literal, so as to
 ;; speed up testing for non-literality.
-(defconst c-state-nonlit-pos-interval 10000)
+(defconst c-state-nonlit-pos-interval 3000)
 ;; The approximate interval between entries in `c-state-nonlit-pos-cache'.
 
 (defvar c-state-nonlit-pos-cache nil)
@@ -2129,7 +2129,7 @@
     (widen)
     (save-excursion
       (let ((c c-state-nonlit-pos-cache)
-           pos npos lit)
+           pos npos lit macro-beg)
        ;; Trim the cache to take account of buffer changes.
        (while (and c (> (car c) c-state-nonlit-pos-cache-limit))
          (setq c (cdr c)))
@@ -2139,16 +2139,32 @@
          (setq c (cdr c)))
        (setq pos (or (car c) (point-min)))
 
-       (while (<= (setq npos (+ pos c-state-nonlit-pos-interval))
-                  here)
-         (setq lit (car (cddr (c-state-pp-to-literal pos npos))))
-         (setq pos (or (cdr lit) npos)) ; end of literal containing npos.
+       (while
+           ;; Add an element to `c-state-nonlit-pos-cache' each iteration.
+           (and
+            (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here)
+            (progn
+              (setq lit (car (cddr (c-state-pp-to-literal pos npos))))
+              (cond
+               ((null lit)
+                (setq pos npos)
+                t)
+               ((<= (cdr lit) here)
+                (setq pos (cdr lit))
+                t)
+               (t
+                (setq pos (car lit))
+                nil))))
+
          (goto-char pos)
          (when (and (c-beginning-of-macro) (/= (point) pos))
-           (c-syntactic-end-of-macro)
-           (or (eobp) (forward-char))
-           (setq pos (point)))
-         (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
+             (setq macro-beg (point))
+             (c-syntactic-end-of-macro)
+             (or (eobp) (forward-char))
+             (setq pos (if (<= (point) here)
+                           (point)
+                         macro-beg)))
+           (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
 
        (if (> pos c-state-nonlit-pos-cache-limit)
            (setq c-state-nonlit-pos-cache-limit pos))
@@ -4351,6 +4367,78 @@
              (t 'c)))                  ; Assuming the range is valid.
     range))
 
+(defsubst c-determine-limit-get-base (start try-size)
+  ;; Get a "safe place" approximately TRY-SIZE characters before START.
+  ;; This doesn't preserve point.
+  (let* ((pos (max (- start try-size) (point-min)))
+        (base (c-state-safe-place pos))
+        (s (parse-partial-sexp base pos)))
+    (if (or (nth 4 s) (nth 3 s))       ; comment or string
+       (nth 8 s)
+      (point))))
+
+(defun c-determine-limit (how-far-back &optional start try-size)
+  ;; Return a buffer position HOW-FAR-BACK non-literal characters from START
+  ;; (default point).  This is done by going back further in the buffer then
+  ;; searching forward for literals.  The position found won't be in a
+  ;; literal.  We start searching for the sought position TRY-SIZE (default
+  ;; twice HOW-FAR-BACK) bytes back from START.  This function must be fast.
+  ;; :-)
+  (save-excursion
+    (let* ((start (or start (point)))
+          (try-size (or try-size (* 2 how-far-back)))
+          (base (c-determine-limit-get-base start try-size))
+          (pos base)
+
+          (s (parse-partial-sexp pos pos)) ; null state.
+          stack elt size
+          (count 0))
+      (while (< pos start)
+       ;; Move forward one literal each time round this loop.
+       ;; Move forward to the start of a comment or string.
+       (setq s (parse-partial-sexp
+                pos
+                start
+                nil                    ; target-depth
+                nil                    ; stop-before
+                s                      ; state
+                'syntax-table))        ; stop-comment
+
+       ;; Gather details of the non-literal-bit - starting pos and size.
+       (setq size (- (if (or (nth 4 s) (nth 3 s))
+                         (nth 8 s)
+                       (point))
+                     pos))
+       (if (> size 0)
+           (setq stack (cons (cons pos size) stack)))
+
+       ;; Move forward to the end of the comment/string.
+       (if (or (nth 4 s) (nth 3 s))
+           (setq s (parse-partial-sexp
+                    (point)
+                    start
+                    nil                ; target-depth
+                    nil                ; stop-before
+                    s                  ; state
+                    'syntax-table)))   ; stop-comment
+       (setq pos (point)))
+    
+      ;; Now try and find enough non-literal characters recorded on the stack.
+      ;; Go back one recorded literal each time round this loop.
+      (while (and (< count how-far-back)
+                 stack)
+       (setq elt (car stack)
+             stack (cdr stack))
+       (setq count (+ count (cdr elt))))
+
+      ;; Have we found enough yet?
+      (cond
+       ((>= count how-far-back)
+       (+ (car elt) (- count how-far-back)))
+       ((eq base (point-min))
+       (point-min))
+       (t
+       (c-determine-limit (- how-far-back count) base try-size))))))
 
 ;; `c-find-decl-spots' and accompanying stuff.
 
@@ -4487,13 +4575,14 @@
   ;; Call CFD-FUN for each possible spot for a declaration, cast or
   ;; label from the point to CFD-LIMIT.
   ;;
-  ;; CFD-FUN is called with point at the start of the spot.  It's
-  ;; passed two arguments: The first is the end position of the token
-  ;; preceding the spot, or 0 for the implicit match at bob.  The
-  ;; second is a flag that is t when the match is inside a macro.  If
-  ;; CFD-FUN adds `c-decl-end' properties somewhere below the current
-  ;; spot, it should return non-nil to ensure that the next search
-  ;; will find them.
+  ;; CFD-FUN is called with point at the start of the spot.  It's passed two
+  ;; arguments: The first is the end position of the token preceding the spot,
+  ;; or 0 for the implicit match at bob.  The second is a flag that is t when
+  ;; the match is inside a macro.  Point should be moved forward by at least
+  ;; one token.
+  ;;
+  ;; If CFD-FUN adds `c-decl-end' properties somewhere below the current spot,
+  ;; it should return non-nil to ensure that the next search will find them.
   ;;
   ;; Such a spot is:
   ;; o  The first token after bob.
@@ -4867,7 +4956,8 @@
       (goto-char cfd-continue-pos)
       (if (= cfd-continue-pos cfd-limit)
          (setq cfd-match-pos cfd-limit)
-       (c-find-decl-prefix-search)))))
+       (c-find-decl-prefix-search))))) ; Moves point, sets cfd-continue-pos,
+                                       ; cfd-match-pos, etc.
 
 
 ;; A cache for found types.
@@ -8047,6 +8137,23 @@
            next-open-brace (c-pull-open-brace paren-state)))
     open-brace))
 
+(defun c-cheap-inside-bracelist-p (paren-state)
+  ;; Return the position of the L-brace if point is inside a brace list
+  ;; initialization of an array, etc.  This is an approximate function,
+  ;; designed for speed over accuracy.  It will not find every bracelist, but
+  ;; a non-nil result is reliable.  We simply search for "= {" (naturally with
+  ;; syntactic whitespace allowed).  PAREN-STATE is the normal thing that it
+  ;; is everywhere else.
+  (let (b-pos)
+    (save-excursion
+      (while
+         (and (setq b-pos (c-pull-open-brace paren-state))
+              (progn (goto-char b-pos)
+                     (c-backward-sws)
+                     (c-backward-token-2)
+                     (not (looking-at "=")))))
+      b-pos)))
+
 (defun c-inside-bracelist-p (containing-sexp paren-state)
   ;; return the buffer position of the beginning of the brace list
   ;; statement if we're inside a brace list, otherwise return nil.

=== modified file 'lisp/progmodes/cc-fonts.el'
--- a/lisp/progmodes/cc-fonts.el        2012-01-10 06:20:22 +0000
+++ b/lisp/progmodes/cc-fonts.el        2012-01-18 13:19:31 +0000
@@ -446,10 +446,12 @@
              ;; `parse-sexp-lookup-properties' (when it exists).
              (parse-sexp-lookup-properties
               (cc-eval-when-compile
-                (boundp 'parse-sexp-lookup-properties))))
+                (boundp 'parse-sexp-lookup-properties)))
+             (BOD-limit
+              (c-determine-limit 1000)))
          (goto-char
           (let ((here (point)))
-            (if (eq (car (c-beginning-of-decl-1)) 'same)
+            (if (eq (car (c-beginning-of-decl-1 BOD-limit)) 'same)
                 (point)
               here)))
          ,(c-make-font-lock-search-form regexp highlights))
@@ -1240,6 +1242,7 @@
          ;; it finds any.  That's necessary so that we later will
          ;; stop inside them to fontify types there.
          (c-parse-and-markup-<>-arglists t)
+         lbrace ; position of some {.
          ;; The font-lock package in Emacs is known to clobber
          ;; `parse-sexp-lookup-properties' (when it exists).
          (parse-sexp-lookup-properties
@@ -1351,7 +1354,6 @@
              (or (looking-at c-typedef-key)
                  (goto-char start-pos)))
 
-           ;; Now analyze the construct.
            ;; In QT, "more" is an irritating keyword that expands to nothing.
            ;; We skip over it to prevent recognition of "more slots: <symbol>"
            ;; as a bitfield declaration.
@@ -1360,6 +1362,8 @@
                        (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)")))
              (goto-char (match-end 1))
              (c-forward-syntactic-ws))
+
+           ;; Now analyze the construct.
            (setq decl-or-cast (c-forward-decl-or-cast-1
                                match-pos context last-cast-end))
 
@@ -1428,6 +1432,39 @@
              (c-fontify-recorded-types-and-refs)
              nil)
 
+            ;; Restore point, since at this point in the code it has been
+            ;; left undefined by c-forward-decl-or-cast-1 above.
+            ((progn (goto-char start-pos) nil))
+
+            ;; If point is inside a bracelist, there's no point checking it
+            ;; being at a declarator.
+            ((let ((paren-state (c-parse-state)))
+               (setq lbrace (c-cheap-inside-bracelist-p paren-state)))
+             ;; Move past this bracelist to prevent an endless loop.
+             (goto-char lbrace)
+             (unless (c-safe (progn (forward-list) t))
+               (goto-char start-pos)
+               (c-forward-token-2))
+             nil)
+
+            ;; If point is just after a ")" which is followed by an
+            ;; identifier which isn't a label, or at the matching "(", we're
+            ;; at either a macro invocation, a cast, or a
+            ;; for/while/etc. statement.  The cast case is handled above.
+            ;; None of these cases can contain a declarator.
+            ((or (and (eq (char-before match-pos) ?\))
+                      (c-on-identifier)
+                      (save-excursion (not (c-forward-label))))
+                 (and (eq (char-after) ?\()
+                      (save-excursion
+                        (and
+                         (progn (c-backward-token-2) (c-on-identifier))
+                         (save-excursion (not (c-forward-label)))
+                         (progn (c-backward-token-2)
+                                (eq (char-after) ?\())))))
+             (c-forward-token-2)       ; Must prevent looping.
+             nil)
+
             ((and (not c-enums-contain-decls)
                   ;; An optimization quickly to eliminate scans of long enum
                   ;; declarations in the next cond arm.
@@ -1441,13 +1478,14 @@
                            (progn
                              (c-backward-token-2)
                              (looking-at c-brace-list-key)))))))
-             t)
+             (c-forward-token-2)
+             nil)
 
             (t
              ;; Are we at a declarator?  Try to go back to the declaration
              ;; to check this.  If we get there, check whether a "typedef"
              ;; is there, then fontify the declarators accordingly.
-             (let ((decl-search-lim (max (- (point) 50000) (point-min)))
+             (let ((decl-search-lim (c-determine-limit 1000))
                    paren-state bod-res encl-pos is-typedef
                    c-recognize-knr-p) ; Strictly speaking, bogus, but it
                                       ; speeds up lisp.h tremendously.

=== modified file 'lisp/progmodes/cc-mode.el'
--- a/lisp/progmodes/cc-mode.el 2012-01-08 12:49:44 +0000
+++ b/lisp/progmodes/cc-mode.el 2012-01-13 10:59:27 +0000
@@ -490,6 +490,7 @@
   (make-local-variable 'paragraph-ignore-fill-prefix)
   (make-local-variable 'adaptive-fill-mode)
   (make-local-variable 'adaptive-fill-regexp)
+  (make-local-variable 'fill-paragraph-handle-comment)
 
   ;; now set their values
   (set (make-local-variable 'parse-sexp-ignore-comments) t)
@@ -500,6 +501,9 @@
   (set (make-local-variable 'comment-line-break-function)
        'c-indent-new-comment-line)
 
+  ;; For the benefit of adaptive file, which otherwise mis-fills.
+  (setq fill-paragraph-handle-comment nil)
+
   ;; Install `c-fill-paragraph' on `fill-paragraph-function' so that a
   ;; direct call to `fill-paragraph' behaves better.  This still
   ;; doesn't work with filladapt but it's better than nothing.