* Patch: Lazy wdired preprocessing
@ 2021-03-23 14:52 Arthur Miller
0 siblings, 0 replies; only message in thread
From: Arthur Miller @ 2021-03-23 14:52 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1282 bytes --]
The original thread seems to have become more of a lisp language thread,
so to make it easier, I made a new one, with more descriptive name.
Attached is new a version of patch. Seems to correctly work with
permissions now. I have also discovered (current-column) function so I
no longer calculate columns in my own code :-).
I have tested on my ext4 file system where my normal system is
installed, and there it works correctly.
I have also tested on one NTFS drive, where I can not change permissions
normally and there is following behaviour, don't know if it is
acceptable or not:
In wdired buffer I can seemingly change permission, but when I save
buffer, then permission is of course not saved and reverted dired buffer
shows correct permission. In Dolphin, it seems to work similar (I can
set pulldown menu in permissions dialog to only read, and press OK, but
it is not saved).
There is also a question what happeneds when one have an empty folder
and switches to wdired buffer. I don't see it handled in old wdired, so
I have added an error condition for that in
wdired-change-to-wdired-mode.
Please test it, there might be some other test condition I haven't
tested. I am attaching both the working file for easy evaluation and
test, and the patch.
best regards
/a
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Lazy-wdired-preprocessing.patch --]
[-- Type: text/x-patch, Size: 11757 bytes --]
From a0f6a988576c6083b86e3b01e47c4967194e2822 Mon Sep 17 00:00:00 2001
From: Arthur Miller <arthur.miller@live.com>
Date: Tue, 23 Mar 2021 15:38:43 +0100
Subject: [PATCH] Lazy wdired preprocessing.
---
lisp/wdired.el | 191 +++++++++++++++++++++++++++++--------------------
1 file changed, 113 insertions(+), 78 deletions(-)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 43026d4bb7..b1ba815a68 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,25 @@ 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)
+ ;;(advice-add 'self-insert-command :around #'wdired--self-insert-advice)
(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 +276,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 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)
+ (when wdired-allow-to-change-permissions
+ (wdired--preprocess-perms beg))
+ (when (fboundp 'make-symbolic-link)
+ (wdired--preprocess-symlinks beg)))
+ (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 (beg)
(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) '("." ".."))))
@@ -287,19 +327,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 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)
@@ -362,7 +399,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 +415,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 +740,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)
+ (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.
@@ -822,34 +858,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 (beg)
+ (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
[-- Attachment #3: lazy-wdired.el --]
[-- Type: text/plain, Size: 8778 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)
;;(advice-add 'self-insert-command :around #'wdired--self-insert-advice)
(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--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)
(when wdired-allow-to-change-permissions
(wdired--preprocess-perms beg))
(when (fboundp 'make-symbolic-link)
(wdired--preprocess-symlinks beg)))
(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--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)))
;; 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)
(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)))))))
(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 (beg)
(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)
(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)))))))
(provide 'lazy-wdired)
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2021-03-23 14:52 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-03-23 14:52 Patch: Lazy wdired preprocessing 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).