diff options
Diffstat (limited to 'lisp/vc/vc-hooks.el')
| -rw-r--r-- | lisp/vc/vc-hooks.el | 209 |
1 files changed, 129 insertions, 80 deletions
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index bf4c87034fa..8f212e96933 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -87,6 +87,11 @@ "Face for VC modeline state when the file is edited." :version "25.1") +(defface vc-ignored-state + '((default :inherit vc-state-base)) + "Face for VC modeline state when the file is registered, but ignored." + :version "30.1") + ;; Customization Variables (the rest is in vc.el) (defcustom vc-ignore-dir-regexp @@ -147,8 +152,12 @@ visited and a warning displayed." (defcustom vc-display-status t "If non-nil, display revision number and lock status in mode line. -Otherwise, not displayed." - :type 'boolean +If nil, only the backend name is displayed. When the value +is `no-backend', then no backend name is displayed before the +revision number and lock status." + :type '(choice (const :tag "Show only revision/status" no-backend) + (const :tag "Show backend and revision/status" t) + (const :tag "Show only backend name" nil)) :group 'vc) @@ -176,8 +185,9 @@ Otherwise, not displayed." "Version Control minor mode. This minor mode is automatically activated whenever you visit a file under control of one of the revision control systems in `vc-handled-backends'. -VC commands are globally reachable under the prefix `\\[vc-prefix-map]': -\\{vc-prefix-map}") +VC commands are globally reachable under the prefix \\[vc-prefix-map]: +\\{vc-prefix-map}" + nil) (defmacro vc-error-occurred (&rest body) `(condition-case nil (progn ,@body nil) (error t))) @@ -188,7 +198,7 @@ VC commands are globally reachable under the prefix `\\[vc-prefix-map]': ;; during any subsequent VC operations, and forget them when ;; the buffer is killed. -(defvar vc-file-prop-obarray (make-vector 17 0) +(defvar vc-file-prop-obarray (obarray-make 17) "Obarray for per-file properties.") (defvar vc-touched-properties nil) @@ -316,31 +326,37 @@ This function performs the check each time it is called. To rely on the result of a previous call, use `vc-backend' instead. If the file was previously registered under a certain backend, then that backend is tried first." - (let (handler) - (cond - ((and (file-name-directory file) - (string-match vc-ignore-dir-regexp (file-name-directory file))) - nil) - ((and (boundp 'file-name-handler-alist) - (setq handler (find-file-name-handler file 'vc-registered))) - ;; handler should set vc-backend and return t if registered - (funcall handler 'vc-registered file)) - (t - ;; There is no file name handler. - ;; Try vc-BACKEND-registered for each handled BACKEND. - (catch 'found - (let ((backend (vc-file-getprop file 'vc-backend))) - (mapc - (lambda (b) - (and (vc-call-backend b 'registered file) - (vc-file-setprop file 'vc-backend b) - (throw 'found t))) - (if (or (not backend) (eq backend 'none)) - vc-handled-backends - (cons backend vc-handled-backends)))) - ;; File is not registered. - (vc-file-setprop file 'vc-backend 'none) - nil))))) + ;; Subprocesses (and with them, VC backends) can't run from /contents + ;; or /actions, which are fictions maintained by Emacs that do not + ;; exist in the filesystem. + (if (and (eq system-type 'android) + (string-match-p "/\\(content\\|assets\\)[/$]" + (expand-file-name file))) + nil + (let (handler) + (cond + ((and (file-name-directory file) + (string-match vc-ignore-dir-regexp (file-name-directory file))) + nil) + ((setq handler (find-file-name-handler file 'vc-registered)) + ;; handler should set vc-backend and return t if registered + (funcall handler 'vc-registered file)) + (t + ;; There is no file name handler. + ;; Try vc-BACKEND-registered for each handled BACKEND. + (catch 'found + (let ((backend (vc-file-getprop file 'vc-backend))) + (mapc + (lambda (b) + (and (vc-call-backend b 'registered file) + (vc-file-setprop file 'vc-backend b) + (throw 'found t))) + (if (or (not backend) (eq backend 'none)) + vc-handled-backends + (cons backend vc-handled-backends)))) + ;; File is not registered. + (vc-file-setprop file 'vc-backend 'none) + nil)))))) (defun vc-backend (file-or-list) "Return the version control type of FILE-OR-LIST, nil if it's not registered. @@ -348,15 +364,22 @@ If the argument is a list, the files must all have the same back end." ;; `file' can be nil in several places (typically due to the use of ;; code like (vc-backend buffer-file-name)). (cond ((stringp file-or-list) - (let ((property (vc-file-getprop file-or-list 'vc-backend))) - ;; Note that internally, Emacs remembers unregistered - ;; files by setting the property to `none'. - (cond ((eq property 'none) nil) - (property) - ;; vc-registered sets the vc-backend property - (t (if (vc-registered file-or-list) - (vc-file-getprop file-or-list 'vc-backend) - nil))))) + ;; Subprocesses (and with them, VC backends) can't run from + ;; /contents or /actions, which are fictions maintained by + ;; Emacs that do not exist in the filesystem. + (if (and (eq system-type 'android) + (string-match-p "/\\(content\\|assets\\)[/$]" + (expand-file-name file-or-list))) + nil + (let ((property (vc-file-getprop file-or-list 'vc-backend))) + ;; Note that internally, Emacs remembers unregistered + ;; files by setting the property to `none'. + (cond ((eq property 'none) nil) + (property) + ;; vc-registered sets the vc-backend property + (t (if (vc-registered file-or-list) + (vc-file-getprop file-or-list 'vc-backend) + nil)))))) ((and file-or-list (listp file-or-list)) (vc-backend (car file-or-list))) (t @@ -498,6 +521,18 @@ If FILE is not registered, this function always returns nil." (vc-call-backend backend 'working-revision file)))))) +(defvar vc-use-short-revision nil + "If non-nil, VC backend functions should return short revisions if possible. +This is set to t when calling `vc-short-revision', which will +then call the \\=`working-revision' backend function.") + +(defun vc-short-revision (file &optional backend) + "Return the repository version for FILE in a shortened form. +If FILE is not registered, this function always returns nil." + (let ((vc-use-short-revision t)) + (vc-call-backend (or backend (vc-backend file)) + 'working-revision file))) + (defun vc-default-registered (backend file) "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." (let ((sym (vc-make-backend-sym backend 'master-templates))) @@ -701,6 +736,50 @@ If BACKEND is passed use it as the VC backend when computing the result." (force-mode-line-update) backend) +(defun vc-mode-line-state (state) + "Return a list of data to display on the mode line. +The argument STATE should contain the version control state returned +from `vc-state'. The returned list includes three elements: the echo +string, the face name, and the indicator that usually is one character." + (let (state-echo face indicator) + (cond ((or (eq state 'up-to-date) + (eq state 'needs-update)) + (setq state-echo "Up to date file") + (setq face 'vc-up-to-date-state) + (setq indicator "-")) + ((stringp state) + (setq state-echo (concat "File locked by" state)) + (setq face 'vc-locked-state) + (setq indicator (concat ":" state ":"))) + ((eq state 'added) + (setq state-echo "Locally added file") + (setq face 'vc-locally-added-state) + (setq indicator "@")) + ((eq state 'conflict) + (setq state-echo "File contains conflicts after the last merge") + (setq face 'vc-conflict-state) + (setq indicator "!")) + ((eq state 'removed) + (setq state-echo "File removed from the VC system") + (setq face 'vc-removed-state) + (setq indicator "!")) + ((eq state 'missing) + (setq state-echo "File tracked by the VC system, but missing from the file system") + (setq face 'vc-missing-state) + (setq indicator "?")) + ((eq state 'ignored) + (setq state-echo "File tracked by the VC system, but ignored") + (setq face 'vc-ignored-state) + (setq indicator "!")) + (t + ;; Not just for the 'edited state, but also a fallback + ;; for all other states. Think about different symbols + ;; for 'needs-update and 'needs-merge. + (setq state-echo "Locally modified file") + (setq face 'vc-edited-state) + (setq indicator ":"))) + (list state-echo face indicator))) + (defun vc-default-mode-line-string (backend file) "Return a string for `vc-mode-line' to put in the mode line for FILE. Format: @@ -713,47 +792,17 @@ Format: \"BACKEND?REV\" if the file is under VC, but is missing This function assumes that the file is registered." - (let* ((backend-name (symbol-name backend)) - (state (vc-state file backend)) - (state-echo nil) - (face nil) - (rev (vc-working-revision file backend))) - (propertize - (cond ((or (eq state 'up-to-date) - (eq state 'needs-update)) - (setq state-echo "Up to date file") - (setq face 'vc-up-to-date-state) - (concat backend-name "-" rev)) - ((stringp state) - (setq state-echo (concat "File locked by" state)) - (setq face 'vc-locked-state) - (concat backend-name ":" state ":" rev)) - ((eq state 'added) - (setq state-echo "Locally added file") - (setq face 'vc-locally-added-state) - (concat backend-name "@" rev)) - ((eq state 'conflict) - (setq state-echo "File contains conflicts after the last merge") - (setq face 'vc-conflict-state) - (concat backend-name "!" rev)) - ((eq state 'removed) - (setq state-echo "File removed from the VC system") - (setq face 'vc-removed-state) - (concat backend-name "!" rev)) - ((eq state 'missing) - (setq state-echo "File tracked by the VC system, but missing from the file system") - (setq face 'vc-missing-state) - (concat backend-name "?" rev)) - (t - ;; Not just for the 'edited state, but also a fallback - ;; for all other states. Think about different symbols - ;; for 'needs-update and 'needs-merge. - (setq state-echo "Locally modified file") - (setq face 'vc-edited-state) - (concat backend-name ":" rev))) - 'face face - 'help-echo (concat state-echo " under the " backend-name - " version control system")))) + (pcase-let* ((backend-name (symbol-name backend)) + (state (vc-state file backend)) + (rev (vc-working-revision file backend)) + (`(,state-echo ,face ,indicator) + (vc-mode-line-state state)) + (state-string (concat (unless (eq vc-display-status 'no-backend) + backend-name) + indicator rev))) + (propertize state-string 'face face 'help-echo + (concat state-echo " under the " backend-name + " version control system")))) (defun vc-follow-link () "If current buffer visits a symbolic link, visit the real file. |