From 936b2efdb389488d291086d5c2189fd1a7170aa6 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 6 Apr 2025 11:18:57 +0800 Subject: [PATCH] Teach VC-Dir to automatically add and remove marks on other lines * lisp/vc/vc-dir.el (vc-dir-allow-mass-mark-changes): New option. (vc-dir-parent-marked-p): Replace with ... (vc-dir--parent): ... this. (vc-dir-children-marked-p): Replace with ... (vc-dir--children): ... this. (vc-dir-mark-file): Unmark subitems before marking a directory. Offer to unmark a directory before marking a subitem. (vc-dir-unmark-file): For an implicitly marked item, offer to unmark it by marking everything else that's implicitly marked. For an unmarked directory with marked subitems, offer to unmark them all. * etc/NEWS: Document the changes. --- etc/NEWS | 11 ++++ lisp/vc/vc-dir.el | 146 ++++++++++++++++++++++++++++++++++++---------- 2 files changed, 125 insertions(+), 32 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 61474af7fcb..35e6edcd712 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1489,6 +1489,17 @@ its default value. Effectively, the default value hasn't changed, since 'vc-resolve-conflicts' defaults to t, the previous default value for 'vc-git-resolve-conflicts'. +--- +*** VC-Dir can now automatically add and remove marks on other lines. +When you try to use a mark or unmark command where doing so would only +be permitted if other lines were marked or unmarked first, Emacs +will now ask you if you'd like to change the marks on those other lines. +For example, if you try to mark a file contained within a directory that +is already marked, Emacs will offer to unmark the directory, first. +Previously, Emacs would simply refuse to make any changes. +You can customize 'vc-dir-allow-mass-mark-changes' to restore the old +behavior or dispense with the prompting. + ** Diff mode +++ diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 93c11fdbc68..1074986090e 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -126,6 +126,38 @@ See `run-hooks'." (defvar vc-dir-backend nil "The backend used by the current *vc-dir* buffer.") +(defcustom vc-dir-allow-mass-mark-changes 'ask + "If non-nil, VC-Dir commands may mark or unmark many items at once. + +When a directory in VC-Dir is marked, then for most VCS, this means that +all files within it are implicitly marked as well. +For consistency, the mark and unmark commands (principally \\\\[vc-dir-mark] and \\[vc-dir-unmark]) will +not explicitly mark or unmark entries if doing so would result in a +situation where both a directory and a file or directory within it are +both marked. + +With the default value of this variable, `ask', if you attempt to mark +or unmark a particular item and doing so consistent with these +restrictions would require other items to be marked or unmarked too, +Emacs will prompt you to confirm that you do mean for the other items to +be marked or unmarked. + +If this variable is nil, the commands will refuse to do anything if they +would need to mark or unmark other entries too. +If this variable is any other non-nil value, the commands will always +proceed to mark and unmark other entries, without asking. + +There is one operation where marking or unmarking other entries in order +to mark or unmark the entry at point is unlikely to be surprising: +when you use \\[vc-dir-mark] on a directory which already has marked items within it. +In this case, the subitems are unmarked regardless of the value of this +option." + :type '(choice (const :tag "Don't allow" nil) + (const :tag "Prompt to allow" ask) + (const :tag "Allow without prompting" t)) + :group 'vc + :version "31.1") + (defun vc-dir-move-to-goal-column () ;; Used to keep the cursor on the file name column. (beginning-of-line) @@ -640,9 +672,9 @@ With prefix argument ARG, move that many lines." (error (vc-dir-next-line 1)))))) (funcall mark-unmark-function))) -(defun vc-dir-parent-marked-p (arg) - ;; Non-nil iff a parent directory of arg is marked. - ;; Return value, if non-nil is the `ewoc-data' for the marked parent. +(defun vc-dir--parent (arg &optional if-marked) + "Return the parent node of ARG. +If IF-MARKED, return the nearest marked parent." (let* ((argdir (vc-dir-node-directory arg)) ;; (arglen (length argdir)) (crt arg) @@ -655,46 +687,58 @@ With prefix argument ARG, move that many lines." (dir (vc-dir-node-directory crt))) (and (vc-dir-fileinfo->directory data) (string-prefix-p dir argdir) - (vc-dir-fileinfo->marked data) - (setq found data)))) + (or (not if-marked) (vc-dir-fileinfo->marked data)) + (setq found crt)))) found)) -(defun vc-dir-children-marked-p (arg) - ;; Non-nil iff a child of ARG is marked. - ;; Return value, if non-nil, is the `ewoc-data' for the marked child. - (let* ((argdir-re (concat "\\`" (regexp-quote (vc-dir-node-directory arg)))) +(defun vc-dir--children (arg &optional only-marked) + "Return a list of children of ARG. If ONLY-MARKED, only those marked." + (let* ((argdir-re (concat "\\`" + (regexp-quote (vc-dir-node-directory arg)))) (is-child t) (crt arg) (found nil)) (while (and is-child - (null found) (setq crt (ewoc-next vc-ewoc crt))) - (let ((data (ewoc-data crt)) - (dir (vc-dir-node-directory crt))) - (if (string-match argdir-re dir) - (if (vc-dir-fileinfo->marked data) - (setq found data)) - ;; We are done, we got to an entry that is not a child of `arg'. - (setq is-child nil)))) + (if (string-match argdir-re (vc-dir-node-directory crt)) + (when (or (not only-marked) + (vc-dir-fileinfo->marked (ewoc-data crt))) + (push crt found)) + ;; We are done, we got to an entry that is not a child of `arg'. + (setq is-child nil))) found)) (defun vc-dir-mark-file (&optional arg) ;; Mark ARG or the current file and move to the next line. (let* ((crt (or arg (ewoc-locate vc-ewoc))) (file (ewoc-data crt)) - (isdir (vc-dir-fileinfo->directory file)) - ;; Forbid marking a directory containing marked files in its - ;; tree, or a file or directory in a marked directory tree. - (child-conflict (and isdir (vc-dir-children-marked-p crt))) - (parent-conflict (vc-dir-parent-marked-p crt))) - (when (or child-conflict parent-conflict) - (error (if child-conflict - "Entry `%s' in this directory is already marked" - "Parent directory `%s' is already marked") - (vc-dir-fileinfo->name (or child-conflict - parent-conflict)))) + (to-inval (list crt))) + ;; We do not allow a state in which a directory is marked and also + ;; some of its files are marked. If the user's intent is clear, + ;; adjust things for them so that they can proceed. + (if-let* (((vc-dir-fileinfo->directory file)) + (children (vc-dir--children crt t))) + ;; The user wants to mark a directory where some of its children + ;; are already marked. The user's intent is quite clear, so + ;; unconditionally unmark the children. + (dolist (child children) + (setf (vc-dir-fileinfo->marked (ewoc-data child)) nil) + (push child to-inval)) + (when-let* ((parent (vc-dir--parent crt t)) + (name (vc-dir-fileinfo->name (ewoc-data parent)))) + ;; The user seems to want to mark an entry whose directory is + ;; already marked. As the file is already implicitly marked for + ;; most VCS, they may not really intend this. + (when (or (not vc-dir-allow-mass-mark-changes) + (and (eq vc-dir-allow-mass-mark-changes 'ask) + (not (yes-or-no-p + (format "`%s' is already marked; unmark it?" + name))))) + (error "`%s' is already marked" name)) + (setf (vc-dir-fileinfo->marked (ewoc-data parent)) nil) + (push parent to-inval))) (setf (vc-dir-fileinfo->marked file) t) - (ewoc-invalidate vc-ewoc crt) + (apply #'ewoc-invalidate vc-ewoc to-inval) (unless (or arg (mouse-event-p last-command-event)) (vc-dir-next-line 1)))) @@ -816,9 +860,47 @@ Directories must have trailing slashes." (defun vc-dir-unmark-file () ;; Unmark the current file and move to the next line. (let* ((crt (ewoc-locate vc-ewoc)) - (file (ewoc-data crt))) - (setf (vc-dir-fileinfo->marked file) nil) - (ewoc-invalidate vc-ewoc crt) + (file (ewoc-data crt)) + to-inval) + (if (vc-dir-fileinfo->marked file) + (progn (setf (vc-dir-fileinfo->marked file) nil) + (push crt to-inval)) + ;; The current item is not explicitly marked, but its containing + ;; directory is marked. So this item is implicitly marked, for + ;; most VCS. Offer to change that. + (if-let* ((parent (vc-dir--parent crt t)) + (all-children (vc-dir--children parent))) + (when (and vc-dir-allow-mass-mark-changes + (or (not (eq vc-dir-allow-mass-mark-changes 'ask)) + (yes-or-no-p + (format "\ +Replace mark on `%s' with marks on all subitems but this one?" + (vc-dir-fileinfo->name file))))) + (let ((subtree (if (vc-dir-fileinfo->directory file) + (cons crt (vc-dir--children crt)) + (list crt (vc-dir--parent crt))))) + (setf (vc-dir-fileinfo->marked (ewoc-data parent)) nil) + (push parent to-inval) + (dolist (child all-children) + (setf (vc-dir-fileinfo->marked (ewoc-data child)) + (not (memq child subtree))) + (push child to-inval)))) + ;; The current item is a directory that's not marked, implicitly + ;; or explicitly, but it has marked items below it. + ;; Offer to unmark those. + (when-let* + (((vc-dir-fileinfo->directory file)) + (children (vc-dir--children crt t)) + ((and vc-dir-allow-mass-mark-changes + (or (not (eq vc-dir-allow-mass-mark-changes 'ask)) + (yes-or-no-p + (format "Unmark all items within `%s'?" + (vc-dir-fileinfo->name file))))))) + (dolist (child children) + (setf (vc-dir-fileinfo->marked (ewoc-data child)) nil) + (push child to-inval))))) + (when to-inval + (apply #'ewoc-invalidate vc-ewoc to-inval)) (unless (mouse-event-p last-command-event) (vc-dir-next-line 1))))