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

Refine use of vc-dir faces; apply to all backends

Browse source 
* lisp/vc/vc-dir.el (vc-default-dir-printer): Add check for the
"ignored" status and make 'vc-dir-status-edited' the default face.
Also extend condition for more states that qualify as "warnings".

(vc-dir-ignored, vc-dir-status-ignored): Rename face for consistency.

* lisp/vc/vc-git.el (vc-git-dir-printer): Use the
'vc-dir-status-edited' as the default for the Git backend.  And
reference the renamed face.  Also stop treating the empty stash
differently from other header values.

* lisp/vc/vc-bzr.el (vc-bzr-dir-extra-headers): Implement new faces.
* lisp/vc/vc-cvs.el (vc-cvs-dir-extra-headers): Same.
* lisp/vc/vc-hg.el (vc-hg-dir-extra-headers): Same.
* lisp/vc/vc-svn.el (vc-svn-dir-extra-headers): Same.

This follows from the discussion in bug#46358.
This commit is contained in:
Protesilaos Stavrou 2021-02-09 06:49:05 +02:00 • committed by Dmitry Gutov
parent bff9bd0d3a
commit ff16c897ea
6 changed files with 35 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
lisp/vc/vc-bzr.el
View file

@ -1076,49 +1076,49 @@ stream. Standard error output is discarded."
(when (string-match ".+checkout of branch: \\(.+\\)$" str)
(match-string 1 str)))))
(concat
(propertize "Parent branch : " 'face 'font-lock-type-face)
(propertize "Parent branch : " 'face 'vc-dir-header)
(propertize
(if (string-match "parent branch: \\(.+\\)$" str)
(match-string 1 str)
"None")
'face 'font-lock-variable-name-face)
'face 'vc-dir-header-value)
"\n"
(when light-checkout
(concat
(propertize "Light checkout root: " 'face 'font-lock-type-face)
(propertize light-checkout 'face 'font-lock-variable-name-face)
(propertize "Light checkout root: " 'face 'vc-dir-header)
(propertize light-checkout 'face 'vc-dir-header-value)
"\n"))
(when light-checkout-branch
(concat
(propertize "Checkout of branch : " 'face 'font-lock-type-face)
(propertize light-checkout-branch 'face 'font-lock-variable-name-face)
(propertize "Checkout of branch : " 'face 'vc-dir-header)
(propertize light-checkout-branch 'face 'vc-dir-header-value)
"\n"))
(when pending-merge
(concat
(propertize "Warning : " 'face 'font-lock-warning-face
(propertize "Warning : " 'face 'vc-dir-status-warning
'help-echo pending-merge-help-echo)
(propertize "Pending merges, commit recommended before any other action"
'help-echo pending-merge-help-echo
'face 'font-lock-warning-face)
'face 'vc-dir-status-warning)
"\n"))
(if shelve
(concat
(propertize "Shelves :\n" 'face 'font-lock-type-face
(propertize "Shelves :\n" 'face 'vc-dir-header
'help-echo shelve-help-echo)
(mapconcat
(lambda (x)
(propertize x
'face 'font-lock-variable-name-face
'face 'vc-dir-header-value
'mouse-face 'highlight
'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf"
'keymap vc-bzr-shelve-map))
shelve "\n"))
(concat
(propertize "Shelves : " 'face 'font-lock-type-face
(propertize "Shelves : " 'face 'vc-dir-header
'help-echo shelve-help-echo)
(propertize "No shelved changes"
'help-echo shelve-help-echo
'face 'font-lock-variable-name-face))))))
'face 'vc-dir-header-value))))))
;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher.
(declare-function vc-resynch-buffer "vc-dispatcher"

18
lisp/vc/vc-cvs.el
View file

@ -1047,29 +1047,29 @@ Query all files in DIR if files is nil."
(file-error nil))))
(concat
(cond (repo
(concat (propertize "Repository : " 'face 'font-lock-type-face)
(propertize repo 'face 'font-lock-variable-name-face)))
(concat (propertize "Repository : " 'face 'vc-dir-header)
(propertize repo 'face 'vc-dir-header-value)))
(t ""))
(cond (module
(concat (propertize "Module : " 'face 'font-lock-type-face)
(propertize module 'face 'font-lock-variable-name-face)))
(concat (propertize "Module : " 'face 'vc-dir-header)
(propertize module 'face 'vc-dir-header-value)))
(t ""))
(if (file-readable-p "CVS/Tag")
(let ((tag (vc-cvs-file-to-string "CVS/Tag")))
(cond
((string-match "\\`T" tag)
(concat (propertize "Tag : " 'face 'font-lock-type-face)
(concat (propertize "Tag : " 'face 'vc-dir-header)
(propertize (substring tag 1)
'face 'font-lock-variable-name-face)))
'face 'vc-dir-header-value)))
((string-match "\\`D" tag)
(concat (propertize "Date : " 'face 'font-lock-type-face)
(concat (propertize "Date : " 'face 'vc-dir-header)
(propertize (substring tag 1)
'face 'font-lock-variable-name-face)))
'face 'vc-dir-header-value)))
(t ""))))
;; In CVS, branch is a per-file property, not a per-directory property.
;; We can't really do this here without making dangerous assumptions.
;;(propertize "Branch: " 'face 'font-lock-type-face)
;;(propertize "Branch: " 'face 'vc-dir-header)
;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
;; 'face 'font-lock-warning-face)
)))

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

@ -86,7 +86,7 @@ See `run-hooks'."
"Face for up-to-date status in VC-dir buffers."
:group 'vc)
(defface vc-dir-ignored '((t :inherit shadow))
(defface vc-dir-status-ignored '((t :inherit shadow))
"Face for ignored or empty values in VC-dir buffers."
:group 'vc)
@ -1454,10 +1454,12 @@ These are the commands available for use in the file status buffer:
" "
(propertize
(format "%-20s" state)
'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
((memq state '(missing conflict)) 'vc-dir-status-warning)
((eq state 'edited) 'font-lock-constant-face)
(t 'vc-dir-header-value))
'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))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
" "

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

@ -479,7 +479,8 @@ or an empty string if none."
(propertize
(format "%-12s" state)
'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
((eq state '(missing conflict)) 'vc-dir-status-warning)
((memq state '(missing conflict)) 'vc-dir-status-warning)
((eq state 'ignored) 'vc-dir-status-ignored)
(t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
@ -835,7 +836,7 @@ or an empty string if none."
(propertize "Nothing stashed"
'help-echo vc-git-stash-shared-help
'keymap vc-git-stash-shared-map
'face 'vc-dir-ignored))))))
'face 'vc-dir-header-value))))))
(defun vc-git-branches ()
"Return the existing branches, as a list of strings.

4
lisp/vc/vc-hg.el
View file

@ -1403,8 +1403,8 @@ This runs the command \"hg summary\"."
(cons (capitalize (match-string 1)) (match-string 2))
(cons "" (buffer-substring (point) (line-end-position))))))
(concat
(propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face)
(propertize (cdr entry) 'face 'font-lock-variable-name-face)))
(propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header)
(propertize (cdr entry) 'face 'vc-dir-header-value)))
result)
(forward-line))
(nreverse result))

4
lisp/vc/vc-svn.el
View file

@ -239,8 +239,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
(concat
(cond (repo
(concat
(propertize "Repository : " 'face 'font-lock-type-face)
(propertize repo 'face 'font-lock-variable-name-face)))
(propertize "Repository : " 'face 'vc-dir-header)
(propertize repo 'face 'vc-dir-header-value)))
(t "")))))
(defun vc-svn-working-revision (file)