From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: [PATCH] Lazy wdired preprocessing Date: Sat, 27 Mar 2021 10:56:01 -0400 Message-ID: References: Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="22304"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: emacs-devel@gnu.org To: Arthur Miller Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sat Mar 27 15:57:05 2021 Return-path: Envelope-to: ged-emacs-devel@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 1lQAN7-0005gC-66 for ged-emacs-devel@m.gmane-mx.org; Sat, 27 Mar 2021 15:57:05 +0100 Original-Received: from localhost ([::1]:32914 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lQAN6-0004M4-6h for ged-emacs-devel@m.gmane-mx.org; Sat, 27 Mar 2021 10:57:04 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:38086) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lQAMI-0003oI-5L for emacs-devel@gnu.org; Sat, 27 Mar 2021 10:56:14 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:11886) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lQAMF-00083b-3c for emacs-devel@gnu.org; Sat, 27 Mar 2021 10:56:13 -0400 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 221D880182; Sat, 27 Mar 2021 10:56:09 -0400 (EDT) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 9C813805EF; Sat, 27 Mar 2021 10:56:02 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1616856962; bh=tbivkbf/A5PHM7dEpGOwujyzu7GtzOGDphnhDl7Ovwg=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=BQU3QjMKOI5LH/oVIfA+A36UIdY5kos42fRQ7fuIGZmQO/R6FctuIz6P2Ej6GJfDo BK+Qg8HQHA/0psSOBzctFLEys8PTsXaldF9zZp24jQ0FfM6mq+16FbjUAR3kIRHvDV i6EFlu8/zsTnGpSG65A/6tJqF9sGJz3YKfkp3dFVMiZI0H/bOb79GUct9swlwgV8v1 A+a3rF2pUDwDvPNMZ39a9YHl6CMTdY5gw+WI5aimuOdblrpBICgqhmyipJUUAMnWUN /kTmKAv99ivDF2Qf04p9ZTKRLO+pfpV1xxq97bw1Ts/ATjJly1D+yh3Ua3+MpuLiyf UXVP/ANytKJBg== Original-Received: from alfajor (unknown [216.154.43.249]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 6B04E12016F; Sat, 27 Mar 2021 10:56:02 -0400 (EDT) In-Reply-To: (Arthur Miller's message of "Sat, 27 Mar 2021 08:39:35 +0100") Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:267100 Archived-At: >>> +(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, Stefan commit ed6b9586d74795605debf614bd4328611e1f1c22 Author: Stefan Monnier 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."