diff options
Diffstat (limited to 'lisp/vc/vc-hooks.el')
| -rw-r--r-- | lisp/vc/vc-hooks.el | 243 |
1 files changed, 91 insertions, 152 deletions
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index fb10edca06d..5448f38f042 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -32,6 +32,69 @@ (eval-when-compile (require 'cl-lib)) +;; Faces + +(defgroup vc-state-faces nil + "Faces used in the mode line by the VC state indicator." + :group 'vc-faces + :group 'mode-line + :version "25.1") + +(defface vc-state-base-face + '((default)) + "Base face for VC state indicator." + :group 'vc-faces + :group 'mode-line + :version "25.1") + +(defface vc-up-to-date-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is up to date." + :version "25.1" + :group 'vc-faces) + +(defface vc-needs-update-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file needs update." + :version "25.1" + :group 'vc-faces) + +(defface vc-locked-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file locked." + :version "25.1" + :group 'vc-faces) + +(defface vc-locally-added-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is locally added." + :version "25.1" + :group 'vc-faces) + +(defface vc-conflict-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file contains merge conflicts." + :version "25.1" + :group 'vc-faces) + +(defface vc-removed-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file was removed from the VC system." + :version "25.1" + :group 'vc-faces) + +(defface vc-missing-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is missing from the file system." + :version "25.1" + :group 'vc-faces) + +(defface vc-edited-state + '((default :inherit vc-state-base-face)) + "Face for VC modeline state when the file is up to date." + :version "25.1" + :group 'vc-faces) + ;; Customization Variables (the rest is in vc.el) (defcustom vc-ignore-dir-regexp @@ -44,8 +107,8 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch) - ;; RCS, CVS, SVN and SCCS come first because they are per-dir +(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn) + ;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir ;; rather than per-tree. RCS comes first because of the multibackend ;; support intended to use RCS for local commits (with a remote CVS server). "List of version control backends for which VC will be used. @@ -55,13 +118,14 @@ Removing an entry from the list prevents VC from being activated when visiting a file managed by that backend. An empty list disables VC altogether." :type '(repeat symbol) - :version "23.1" + :version "25.1" :group 'vc) ;; Note: we don't actually have a darcs back end yet. -;; Also, Meta-CVS (corresponding to MCVS) is unsupported. +;; Also, Meta-CVS (corresponding to MCVS) and Arch are unsupported. +;; The Arch back end will be retrieved and fixed if it is ever required. (defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS" - ".svn" ".git" ".hg" ".bzr" + ".src" ".svn" ".git" ".hg" ".bzr" "_MTN" "_darcs" "{arch}")) "List of directory names to be ignored when walking directory trees." :type '(repeat string) @@ -100,87 +164,6 @@ Otherwise, not displayed." :type 'boolean :group 'vc) -(defcustom vc-keep-workfiles t - "Whether to keep work files on disk after commits, on a locking VCS. -This variable has no effect on modern merging-based version -control systems." - :type 'boolean - :group 'vc) - -;; If you fix bug#11490, probably you can set this back to nil. -(defcustom vc-mistrust-permissions t - "If non-nil, don't assume permissions/ownership track version-control status. -If nil, do rely on the permissions. -See also variable `vc-consult-headers'." - :version "24.3" ; nil->t, bug#11490 - :type 'boolean - :group 'vc) - -(defun vc-mistrust-permissions (file) - "Internal access function to variable `vc-mistrust-permissions' for FILE." - (or (eq vc-mistrust-permissions 't) - (and vc-mistrust-permissions - (funcall vc-mistrust-permissions - (vc-backend-subdirectory-name file))))) - -(defcustom vc-stay-local 'only-file - "Non-nil means use local operations when possible for remote repositories. -This avoids slow queries over the network and instead uses heuristics -and past information to determine the current status of a file. - -If value is the symbol `only-file', `vc-dir' will connect to the -server, but heuristics will be used to determine the status for -all other VC operations. - -The value can also be a regular expression or list of regular -expressions to match against the host name of a repository; then VC -only stays local for hosts that match it. Alternatively, the value -can be a list of regular expressions where the first element is the -symbol `except'; then VC always stays local except for hosts matched -by these regular expressions." - :type '(choice - (const :tag "Always stay local" t) - (const :tag "Only for file operations" only-file) - (const :tag "Don't stay local" nil) - (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." - (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) - (regexp :format " stay local,\n%t: %v" :tag "if it matches") - (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) - :version "23.1" - :group 'vc) - -(defun vc-stay-local-p (file &optional backend) - "Return non-nil if VC should stay local when handling FILE. -This uses the `repository-hostname' backend operation. -If FILE is a list of files, return non-nil if any of them -individually should stay local." - (if (listp file) - (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file)) - (setq backend (or backend (vc-backend file))) - (let* ((sym (vc-make-backend-sym backend 'stay-local)) - (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local))) - (if (symbolp stay-local) stay-local - (let ((dirname (if (file-directory-p file) - (directory-file-name file) - (file-name-directory file)))) - (eq 'yes - (or (vc-file-getprop dirname 'vc-stay-local-p) - (vc-file-setprop - dirname 'vc-stay-local-p - (let ((hostname (vc-call-backend - backend 'repository-hostname dirname))) - (if (not hostname) - 'no - (let ((default t)) - (if (eq (car-safe stay-local) 'except) - (setq default nil stay-local (cdr stay-local))) - (when (consp stay-local) - (setq stay-local - (mapconcat 'identity stay-local "\\|"))) - (if (if (string-match stay-local hostname) - default (not default)) - 'yes 'no)))))))))))) - ;;; This is handled specially now. ;; Tell Emacs about this new kind of minor mode ;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode)) @@ -190,6 +173,11 @@ individually should stay local." (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) +;;; We signal this error when we try to do something a VC backend +;;; doesn't support. Two arguments: the method that's not supported +;;; and the backend +(define-error 'vc-not-supported "VC method not implemented for backend") + (defun vc-mode (&optional _arg) ;; Dummy function for C-h m "Version Control minor mode. @@ -268,10 +256,10 @@ It is usually called via the `vc-call' macro." (setq f (vc-find-backend-function backend function-name)) (push (cons function-name f) (get backend 'vc-functions))) (cond - ((null f) - (error "Sorry, %s is not implemented for %s" function-name backend)) - ((consp f) (apply (car f) (cdr f) args)) - (t (apply f args))))) + ((null f) + (signal 'vc-not-supported (list function-name backend))) + ((consp f) (apply (car f) (cdr f) args)) + (t (apply f args))))) (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. @@ -386,19 +374,6 @@ If the argument is a list, the files must all have the same back end." "Return where the repository for the current directory is kept." (symbol-name (vc-backend file))) -(defun vc-name (file) - "Return the master name of FILE. -If the file is not registered, or the master name is not known, return nil." - ;; TODO: This should ultimately become obsolete, at least up here - ;; in vc-hooks. - (or (vc-file-getprop file 'vc-name) - ;; force computation of the property by calling - ;; vc-BACKEND-registered explicitly - (let ((backend (vc-backend file))) - (if (and backend - (vc-call-backend backend 'registered file)) - (vc-file-getprop file 'vc-name))))) - (defun vc-checkout-model (backend files) "Indicate how FILES are checked out. @@ -509,51 +484,12 @@ status of this file. Otherwise, the value returned is one of: "Quickly recompute the `state' of FILE." (vc-file-setprop file 'vc-state - (vc-call-backend backend 'state-heuristic file))) + (vc-call-backend backend 'state file))) (defsubst vc-up-to-date-p (file) "Convenience function that checks whether `vc-state' of FILE is `up-to-date'." (eq (vc-state file) 'up-to-date)) -(defun vc-default-state-heuristic (backend file) - "Default implementation of vc-BACKEND-state-heuristic. -It simply calls the real state computation function `vc-BACKEND-state' -and does not employ any heuristic at all." - (vc-call-backend backend 'state file)) - -(defun vc-workfile-unchanged-p (file) - "Return non-nil if FILE has not changed since the last checkout." - (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) - (lastmod (nth 5 (file-attributes file)))) - ;; This is a shortcut for determining when the workfile is - ;; unchanged. It can fail under some circumstances; see the - ;; discussion in bug#694. - (if (and checkout-time - ;; Tramp and Ange-FTP return this when they don't know the time. - (not (equal lastmod '(0 0)))) - (equal checkout-time lastmod) - (let ((unchanged (vc-call workfile-unchanged-p file))) - (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) - unchanged)))) - -(defun vc-default-workfile-unchanged-p (backend file) - "Check if FILE is unchanged by diffing against the repository version. -Return non-nil if FILE is unchanged." - (zerop (condition-case err - ;; If the implementation supports it, let the output - ;; go to *vc*, not *vc-diff*, since this is an internal call. - (vc-call-backend backend 'diff (list file) nil nil "*vc*") - (wrong-number-of-arguments - ;; If this error came from the above call to vc-BACKEND-diff, - ;; try again without the optional buffer argument (for - ;; backward compatibility). Otherwise, resignal. - (if (or (not (eq (cadr err) - (indirect-function - (vc-find-backend-function backend 'diff)))) - (not (eq (cl-caddr err) 4))) - (signal (car err) (cdr err)) - (vc-call-backend backend 'diff (list file))))))) - (defun vc-working-revision (file &optional backend) "Return the repository version from which FILE was checked out. If FILE is not registered, this function always returns nil." @@ -579,9 +515,10 @@ If FILE is not registered, this function always returns nil." (put backend 'vc-templates-grabbed t)) (let ((result (vc-check-master-templates file (symbol-value sym)))) (if (stringp result) - (vc-file-setprop file 'vc-name result) + (vc-file-setprop file 'vc-master-name result) nil)))) ; Not registered +;;;###autoload (defun vc-possible-master (s dirname basename) (cond ((stringp s) (format s dirname basename)) @@ -795,33 +732,42 @@ 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")))) @@ -922,7 +868,6 @@ current, and kill the buffer that visits the link." (let ((map (make-sparse-keymap))) (define-key map "a" 'vc-update-change-log) (define-key map "b" 'vc-switch-backend) - (define-key map "c" 'vc-rollback) (define-key map "d" 'vc-dir) (define-key map "g" 'vc-annotate) (define-key map "G" 'vc-ignore) @@ -941,6 +886,7 @@ current, and kill the buffer that visits the link." (define-key map "=" 'vc-diff) (define-key map "D" 'vc-root-diff) (define-key map "~" 'vc-revision-other-window) + (define-key map "[delete]" 'vc-delete-file) map)) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) @@ -991,13 +937,6 @@ current, and kill the buffer that visits the link." '(menu-item "Insert Header" vc-insert-headers :help "Insert headers into a file for use with a version control system. ")) - (bindings--define-key map [undo] - '(menu-item "Undo Last Check-In" vc-rollback - :enable (let ((backend (if buffer-file-name - (vc-backend buffer-file-name)))) - (or (not backend) - (vc-find-backend-function backend 'rollback))) - :help "Remove the most recent changeset committed to the repository")) (bindings--define-key map [vc-revert] '(menu-item "Revert to Base Version" vc-revert :help "Revert working copies of the selected file set to their repository contents")) |