mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 08:43:40 -07:00
Code Issues Projects Releases Wiki Activity

Show "committing" pseudo-state in VC-Dir during an async checkin

Browse source 
* lisp/vc/vc-dir.el (vc-dir-fileinfo): New 'display-state'
field.
(vc-dir-update): Use it.
(vc-default-dir-printer):
* lisp/vc/vc-git.el (vc-git-dir-printer): Use it.  Fontify a
display state of "committing" as vc-dir-status-warning.
* lisp/vc/vc-hooks.el (vc--file-getinheprop): New function.
* lisp/vc/vc.el (vc-checkin): Set "committing" display state on
items we are checking in asynchronously.
This commit is contained in:
Sean Whitton 2026-02-20 11:37:34 +00:00
parent 027a33f81b
commit 0903fe3ac0
4 changed files with 79 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -115,13 +115,15 @@ See `run-hooks'."
(:conc-name vc-dir-fileinfo->))
name ;Keep it as first, for `member'.
state
;; For storing backend specific information.
;; For storing backend-specific information.
extra
marked
;; To keep track of not updated files during a global refresh
needs-update
;; To distinguish files and directories.
directory)
directory
;; Pseudo-states for display only.
display-state)
(defvar vc-ewoc nil)
@ -553,6 +555,8 @@ Also update some VC file properties from ENTRIES."
(if (nth 1 entry)
(progn
(setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
(setf (vc-dir-fileinfo->display-state (ewoc-data node))
(vc--file-getinheprop nodefile 'display-state))
(setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
(setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
(ewoc-invalidate vc-ewoc node))
@ -1665,21 +1669,25 @@ These are the commands available for use in the file status buffer:
;; function. Changes here might need to be reflected in the
;; vc-BACKEND-dir-printer functions.
(let* ((isdir (vc-dir-fileinfo->directory fileentry))
(state (if isdir "" (vc-dir-fileinfo->state fileentry)))
(filename (vc-dir-fileinfo->name fileentry)))
(display-state (cond (isdir "")
((vc-dir-fileinfo->display-state fileentry))
((vc-dir-fileinfo->state fileentry))))
(filename (vc-dir-fileinfo->name fileentry)))
(insert
(propertize
(format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
'face 'vc-dir-mark-indicator)
" "
(propertize
(format "%-20s" state)
(format "%-20s" display-state)
'face (cond
((eq state 'up-to-date) 'vc-dir-status-up-to-date)
((memq state '(missing conflict needs-update unlocked-changes))
'vc-dir-status-warning)
((eq state 'ignored) 'vc-dir-status-ignored)
(t 'vc-dir-status-edited))
((eq display-state 'up-to-date) 'vc-dir-status-up-to-date)
((member display-state
'(missing conflict needs-update unlocked-changes
"committing"))
'vc-dir-status-warning)
((eq display-state 'ignored) 'vc-dir-status-ignored)
(t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
" "

16
lisp/vc/vc-git.el
View file

@ -544,7 +544,10 @@ or an empty string if none."
(defun vc-git-dir-printer (info)
"Pretty-printer for the vc-dir-fileinfo structure."
(let* ((isdir (vc-dir-fileinfo->directory info))
(state (if isdir "" (vc-dir-fileinfo->state info)))
(state (if isdir "" (vc-dir-fileinfo->state info)))
(display-state (cond (isdir "")
((vc-dir-fileinfo->display-state info))
((vc-dir-fileinfo->state info))))
(extra (vc-dir-fileinfo->extra info))
(old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
(new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
@ -554,10 +557,13 @@ or an empty string if none."
'face 'vc-dir-mark-indicator)
" "
(propertize
(format "%-12s" state)
'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
((memq state '(missing conflict)) 'vc-dir-status-warning)
((eq state 'ignored) 'vc-dir-status-ignored)
(format "%-12s" display-state)
'face (cond ((eq display-state 'up-to-date)
'vc-dir-status-up-to-date)
((member display-state '(missing conflict "committing"))
'vc-dir-status-warning)
((eq display-state 'ignored)
'vc-dir-status-ignored)
(t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)

15
lisp/vc/vc-hooks.el
View file

@ -253,6 +253,21 @@ VC commands are globally reachable under the prefix \\[vc-prefix-map]:
"Get per-file VC PROPERTY for FILE."
(get (intern (expand-file-name file) vc-file-prop-obarray) property))
(defun vc--file-getinheprop (file property)
"Get VC PROPERTY for FILE, including inherited properties.
An inherited property is a property of a directory containing FILE.
(The property must have been set on the file name of the directory
interpreted as a directory, i.e., passing the result of calling
`file-name-as-directory' on the file name to `vc-file-setprop'.)
Properties of FILE itself override any inherited properties, and
properties further down the directory hierarchy override ones higher up."
(or (vc-file-getprop file property)
(catch 'done
(locate-dominating-file file
(lambda (f)
(and-let* ((v (vc-file-getprop f property)))
(throw 'done v)))))))
(defun vc-file-clearprops (file)
"Clear all VC properties of FILE."
(if (boundp 'vc-parent-buffer)

61
lisp/vc/vc.el
View file

@ -2192,32 +2192,41 @@ have changed; continue with old fileset?" (current-buffer))))
;; NOQUERY parameter non-nil.
(vc-buffer-sync-fileset (list backend files)))
(when register (vc-register (list backend register)))
(cl-flet ((do-it ()
;; We used to change buffers to get local value of
;; `vc-checkin-switches', but the (singular) local
;; buffer is not well defined for filesets.
(prog1 (if patch-string
(vc-call-backend backend 'checkin-patch
patch-string comment)
(vc-call-backend backend 'checkin
files comment rev))
(mapc #'vc-delete-automatic-version-backups files)))
(done-msg ()
(message "Checking in %s...done" (vc-delistify files))))
(if do-async
;; Rely on `vc-set-async-update' to update properties.
(let ((ret (do-it)))
(when (eq (car-safe ret) 'async)
(vc-exec-after #'done-msg nil (cadr ret)))
ret)
(prog2 (message "Checking in %s..." (vc-delistify files))
(with-vc-properties files (do-it)
`((vc-state . up-to-date)
(vc-checkout-time
. ,(file-attribute-modification-time
(file-attributes file)))
(vc-working-revision . nil)))
(done-msg)))))
(let (to-remove-props)
(cl-flet ((do-it ()
;; We used to change buffers to get local value of
;; `vc-checkin-switches', but the (singular) local
;; buffer is not well defined for filesets.
(prog1 (if patch-string
(vc-call-backend backend 'checkin-patch
patch-string comment)
(vc-call-backend backend 'checkin
files comment rev))
(mapc #'vc-delete-automatic-version-backups files)))
(remove-props-done-msg ()
(dolist (file to-remove-props)
(vc-file-setprop file 'display-state nil))
(message "Checking in %s...done" (vc-delistify files))))
(if do-async
;; Rely on `vc-set-async-update' to update properties
;; other than the display-only `display-state' property.
(let ((ret (do-it)))
(when (eq (car-safe ret) 'async)
(dolist (file files)
(let ((file (expand-file-name file)))
(vc-file-setprop file 'display-state "committing")
(vc-dir-resynch-file file)
(push file to-remove-props)))
(vc-exec-after #'remove-props-done-msg nil (cadr ret)))
ret)
(prog2 (message "Checking in %s..." (vc-delistify files))
(with-vc-properties files (do-it)
`((vc-state . up-to-date)
(vc-checkout-time
. ,(file-attribute-modification-time
(file-attributes file)))
(vc-working-revision . nil)))
(remove-props-done-msg))))))
'vc-checkin-hook
backend
patch-string)))