From: Arthur Miller <arthur.miller@live.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: Partial wdired (edit just filename at the point)
Date: Fri, 19 Mar 2021 12:15:57 +0100 [thread overview]
Message-ID: <AM9PR09MB4977D4E3E2405E9D35F76AD596689@AM9PR09MB4977.eurprd09.prod.outlook.com> (raw)
In-Reply-To: <jwvwnu4eetz.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Thu, 18 Mar 2021 10:21:23 -0400")
[-- Attachment #1: Type: text/plain, Size: 1715 bytes --]
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>>> As you can guess from the previous comment, we should loop over BEG...END
>>> to process all the lines involved.
>> Can you elaborate more on this please?
>
> Because that's how `before-change-functions` is defined. We can try and
> argue that in the specific case of wdired buffer the multiline case will
> never happen (presumably because of all the `read-only` annotations) or
> that it will always be "on the same line as point", but I'm pretty sure
> we'll end up finding corner cases where these are not true, so I find it
> easier to slap a simple while loop around the code and stop worrying
> about corner cases.
Ok, thanks for the explanation.
> [ As a general rule, I find it easier to write code if I just rely on
> the few things which I know to be true, rather than having to think of
> a set of unbounded possible cases. Here, what we know to be true is
> that the upcoming changes will not affect anything outside BEG...END
> (at least not until `before-change-functions` are called again). ]
>
>> This is what I got for each char I typed in:
>
> Try something like
>
> M-: (subst-char-in-region (point-min) (point-min) ?. ?-) RET
Indeed, I was only concentrated on "interactive" editing, didn't thought
so much of other elisp functions.
Jere is a sketch with region, however, I am not able to get
editing permissions correctly. I am not really sure what is going on.
Maybe you or someone else see what is wrong there. Otherwise editing
names and symlinks works fine. I hope the general "setup" to loop
through the region is acceptable. I have attached my working file and as
a patch so take a look at whichever is easier.
[-- Attachment #2: partial-wdired.el --]
[-- Type: text/plain, Size: 7412 bytes --]
;;; partial-wdired.el --- -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Arthur Miller
;; Author: Arthur Miller <arthur.miller@live.com>
;; Keywords:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Enable editing of file name and properties only at the point.
;;; Code:
(require 'wdired)
;;;###autoload
(defun wdired-change-to-wdired-mode ()
"Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
In WDired mode, you can edit the names of the files in the
buffer, the target of the links, and the permission bits of the
files. After typing \\[wdired-finish-edit], Emacs modifies the files and
directories to reflect your edits.
See `wdired-mode'."
(interactive)
(unless (derived-mode-p 'dired-mode)
(error "Not a Dired buffer"))
(setq-local wdired-old-content
(buffer-substring (point-min) (point-max)))
(setq-local wdired-old-marks
(dired-remember-marks (point-min) (point-max)))
(setq-local wdired-old-point (point))
(setq-local query-replace-skip-read-only t)
(add-function :after-while (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
(use-local-map wdired-mode-map)
(force-mode-line-update)
(setq buffer-read-only nil)
(dired-unadvertise default-directory)
(add-hook 'kill-buffer-hook #'wdired-check-kill-buffer nil t)
(add-hook 'before-change-functions #'wdired--before-change-fn 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)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-mode-hooks 'wdired-mode-hook)
(message "%s" (substitute-command-keys
"Press \\[wdired-finish-edit] when finished \
or \\[wdired-abort-changes] to abort changes")))
(defun wdired--before-change-fn (beg end)
(save-excursion
;; make sure to process at least entire line
(goto-char beg)
(setq beg (line-beginning-position))
(goto-char end)
(setq end (line-end-position))
(while (< beg end)
(unless (get-text-property beg 'front-sticky)
(put-text-property beg (1+ beg) 'front-sticky t)
(wdired--preprocess-files beg end)
(when wdired-allow-to-change-permissions
(wdired--preprocess-perms beg end))
(when (fboundp 'make-symbolic-link)
(wdired--preprocess-symlinks beg end)))
(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)))
;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
(defun wdired--preprocess-files (beg end)
(save-excursion
(with-silent-modifications
(goto-char beg)
(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 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)))))))
;; Put the needed properties to allow the user to change links' targets
(defun wdired--preprocess-symlinks (beg end)
(save-excursion
(with-silent-modifications
(goto-char beg)
(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--preprocess-perms (beg end)
(save-excursion
(with-silent-modifications
(setq-local wdired-col-perm nil)
(goto-char beg)
(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)))))))
(defun wdired-change-to-dired-mode ()
"Change the mode back to dired."
(or (eq major-mode 'wdired-mode)
(error "Not a Wdired buffer"))
(let ((inhibit-read-only t))
(remove-text-properties
(point-min) (point-max)
'(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
(remove-function (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
(use-local-map dired-mode-map)
(force-mode-line-update)
(setq buffer-read-only t)
(setq major-mode 'dired-mode)
(setq mode-name "Dired")
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
(remove-hook 'before-change-functions 'wdired--before-change-fn t)
(remove-hook 'after-change-functions 'wdired--restore-properties t)
(setq-local revert-buffer-function 'dired-revert))
(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
(erase-buffer)
(insert wdired-old-content)
(goto-char wdired-old-point))
(wdired-change-to-dired-mode)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(message "Changes aborted"))
(provide 'partial-wdired)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Lazy-wdired-preprocessing.patch --]
[-- Type: text/x-patch, Size: 10341 bytes --]
From fe606faf0bd6dedadf5e8d90183d929e2bea60c4 Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Fri, 19 Mar 2021 11:50:06 +0100
Subject: [PATCH] Lazy wdired preprocessing.
---
lisp/wdired.el | 174 ++++++++++++++++++++++++++-----------------------
1 file changed, 91 insertions(+), 83 deletions(-)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index c495d8de34..88953d3bbd 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -249,21 +249,12 @@ wdired-change-to-wdired-mode
(force-mode-line-update)
(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-properties nil t)
+ (add-hook 'kill-buffer-hook #'wdired-check-kill-buffer nil t)
+ (add-hook 'before-change-functions #'wdired--before-change-fn 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)
- ;; I temp disable undo for performance: since I'm going to clear the
- ;; undo list, it can save more than a 9% of time with big
- ;; directories because setting properties modify the undo-list.
- (buffer-disable-undo)
- (wdired-preprocess-files)
- (if wdired-allow-to-change-permissions
- (wdired-preprocess-perms))
- (if (fboundp 'make-symbolic-link)
- (wdired-preprocess-symlinks))
- (buffer-enable-undo) ; Performance hack. See above.
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-mode-hooks 'wdired-mode-hook)
@@ -271,6 +262,27 @@ wdired-change-to-wdired-mode
"Press \\[wdired-finish-edit] when finished \
or \\[wdired-abort-changes] to abort changes")))
+(defun wdired--before-change-fn (beg end)
+ (save-excursion
+ ;; make sure to process at least entire line
+ (goto-char beg)
+ (setq beg (line-beginning-position))
+ (goto-char end)
+ (setq end (line-end-position))
+
+ (while (< beg end)
+ (unless (get-text-property beg 'front-sticky)
+ (put-text-property beg (1+ beg) 'front-sticky t)
+ (wdired--preprocess-files beg end)
+ (when wdired-allow-to-change-permissions
+ (wdired--preprocess-perms beg end))
+ (when (fboundp 'make-symbolic-link)
+ (wdired--preprocess-symlinks beg end)))
+ (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)))
+
(defun wdired-isearch-filter-read-only (beg end)
"Skip matches that have a read-only property."
(not (text-property-not-all (min beg end) (max beg end)
@@ -278,35 +290,33 @@ wdired-isearch-filter-read-only
;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
-(defun wdired-preprocess-files ()
- (put-text-property (point-min) (1+ (point-min))'front-sticky t)
+(defun wdired--preprocess-files (beg end)
(save-excursion
- (goto-char (point-min))
- (let ((b-protection (point))
- (used-F (dired-check-switches dired-actual-switches "F" "classify"))
- filename)
- (while (not (eobp))
+ (with-silent-modifications
+ (goto-char beg)
+ (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) '("." ".."))))
+ (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.
+ ;; 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 b-protection (point) 'read-only t)
+ (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)))
- (setq b-protection (point))
- (forward-line))
- (put-text-property b-protection (point-max) 'read-only 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)
@@ -369,7 +379,6 @@ wdired-get-filename
(and file (> (length file) 0)
(concat (dired-current-directory) file))))))
-
(defun wdired-change-to-dired-mode ()
"Change the mode back to dired."
(or (eq major-mode 'wdired-mode)
@@ -387,14 +396,15 @@ wdired-change-to-dired-mode
(setq mode-name "Dired")
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
+ (remove-hook 'before-change-functions 'wdired--before-change-fn t)
(remove-hook 'after-change-functions 'wdired--restore-properties t)
(setq-local revert-buffer-function 'dired-revert))
-
(defun wdired-abort-changes ()
- "Abort changes and return to dired mode."
+ "Abort changes and return to dired mode. "
(interactive)
- (let ((inhibit-read-only t))
+ (remove-hook 'before-change-functions 'wdired--before-change-fn t)
+ (with-silent-modifications
(erase-buffer)
(insert wdired-old-content)
(goto-char wdired-old-point))
@@ -710,21 +720,19 @@ wdired-previous-line
(dired-move-to-filename)))
;; Put the needed properties to allow the user to change links' targets
-(defun wdired-preprocess-symlinks ()
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (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--preprocess-symlinks (beg end)
+ (save-excursion
+ (with-silent-modifications
+ (goto-char beg)
+ (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.
@@ -828,36 +836,36 @@ wdired-perm-mode-map
(define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
map))
-;; Put a keymap property to the permission bits of the files, and store the
-;; original name and permissions as a property
-(defun wdired-preprocess-perms ()
- (let ((inhibit-read-only t))
- (setq-local wdired-col-perm nil)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (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))))
- (forward-line)
- (beginning-of-line)))))
+;; Put a keymap property to the permission bits of the files,
+;; and store the original name and permissions as a property
+(defun wdired--preprocess-perms (beg end)
+ (save-excursion
+ (with-silent-modifications
+ (setq-local wdired-col-perm nil)
+ (goto-char beg)
+ (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)))))))
(defun wdired-perm-allowed-in-pos (char pos)
(cond
--
2.31.0
next prev parent reply other threads:[~2021-03-19 11:15 UTC|newest]
Thread overview: 33+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-16 18:23 Partial wdired (edit just filename at the point) Arthur Miller
2021-03-17 1:18 ` Stefan Monnier
2021-03-17 2:21 ` Arthur Miller
2021-03-17 2:34 ` Stefan Monnier
2021-03-17 13:58 ` Arthur Miller
2021-03-17 14:09 ` Stefan Monnier
2021-03-17 19:56 ` Arthur Miller
2021-03-17 22:40 ` Arthur Miller
2021-03-18 2:10 ` Stefan Monnier
2021-03-18 10:26 ` Arthur Miller
2021-03-18 10:32 ` Thierry Volpiatto
2021-03-18 11:00 ` Arthur Miller
2021-03-18 11:11 ` Thierry Volpiatto
2021-03-18 11:46 ` Arthur Miller
2021-03-23 23:32 ` Michael Heerdegen
2021-03-18 14:21 ` Stefan Monnier
2021-03-19 11:15 ` Arthur Miller [this message]
2021-03-19 16:18 ` Stefan Monnier
2021-03-19 20:40 ` Sv: " arthur miller
2021-03-19 21:58 ` Stefan Monnier
2021-03-20 11:23 ` Sv: " arthur miller
2021-03-21 22:17 ` Tomas Hlavaty
2021-03-22 8:12 ` tomas
2021-03-22 12:44 ` Arthur Miller
2021-03-22 14:50 ` tomas
2021-03-22 13:11 ` Stefan Monnier
2021-03-22 20:08 ` Tomas Hlavaty
2021-03-22 20:28 ` Andreas Schwab
2021-03-22 21:00 ` Stefan Monnier
2021-03-22 21:52 ` Tomas Hlavaty
2021-03-22 22:16 ` Stefan Monnier
2021-03-22 22:39 ` Tomas Hlavaty
2021-03-22 23:27 ` Andreas Schwab
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=AM9PR09MB4977D4E3E2405E9D35F76AD596689@AM9PR09MB4977.eurprd09.prod.outlook.com \
--to=arthur.miller@live.com \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).