From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Lars Ingebrigtsen Newsgroups: gmane.emacs.bugs Subject: bug#18475: 24.4.50; Wdired: cannot use C-k to delete a dir name if -F switch used Date: Tue, 25 Aug 2020 12:11:22 +0200 Message-ID: <87blizc9x1.fsf@gnus.org> References: <56994c97-c501-4233-b029-dcb12c796441@default> <8736m4pavn.fsf@tcd.ie> <87muk740yk.fsf@gmx.net> <87ef537suj.fsf@tcd.ie> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="40767"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: 18475@debbugs.gnu.org, Stephen Berman To: "Basil L. Contovounesios" Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Aug 25 12:12:10 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kAVw1-000AT9-FW for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 25 Aug 2020 12:12:09 +0200 Original-Received: from localhost ([::1]:37232 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kAVw0-0000pm-IG for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 25 Aug 2020 06:12:08 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:51198) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kAVvu-0000pd-Tb for bug-gnu-emacs@gnu.org; Tue, 25 Aug 2020 06:12:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:48822) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kAVvu-0003df-KH for bug-gnu-emacs@gnu.org; Tue, 25 Aug 2020 06:12:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kAVvu-0007oi-F1 for bug-gnu-emacs@gnu.org; Tue, 25 Aug 2020 06:12:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Lars Ingebrigtsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 25 Aug 2020 10:12:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 18475 X-GNU-PR-Package: emacs Original-Received: via spool by 18475-submit@debbugs.gnu.org id=B18475.159835030530014 (code B ref 18475); Tue, 25 Aug 2020 10:12:02 +0000 Original-Received: (at 18475) by debbugs.gnu.org; 25 Aug 2020 10:11:45 +0000 Original-Received: from localhost ([127.0.0.1]:60366 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAVvd-0007o1-5T for submit@debbugs.gnu.org; Tue, 25 Aug 2020 06:11:45 -0400 Original-Received: from quimby.gnus.org ([95.216.78.240]:39610) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAVva-0007nk-0n for 18475@debbugs.gnu.org; Tue, 25 Aug 2020 06:11:44 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org; s=20200322; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date: References:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding: Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender: Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe: List-Subscribe:List-Post:List-Owner:List-Archive; bh=1KDaW89wKgdlnSn9p8iYMDncwxDfMVmZ2Cu90oE9HS0=; b=mA9Vd4xgbPBQiVd10zRLV/JFR4 7YLcWiVF1327fXRus6srWMrPNT7puvWJbeSmyzn30DASPPAC1vLe7FCaUMBd6XuitDicxK0KBXdJ4 0ds6ckPoYbiccM99L1ZndivE0Rtxye9kJu6J0Me/QsvFTuxP3EU7VmUpcDu9tDpfA1bU=; Original-Received: from cm-84.212.202.86.getinternet.no ([84.212.202.86] helo=xo) by quimby with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kAVvI-00049v-9L; Tue, 25 Aug 2020 12:11:35 +0200 X-Now-Playing: Orchestral Manoeuvres in the Dark's _Souvenir (3): Unreleased Archives Vol 1_: "Flamenco" In-Reply-To: <87ef537suj.fsf@tcd.ie> (Basil L. Contovounesios's message of "Sun, 12 May 2019 13:36:04 +0100") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:186251 Archived-At: "Basil L. Contovounesios" 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