bug#18475: 24.4.50; Wdired: cannot use C-k to delete a dir name if -F switch used

[Lars Ingebrigtsen]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

>> I've tested these cases, but it is quite possible that I overlooked some
>> variants or other cases, so I'd appreciate testing and feedback from
>> others.  (Also, the code still needs more commenting and probably
>> cleaning up.)
>
> I can confirm your patch fixes the issue in the OP, but I haven't tested
> it extensively.

The patch no longer applies to Emacs 28, so I've respun the patch
(included below).

I've given it some light testing, and it seems to fix the problem for
me, but there's been other changes in this area in the meantime...
Could people who use wdired a lot give this patch a spin and see whether
it works for them?

diff --git a/lisp/wdired.el b/lisp/wdired.el
index b98becfafe..2c2d3cec25 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -255,7 +255,7 @@ 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 'after-change-functions 'wdired--restore-dired-filename-prop nil t)
+  (add-hook 'after-change-functions 'wdired--restore-properties nil t)
   (setq major-mode 'wdired-mode)
   (setq mode-name "Editable Dired")
   (setq revert-buffer-function 'wdired-revert)
@@ -266,7 +266,7 @@ wdired-change-to-wdired-mode
   (wdired-preprocess-files)
   (if wdired-allow-to-change-permissions
       (wdired-preprocess-perms))
-  (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
+  (if (fboundp 'make-symbolic-link)
       (wdired-preprocess-symlinks))
   (buffer-enable-undo) ; Performance hack. See above.
   (set-buffer-modified-p nil)
@@ -288,6 +288,7 @@ 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))
        (setq filename (dired-get-filename nil t))
@@ -299,8 +300,16 @@ wdired-preprocess-files
          (add-text-properties
           (1- (point)) (point) `(old-name ,filename rear-nonsticky 
(read-only)))
          (put-text-property b-protection (point) 'read-only t)
-         (setq b-protection (dired-move-to-end-of-filename 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))))
 
@@ -327,7 +336,8 @@ wdired-get-filename
 non-nil means don't include directory.  Optional arg OLD with value
 non-nil means return old filename."
   ;; FIXME: Use dired-get-filename's new properties.
-  (let (beg end file)
+  (let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
+        beg end file)
     (save-excursion
       (setq end (line-end-position))
       (beginning-of-line)
@@ -339,7 +349,20 @@ wdired-get-filename
          ;; the filename end is found even when the filename is empty.
          ;; Fixes error and spurious newlines when marking files for
          ;; deletion.
-         (setq end (next-single-property-change beg 'end-name))
+         (setq end (next-single-property-change beg 'end-name nil end))
+          (when (save-excursion
+                  (and (re-search-forward
+                        dired-permission-flags-regexp nil t)
+                       (goto-char (match-beginning 0))
+                       (looking-at "l")
+                       (search-forward " -> " (line-end-position) t)))
+            (goto-char (match-beginning 0))
+            (setq end (point)))
+          (when (and used-F
+                     (save-excursion
+                       (goto-char end)
+                       (looking-back "[*/@|=>]$" (1- (point)))))
+              (setq end (1- end)))
          (setq file (buffer-substring-no-properties (1+ beg) end)))
        ;; Don't unquote the old name, it wasn't quoted in the first place
         (and file (setq file (wdired-normalize-filename file (not old)))))
@@ -366,7 +389,7 @@ wdired-change-to-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-dired-filename-prop t)
+  (remove-hook 'after-change-functions 'wdired--restore-properties t)
   (set (make-local-variable 'revert-buffer-function) 'dired-revert))
 
 
@@ -427,9 +450,9 @@ wdired-finish-edit
     (when files-renamed
       (setq errors (+ errors (wdired-do-renames files-renamed))))
     ;; We have to be in wdired-mode when wdired-do-renames is executed
-    ;; so that wdired--restore-dired-filename-prop runs, but we have
-    ;; to change back to dired-mode before reverting the buffer to
-    ;; avoid using wdired-revert, which changes back to wdired-mode.
+    ;; so that wdired--restore-properties runs, but we have to change
+    ;; back to dired-mode before reverting the buffer to avoid using
+    ;; wdired-revert, which changes back to wdired-mode.
     (wdired-change-to-dired-mode)
     (if changes
        (progn
@@ -451,7 +474,11 @@ wdired-finish-edit
                                '(old-name nil end-name nil old-link nil
                                           end-link nil end-perm nil
                                           old-perm nil perm-changed nil))
-       (message "(No changes to be performed)")))
+       (message "(No changes to be performed)")
+        ;; Deleting file indicator characters or editing the symlink
+        ;; arrow in WDired are noops, so redisplay them immediately on
+        ;; returning to Dired.
+        (revert-buffer)))
     (when files-deleted
       (wdired-flag-for-deletion files-deleted))
     (when (> errors 0)
@@ -605,14 +632,24 @@ wdired-check-kill-buffer
 ;; dired-filename text property, which allows functions that look for
 ;; this property (e.g. dired-isearch-filenames) to work in wdired-mode
 ;; and also avoids an error with non-nil wdired-use-interactive-rename
-;; (bug#32173).
-(defun wdired--restore-dired-filename-prop (beg end _len)
+;; (bug#32173).  Also prevents editing the symlink arrow (which is a
+;; noop) from corrupting the link name (see bug#18475 for elaboration).
+(defun wdired--restore-properties (beg end _len)
   (save-match-data
     (save-excursion
       (let ((lep (line-end-position))
             (used-F (dired-check-switches
                      dired-actual-switches
                      "F" "classify")))
+        ;; Deleting the space between the link name and the arrow (a
+        ;; noop) also deletes the end-name property, so restore it.
+        (when (and (save-excursion
+                     (re-search-backward dired-permission-flags-regexp nil t)
+                     (looking-at "l"))
+                   (get-text-property (1- (point)) 'dired-filename)
+                   (not (get-text-property (point) 'dired-filename))
+                   (not (get-text-property (point) 'end-name)))
+            (put-text-property (point) (1+ (point)) 'end-name t))
         (beginning-of-line)
         (when (re-search-forward
                directory-listing-before-filename-regexp lep t)
@@ -676,33 +713,36 @@ wdired-preprocess-symlinks
     (save-excursion
       (goto-char (point-min))
       (while (not (eobp))
-        (if (looking-at dired-re-sym)
-            (progn
-              (re-search-forward " -> \\(.*\\)$")
-             (put-text-property (- (match-beginning 1) 2)
-                                (1- (match-beginning 1)) 'old-link
-                                (match-string-no-properties 1))
-              (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
-              (put-text-property (1- (match-beginning 1))
-                                (match-beginning 1)
-                                'rear-nonsticky '(read-only))
-             (put-text-property (match-beginning 1)
-                                (match-end 1) 'read-only nil)))
+        (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-get-previous-link (&optional old move)
   "Return the next symlink target.
 If OLD, return the old target.  If MOVE, move point before it."
   (let (beg end target)
     (setq beg (previous-single-property-change (point) 'old-link nil))
-    (if beg
-       (progn
-         (if old
-             (setq target (get-text-property (1- beg) 'old-link))
-           (setq end (next-single-property-change beg 'end-link))
-           (setq target (buffer-substring-no-properties (1+ beg) end)))
-         (if move (goto-char (1- beg)))))
+    (when beg
+      (when (save-excursion
+              (goto-char beg)
+              (and (looking-at " ")
+                   (looking-back " ->" (line-beginning-position))))
+        (setq beg (1+ beg)))
+      (if old
+          (setq target (get-text-property (1- beg) 'old-link))
+        (setq end (save-excursion
+                    (goto-char beg)
+                    (next-single-property-change beg 'end-link nil
+                                                 (line-end-position))))
+        (setq target (buffer-substring-no-properties beg end)))
+      (if move (goto-char (1- beg))))
     (and target (wdired-normalize-filename target t))))
 
 (declare-function make-symbolic-link "fileio.c")


-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no