[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Lazy wdired preprocessing
From: |
Arthur Miller |
Subject: |
Re: [PATCH] Lazy wdired preprocessing |
Date: |
Sat, 27 Mar 2021 16:17:29 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) |
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?
Hmm, I don't think I know what it's about; but I trust your and RMS
judgement! :-)
> I pushed your change with the following additional patch on top,
Cool, thnks!
>
> 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."
- [PATCH] Lazy wdired preprocessing, Arthur Miller, 2021/03/25
- Re: [PATCH] Lazy wdired preprocessing, Stefan Kangas, 2021/03/26
- Re: [PATCH] Lazy wdired preprocessing, Stefan Monnier, 2021/03/26
- Re: [PATCH] Lazy wdired preprocessing - BUG, Arthur Miller, 2021/03/27
- Re: [PATCH] Lazy wdired preprocessing - BUG, Stefan Monnier, 2021/03/27
- Re: [PATCH] Lazy wdired preprocessing - BUG, Arthur Miller, 2021/03/27