From 50be6d9fe954bea6543025a6a7bfc2d606ac34eb Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Sun, 11 Oct 2020 06:05:49 +0200 Subject: [PATCH] Allow killing files with C-k in wdired if -F is used * lisp/wdired.el (wdired-change-to-wdired-mode): Add hook to restore properties. (wdired-change-to-wdired-mode): Adjust check for symlinks. (wdired-preprocess-files): Fix parsing when using the -F flag. (wdired-get-filename): Fix parsing of symlinks when using the -F flag. (wdired--restore-properties): Renamed, and restore more properties (bug#18475). --- lisp/wdired.el | 104 ++++++++++++++++++++++++++++++++++--------------- 1 file changed, 72 insertions(+), 32 deletions(-) diff --git a/lisp/wdired.el b/lisp/wdired.el index 40f4cd97190..da162b7bb29 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -255,7 +255,7 @@ 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 '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 @@ See `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 @@ or \\[wdired-abort-changes] to abort changes"))) (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 @@ or \\[wdired-abort-changes] to abort changes"))) (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 @@ relies on WDired buffer's properties. Optional arg NO-DIR with value 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 @@ non-nil means return old 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 @@ non-nil means return old filename." (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 @@ non-nil means return old filename." (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 @@ non-nil means return old filename." '(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) @@ -609,14 +636,24 @@ Optional arguments are ignored." ;; 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) @@ -680,33 +717,36 @@ says how many lines to move; default is one line." (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") -- 2.39.5