Re: [PATCH] Lazy wdired preprocessing

[Stefan Monnier <monnier@iro.umontreal.ca>]

>>> +(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.

I know; fixing all the old code to use such conventions is hard, but
I try and make sure that new code at least follows those conventions ;-)

>> `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).

Oh, not *that* costly.  Just in the sense that it's
better not to feel free to call it redundantly.
But, I think `wdired--current-column` looks fine: it completely
side-steps the question of what happens if some of the text is
currently invisible.

> 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 :-).

Would it be time to plug in Richard's endorsement of reproduction here?

I pushed your change with the following additional patch on top,


        Stefan


commit ed6b9586d74795605debf614bd4328611e1f1c22
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Date:   Sat Mar 27 10:54:10 2021 -0400

    * lisp/wdired.el: Fix minor regressions and simplify a bit
    
    Use `wdired--current-column` more consistently to avoid mayhem when it
    doesn't return the same result as `current-column`.
    
    (wdired--col-perm): Remove, redundant with `wdired--perm-beg`.
    (wdired-change-to-wdired-mode): Don't error in empty directory.
    (wdired--set-permission-bounds): Set `wdired--perm-beg` when we can't
    find permissions.  Move `wdired--perm-beg` 1 char further (like
    `wdired--col-perm`).  Use `wdired--current-column`.
    (wdired--point-at-perms-p): Fix when `wdired--perm-beg` is nil.
    (wdired--self-insert): Lookup the keymap to know command to call.
    (wdired--before-change-fn): Just use `point` instead of `beg`.
    Use `with-silent-modifications` here rather than in each of the
    `wdired--preprocess-*` functions.
    (wdired--preprocess-files): Presume we're at BOL and within
    `with-silent-modifications`.  Fix application of `read-only`.
    (wdired-abort-changes): Don't use `with-silent-modifications` since
    we're really modifying the buffer.
    (wdired--preprocess-symlinks): Presume we're at BOL and within
    `with-silent-modifications`.
    (wdired--preprocess-perms): Presume we're at BOL and within
    `with-silent-modifications`.
    (wdired-set-bit): Add `char` argument.  Use `wdired--current-column`.
    Copy previous text properties rather than duplicating the code of
    `wdired--preprocess-perms`.
    (wdired-toggle-bit): Delegate to `wdired-set-bit`.

diff --git a/lisp/wdired.el b/lisp/wdired.el
index 61272d947f..97861a4474 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -189,7 +189,6 @@ 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--perm-beg) ;; Column where the permission bits start
 (defvar wdired--perm-end) ;; Column where the permission bits stop
 (defvar wdired--old-content)
@@ -233,8 +232,6 @@ 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
@@ -264,49 +261,60 @@ wdired-change-to-wdired-mode
 (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))))
+    (if (not (re-search-forward dired-re-perms nil t 1))
+        (progn
+          (setq-local wdired--perm-beg nil)
+          (setq-local wdired--perm-end nil))
+      (goto-char (match-beginning 0))
+      ;; Add 1 since the first char matched by `dired-re-perms' is the
+      ;; one describing the nature of the entry (dir/symlink/...) rather
+      ;; than its permissions.
+      (setq-local wdired--perm-beg (1+ (wdired--current-column)))
+      (goto-char (match-end 0))
+      (setq-local wdired--perm-end (wdired--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))
+  (and wdired--perm-beg
+       (<= 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)))
+  (if (wdired--line-preprocessed-p)
+      (call-interactively 'self-insert-command)
+    (wdired--before-change-fn (line-beginning-position) (line-end-position))
+    (let ((map (get-text-property (point) 'keymap)))
+      (when map
+        (let ((cmd (lookup-key map (this-command-keys))))
+          (call-interactively (or cmd '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))
+    ;; Make sure to process entire lines.
     (goto-char end)
     (setq end (line-end-position))
+    (goto-char beg)
+    (forward-line 0)
 
-    (while (< beg end)
+    (while (< (point) 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)))
+        (with-silent-modifications
+          (put-text-property (point) (1+ (point)) '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))
+    (when (eobp)
+      (with-silent-modifications
+        ;; 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."
@@ -317,28 +325,26 @@ wdired-isearch-filter-read-only
 ;; properties so filenames (old and new) can be easily found.
 (defun wdired--preprocess-files ()
   (save-excursion
-    (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) '("." ".."))))
-	  (dired-move-to-filename)
-	  ;; The rear-nonsticky property below shall ensure that text preceding
-	  ;; the filename can't be modified.
-	  (add-text-properties
-	   (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
-	  (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)))))))
+    (let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
+	  (beg (point))
+          (filename (dired-get-filename nil t)))
+      (when (and filename
+		 (not (member (file-name-nondirectory filename) '("." ".."))))
+	(dired-move-to-filename)
+	;; The rear-nonsticky property below shall ensure that text preceding
+	;; the filename can't be modified.
+	(add-text-properties
+	 (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
+	(put-text-property beg (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))))))
 
 ;; This code is a copy of some dired-get-filename lines.
 (defsubst wdired-normalize-filename (file unquotep)
@@ -425,8 +431,8 @@ wdired-change-to-dired-mode
 (defun wdired-abort-changes ()
   "Abort changes and return to dired mode."
   (interactive)
-  (remove-hook 'before-change-functions 'wdired--before-change-fn t)
-  (with-silent-modifications
+  (remove-hook 'before-change-functions #'wdired--before-change-fn t)
+  (let ((inhibit-read-only t))
     (erase-buffer)
     (insert wdired--old-content)
     (goto-char wdired--old-point))
@@ -451,7 +457,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
+		 wdired--perm-beg) ; could have been changed
 	(setq tmp-value (wdired-do-perm-changes))
 	(setq errors (+ errors (cdr tmp-value)))
 	(setq changes (or changes (car tmp-value))))
@@ -744,17 +750,15 @@ wdired-previous-line
 ;; Put the needed properties to allow the user to change links' targets
 (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))))))
+    (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.
@@ -861,31 +865,26 @@ wdired-perm-mode-map
 ;; original name and permissions as a property
 (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)))))))
+    (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)))
+	(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
@@ -897,39 +896,30 @@ wdired-perm-allowed-in-pos
    ((memq char '(?t ?T)) (= pos 8))
    ((= char ?l)          (= pos 5))))
 
-(defun wdired-set-bit ()
+(defun wdired-set-bit (&optional char)
   "Set a permission bit character."
-  (interactive)
-  (if (wdired-perm-allowed-in-pos last-command-event
-                                  (- (current-column) wdired--col-perm))
-      (let ((new-bit (char-to-string last-command-event))
+  (interactive (list last-command-event))
+  (unless char (setq char last-command-event))
+  (if (wdired-perm-allowed-in-pos char
+                                  (- (wdired--current-column) wdired--perm-beg))
+      (let ((new-bit (char-to-string char))
             (inhibit-read-only t)
-	    (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)
+	    (pos-prop (+ (line-beginning-position) wdired--perm-beg)))
+        (set-text-properties 0 1 (text-properties-at (point)) new-bit)
         (insert new-bit)
         (delete-char 1)
-	(put-text-property (1- pos-prop) pos-prop 'perm-changed t)
-	(put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
+	(put-text-property (1- pos-prop) pos-prop 'perm-changed t))
     (forward-char 1)))
 
 (defun wdired-toggle-bit ()
   "Toggle the permission bit at point."
   (interactive)
-  (let ((inhibit-read-only t)
-	(new-bit "-")
-	(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"
-		  "x"))))
-    (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)
-    (delete-char 1)
-    (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
-    (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
+  (wdired-set-bit
+   (cond
+    ((not (eq (char-after (point)) ?-)) ?-)
+    ((= (% (- (wdired--current-column) wdired--perm-beg) 3) 0) ?r)
+    ((= (% (- (wdired--current-column) wdired--perm-beg) 3) 1) ?w)
+    (t ?x))))
 
 (defun wdired-mouse-toggle-bit (event)
   "Toggle the permission bit that was left clicked."