From: Arthur Miller <arthur.miller@live.com>
To: emacs-devel@gnu.org
Subject: [PATCH] Lazy wdired preprocessing
Date: Thu, 25 Mar 2021 17:06:36 +0100 [thread overview]
Message-ID: <AM9PR09MB49779174BEE1FA612D22024896629@AM9PR09MB4977.eurprd09.prod.outlook.com> (raw)
[-- 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)
next reply other threads:[~2021-03-25 16:06 UTC|newest]
Thread overview: 24+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-25 16:06 Arthur Miller [this message]
2021-03-25 23:09 ` [PATCH] Lazy wdired preprocessing 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
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=AM9PR09MB49779174BEE1FA612D22024896629@AM9PR09MB4977.eurprd09.prod.outlook.com \
--to=arthur.miller@live.com \
--cc=emacs-devel@gnu.org \
/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).