unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] Lazy wdired preprocessing
@ 2021-03-25 16:06 Arthur Miller
  2021-03-25 23:09 ` Michael Heerdegen
                   ` (2 more replies)
  0 siblings, 3 replies; 24+ messages in thread
From: Arthur Miller @ 2021-03-25 16:06 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 381 bytes --]


Haven't got any repsonses, but for me it seems to work fine. Maybe I
haven't tested some use-case though.

I have tied-up just a bit: removed unnecessary commented out line I
added while testing and unnecessary argument passing to pre-processing
routines.

If it is still interesting.

I attach also my working file if someone wishes to just eval and test it
without rebuilding.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Lazy-wdired-preprocessing.patch --]
[-- Type: text/x-patch, Size: 11673 bytes --]

From 6ee3ce6cb3c2ed442ecc32d59ff47f0ff4e5a4d1 Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Thu, 25 Mar 2021 16:57:18 +0100
Subject: [PATCH] Lazy wdired preprocessing

---
 lisp/wdired.el | 190 +++++++++++++++++++++++++++++--------------------
 1 file changed, 112 insertions(+), 78 deletions(-)

diff --git a/lisp/wdired.el b/lisp/wdired.el
index 43026d4bb7..8c997dc340 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -189,6 +189,8 @@ wdired-mode-hook
 
 ;; 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)
 (defvar wdired-old-point)
 (defvar wdired-old-marks)
@@ -235,6 +237,8 @@ wdired-change-to-wdired-mode
   (setq-local wdired-old-marks
               (dired-remember-marks (point-min) (point-max)))
   (setq-local wdired-old-point (point))
+  (setq-local wdired-perm-beg nil)
+  (setq-local wdired-perm-end nil)
   (setq-local query-replace-skip-read-only t)
   (add-function :after-while (local 'isearch-filter-predicate)
                 #'wdired-isearch-filter-read-only)
@@ -243,22 +247,24 @@ wdired-change-to-wdired-mode
   (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")
-  (add-function :override (local '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.
+  (setq revert-buffer-function 'wdired-revert)
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
+  ;; find one column with permissions and set permision text boundaries
+  (save-excursion
+    (goto-char (point-min))
+    (unless (re-search-forward dired-re-perms nil t 1)
+      (wdired-abort-changes)
+      (error "No files to be renamed - Exiting to Dired mode."))
+    (goto-char (match-beginning 0))
+    (setq-local wdired-perm-beg (current-column))
+    (goto-char (match-end 0))
+    (setq-local wdired-perm-end (current-column)))
+  (define-key wdired-mode-map [remap self-insert-command] #'wdired--self-insert)
   (run-mode-hooks 'wdired-mode-hook)
   (message "%s" (substitute-command-keys
 		 "Press \\[wdired-finish-edit] when finished \
@@ -269,16 +275,49 @@ wdired-isearch-filter-read-only
   (not (text-property-not-all (min beg end) (max beg end)
 			      'read-only nil)))
 
+(defun wdired--point-at-perms-p ()
+  (and (>= (current-column) wdired-perm-beg)
+       (<= (current-column) wdired-perm-end)))
+
+(defun wdired--self-insert ()
+  (interactive)
+  (if (wdired--point-at-perms-p)
+    (when (not (get-text-property (line-beginning-position) 'front-sticky))
+      (wdired--before-change-fn (line-beginning-position) (line-end-position))
+      (setq unread-command-events (nconc (listify-key-sequence
+                                          (this-command-keys))
+                                         unread-command-events)))
+    (call-interactively '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))
+    (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)
+        (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)))
+
 ;; 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 ()
   (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
+      (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) '("." ".."))))
@@ -287,19 +326,16 @@ wdired-preprocess-files
 	  ;; 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)
+	  (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)))
-	  (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)
@@ -362,7 +398,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)
@@ -379,14 +414,16 @@ wdired-change-to-dired-mode
   (setq major-mode 'dired-mode)
   (setq mode-name "Dired")
   (dired-advertise)
-  (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
-  (remove-hook 'after-change-functions #'wdired--restore-properties t)
-  (remove-function (local 'revert-buffer-function) #'wdired-revert))
+  (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))
@@ -702,21 +739,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 ()
+  (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))))))
 
 (defun wdired-get-previous-link (&optional old move)
   "Return the next symlink target.
@@ -822,34 +857,33 @@ wdired-perm-mode-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)))))
+(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)))))))
 
 (defun wdired-perm-allowed-in-pos (char pos)
   (cond
-- 
2.31.0


[-- Attachment #3: lazy-wdired.el --]
[-- Type: text/plain, Size: 8695 bytes --]

;;; lazy-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)

(defvar wdired-perm-beg) ;; Column where the permission bits start
(defvar wdired-perm-end) ;; Column where the permission bits stop

;;;###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 wdired-perm-beg nil)
  (setq-local wdired-perm-end nil)
  (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)
  ;; find one column with permissions and set permision text boundaries
  (save-excursion
    (goto-char (point-min))
    (unless (re-search-forward dired-re-perms nil t 1)
      (wdired-abort-changes)
      (error "No files to be renamed - Exiting to Dired mode."))
    (goto-char (match-beginning 0))
    (setq-local wdired-perm-beg (current-column))
    (goto-char (match-end 0))
    (setq-local wdired-perm-end (current-column)))
  (define-key wdired-mode-map [remap self-insert-command] #'wdired--self-insert)
  (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--point-at-perms-p ()
  (and (>= (current-column) wdired-perm-beg)
       (<= (current-column) wdired-perm-end)))

(defun wdired--self-insert ()
  (interactive)
  (if (wdired--point-at-perms-p)
    (when (not (get-text-property (line-beginning-position) 'front-sticky))
      (wdired--before-change-fn (line-beginning-position) (line-end-position))
      (setq unread-command-events (nconc (listify-key-sequence
                                          (this-command-keys))
                                         unread-command-events)))
  (call-interactively '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))
    (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)
        (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)))

;; 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 ()
  (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)))))))

(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"))

;; 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))))))

(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)))))))

(provide 'lazy-wdired)

^ permalink raw reply related	[flat|nested] 24+ messages in thread

end of thread, other threads:[~2021-03-29  8:35 UTC | newest]

Thread overview: 24+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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       ` [PATCH] Lazy wdired preprocessing - BUG Arthur Miller
2021-03-27 18:32         ` Stefan Monnier
2021-03-27 18:50           ` Arthur Miller

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).