Re: Fwd: Serious performace problems on Windows XP with new(!) GNU Emacs v22 (both patched and unpatched EmacsW32 were tried)

[martin rudalics]

Attached find patch and ChangeLog entry for this.

        * whitespace.el (whitespace-indent-regexp): Make this match any
        multiples of eight spaces near the beginning of a line.
        (whitespace-buffer): Use `remove-overlays' instead of
        `whitespace-unhighlight-the-space' to speed up things.
        (whitespace-buffer-leading, whitespace-buffer-trailing): Make
        these functions highlight the text removed by
        `whitespace-buffer-leading-cleanup' and
        `whitespace-buffer-trailing-cleanup' respectively.
        (whitespace-buffer-search): Use `with-local-quit'.  Move
        `format' out of loop to speed up scanning larger buffers.
        (whitespace-unhighlight-the-space): Remove `remove-hook' since
        that function is never added to a hook.
        (whitespace-spacetab-regexp, whitespace-ateol-regexp)
        (whitespace-buffer-leading-cleanup)
        (whitespace-refresh-rescan-list): Fix docstrings.

*** whitespace.el.~1.46.~       Mon Aug 21 15:35:24 2006
--- whitespace.el       Wed Nov  1 20:06:46 2006
***************
*** 194,200 ****
    :group 'whitespace)

  (defcustom whitespace-spacetab-regexp "[ ]+\t"
!   "Regexp to match a space followed by a TAB."
    :type 'regexp
    :group 'whitespace)

--- 194,200 ----
    :group 'whitespace)

  (defcustom whitespace-spacetab-regexp "[ ]+\t"
!   "Regexp to match one or more spaces followed by a TAB."
    :type 'regexp
    :group 'whitespace)

***************
*** 205,212 ****
    :type 'boolean
    :group 'whitespace)

! (defcustom whitespace-indent-regexp (concat "^\\(\t*\\)    " "    ")
!   "Regexp to match (any TABS followed by) 8/more whitespaces at start of 
line."
    :type 'regexp
    :group 'whitespace)

--- 205,213 ----
    :type 'boolean
    :group 'whitespace)

! (defcustom whitespace-indent-regexp "^\t*\\(        \\)+"
!   "Regexp to match multiples of eight spaces near line beginnings.
! The default value ignores leading TABs."
    :type 'regexp
    :group 'whitespace)

***************
*** 217,225 ****
    :type 'boolean
    :group 'whitespace)

- ;; (defcustom whitespace-ateol-regexp "[ \t]$"
  (defcustom whitespace-ateol-regexp "[ \t]+$"
!   "Regexp to match a TAB or a space at the EOL."
    :type 'regexp
    :group 'whitespace)

--- 218,225 ----
    :type 'boolean
    :group 'whitespace)

  (defcustom whitespace-ateol-regexp "[ \t]+$"
!   "Regexp to match one or more TABs or spaces at line ends."
    :type 'regexp
    :group 'whitespace)

***************
*** 425,431 ****
        (progn
          (whitespace-check-buffer-list (buffer-name) buffer-file-name)
          (whitespace-tickle-timer)
!         (whitespace-unhighlight-the-space)
          (if whitespace-auto-cleanup
              (if buffer-read-only
                  (if (not quiet)
--- 425,431 ----
        (progn
          (whitespace-check-buffer-list (buffer-name) buffer-file-name)
          (whitespace-tickle-timer)
!         (remove-overlays nil nil 'face 'whitespace-highlight)
          (if whitespace-auto-cleanup
              (if buffer-read-only
                  (if (not quiet)
***************
*** 591,664 ****
      (whitespace-buffer t)))

  (defun whitespace-buffer-leading ()
!   "Check to see if there are any empty lines at the top of the file."
    (save-excursion
!     (let ((pmin nil)
!         (pmax nil))
!       (goto-char (point-min))
!       (beginning-of-line)
!       (setq pmin (point))
!       (end-of-line)
!       (setq pmax (point))
!       (if (equal pmin pmax)
!         (progn
!           (whitespace-highlight-the-space pmin (1+ pmax))
!           t)
!       nil))))

  (defun whitespace-buffer-leading-cleanup ()
!   "Remove any empty lines at the top of the file."
    (save-excursion
      (goto-char (point-min))
      (skip-chars-forward "\n")
      (delete-region (point-min) (point))))

  (defun whitespace-buffer-trailing ()
!   "Check to see if are is more than one empty line at the bottom."
    (save-excursion
!     (let ((pmin nil)
!         (pmax nil))
!       (goto-char (point-max))
!       (beginning-of-line)
!       (setq pmin (point))
!       (end-of-line)
!       (setq pmax (point))
!       (if (equal pmin pmax)
!         (progn
!           (goto-char (- (point) 1))
!           (beginning-of-line)
!           (setq pmin (point))
!           (end-of-line)
!           (setq pmax (point))
!           (if (equal pmin pmax)
!               (progn
!                 (whitespace-highlight-the-space (- pmin 1) pmax)
!                 t)
!             nil))
!       nil))))

  (defun whitespace-buffer-trailing-cleanup ()
!   "Delete all the empty lines at the bottom."
    (save-excursion
      (goto-char (point-max))
      (skip-chars-backward "\n")
!     (if (not (bolp))
!       (forward-char 1))
!     (delete-region (point) (point-max))))

  (defun whitespace-buffer-search (regexp)
    "Search for any given whitespace REGEXP."
!   (let ((whitespace-retval ""))
!     (save-excursion
!       (goto-char (point-min))
!       (while (re-search-forward regexp nil t)
!       (progn
!         (setq whitespace-retval (format "%s %s" whitespace-retval
!                                       (match-beginning 0)))
!       (whitespace-highlight-the-space (match-beginning 0) (match-end 0))))
!       (if (equal "" whitespace-retval)
!         nil
!       whitespace-retval))))

  (defun whitespace-buffer-cleanup (regexp newregexp)
    "Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
--- 591,643 ----
      (whitespace-buffer t)))

  (defun whitespace-buffer-leading ()
!   "Return t if the current buffer has leading newline characters.
! If highlighting is enabled, highlight these characters."
    (save-excursion
!     (goto-char (point-min))
!     (skip-chars-forward "\n")
!     (unless (bobp)
!       (whitespace-highlight-the-space (point-min) (point))
!       t)))

  (defun whitespace-buffer-leading-cleanup ()
!   "Remove any leading newline characters from current buffer."
    (save-excursion
      (goto-char (point-min))
      (skip-chars-forward "\n")
      (delete-region (point-min) (point))))

  (defun whitespace-buffer-trailing ()
!   "Return t if the current buffer has extra trailing newline characters.
! If highlighting is enabled, highlight these characters."
    (save-excursion
!     (goto-char (point-max))
!     (skip-chars-backward "\n")
!     (forward-line)
!     (unless (eobp)
!       (whitespace-highlight-the-space (point) (point-max))
!       t)))

  (defun whitespace-buffer-trailing-cleanup ()
!   "Remove extra trailing newline characters from current buffer."
    (save-excursion
      (goto-char (point-max))
      (skip-chars-backward "\n")
!     (unless (eobp)
!       (forward-line)
!       (delete-region (point) (point-max)))))

  (defun whitespace-buffer-search (regexp)
    "Search for any given whitespace REGEXP."
!   (with-local-quit
!     (let (whitespace-retval)
!       (save-excursion
!       (goto-char (point-min))
!       (while (re-search-forward regexp nil t)
!         (whitespace-highlight-the-space (match-beginning 0) (match-end 0))
!         (push (match-beginning 0) whitespace-retval)))
!       (when whitespace-retval
!       (format " %s" (nreverse whitespace-retval))))))

  (defun whitespace-buffer-cleanup (regexp newregexp)
    "Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
***************
*** 713,729 ****
    "Highlight the current line, unhighlighting a previously jumped to line."
    (if whitespace-display-spaces-in-color
        (let ((ol (whitespace-make-overlay b e)))
-       (push ol whitespace-highlighted-space)
        (whitespace-overlay-put ol 'face 'whitespace-highlight))))
- ;;  (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space))

  (defun whitespace-unhighlight-the-space()
    "Unhighlight the currently highlight line."
    (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
        (progn
        (mapc 'whitespace-delete-overlay whitespace-highlighted-space)
!       (setq whitespace-highlighted-space nil))
!     (remove-hook 'pre-command-hook 'whitespace-unhighlight-the-space)))

  (defun whitespace-check-buffer-list (buf-name buf-file)
    "Add a buffer and its file to the whitespace monitor list.
--- 692,705 ----
    "Highlight the current line, unhighlighting a previously jumped to line."
    (if whitespace-display-spaces-in-color
        (let ((ol (whitespace-make-overlay b e)))
        (whitespace-overlay-put ol 'face 'whitespace-highlight))))

  (defun whitespace-unhighlight-the-space()
    "Unhighlight the currently highlight line."
    (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
        (progn
        (mapc 'whitespace-delete-overlay whitespace-highlighted-space)
!       (setq whitespace-highlighted-space nil))))

  (defun whitespace-check-buffer-list (buf-name buf-file)
    "Add a buffer and its file to the whitespace monitor list.
***************
*** 780,786 ****
          (whitespace-refresh-rescan-list buffile bufname))))))

  (defun whitespace-refresh-rescan-list (buffile bufname)
!   "Refresh the list of files to be rescaned for whitespace creep."
    (if whitespace-all-buffer-files
        (setq whitespace-all-buffer-files
            (delete (list buffile bufname) whitespace-all-buffer-files))
--- 756,762 ----
          (whitespace-refresh-rescan-list buffile bufname))))))

  (defun whitespace-refresh-rescan-list (buffile bufname)
!   "Refresh the list of files to be rescanned for whitespace creep."
    (if whitespace-all-buffer-files
        (setq whitespace-all-buffer-files
            (delete (list buffile bufname) whitespace-all-buffer-files))