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

[Stephen Berman <stephen.berman@gmx.net>]

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

On Sat, 27 Apr 2019 01:09:16 +0100 "Basil L. Contovounesios" <contovob@tcd.ie> wrote:

> Drew Adams <drew.adams@oracle.com> writes:
>
>> The `wdired-mode' doc string says: "If you delete the filename of a
>> file, it is flagged for deletion in the Dired buffer."  And (emacs)
>> `Wdired' says: "To mark a file for deletion, delete the entire file
>> name."
>>
>> And this applies to directory names also.
>>
>> No problem, except if you use `ls' switch `-F', which appends `/' to
>> directory names.  In that case, if you try to use `C-k' anywhere on the
>> dir name text, you get the error "Text is read only".
>>
>> (Yes, you can use other deletion keys besides `C-k' to delete the dir
>> name but not delete the `/'.  That looks weird and is not easily
>> guessable by users, but it works.  `C-k' should work also, as one would
>> expect.)
>>
>> In GNU Emacs 24.4.50.1 (i686-pc-mingw32)
>>  of 2014-08-15 on LEG570
>> Bzr revision: 117706 rgm@gnu.org-20140815043406-p5hbu97cbm7pulcn
>> Windowing system distributor `Microsoft Corp.', version 6.1.7601
>> Configured using:
>>  `configure --enable-checking 'CFLAGS=-O0 -g3' CPPFLAGS=-DGLYPH_DEBUG=1'
>
> I can still reproduce this on Emacs 26 and latest master.

This happens not only with `/' but also with the other ls file indicator
characters appended when using the -F switch.  Making C-k work as
expected for these cases is a small fix.  However, the same issue also
arises with symlinks, whether or not -F is used, and it does not seem as
straightforward to deal with this case.  The attached patch (against
master) tries to ensure the following behavior:

- Typing `C-k' with point just before the first character of a file name
  ending with an indicator character (using -F), or of link name,
  deletes the file name/symlink in WDired, but it is restored but marked
  for deletion on returning to Dired.  The same also happens when just
  deleting the link name in WDired.

- Typing `C-k' with point on such a file or link name, but after the
  first character, deletes the rest, resulting in renaming on returning
  to Dired.

- Deleting the indicator character is possible in WDired but a noop: the
  character is restored on returning to Dired.  (In the current code
  without the patch, the indicator characters are read-only, but I had
  to change that to make C-k work.)

With symlinks:

- The patch preserves the current behavior that an edit of the target
  name (possible when wdired-allow-to-redirect-links is non-nil, as it
  is by default) is saved on returning to Dired, and if the target name
  is deleted, then the new target on returning to Dired is "/dev/null".

- Editing (changing or deleting) the string " -> " between the link and
  target names is possible in WDired but a noop: the symlink is
  unaltered on returning to Dired.  (In the current code without the
  patch, " -> " is read-only, but I had to change that to make C-k work.)

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

Steve Berman


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

diff --git a/lisp/wdired.el b/lisp/wdired.el
index d2a298bd25..e44b619b46 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)))))
@@ -364,7 +387,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))


@@ -425,9 +448,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
@@ -449,7 +472,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)
@@ -603,11 +630,21 @@ 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)))
+        ;; 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)
@@ -665,34 +702,37 @@ 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)
 	(beginning-of-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")