[Emacs-diffs] /srv/bzr/emacs/trunk r101155: Fix slow cursor movement.

[Vinicius Jose Latorre]

------------------------------------------------------------
revno: 101155
committer: Vinicius Jose Latorre  <address@hidden
branch nick: trunk
timestamp: Sat 2010-08-21 01:43:04 -0300
message:
  Fix slow cursor movement.
modified:
  lisp/ChangeLog
  lisp/whitespace.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-08-21 02:21:51 +0000
+++ b/lisp/ChangeLog    2010-08-21 04:43:04 +0000
@@ -1,3 +1,20 @@
+2010-08-21  Vinicius Jose Latorre  <address@hidden>
+
+       * whitespace.el: Fix slow cursor movement.  Reported by Christoph
+       Groth <address@hidden> and Liu Xin <address@hidden>.  New version
+       13.0.
+       (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp):
+       Adjust initialization.
+       (whitespace-bob-marker, whitespace-eob-marker)
+       (whitespace-buffer-changed): New vars.
+       (whitespace-cleanup, whitespace-color-on, whitespace-color-off)
+       (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp)
+       (whitespace-post-command-hook, whitespace-display-char-on): Adjust
+       code.
+       (whitespace-looking-back, whitespace-buffer-changed): New funs.
+       (whitespace-space-regexp, whitespace-tab-regexp): Eliminated
+       funs.
+
 2010-08-19  Stefan Monnier  <address@hidden>
 
        * files.el (locate-file-completion-table): Only list the .el and .elc
@@ -6244,7 +6261,7 @@
 
        * ps-print.el (ps-face-attributes): It was not returning the
        attribute face for faces specified as string.  Reported by harven
-       <address@hidden>.
+       <address@hidden>.  (Bug#5254)
        (ps-print-version): New version 7.3.5.
 
 2009-12-18  Ulf Jasper  <address@hidden>

=== modified file 'lisp/whitespace.el'
--- a/lisp/whitespace.el        2010-03-12 17:47:22 +0000
+++ b/lisp/whitespace.el        2010-08-21 04:43:04 +0000
@@ -6,7 +6,7 @@
 ;; Author: Vinicius Jose Latorre <address@hidden>
 ;; Maintainer: Vinicius Jose Latorre <address@hidden>
 ;; Keywords: data, wp
-;; Version: 12.1
+;; Version: 13.0
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
 ;; This file is part of GNU Emacs.
@@ -812,7 +812,7 @@
   :group 'whitespace)
 
 
-(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
+(defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)"
   "Specify regexp for empty lines at beginning of buffer.
 
 If you're using `mule' package, there may be other characters besides:
@@ -827,7 +827,7 @@
   :group 'whitespace)
 
 
-(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
+(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)"
   "Specify regexp for empty lines at end of buffer.
 
 If you're using `mule' package, there may be other characters besides:
@@ -1228,6 +1228,19 @@
   "Used to save locally the font-lock refontify state.
 Used by `whitespace-post-command-hook' function (which see).")
 
+(defvar whitespace-bob-marker nil
+  "Used to save locally the bob marker value.
+Used by `whitespace-post-command-hook' function (which see).")
+
+(defvar whitespace-eob-marker nil
+  "Used to save locally the eob marker value.
+Used by `whitespace-post-command-hook' function (which see).")
+
+(defvar whitespace-buffer-changed nil
+  "Used to indicate locally if buffer changed.
+Used by `whitespace-post-command-hook' and `whitespace-buffer-changed'
+functions (which see).")
+
 
 ;;;###autoload
 (defun whitespace-toggle-options (arg)
@@ -1463,10 +1476,10 @@
          (let (overwrite-mode)         ; enforce no overwrite
            (goto-char (point-min))
            (when (re-search-forward
-                  whitespace-empty-at-bob-regexp nil t)
+                  (concat "\\`" whitespace-empty-at-bob-regexp) nil t)
              (delete-region (match-beginning 1) (match-end 1)))
            (when (re-search-forward
-                  whitespace-empty-at-eob-regexp nil t)
+                  (concat whitespace-empty-at-eob-regexp "\\'") nil t)
              (delete-region (match-beginning 1) (match-end 1)))))))
     ;; PROBLEM 3: 8 or more SPACEs at bol
     ;; PROBLEM 4: SPACEs before TAB
@@ -2146,8 +2159,15 @@
     (set (make-local-variable 'whitespace-point)
         (point))
     (set (make-local-variable 'whitespace-font-lock-refontify)
+        0)
+    (set (make-local-variable 'whitespace-bob-marker)
+        (point-min-marker))
+    (set (make-local-variable 'whitespace-eob-marker)
+        (point-max-marker))
+    (set (make-local-variable 'whitespace-buffer-changed)
         nil)
     (add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
+    (add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
     ;; turn off font lock
     (set (make-local-variable 'whitespace-font-lock-mode)
         font-lock-mode)
@@ -2158,7 +2178,7 @@
        nil
        (list
        ;; Show SPACEs
-       (list #'whitespace-space-regexp  1 whitespace-space  t)
+       (list whitespace-space-regexp  1 whitespace-space  t)
        ;; Show HARD SPACEs
        (list whitespace-hspace-regexp 1 whitespace-hspace t))
        t))
@@ -2167,7 +2187,7 @@
        nil
        (list
        ;; Show TABs
-       (list #'whitespace-tab-regexp 1 whitespace-tab t))
+       (list whitespace-tab-regexp 1 whitespace-tab t))
        t))
     (when (memq 'trailing whitespace-active-style)
       (font-lock-add-keywords
@@ -2296,7 +2316,8 @@
   ;; turn off font lock
   (when (whitespace-style-face-p)
     (font-lock-mode 0)
-    (remove-hook 'post-command-hook #'whitespace-post-command-hook)
+    (remove-hook 'post-command-hook #'whitespace-post-command-hook t)
+    (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
     (when whitespace-font-lock
       (setq whitespace-font-lock nil
            font-lock-keywords   whitespace-font-lock-keywords))
@@ -2317,37 +2338,128 @@
 (defun whitespace-empty-at-bob-regexp (limit)
   "Match spaces at beginning of buffer which do not contain the point at \
 beginning of buffer."
-  (and (/= whitespace-point 1)
-       (re-search-forward whitespace-empty-at-bob-regexp limit t)))
+  (let ((b (point))
+       r)
+    (cond
+     ;; at bob
+     ((= b 1)
+      (setq r (and (/= whitespace-point 1)
+                  (looking-at whitespace-empty-at-bob-regexp)))
+      (if r
+         (set-marker whitespace-bob-marker (match-end 1))
+       (set-marker whitespace-bob-marker b)))
+     ;; inside bob empty region
+     ((<= limit whitespace-bob-marker)
+      (setq r (looking-at whitespace-empty-at-bob-regexp))
+      (if r
+         (when (< (match-end 1) limit)
+           (set-marker whitespace-bob-marker (match-end 1)))
+       (set-marker whitespace-bob-marker b)))
+     ;; intersection with end of bob empty region
+     ((<= b whitespace-bob-marker)
+      (setq r (looking-at whitespace-empty-at-bob-regexp))
+      (if r
+         (set-marker whitespace-bob-marker (match-end 1))
+       (set-marker whitespace-bob-marker b)))
+     ;; it is not inside bob empty region
+     (t
+      (setq r nil)))
+    ;; move to end of matching
+    (and r (goto-char (match-end 1)))
+    r))
+
+
+(defsubst whitespace-looking-back (regexp limit)
+  (save-excursion
+    (when (/= 0 (skip-chars-backward " \t\n" limit))
+      (unless (bolp)
+       (forward-line 1))
+      (looking-at regexp))))
 
 
 (defun whitespace-empty-at-eob-regexp (limit)
   "Match spaces at end of buffer which do not contain the point at end of \
 buffer."
-  (and (/= whitespace-point (1+ (buffer-size)))
-       (re-search-forward whitespace-empty-at-eob-regexp limit t)))
-
-
-(defun whitespace-space-regexp (limit)
-  "Match spaces."
-  (setq whitespace-font-lock-refontify t)
-  (re-search-forward whitespace-space-regexp limit t))
-
-
-(defun whitespace-tab-regexp (limit)
-  "Match tabs."
-  (setq whitespace-font-lock-refontify t)
-  (re-search-forward whitespace-tab-regexp limit t))
+  (let ((b (point))
+       (e (1+ (buffer-size)))
+       r)
+    (cond
+     ;; at eob
+     ((= limit e)
+      (when (/= whitespace-point e)
+       (goto-char limit)
+       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)))
+      (if r
+         (set-marker whitespace-eob-marker (match-beginning 1))
+       (set-marker whitespace-eob-marker limit)
+       (goto-char b)))                 ; return back to initial position
+     ;; inside eob empty region
+     ((>= b whitespace-eob-marker)
+      (goto-char limit)
+      (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
+      (if r
+         (when (> (match-beginning 1) b)
+           (set-marker whitespace-eob-marker (match-beginning 1)))
+       (set-marker whitespace-eob-marker limit)
+       (goto-char b)))                 ; return back to initial position
+     ;; intersection with beginning of eob empty region
+     ((>= limit whitespace-eob-marker)
+      (goto-char limit)
+      (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
+      (if r
+         (set-marker whitespace-eob-marker (match-beginning 1))
+       (set-marker whitespace-eob-marker limit)
+       (goto-char b)))                 ; return back to initial position
+     ;; it is not inside eob empty region
+     (t
+      (setq r nil)))
+    r))
+
+
+(defun whitespace-buffer-changed (beg end)
+  "Set `whitespace-buffer-changed' variable to t."
+  (setq whitespace-buffer-changed t))
 
 
 (defun whitespace-post-command-hook ()
   "Save current point into `whitespace-point' variable.
 Also refontify when necessary."
-  (setq whitespace-point (point))
-  (let ((refontify (or (eolp)                   ; end of line
-                      (= whitespace-point 1)))) ; beginning of buffer
-    (when (or whitespace-font-lock-refontify refontify)
-      (setq whitespace-font-lock-refontify refontify)
+  (setq whitespace-point (point))      ; current point position
+  (let ((refontify
+        (or
+         ;; it is at end of line ...
+         (and (eolp)
+              ;; ... with trailing SPACE or TAB
+              (or (= (preceding-char) ?\ )
+                  (= (preceding-char) ?\t)))
+         ;; it is at beginning of buffer (bob)
+         (= whitespace-point 1)
+         ;; the buffer was modified and ...
+         (and whitespace-buffer-changed
+              (or
+               ;; ... or inside bob whitespace region
+               (<= whitespace-point whitespace-bob-marker)
+               ;; ... or at bob whitespace region border
+               (and (= whitespace-point (1+ whitespace-bob-marker))
+                    (= (preceding-char) ?\n))))
+         ;; it is at end of buffer (eob)
+         (= whitespace-point (1+ (buffer-size)))
+         ;; the buffer was modified and ...
+         (and whitespace-buffer-changed
+              (or
+               ;; ... or inside eob whitespace region
+               (>= whitespace-point whitespace-eob-marker)
+               ;; ... or at eob whitespace region border
+               (and (= whitespace-point (1- whitespace-eob-marker))
+                    (= (following-char) ?\n)))))))
+    (when (or refontify (> whitespace-font-lock-refontify 0))
+      (setq whitespace-buffer-changed nil)
+      ;; adjust refontify counter
+      (setq whitespace-font-lock-refontify
+           (if refontify
+               1
+             (1- whitespace-font-lock-refontify)))
+      ;; refontify
       (jit-lock-refontify))))
 
 
@@ -2386,11 +2498,11 @@
       (unless whitespace-display-table-was-local
        (setq whitespace-display-table-was-local t
              whitespace-display-table
+             (copy-sequence buffer-display-table))
+       ;; asure `buffer-display-table' is unique
+       ;; when two or more windows are visible.
+       (setq buffer-display-table
              (copy-sequence buffer-display-table)))
-      ;; asure `buffer-display-table' is unique
-      ;; when two or more windows are visible.
-      (set (make-local-variable 'buffer-display-table)
-          (copy-sequence buffer-display-table))
       (unless buffer-display-table
        (setq buffer-display-table (make-display-table)))
       (dolist (entry whitespace-display-mappings)