all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
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


  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

* 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 external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.