Re: [PATCH] Lazy wdired preprocessing

[Arthur Miller <arthur.miller@live.com>]

[-- Attachment #1: Type: text/plain, Size: 5426 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> +(defvar wdired-perm-beg) ;; Column where the permission bits start
>> +(defvar wdired-perm-end) ;; Column where the permission bits stop
>
> I think this should use "--" in the names since they are internal variables.

I just followed naming as already was in wdired. In general I tried to
change as little as possible, so I didn't re-factor any existing code
unless needed. Partly to save my time, partly to not mess up
unnecessary. I have now changed all global vars to use '--' in name. I
was thinking about "private" functions too, but I'll leave that for some
other time or as exercise to someone else.

>>    (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.
>> +  (setq revert-buffer-function 'wdired-revert)
>>    (set-buffer-modified-p nil)
>
> This reverts part of my recent change to the way we set
> `revert-buffer-function` (most likely an oversight while merging my changes).

You commited changes to wdired? :-)
Yeah, I copy-pasted entire function from my working file, so yes indeed,
it was an oversight on my part, fixed. 

>>    (setq buffer-undo-list nil)
>> +  ;; find one column with permissions and set permision text boundaries
>> +  (save-excursion
>> +    (goto-char (point-min))
>> +    (unless (re-search-forward dired-re-perms nil t 1)
>> +      (wdired-abort-changes)
>> +      (error "No files to be renamed - Exiting to Dired mode."))
>> +    (goto-char (match-beginning 0))
>> +    (setq-local wdired-perm-beg (current-column))
>> +    (goto-char (match-end 0))
>> +    (setq-local wdired-perm-end (current-column)))
>
> I'd recommend you put this in a separate function.

I have refactored that a bit more and am using directory-empty-p to exit
earlier. Hope we can use default-directory there. Check the code.

>> +  (define-key wdired-mode-map [remap self-insert-command] #'wdired--self-insert)
>
> Why is this done here instead of in the definition of `wdired-mode-map`?

Was typing as I was thinking ... :-). Fixed.

>> +(defun wdired--point-at-perms-p ()
>> +  (and (>= (current-column) wdired-perm-beg)
>> +       (<= (current-column) wdired-perm-end)))
>
> `current-column` can be somewhat costly, so we should refrain from
> calling it twice gratuitously.  And here we can even take advantage of
> the (rarely used and rarely applicable) multi-arg form of `<=` to fix
> that "for free":

Ok. Didn't know that (current-column) was expensive. I use now a good 'nuff
implementation for this purpose (wdired--current-column).

>      (<= wdired-perm-beg (current-column) wdired-perm-end)

Cool; thnks, didn't know we can write so.

>> +(defun wdired--self-insert ()
>> +  (interactive)
>> +  (if (wdired--point-at-perms-p)
>> +    (when (not (get-text-property (line-beginning-position) 'front-sticky))
>> +      (wdired--before-change-fn (line-beginning-position) (line-end-position))
>> +      (setq unread-command-events (nconc (listify-key-sequence
>> +                                          (this-command-keys))
>> +                                         unread-command-events)))
>> +    (call-interactively 'self-insert-command)))
>
> I think this deserves a comment about why we look at `front-sticky`.
> Better yet: move this test to a helper function to which you can give
> a meaningful name (like `wdired--processed-p`).

Sure, it makes code more self-documented.

> Also, instead of using `unread-command-events`, you can just call the
> appropriate command directly, no?

As I stated about refactoring above, I tried to change as
little as possible. Partly because I was lazy to look into the old code
and partly because I tried to "plug" into already existing (and
hopefully debugged) code. But sure toggle-bit is the one I think.

>> -  (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
>> -  (remove-hook 'after-change-functions #'wdired--restore-properties t)
>> -  (remove-function (local 'revert-buffer-function) #'wdired-revert))
>> +  (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)
>> +  (setq-local revert-buffer-function 'dired-revert))
>
> This also look like the merge wasn't done right.

No idea; mr. git format-patch seems to shuffle lines around, and I trust
it to do what it has to do.

>>  (defun wdired-abort-changes ()
>> -  "Abort changes and return to dired mode."
>> +  "Abort changes and return to dired mode.  "
>
> What happened here?

No idea. :-).

It's all yours now. I don't think I will have more time nor possibility
to work on this, so if this one is not good enough, you will to finnish
it on your own, or someone else could help. We are waiting a kid any
day now, so no hobby programming for quite some time over for me :-).

Thnks for the guidance.

Cheers


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: lazy-wdired.patch --]
[-- Type: text/x-patch, Size: 15410 bytes --]

From 7e6a6f2d7c958228882a7cdd34533d2c322093b4 Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Sat, 27 Mar 2021 08:29:44 +0100
Subject: [PATCH] lazy wdired

---
 lisp/wdired.el | 223 ++++++++++++++++++++++++++++---------------------
 1 file changed, 129 insertions(+), 94 deletions(-)

diff --git a/lisp/wdired.el b/lisp/wdired.el
index 43026d4bb7..df78082596 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -172,6 +172,7 @@ wdired-mode-map
     (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 @@ wdired-mode-hook
   "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 @@ wdired-change-to-wdired-mode
   (interactive)
   (unless (derived-mode-p 'dired-mode)
     (error "Not a Dired buffer"))
+  (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 @@ wdired-change-to-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 @@ wdired-change-to-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 @@ wdired-isearch-filter-read-only
 
 ;; 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 @@ wdired-preprocess-files
 	  ;; 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 @@ wdired-get-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)
@@ -379,17 +417,19 @@ wdired-change-to-dired-mode
   (setq major-mode 'dired-mode)
   (setq mode-name "Dired")
   (dired-advertise)
-  (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
-  (remove-hook 'after-change-functions #'wdired--restore-properties t)
-  (remove-function (local 'revert-buffer-function) #'wdired-revert))
+  (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)
+  (setq-local revert-buffer-function 'dired-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))
+    (goto-char wdired--old-point))
   (wdired-change-to-dired-mode)
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
@@ -411,7 +451,7 @@ wdired-finish-edit
 	(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 @@ wdired-finish-edit
 		(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 @@ wdired-finish-edit
 	  ;; 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 @@ wdired-previous-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,10 +838,8 @@ wdired-capitalize-word
   (interactive "p")
   (wdired-xcase-word 'capitalize-word arg))
 
-
 ;; The following code deals with changing the access bits (or
 ;; permissions) of the files.
-
 (defvar wdired-perm-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map " " #'wdired-toggle-bit)
@@ -822,34 +858,33 @@ wdired-perm-mode-map
 
 ;; 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 +900,10 @@ wdired-set-bit
   "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 +917,11 @@ wdired-toggle-bit
   (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)
-- 
2.31.0