master 4dbc445: * lisp/wdired.el: Apply text properties lazily

[Stefan Monnier]

branch: master
commit 4dbc44550da640529c7ded7378caf0db439b0bbd
Author: Arthur Miller <arthur.miller@live.com>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * lisp/wdired.el: Apply text properties lazily
    
    Entering wdired was taking time proportional to the size of the directory,
    making it inconvenient to quickly enter wdired just to rename one or two
    files in a large directory.
    
    (wdired-mode-map): Rebind `self-insert-command`.
    (wdired--perm-beg, wdired--perm-end): New vars.
    (wdired--col-perm, wdired--old-content, wdired--old-point)
    (wdired--old-marks): Rename vars, using "--" rather than "-".
    All users updated.
    (wdired--before-change-fn): New function.
    (wdired-change-to-wdired-mode): Use it `before-change-functions`
    instead of eagerly putting the various text properties here.
    (wdired--set-permission-bounds, wdired--current-column)
    (wdired--point-at-perms-p, wdired--line-preprocessed-p):
    New auxiliary functions.
    (wdired--self-insert): New command.
    (wdired--preprocess-files, wdired--preprocess-symlinks)
    (wdired--preprocess-perms): Add "--" to the name.  Make it operate only
    on the current line.  Use `with-silent-modifications`.
    (wdired-abort-changes): Use `with-silent-modifications`.
---
 lisp/wdired.el | 220 +++++++++++++++++++++++++++++++++------------------------
 1 file changed, 128 insertions(+), 92 deletions(-)

diff --git a/lisp/wdired.el b/lisp/wdired.el
index 43026d4..61272d9 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -172,6 +172,7 @@ nonexistent directory will fail."
     (define-key map [remap upcase-word] #'wdired-upcase-word)
     (define-key map [remap capitalize-word] #'wdired-capitalize-word)
     (define-key map [remap downcase-word] #'wdired-downcase-word)
+    (define-key map [remap self-insert-command] #'wdired--self-insert)
     map)
   "Keymap used in `wdired-mode'.")
 
@@ -188,10 +189,12 @@ nonexistent directory will fail."
   "Hooks run when changing to WDired mode.")
 
 ;; Local variables (put here to avoid compilation gripes)
-(defvar wdired-col-perm) ;; Column where the permission bits start
-(defvar wdired-old-content)
-(defvar wdired-old-point)
-(defvar wdired-old-marks)
+(defvar wdired--col-perm) ;; Column where the permission bits start
+(defvar wdired--perm-beg) ;; Column where the permission bits start
+(defvar wdired--perm-end) ;; Column where the permission bits stop
+(defvar wdired--old-content)
+(defvar wdired--old-point)
+(defvar wdired--old-marks)
 
 (defun wdired-mode ()
   "Writable Dired (WDired) mode.
@@ -230,11 +233,14 @@ See `wdired-mode'."
   (interactive)
   (unless (derived-mode-p 'dired-mode)
     (error "Not a Dired buffer"))
-  (setq-local wdired-old-content
+  (when (directory-empty-p (expand-file-name default-directory))
+    (error "No files to be renamed"))
+  (setq-local wdired--old-content
               (buffer-substring (point-min) (point-max)))
-  (setq-local wdired-old-marks
+  (setq-local wdired--old-marks
               (dired-remember-marks (point-min) (point-max)))
-  (setq-local wdired-old-point (point))
+  (setq-local wdired--old-point (point))
+  (wdired--set-permission-bounds)
   (setq-local query-replace-skip-read-only t)
   (add-function :after-while (local 'isearch-filter-predicate)
                 #'wdired-isearch-filter-read-only)
@@ -243,20 +249,11 @@ See `wdired-mode'."
   (setq buffer-read-only nil)
   (dired-unadvertise default-directory)
   (add-hook 'kill-buffer-hook #'wdired-check-kill-buffer nil t)
+  (add-hook 'before-change-functions #'wdired--before-change-fn nil t)
   (add-hook 'after-change-functions #'wdired--restore-properties nil t)
   (setq major-mode 'wdired-mode)
   (setq mode-name "Editable Dired")
   (add-function :override (local 'revert-buffer-function) #'wdired-revert)
-  ;; I temp disable undo for performance: since I'm going to clear the
-  ;; undo list, it can save more than a 9% of time with big
-  ;; directories because setting properties modify the undo-list.
-  (buffer-disable-undo)
-  (wdired-preprocess-files)
-  (if wdired-allow-to-change-permissions
-      (wdired-preprocess-perms))
-  (if (fboundp 'make-symbolic-link)
-      (wdired-preprocess-symlinks))
-  (buffer-enable-undo) ; Performance hack. See above.
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
   (run-mode-hooks 'wdired-mode-hook)
@@ -264,6 +261,53 @@ See `wdired-mode'."
                 "Press \\[wdired-finish-edit] when finished \
 or \\[wdired-abort-changes] to abort changes")))
 
+(defun wdired--set-permission-bounds ()
+  (save-excursion
+    (goto-char (point-min))
+    (re-search-forward dired-re-perms nil t 1)
+    (goto-char (match-beginning 0))
+    (setq-local wdired--perm-beg (current-column))
+    (goto-char (match-end 0))
+    (setq-local wdired--perm-end (current-column))))
+
+(defun wdired--current-column ()
+  (- (point) (line-beginning-position)))
+
+(defun wdired--point-at-perms-p ()
+  (<= wdired--perm-beg (wdired--current-column) wdired--perm-end))
+
+(defun wdired--line-preprocessed-p ()
+  (get-text-property (line-beginning-position) 'front-sticky))
+
+(defun wdired--self-insert ()
+  (interactive)
+  (if (wdired--point-at-perms-p)
+    (unless (wdired--line-preprocessed-p)
+      (wdired--before-change-fn (line-beginning-position) (line-end-position))
+      (wdired-toggle-bit))
+    (call-interactively 'self-insert-command)))
+
+(defun wdired--before-change-fn (beg end)
+  (save-excursion
+    ;; make sure to process entire lines
+    (goto-char beg)
+    (setq beg (line-beginning-position))
+    (goto-char end)
+    (setq end (line-end-position))
+
+    (while (< beg end)
+      (unless (wdired--line-preprocessed-p)
+        (put-text-property beg (1+ beg) 'front-sticky t)
+        (wdired--preprocess-files)
+        (when wdired-allow-to-change-permissions
+          (wdired--preprocess-perms))
+        (when (fboundp 'make-symbolic-link)
+          (wdired--preprocess-symlinks)))
+      (forward-line)
+      (setq beg (point)))
+    ;; is this good enough? assumes no extra white lines from dired
+    (put-text-property (1- (point-max)) (point-max) 'read-only t)))
+
 (defun wdired-isearch-filter-read-only (beg end)
   "Skip matches that have a read-only property."
   (not (text-property-not-all (min beg end) (max beg end)
@@ -271,14 +315,12 @@ or \\[wdired-abort-changes] to abort changes")))
 
 ;; Protect the buffer so only the filenames can be changed, and put
 ;; properties so filenames (old and new) can be easily found.
-(defun wdired-preprocess-files ()
-  (put-text-property (point-min) (1+ (point-min))'front-sticky t)
+(defun wdired--preprocess-files ()
   (save-excursion
-    (goto-char (point-min))
-    (let ((b-protection (point))
-          (used-F (dired-check-switches dired-actual-switches "F" "classify"))
-         filename)
-      (while (not (eobp))
+    (with-silent-modifications
+      (beginning-of-line)
+      (let ((used-F (dired-check-switches dired-actual-switches "F" 
"classify"))
+           filename)
        (setq filename (dired-get-filename nil t))
         (when (and filename
                   (not (member (file-name-nondirectory filename) '("." ".."))))
@@ -287,19 +329,16 @@ or \\[wdired-abort-changes] to abort changes")))
          ;; the filename can't be modified.
          (add-text-properties
           (1- (point)) (point) `(old-name ,filename rear-nonsticky 
(read-only)))
-         (put-text-property b-protection (point) 'read-only t)
+         (put-text-property (- (point) 1) (point) 'read-only t)
           (dired-move-to-end-of-filename t)
          (put-text-property (point) (1+ (point)) 'end-name t))
-          (when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
-          (when (save-excursion
-                  (and (re-search-backward
-                        dired-permission-flags-regexp nil t)
-                       (looking-at "l")
-                       (search-forward " -> " (line-end-position) t)))
-            (goto-char (line-end-position)))
-         (setq b-protection (point))
-        (forward-line))
-      (put-text-property b-protection (point-max) 'read-only t))))
+        (when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
+        (when (save-excursion
+                (and (re-search-backward
+                      dired-permission-flags-regexp nil t)
+                     (looking-at "l")
+                     (search-forward " -> " (line-end-position) t)))
+          (goto-char (line-end-position)))))))
 
 ;; This code is a copy of some dired-get-filename lines.
 (defsubst wdired-normalize-filename (file unquotep)
@@ -362,7 +401,6 @@ non-nil means return old filename."
        (and file (> (length file) 0)
              (concat (dired-current-directory) file))))))
 
-
 (defun wdired-change-to-dired-mode ()
   "Change the mode back to dired."
   (or (eq major-mode 'wdired-mode)
@@ -380,16 +418,18 @@ non-nil means return old filename."
   (setq mode-name "Dired")
   (dired-advertise)
   (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
+  (remove-hook 'before-change-functions #'wdired--before-change-fn t)
   (remove-hook 'after-change-functions #'wdired--restore-properties t)
   (remove-function (local 'revert-buffer-function) #'wdired-revert))
 
 (defun wdired-abort-changes ()
   "Abort changes and return to dired mode."
   (interactive)
-  (let ((inhibit-read-only t))
+  (remove-hook 'before-change-functions 'wdired--before-change-fn t)
+  (with-silent-modifications
     (erase-buffer)
-    (insert wdired-old-content)
-    (goto-char wdired-old-point))
+    (insert wdired--old-content)
+    (goto-char wdired--old-point))
   (wdired-change-to-dired-mode)
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
@@ -411,7 +451,7 @@ non-nil means return old filename."
        (setq errors (cdr tmp-value))
        (setq changes (car tmp-value)))
       (when (and wdired-allow-to-change-permissions
-                (boundp 'wdired-col-perm)) ; could have been changed
+                (boundp 'wdired--col-perm)) ; could have been changed
        (setq tmp-value (wdired-do-perm-changes))
        (setq errors (+ errors (cdr tmp-value)))
        (setq changes (or changes (car tmp-value))))
@@ -429,11 +469,11 @@ non-nil means return old filename."
                (let ((mark (cond ((integerp wdired-keep-marker-rename)
                                   wdired-keep-marker-rename)
                                  (wdired-keep-marker-rename
-                                  (cdr (assoc file-old wdired-old-marks)))
+                                  (cdr (assoc file-old wdired--old-marks)))
                                  (t nil))))
                  (when mark
                    (push (cons (substitute-in-file-name file-new) mark)
-                         wdired-old-marks))))
+                         wdired--old-marks))))
               (push (cons file-old (substitute-in-file-name file-new))
                     files-renamed))))
        (forward-line -1)))
@@ -458,7 +498,7 @@ non-nil means return old filename."
          ;; Re-sort the buffer.
          (revert-buffer)
          (let ((inhibit-read-only t))
-           (dired-mark-remembered wdired-old-marks)))
+           (dired-mark-remembered wdired--old-marks)))
       (let ((inhibit-read-only t))
        (remove-text-properties (point-min) (point-max)
                                '(old-name nil end-name nil old-link nil
@@ -702,21 +742,19 @@ says how many lines to move; default is one line."
       (dired-move-to-filename)))
 
 ;; Put the needed properties to allow the user to change links' targets
-(defun wdired-preprocess-symlinks ()
-  (let ((inhibit-read-only t))
-    (save-excursion
-      (goto-char (point-min))
-      (while (not (eobp))
-        (when (looking-at dired-re-sym)
-          (re-search-forward " -> \\(.*\\)$")
-         (put-text-property (1- (match-beginning 1))
-                            (match-beginning 1) 'old-link
-                            (match-string-no-properties 1))
-          (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
-          (unless wdired-allow-to-redirect-links
-            (put-text-property (match-beginning 0)
-                              (match-end 1) 'read-only t)))
-        (forward-line)))))
+(defun wdired--preprocess-symlinks ()
+  (save-excursion
+    (with-silent-modifications
+      (beginning-of-line)
+      (when (looking-at dired-re-sym)
+        (re-search-forward " -> \\(.*\\)$")
+       (put-text-property (1- (match-beginning 1))
+                          (match-beginning 1) 'old-link
+                          (match-string-no-properties 1))
+        (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
+        (unless wdired-allow-to-redirect-links
+          (put-text-property (match-beginning 0)
+                            (match-end 1) 'read-only t))))))
 
 (defun wdired-get-previous-link (&optional old move)
   "Return the next symlink target.
@@ -800,7 +838,6 @@ Like original function but it skips read-only words."
   (interactive "p")
   (wdired-xcase-word 'capitalize-word arg))
 
-
 ;; The following code deals with changing the access bits (or
 ;; permissions) of the files.
 
@@ -822,34 +859,33 @@ Like original function but it skips read-only words."
 
 ;; Put a keymap property to the permission bits of the files, and store the
 ;; original name and permissions as a property
-(defun wdired-preprocess-perms ()
-  (let ((inhibit-read-only t))
-    (setq-local wdired-col-perm nil)
-    (save-excursion
-      (goto-char (point-min))
-      (while (not (eobp))
-       (when (and (not (looking-at dired-re-sym))
-                  (wdired-get-filename)
-                  (re-search-forward dired-re-perms (line-end-position) 'eol))
-         (let ((begin (match-beginning 0))
-               (end (match-end 0)))
-           (unless wdired-col-perm
-             (setq wdired-col-perm (- (current-column) 9)))
-           (if (eq wdired-allow-to-change-permissions 'advanced)
-               (progn
-                 (put-text-property begin end 'read-only nil)
-                 ;; make first permission bit writable
-                 (put-text-property
-                  (1- begin) begin 'rear-nonsticky '(read-only)))
-             ;; avoid that keymap applies to text following permissions
-             (add-text-properties
-              (1+ begin) end
-              `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
-           (put-text-property end (1+ end) 'end-perm t)
-           (put-text-property
-            begin (1+ begin) 'old-perm (match-string-no-properties 0))))
-        (forward-line)
-       (beginning-of-line)))))
+(defun wdired--preprocess-perms ()
+  (save-excursion
+    (with-silent-modifications
+      (setq-local wdired--col-perm nil)
+      (beginning-of-line)
+      (when (and (not (looking-at dired-re-sym))
+                (wdired-get-filename)
+                (re-search-forward dired-re-perms
+                                    (line-end-position) 'eol))
+       (let ((begin (match-beginning 0))
+             (end (match-end 0)))
+         (unless wdired--col-perm
+           (setq wdired--col-perm (- (current-column) 9)))
+         (if (eq wdired-allow-to-change-permissions 'advanced)
+             (progn
+               (put-text-property begin end 'read-only nil)
+               ;; make first permission bit writable
+               (put-text-property
+                (1- begin) begin 'rear-nonsticky '(read-only)))
+           ;; avoid that keymap applies to text following permissions
+           (add-text-properties
+            (1+ begin) end
+            `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
+         (put-text-property end (1+ end) 'end-perm t)
+         (put-text-property
+          begin (1+ begin)
+           'old-perm (match-string-no-properties 0)))))))
 
 (defun wdired-perm-allowed-in-pos (char pos)
   (cond
@@ -865,10 +901,10 @@ Like original function but it skips read-only words."
   "Set a permission bit character."
   (interactive)
   (if (wdired-perm-allowed-in-pos last-command-event
-                                  (- (current-column) wdired-col-perm))
+                                  (- (current-column) wdired--col-perm))
       (let ((new-bit (char-to-string last-command-event))
             (inhibit-read-only t)
-           (pos-prop (- (point) (- (current-column) wdired-col-perm))))
+           (pos-prop (- (point) (- (current-column) wdired--col-perm))))
         (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
         (put-text-property 0 1 'read-only t new-bit)
         (insert new-bit)
@@ -882,11 +918,11 @@ Like original function but it skips read-only words."
   (interactive)
   (let ((inhibit-read-only t)
        (new-bit "-")
-       (pos-prop (- (point) (- (current-column) wdired-col-perm))))
+       (pos-prop (- (point) (- (current-column) wdired--col-perm))))
     (if (eq (char-after (point)) ?-)
        (setq new-bit
-             (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
-               (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
+             (if (= (% (- (current-column) wdired--col-perm) 3) 0) "r"
+               (if (= (% (- (current-column) wdired--col-perm) 3) 1) "w"
                  "x"))))
     (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
     (put-text-property 0 1 'read-only t new-bit)