procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Teach VC-Dir to automatically add and remove marks on other lines

Browse source 
* 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.
This commit is contained in:
Sean Whitton 2025-04-06 11:18:57 +08:00
parent c0b1b54d73
commit 936b2efdb3
2 changed files with 125 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
etc/NEWS
View file

@ -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
+++

146
lisp/vc/vc-dir.el
View file

@ -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-mode-map>\\[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))))