From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Arthur Miller Newsgroups: gmane.emacs.devel Subject: [PATCH] Lazy wdired preprocessing Date: Thu, 25 Mar 2021 17:06:36 +0100 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="39786"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu Mar 25 17:24:40 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 1lPSmk-000A8e-8b for ged-emacs-devel@m.gmane-mx.org; Thu, 25 Mar 2021 17:24:38 +0100 Original-Received: from localhost ([::1]:54776 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lPSmj-00008x-9O for ged-emacs-devel@m.gmane-mx.org; Thu, 25 Mar 2021 12:24:37 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:50602) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lPSVY-0003ch-AU for emacs-devel@gnu.org; Thu, 25 Mar 2021 12:06:52 -0400 Original-Received: from mail-db8eur06olkn2097.outbound.protection.outlook.com ([40.92.51.97]:56929 helo=EUR06-DB8-obe.outbound.protection.outlook.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lPSVN-0006Lj-T7 for emacs-devel@gnu.org; Thu, 25 Mar 2021 12:06:48 -0400 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=JFnn1tliu2/9udlebLQCXrhhNIHpIW44i/OC6w0EoUDkbaq7ixknw2EbGvQOghp2R+HrIoqP3aK2a/smn6sdjwVX9hQxwNWqu+CQ1U71ANhDwlpTqvZ86YDwSnmvsiiECDFtlizDj8nO0phTQRRciciYmH3ZSr6arGD7bJ5HIqRXEhXU+2A/kwsYoNZodEtQpDOG8ETWAvz/7+0xtGhcfRB61ZchS2QLS5OCIASJY+W80/boTgfRM9xXjle1WuvzAbhmf8yMTpv0IBLYga4jl5KcJAa3sPB4Trps/ZH5+6joyveTc8lN+IYdEZ2ROfLNyd+tis+EV7f8SPBROXdoTw== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=9qRFCF+KHIC3K8oKHASzWs3N+1G6ATK48NAfoIacgsw=; b=VoGgYz6s31xuqMjH8f210ScwPF1cxTskYfBm/Vy6is9RY1aDmBQsYuTRHX1T+puRzBG23aJWafHs5bxHxgt+hdzllcKw2Q7J5oiVqX6pCokT17yYpnAWeJIIA6/MP0czj8xaz4VVXmps1tNMz5NWkhiO7c2NgrHWJPm/TpqmSEAeYC+Nz8P02Cqow3DRVfCC7dWfIWmDL6RtQdkIkgY2Y4Aw/LTZNZn7wtC7sjw2pU5aPQvxhTuTvp8mgtECGKzP06Ifno6XlmVtR4+N+TDN6PJULOJp4PyI2UcgDakSXLx01TN2Rg55ZoqcxM4AigIk/ZSD1XcfztlpdklvIC3WhA== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=none; dmarc=none; dkim=none; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=live.com; s=selector1; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=9qRFCF+KHIC3K8oKHASzWs3N+1G6ATK48NAfoIacgsw=; b=AzfDbLaxQ2x1HNZLfW8lEav2UizaEEqxPoMYMz0vDHOV0eDuUuIvus6MK/DALZqIcrK4rnhc8igpiOLs3W5zodDtEMGTcllfzwt5N0tCOmKpqKDNPytNNgZLY7hwMlnRqNyehByUs6aUYl6VtQCA7qTX+vY3Y1T2kUdhY5gWciVvr2XY/2IXyPHL9LdsAcL0aGMDS1ha7rSlp2GFV4sRUZ2lO00kRjKpJ3fYNpfiLN3s2gVy42xzJMErSKx8jrJ0ZV8YsRtrTOLynaUIcS21zfHTYDp/G1ajeu7Sd4LLahxTtbQPpRnIAGZsEhslCKNmWVTU9Xj3fpQ4F3sGT7Ak+g== Original-Received: from AM7EUR06FT045.eop-eur06.prod.protection.outlook.com (2a01:111:e400:fc36::4b) by AM7EUR06HT194.eop-eur06.prod.protection.outlook.com (2a01:111:e400:fc36::398) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.3977.25; Thu, 25 Mar 2021 16:06:37 +0000 Original-Received: from AM9PR09MB4977.eurprd09.prod.outlook.com (2a01:111:e400:fc36::49) by AM7EUR06FT045.mail.protection.outlook.com (2a01:111:e400:fc36::383) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.3977.25 via Frontend Transport; Thu, 25 Mar 2021 16:06:37 +0000 X-IncomingTopHeaderMarker: OriginalChecksum:5523BB0C5BB8826CD2D054F4A817EEAD826B4F8E8AFCF4432B2DB32A591BD4D5; UpperCasedChecksum:F99D17522F5B94A6DE6EBDE2EE97C71757282227C2B899FAC35FA498BD3FA806; SizeAsReceived:7203; Count:43 Original-Received: from AM9PR09MB4977.eurprd09.prod.outlook.com ([fe80::2103:e705:bc0c:5a8b]) by AM9PR09MB4977.eurprd09.prod.outlook.com ([fe80::2103:e705:bc0c:5a8b%6]) with mapi id 15.20.3977.025; Thu, 25 Mar 2021 16:06:37 +0000 X-TMN: [VSeTFMT9jTli47LXrQJxV69wAdepHEaN] X-ClientProxiedBy: AM6PR10CA0034.EURPRD10.PROD.OUTLOOK.COM (2603:10a6:209:89::47) To AM9PR09MB4977.eurprd09.prod.outlook.com (2603:10a6:20b:304::20) X-Microsoft-Original-Message-ID: <87ft0jdxpv.fsf@live.com> X-MS-Exchange-MessageSentRepresentingType: 1 Original-Received: from pascal.homepc (90.230.29.56) by AM6PR10CA0034.EURPRD10.PROD.OUTLOOK.COM (2603:10a6:209:89::47) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.3977.25 via Frontend Transport; Thu, 25 Mar 2021 16:06:37 +0000 X-MS-PublicTrafficType: Email X-IncomingHeaderCount: 43 X-EOPAttributedMessage: 0 X-MS-Office365-Filtering-Correlation-Id: 7e42e63f-b69f-4299-a49e-08d8efa7f81e X-MS-TrafficTypeDiagnostic: AM7EUR06HT194: X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: xoZZUkWfu4u6Q09mdB+Fxjqyr7ojeRpHMb4YYF8Iah0GJbCxqHmRcvn1MItWEC8gXqzqYrMxT3p3uHBeuCYwFGKFUhkAYfk2l/DZRRsCBgvRGAwayfo4zijVGFTXcxmoYo6lEN5XhaORQD2iGvtlDXH3OyLbp0jTKitASFc50+59L+rKzcSLwxPKYSZ2oT3bxIESmG3Ty6N71KacXUx5DG1XLqqOlOo/vNnLhlr6CLw/pXc6zXIZyrY3yymv8YxVjkbhNS3BaKpxa3MaaCK8o4Oj+BNAywXcC90N+yQNiujFH0AW2ml6jDUMaJo2d+22xFdbwvOOvHtYHE/ZObla4dXoVSTv/WDMYmopd/q5bQHCdjZ78FPCdCK5779s6x5I X-MS-Exchange-AntiSpam-MessageData: T9U6iH4mH+aYGp+LmvLNOQznv1gYKxAphyOnQWMlO4bYLyZDHzjugUzJJLoW4ObtYXyqpgieFl2GPvAAmlwxtX5hS8jwixkg8WvmpaaxBxcYWPtg57FLTyCkBbmc7QMRlBw0ib2laBXLJJwDkZWb9Q== X-OriginatorOrg: live.com X-MS-Exchange-CrossTenant-Network-Message-Id: 7e42e63f-b69f-4299-a49e-08d8efa7f81e X-MS-Exchange-CrossTenant-OriginalArrivalTime: 25 Mar 2021 16:06:37.7107 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: 84df9e7f-e9f6-40af-b435-aaaaaaaaaaaa X-MS-Exchange-CrossTenant-AuthSource: AM7EUR06FT045.eop-eur06.prod.protection.outlook.com X-MS-Exchange-CrossTenant-AuthAs: Anonymous X-MS-Exchange-CrossTenant-FromEntityHeader: Internet X-MS-Exchange-CrossTenant-RMS-PersistedConsumerOrg: 00000000-0000-0000-0000-000000000000 X-MS-Exchange-Transport-CrossTenantHeadersStamped: AM7EUR06HT194 Received-SPF: pass client-ip=40.92.51.97; envelope-from=arthur.miller@live.com; helo=EUR06-DB8-obe.outbound.protection.outlook.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, MSGID_FROM_MTA_HEADER=0.001, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_PASS=-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:267030 Archived-At: --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Lazy-wdired-preprocessing.patch >From 6ee3ce6cb3c2ed442ecc32d59ff47f0ff4e5a4d1 Mon Sep 17 00:00:00 2001 From: Arthur Miller 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=lazy-wdired.el ;;; lazy-wdired.el --- -*- lexical-binding: t; -*- ;; Copyright (C) 2020 Arthur Miller ;; Author: Arthur Miller ;; 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 . ;;; 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. \\ 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) --=-=-=--