From: Arthur Miller <arthur.miller@live.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: [PATCH] Lazy wdired preprocessing - BUG
Date: Sat, 27 Mar 2021 19:20:04 +0100 [thread overview]
Message-ID: <AM9PR09MB497743247CDAC9751B41B14896609@AM9PR09MB4977.eurprd09.prod.outlook.com> (raw)
In-Reply-To: <jwvtuowydj5.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Sat, 27 Mar 2021 10:56:01 -0400")
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>>>> +(defvar wdired-perm-beg) ;; Column where the permission bits start
>>>> +(defvar wdired-perm-end) ;; Column where the permission bits stop
>>> I think this should use "--" in the names since they are internal variables.
>> I just followed naming as already was in wdired.
>
> I know; fixing all the old code to use such conventions is hard, but
> I try and make sure that new code at least follows those conventions ;-)
>
>>> `current-column` can be somewhat costly, so we should refrain from
>>> calling it twice gratuitously. And here we can even take advantage of
>>> the (rarely used and rarely applicable) multi-arg form of `<=` to fix
>>> that "for free":
>> Ok. Didn't know that (current-column) was expensive. I use now a good 'nuff
>> implementation for this purpose (wdired--current-column).
>
> Oh, not *that* costly. Just in the sense that it's
> better not to feel free to call it redundantly.
> But, I think `wdired--current-column` looks fine: it completely
> side-steps the question of what happens if some of the text is
> currently invisible.
>
>> It's all yours now. I don't think I will have more time nor possibility
>> to work on this, so if this one is not good enough, you will to finnish
>> it on your own, or someone else could help. We are waiting a kid any
>> day now, so no hobby programming for quite some time over for me :-).
>
> Would it be time to plug in Richard's endorsement of reproduction here?
>
> I pushed your change with the following additional patch on top,
I have just rebuild with the new patch. I see a small bug: when entered
wdired mode, and trying to do a very first change, it requires two
keypresses. The first key press, I think, gets consumed in first call to
wdired--self insert, so user is required to press again a key to do
actual edit.
I was struggling with that one so one of the reasons I pushed key event back
onto the queue was that one.
> + (let ((cmd (lookup-key map (this-command-keys))))
> + (call-interactively (or cmd 'self-insert-command)))))))
I am not sure how that part works, so I am not attempting to suggest a
change, not sure if it's that part, but I think the keypress is
consumed in call to preprocess function.
>
> Stefan
>
>
> commit ed6b9586d74795605debf614bd4328611e1f1c22
> Author: Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Sat Mar 27 10:54:10 2021 -0400
>
> * lisp/wdired.el: Fix minor regressions and simplify a bit
>
> Use `wdired--current-column` more consistently to avoid mayhem when it
> doesn't return the same result as `current-column`.
>
> (wdired--col-perm): Remove, redundant with `wdired--perm-beg`.
> (wdired-change-to-wdired-mode): Don't error in empty directory.
> (wdired--set-permission-bounds): Set `wdired--perm-beg` when we can't
> find permissions. Move `wdired--perm-beg` 1 char further (like
> `wdired--col-perm`). Use `wdired--current-column`.
> (wdired--point-at-perms-p): Fix when `wdired--perm-beg` is nil.
> (wdired--self-insert): Lookup the keymap to know command to call.
> (wdired--before-change-fn): Just use `point` instead of `beg`.
> Use `with-silent-modifications` here rather than in each of the
> `wdired--preprocess-*` functions.
> (wdired--preprocess-files): Presume we're at BOL and within
> `with-silent-modifications`. Fix application of `read-only`.
> (wdired-abort-changes): Don't use `with-silent-modifications` since
> we're really modifying the buffer.
> (wdired--preprocess-symlinks): Presume we're at BOL and within
> `with-silent-modifications`.
> (wdired--preprocess-perms): Presume we're at BOL and within
> `with-silent-modifications`.
> (wdired-set-bit): Add `char` argument. Use `wdired--current-column`.
> Copy previous text properties rather than duplicating the code of
> `wdired--preprocess-perms`.
> (wdired-toggle-bit): Delegate to `wdired-set-bit`.
>
> diff --git a/lisp/wdired.el b/lisp/wdired.el
> index 61272d947f..97861a4474 100644
> --- a/lisp/wdired.el
> +++ b/lisp/wdired.el
> @@ -189,7 +189,6 @@ wdired-mode-hook
> "Hooks run when changing to WDired mode.")
>
> ;; Local variables (put here to avoid compilation gripes)
> -(defvar wdired--col-perm) ;; Column where the permission bits start
> (defvar wdired--perm-beg) ;; Column where the permission bits start
> (defvar wdired--perm-end) ;; Column where the permission bits stop
> (defvar wdired--old-content)
> @@ -233,8 +232,6 @@ wdired-change-to-wdired-mode
> (interactive)
> (unless (derived-mode-p 'dired-mode)
> (error "Not a Dired buffer"))
> - (when (directory-empty-p (expand-file-name default-directory))
> - (error "No files to be renamed"))
> (setq-local wdired--old-content
> (buffer-substring (point-min) (point-max)))
> (setq-local wdired--old-marks
> @@ -264,49 +261,60 @@ wdired-change-to-wdired-mode
> (defun wdired--set-permission-bounds ()
> (save-excursion
> (goto-char (point-min))
> - (re-search-forward dired-re-perms nil t 1)
> - (goto-char (match-beginning 0))
> - (setq-local wdired--perm-beg (current-column))
> - (goto-char (match-end 0))
> - (setq-local wdired--perm-end (current-column))))
> + (if (not (re-search-forward dired-re-perms nil t 1))
> + (progn
> + (setq-local wdired--perm-beg nil)
> + (setq-local wdired--perm-end nil))
> + (goto-char (match-beginning 0))
> + ;; Add 1 since the first char matched by `dired-re-perms' is the
> + ;; one describing the nature of the entry (dir/symlink/...) rather
> + ;; than its permissions.
> + (setq-local wdired--perm-beg (1+ (wdired--current-column)))
> + (goto-char (match-end 0))
> + (setq-local wdired--perm-end (wdired--current-column)))))
>
> (defun wdired--current-column ()
> (- (point) (line-beginning-position)))
>
> (defun wdired--point-at-perms-p ()
> - (<= wdired--perm-beg (wdired--current-column) wdired--perm-end))
> + (and wdired--perm-beg
> + (<= wdired--perm-beg (wdired--current-column) wdired--perm-end)))
>
> (defun wdired--line-preprocessed-p ()
> (get-text-property (line-beginning-position) 'front-sticky))
>
> (defun wdired--self-insert ()
> (interactive)
> - (if (wdired--point-at-perms-p)
> - (unless (wdired--line-preprocessed-p)
> - (wdired--before-change-fn (line-beginning-position) (line-end-position))
> - (wdired-toggle-bit))
> - (call-interactively 'self-insert-command)))
> + (if (wdired--line-preprocessed-p)
> + (call-interactively 'self-insert-command)
> + (wdired--before-change-fn (line-beginning-position) (line-end-position))
> + (let ((map (get-text-property (point) 'keymap)))
> + (when map
> + (let ((cmd (lookup-key map (this-command-keys))))
> + (call-interactively (or cmd 'self-insert-command)))))))
>
> (defun wdired--before-change-fn (beg end)
> (save-excursion
> - ;; make sure to process entire lines
> - (goto-char beg)
> - (setq beg (line-beginning-position))
> + ;; Make sure to process entire lines.
> (goto-char end)
> (setq end (line-end-position))
> + (goto-char beg)
> + (forward-line 0)
>
> - (while (< beg end)
> + (while (< (point) end)
> (unless (wdired--line-preprocessed-p)
> - (put-text-property beg (1+ beg) 'front-sticky t)
> - (wdired--preprocess-files)
> - (when wdired-allow-to-change-permissions
> - (wdired--preprocess-perms))
> - (when (fboundp 'make-symbolic-link)
> - (wdired--preprocess-symlinks)))
> - (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)))
> + (with-silent-modifications
> + (put-text-property (point) (1+ (point)) 'front-sticky t)
> + (wdired--preprocess-files)
> + (when wdired-allow-to-change-permissions
> + (wdired--preprocess-perms))
> + (when (fboundp 'make-symbolic-link)
> + (wdired--preprocess-symlinks))))
> + (forward-line))
> + (when (eobp)
> + (with-silent-modifications
> + ;; 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."
> @@ -317,28 +325,26 @@ wdired-isearch-filter-read-only
> ;; properties so filenames (old and new) can be easily found.
> (defun wdired--preprocess-files ()
> (save-excursion
> - (with-silent-modifications
> - (beginning-of-line)
> - (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 (- (point) 1) (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)))))))
> + (let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
> + (beg (point))
> + (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))))))
>
> ;; This code is a copy of some dired-get-filename lines.
> (defsubst wdired-normalize-filename (file unquotep)
> @@ -425,8 +431,8 @@ wdired-change-to-dired-mode
> (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
> + (remove-hook 'before-change-functions #'wdired--before-change-fn t)
> + (let ((inhibit-read-only t))
> (erase-buffer)
> (insert wdired--old-content)
> (goto-char wdired--old-point))
> @@ -451,7 +457,7 @@ wdired-finish-edit
> (setq errors (cdr tmp-value))
> (setq changes (car tmp-value)))
> (when (and wdired-allow-to-change-permissions
> - (boundp 'wdired--col-perm)) ; could have been changed
> + wdired--perm-beg) ; could have been changed
> (setq tmp-value (wdired-do-perm-changes))
> (setq errors (+ errors (cdr tmp-value)))
> (setq changes (or changes (car tmp-value))))
> @@ -744,17 +750,15 @@ wdired-previous-line
> ;; Put the needed properties to allow the user to change links' targets
> (defun wdired--preprocess-symlinks ()
> (save-excursion
> - (with-silent-modifications
> - (beginning-of-line)
> - (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))))))
> + (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.
> @@ -861,31 +865,26 @@ wdired-perm-mode-map
> ;; original name and permissions as a property
> (defun wdired--preprocess-perms ()
> (save-excursion
> - (with-silent-modifications
> - (setq-local wdired--col-perm nil)
> - (beginning-of-line)
> - (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)))))))
> + (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)))
> + (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
> @@ -897,39 +896,30 @@ wdired-perm-allowed-in-pos
> ((memq char '(?t ?T)) (= pos 8))
> ((= char ?l) (= pos 5))))
>
> -(defun wdired-set-bit ()
> +(defun wdired-set-bit (&optional char)
> "Set a permission bit character."
> - (interactive)
> - (if (wdired-perm-allowed-in-pos last-command-event
> - (- (current-column) wdired--col-perm))
> - (let ((new-bit (char-to-string last-command-event))
> + (interactive (list last-command-event))
> + (unless char (setq char last-command-event))
> + (if (wdired-perm-allowed-in-pos char
> + (- (wdired--current-column) wdired--perm-beg))
> + (let ((new-bit (char-to-string char))
> (inhibit-read-only t)
> - (pos-prop (- (point) (- (current-column) wdired--col-perm))))
> - (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
> - (put-text-property 0 1 'read-only t new-bit)
> + (pos-prop (+ (line-beginning-position) wdired--perm-beg)))
> + (set-text-properties 0 1 (text-properties-at (point)) new-bit)
> (insert new-bit)
> (delete-char 1)
> - (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
> - (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
> + (put-text-property (1- pos-prop) pos-prop 'perm-changed t))
> (forward-char 1)))
>
> (defun wdired-toggle-bit ()
> "Toggle the permission bit at point."
> (interactive)
> - (let ((inhibit-read-only t)
> - (new-bit "-")
> - (pos-prop (- (point) (- (current-column) wdired--col-perm))))
> - (if (eq (char-after (point)) ?-)
> - (setq new-bit
> - (if (= (% (- (current-column) wdired--col-perm) 3) 0) "r"
> - (if (= (% (- (current-column) wdired--col-perm) 3) 1) "w"
> - "x"))))
> - (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
> - (put-text-property 0 1 'read-only t new-bit)
> - (insert new-bit)
> - (delete-char 1)
> - (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
> - (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
> + (wdired-set-bit
> + (cond
> + ((not (eq (char-after (point)) ?-)) ?-)
> + ((= (% (- (wdired--current-column) wdired--perm-beg) 3) 0) ?r)
> + ((= (% (- (wdired--current-column) wdired--perm-beg) 3) 1) ?w)
> + (t ?x))))
>
> (defun wdired-mouse-toggle-bit (event)
> "Toggle the permission bit that was left clicked."
next prev parent reply other threads:[~2021-03-27 18:20 UTC|newest]
Thread overview: 24+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-25 16:06 [PATCH] Lazy wdired preprocessing Arthur Miller
2021-03-25 23:09 ` Michael Heerdegen
2021-03-26 1:00 ` Arthur Miller
2021-03-26 3:27 ` Michael Heerdegen
2021-03-26 12:15 ` Arthur Miller
2021-03-26 12:21 ` Arthur Miller
2021-03-27 23:49 ` Michael Heerdegen
2021-03-28 1:51 ` Stefan Monnier
2021-03-28 1:56 ` Michael Heerdegen
2021-03-28 2:00 ` Stefan Monnier
2021-03-28 7:50 ` Sv: " arthur miller
2021-03-28 13:51 ` Stefan Monnier
2021-03-28 16:22 ` Sv: " arthur miller
[not found] ` <87y2e6242i.fsf@web.de>
2021-03-29 8:35 ` arthur miller
2021-03-26 10:18 ` Stefan Kangas
2021-03-26 19:37 ` Stefan Monnier
2021-03-27 7:39 ` Arthur Miller
2021-03-27 14:56 ` Stefan Monnier
2021-03-27 15:17 ` Arthur Miller
2021-03-27 15:56 ` Stefan Monnier
2021-03-27 17:01 ` Arthur Miller
2021-03-27 18:20 ` Arthur Miller [this message]
2021-03-27 18:32 ` [PATCH] Lazy wdired preprocessing - BUG Stefan Monnier
2021-03-27 18:50 ` Arthur Miller
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=AM9PR09MB497743247CDAC9751B41B14896609@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).