vc-hooks.el 41.6 KB
Newer Older
1
;;; vc-hooks.el --- resident support for version-control
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

Gerd Moellmann's avatar
Gerd Moellmann committed
5 6
;; Author:     FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7
;; Package: vc
Eric S. Raymond's avatar
Eric S. Raymond committed
8 9 10

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Eric S. Raymond's avatar
Eric S. Raymond committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Eric S. Raymond's avatar
Eric S. Raymond committed
15 16 17 18

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Glenn Morris's avatar
Glenn Morris committed
19
;; GNU General Public License for more details.
Eric S. Raymond's avatar
Eric S. Raymond committed
20 21

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
23 24 25

;;; Commentary:

Gerd Moellmann's avatar
Gerd Moellmann committed
26 27 28 29
;; This is the always-loaded portion of VC.  It takes care of
;; VC-related activities that are done when you visit a file, so that
;; vc.el itself is loaded only when you use a VC command.  See the
;; commentary of vc.el.
Eric S. Raymond's avatar
Eric S. Raymond committed
30 31 32

;;; Code:

33
(eval-when-compile (require 'cl-lib))
34

35 36
;; Customization Variables (the rest is in vc.el)

37 38
(defcustom vc-ignore-dir-regexp
  ;; Stop SMB, automounter, AFS, and DFS host lookups.
39
  locate-dominating-stop-dir-regexp
40
  "Regexp matching directory names that are not under VC's control.
41 42
The default regexp prevents fruitless and time-consuming attempts
to determine the VC status in directories in which filenames are
43 44 45
interpreted as hostnames."
  :type 'regexp
  :group 'vc)
46

Eric S. Raymond's avatar
Eric S. Raymond committed
47
(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch)
Stefan Monnier's avatar
Stefan Monnier committed
48 49 50
  ;; RCS, CVS, SVN and SCCS 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).
51
  "List of version control backends for which VC will be used.
Gerd Moellmann's avatar
Gerd Moellmann committed
52 53 54 55 56 57
Entries in this list will be tried in order to determine whether a
file is under that sort of version control.
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)
58
  :version "23.1"
Karl Heuer's avatar
Karl Heuer committed
59
  :group 'vc)
60

61
;; Note: we don't actually have a darcs back end yet.
Paul Eggert's avatar
Paul Eggert committed
62
;; Also, Meta-CVS (corresponding to MCVS) is unsupported.
63
(defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS"
64
					 ".svn" ".git" ".hg" ".bzr"
65
					 "_MTN" "_darcs" "{arch}"))
66 67 68 69
  "List of directory names to be ignored when walking directory trees."
  :type '(repeat string)
  :group 'vc)

Karl Heuer's avatar
Karl Heuer committed
70
(defcustom vc-make-backup-files nil
71
  "If non-nil, backups of registered files are made as with other files.
Karl Heuer's avatar
Karl Heuer committed
72 73
If nil (the default), files covered by version control don't get backups."
  :type 'boolean
74 75
  :group 'vc
  :group 'backup)
Eric S. Raymond's avatar
Eric S. Raymond committed
76

Karl Heuer's avatar
Karl Heuer committed
77
(defcustom vc-follow-symlinks 'ask
78
  "What to do if visiting a symbolic link to a file under version control.
Gerd Moellmann's avatar
Gerd Moellmann committed
79 80 81 82
Editing such a file through the link bypasses the version control system,
which is dangerous and probably not what you want.

If this variable is t, VC follows the link and visits the real file,
83 84
telling you about it in the echo area.  If it is `ask', VC asks for
confirmation whether it should follow the link.  If nil, the link is
Karl Heuer's avatar
Karl Heuer committed
85
visited and a warning displayed."
Gerd Moellmann's avatar
Gerd Moellmann committed
86 87 88
  :type '(choice (const :tag "Ask for confirmation" ask)
		 (const :tag "Visit link and warn" nil)
		 (const :tag "Follow link" t))
Karl Heuer's avatar
Karl Heuer committed
89
  :group 'vc)
90

Karl Heuer's avatar
Karl Heuer committed
91
(defcustom vc-display-status t
92
  "If non-nil, display revision number and lock status in mode line.
Karl Heuer's avatar
Karl Heuer committed
93 94 95 96
Otherwise, not displayed."
  :type 'boolean
  :group 'vc)

97

Karl Heuer's avatar
Karl Heuer committed
98
(defcustom vc-consult-headers t
99
  "If non-nil, identify work files by searching for version headers."
Karl Heuer's avatar
Karl Heuer committed
100 101
  :type 'boolean
  :group 'vc)
102

Karl Heuer's avatar
Karl Heuer committed
103
(defcustom vc-keep-workfiles t
104 105 106
  "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."
Karl Heuer's avatar
Karl Heuer committed
107 108
  :type 'boolean
  :group 'vc)
109

110 111
;; If you fix bug#11490, probably you can set this back to nil.
(defcustom vc-mistrust-permissions t
112
  "If non-nil, don't assume permissions/ownership track version-control status.
Gerd Moellmann's avatar
Gerd Moellmann committed
113
If nil, do rely on the permissions.
Karl Heuer's avatar
Karl Heuer committed
114
See also variable `vc-consult-headers'."
115
  :version "24.3"                       ; nil->t, bug#11490
Karl Heuer's avatar
Karl Heuer committed
116 117
  :type 'boolean
  :group 'vc)
118 119

(defun vc-mistrust-permissions (file)
Gerd Moellmann's avatar
Gerd Moellmann committed
120
  "Internal access function to variable `vc-mistrust-permissions' for FILE."
121 122
  (or (eq vc-mistrust-permissions 't)
      (and vc-mistrust-permissions
Gerd Moellmann's avatar
Gerd Moellmann committed
123
	   (funcall vc-mistrust-permissions
124 125
		    (vc-backend-subdirectory-name file)))))

126
(defcustom vc-stay-local 'only-file
127
  "Non-nil means use local operations when possible for remote repositories.
128 129 130
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.

Xue Fuqiao's avatar
Xue Fuqiao committed
131
If value is the symbol `only-file', `vc-dir' will connect to the
132 133 134
server, but heuristics will be used to determine the status for
all other VC operations.

135 136 137 138 139 140
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."
141 142
  :type '(choice
	  (const :tag "Always stay local" t)
143
	  (const :tag "Only for file operations" only-file)
144 145 146 147 148
	  (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"))))
149
  :version "23.1"
150 151
  :group 'vc)

152
(defun vc-stay-local-p (file &optional backend)
153
  "Return non-nil if VC should stay local when handling FILE.
154 155 156
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."
157
  (if (listp file)
158 159 160
      (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))
161
	   (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
      (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))))))))))))
183

184
;;; This is handled specially now.
Eric S. Raymond's avatar
Eric S. Raymond committed
185
;; Tell Emacs about this new kind of minor mode
186
;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
Eric S. Raymond's avatar
Eric S. Raymond committed
187

188
;;;###autoload
189
(put 'vc-mode 'risky-local-variable t)
Eric S. Raymond's avatar
Eric S. Raymond committed
190
(make-variable-buffer-local 'vc-mode)
191
(put 'vc-mode 'permanent-local t)
Eric S. Raymond's avatar
Eric S. Raymond committed
192

193 194 195 196 197 198 199 200
(defun vc-mode (&optional arg)
  ;; Dummy function for C-h m
  "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}")

201
(defmacro vc-error-occurred (&rest body)
202
  `(condition-case nil (progn ,@body nil) (error t)))
203

Eric S. Raymond's avatar
Eric S. Raymond committed
204
;; We need a notion of per-file properties because the version
205
;; control state of a file is expensive to derive --- we compute
Gerd Moellmann's avatar
Gerd Moellmann committed
206
;; them when the file is initially found, keep them up to date
207 208
;; during any subsequent VC operations, and forget them when
;; the buffer is killed.
Eric S. Raymond's avatar
Eric S. Raymond committed
209

210
(defvar vc-file-prop-obarray (make-vector 17 0)
Eric S. Raymond's avatar
Eric S. Raymond committed
211 212
  "Obarray for per-file properties.")

213 214
(defvar vc-touched-properties nil)

Eric S. Raymond's avatar
Eric S. Raymond committed
215
(defun vc-file-setprop (file property value)
Gerd Moellmann's avatar
Gerd Moellmann committed
216
  "Set per-file VC PROPERTY for FILE to VALUE."
217 218 219 220
  (if (and vc-touched-properties
	   (not (memq property vc-touched-properties)))
      (setq vc-touched-properties (append (list property)
					  vc-touched-properties)))
Eric S. Raymond's avatar
Eric S. Raymond committed
221 222 223
  (put (intern file vc-file-prop-obarray) property value))

(defun vc-file-getprop (file property)
224
  "Get per-file VC PROPERTY for FILE."
Eric S. Raymond's avatar
Eric S. Raymond committed
225 226
  (get (intern file vc-file-prop-obarray) property))

227
(defun vc-file-clearprops (file)
Gerd Moellmann's avatar
Gerd Moellmann committed
228
  "Clear all VC properties of FILE."
229 230
  (if (boundp 'vc-parent-buffer)
      (kill-local-variable 'vc-parent-buffer))
231
  (setplist (intern file vc-file-prop-obarray) nil))
232

Gerd Moellmann's avatar
Gerd Moellmann committed
233 234 235 236 237 238 239 240 241 242 243

;; We keep properties on each symbol naming a backend as follows:
;;  * `vc-functions': an alist mapping vc-FUNCTION to vc-BACKEND-FUNCTION.

(defun vc-make-backend-sym (backend sym)
  "Return BACKEND-specific version of VC symbol SYM."
  (intern (concat "vc-" (downcase (symbol-name backend))
		  "-" (symbol-name sym))))

(defun vc-find-backend-function (backend fun)
  "Return BACKEND-specific implementation of FUN.
244
If there is no such implementation, return the default implementation;
Gerd Moellmann's avatar
Gerd Moellmann committed
245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
if that doesn't exist either, return nil."
  (let ((f (vc-make-backend-sym backend fun)))
    (if (fboundp f) f
      ;; Load vc-BACKEND.el if needed.
      (require (intern (concat "vc-" (downcase (symbol-name backend)))))
      (if (fboundp f) f
	(let ((def (vc-make-backend-sym 'default fun)))
	  (if (fboundp def) (cons def backend) nil))))))

(defun vc-call-backend (backend function-name &rest args)
  "Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
Calls

    (apply 'vc-BACKEND-FUN ARGS)

if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
and else calls

    (apply 'vc-default-FUN BACKEND ARGS)

It is usually called via the `vc-call' macro."
266 267
  (let ((f (assoc function-name (get backend 'vc-functions))))
    (if f (setq f (cdr f))
Gerd Moellmann's avatar
Gerd Moellmann committed
268
      (setq f (vc-find-backend-function backend function-name))
269 270 271 272 273 274
      (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)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
275 276

(defmacro vc-call (fun file &rest args)
Jason Rumney's avatar
Jason Rumney committed
277 278
  "A convenience macro for calling VC backend functions.
Functions called by this macro must accept FILE as the first argument.
279 280
ARGS specifies any additional arguments.  FUN should be unquoted.
BEWARE!! FILE is evaluated twice!!"
Gerd Moellmann's avatar
Gerd Moellmann committed
281 282 283 284 285 286 287
  `(vc-call-backend (vc-backend ,file) ',fun ,file ,@args))

(defsubst vc-parse-buffer (pattern i)
  "Find PATTERN in the current buffer and return its Ith submatch."
  (goto-char (point-min))
  (if (re-search-forward pattern nil t)
      (match-string i)))
288

289
(defun vc-insert-file (file &optional limit blocksize)
Gerd Moellmann's avatar
Gerd Moellmann committed
290 291 292 293
  "Insert the contents of FILE into the current buffer.

Optional argument LIMIT is a regexp.  If present, the file is inserted
in chunks of size BLOCKSIZE (default 8 kByte), until the first
294
occurrence of LIMIT is found.  Anything from the start of that occurrence
295 296
to the end of the buffer is then deleted.  The function returns
non-nil if FILE exists and its contents were successfully inserted."
297
  (erase-buffer)
298 299 300
  (when (file-exists-p file)
    (if (not limit)
        (insert-file-contents file)
301
      (unless blocksize (setq blocksize 8192))
302 303 304
      (let ((filepos 0))
        (while
	    (and (< 0 (cadr (insert-file-contents
305
			     file nil filepos (cl-incf filepos blocksize))))
306
		 (progn (beginning-of-line)
307
                        (let ((pos (re-search-forward limit nil 'move)))
308 309
                          (when pos (delete-region (match-beginning 0)
						   (point-max)))
310
                          (not pos)))))))
311 312
    (set-buffer-modified-p nil)
    t))
313

Stefan Monnier's avatar
Stefan Monnier committed
314
(defun vc-find-root (file witness)
315 316
  "Find the root of a checked out project.
The function walks up the directory tree from FILE looking for WITNESS.
Stefan Monnier's avatar
Stefan Monnier committed
317
If WITNESS if not found, return nil, otherwise return the root."
318 319 320
  (let ((locate-dominating-stop-dir-regexp
         (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)))
    (locate-dominating-file file witness)))
321

322 323 324
;; Access functions to file properties
;; (Properties should be _set_ using vc-file-setprop, but
;; _retrieved_ only through these functions, which decide
325
;; if the property is already known or not.  A property should
326 327
;; only be retrieved by vc-file-getprop if there is no
;; access function.)
328

329
;; properties indicating the backend being used for FILE
330

Gerd Moellmann's avatar
Gerd Moellmann committed
331 332 333
(defun vc-registered (file)
  "Return non-nil if FILE is registered in a version control system.

334 335 336 337
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."
Gerd Moellmann's avatar
Gerd Moellmann committed
338
  (let (handler)
339
    (cond
340 341
     ((and (file-name-directory file)
           (string-match vc-ignore-dir-regexp (file-name-directory file)))
342
      nil)
343 344 345 346 347
     ((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
Gerd Moellmann's avatar
Gerd Moellmann committed
348 349 350
      ;; There is no file name handler.
      ;; Try vc-BACKEND-registered for each handled BACKEND.
      (catch 'found
351
	(let ((backend (vc-file-getprop file 'vc-backend)))
352
	  (mapc
353 354 355 356
	   (lambda (b)
	     (and (vc-call-backend b 'registered file)
		  (vc-file-setprop file 'vc-backend b)
		  (throw 'found t)))
357
	   (if (or (not backend) (eq backend 'none))
358 359
	       vc-handled-backends
	     (cons backend vc-handled-backends))))
Gerd Moellmann's avatar
Gerd Moellmann committed
360 361
        ;; File is not registered.
        (vc-file-setprop file 'vc-backend 'none)
362
        nil)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
363

364 365 366
(defun vc-backend (file-or-list)
  "Return the version control type of FILE-OR-LIST, nil if it's not registered.
If the argument is a list, the files must all have the same back end."
Gerd Moellmann's avatar
Gerd Moellmann committed
367
  ;; `file' can be nil in several places (typically due to the use of
368
  ;; code like (vc-backend buffer-file-name)).
369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
  (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)))))
	((and file-or-list (listp file-or-list))
	 (vc-backend (car file-or-list)))
	(t
	 nil)))

Gerd Moellmann's avatar
Gerd Moellmann committed
384 385

(defun vc-backend-subdirectory-name (file)
386
  "Return where the repository for the current directory is kept."
Gerd Moellmann's avatar
Gerd Moellmann committed
387
  (symbol-name (vc-backend file)))
388

389
(defun vc-name (file)
Dave Love's avatar
Dave Love committed
390 391 392
  "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
Gerd Moellmann's avatar
Gerd Moellmann committed
393
  ;; in vc-hooks.
394
  (or (vc-file-getprop file 'vc-name)
395 396
      ;; force computation of the property by calling
      ;; vc-BACKEND-registered explicitly
397 398 399 400
      (let ((backend (vc-backend file)))
	(if (and backend
		 (vc-call-backend backend 'registered file))
	    (vc-file-getprop file 'vc-name)))))
401

402 403
(defun vc-checkout-model (backend files)
  "Indicate how FILES are checked out.
Gerd Moellmann's avatar
Gerd Moellmann committed
404

405
If FILES are not registered, this function always returns nil.
406
For registered files, the possible values are:
Gerd Moellmann's avatar
Gerd Moellmann committed
407

Chong Yidong's avatar
Chong Yidong committed
408
  'implicit   FILES are always writable, and checked out `implicitly'
Gerd Moellmann's avatar
Gerd Moellmann committed
409 410
              when the user saves the first changes to the file.

411
  'locking    FILES are read-only if up-to-date; user must type
412
              \\[vc-next-action] before editing.  Strict locking
Gerd Moellmann's avatar
Gerd Moellmann committed
413 414
              is assumed.

415
  'announce   FILES are read-only if up-to-date; user must type
416
              \\[vc-next-action] before editing.  But other users
Gerd Moellmann's avatar
Gerd Moellmann committed
417
              may be editing at the same time."
418
  (vc-call-backend backend 'checkout-model files))
419

420 421 422 423
(defun vc-user-login-name (file)
  "Return the name under which the user accesses the given FILE."
  (or (and (eq (string-match tramp-file-name-regexp file) 0)
           ;; tramp case: execute "whoami" via tramp
424 425
           (let ((default-directory (file-name-directory file))
		 process-file-side-effects)
426 427 428 429 430 431 432 433 434 435 436
             (with-temp-buffer
               (if (not (zerop (process-file "whoami" nil t)))
                   ;; fall through if "whoami" didn't work
                   nil
                 ;; remove trailing newline
                 (delete-region (1- (point-max)) (point-max))
                 (buffer-string)))))
      ;; normal case
      (user-login-name)
      ;; if user-login-name is nil, return the UID as a string
      (number-to-string (user-uid))))
Gerd Moellmann's avatar
Gerd Moellmann committed
437

438
(defun vc-state (file &optional backend)
Gerd Moellmann's avatar
Gerd Moellmann committed
439 440
  "Return the version control state of FILE.

441 442
A return of nil from this function means we have no information on the
status of this file.  Otherwise, the value returned is one of:
Gerd Moellmann's avatar
Gerd Moellmann committed
443 444 445 446 447 448 449

  'up-to-date        The working file is unmodified with respect to the
                     latest version on the current branch, and not locked.

  'edited            The working file has been edited by the user.  If
                     locking is used for the file, this state means that
                     the current version is locked by the calling user.
Paul Eggert's avatar
Paul Eggert committed
450 451
                     This status should *not* be reported for files
                     which have a changed mtime but the same content
452
                     as the repo copy.
Gerd Moellmann's avatar
Gerd Moellmann committed
453 454 455

  USER               The current version of the working file is locked by
                     some other USER (a string).
456

457
  'needs-update      The file has not been edited by the user, but there is
Gerd Moellmann's avatar
Gerd Moellmann committed
458
                     a more recent version on the current branch stored
459
                     in the repository.
Gerd Moellmann's avatar
Gerd Moellmann committed
460 461 462

  'needs-merge       The file has been edited by the user, and there is also
                     a more recent version on the current branch stored in
463
                     the repository.  This state can only occur if locking
Gerd Moellmann's avatar
Gerd Moellmann committed
464 465
                     is not used for the file.

Eric S. Raymond's avatar
Eric S. Raymond committed
466
  'unlocked-changes  The working version of the file is not locked,
Gerd Moellmann's avatar
Gerd Moellmann committed
467 468 469 470
                     but the working file has been changed with respect
                     to that version.  This state can only occur for files
                     with locking; it represents an erroneous condition that
                     should be resolved by the user (vc-next-action will
Eric S. Raymond's avatar
Eric S. Raymond committed
471 472 473
                     prompt the user to do it).

  'added             Scheduled to go into the repository on the next commit.
Eric S. Raymond's avatar
Eric S. Raymond committed
474
                     Often represented by vc-working-revision = \"0\" in VCSes
475 476
                     with monotonic IDs like Subversion and Mercurial.

477
  'removed           Scheduled to be deleted from the repository on next commit.
478

479
  'conflict          The file contains conflicts as the result of a merge.
480 481
                     For now the conflicts are text conflicts.  In the
                     future this might be extended to deal with metadata
482 483
                     conflicts too.

484
  'missing           The file is not present in the file system, but the VC
485 486
                     system still tracks it.

487
  'ignored           The file showed up in a dir-status listing with a flag
488
                     indicating the version-control system is ignoring it,
489 490
                     Note: This property is not set reliably (some VCSes
                     don't have useful directory-status commands) so assume
491
                     that any file with vc-state nil might be ignorable
492
                     without VC knowing it.
493

494
  'unregistered      The file is not under version control."
495

Eric S. Raymond's avatar
Eric S. Raymond committed
496 497 498
  ;; Note: in Emacs 22 and older, return of nil meant the file was
  ;; unregistered.  This is potentially a source of
  ;; backward-compatibility bugs.
Eric S. Raymond's avatar
Eric S. Raymond committed
499

500 501
  ;; FIXME: New (sub)states needed (?):
  ;; - `copied' and `moved' (might be handled by `removed' and `added')
Gerd Moellmann's avatar
Gerd Moellmann committed
502
  (or (vc-file-getprop file 'vc-state)
503
      (when (> (length file) 0)         ;Why??  --Stef
504 505
	(setq backend (or backend (vc-backend file)))
	(when backend
506 507 508 509 510 511 512
          (vc-state-refresh file backend)))))

(defun vc-state-refresh (file backend)
  "Quickly recompute the `state' of FILE."
  (vc-file-setprop
   file 'vc-state
   (vc-call-backend backend 'state-heuristic file)))
Gerd Moellmann's avatar
Gerd Moellmann committed
513 514 515 516 517 518

(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)
519
  "Default implementation of vc-BACKEND-state-heuristic.
Dave Love's avatar
Dave Love committed
520 521
It simply calls the real state computation function `vc-BACKEND-state'
and does not employ any heuristic at all."
Gerd Moellmann's avatar
Gerd Moellmann committed
522
   (vc-call-backend backend 'state file))
523

524 525 526 527
(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))))
528 529 530 531 532 533 534 535 536 537
    ;; 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))))
538 539

(defun vc-default-workfile-unchanged-p (backend file)
540
  "Check if FILE is unchanged by diffing against the repository version.
541
Return non-nil if FILE is unchanged."
542
  (zerop (condition-case err
543 544
             ;; If the implementation supports it, let the output
             ;; go to *vc*, not *vc-diff*, since this is an internal call.
545
             (vc-call-backend backend 'diff (list file) nil nil "*vc*")
546 547 548 549 550 551
           (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
552
                              (vc-find-backend-function backend 'diff))))
553
                    (not (eq (cl-caddr err) 4)))
554
                (signal (car err) (cdr err))
555
              (vc-call-backend backend 'diff (list file)))))))
556

557
(defun vc-working-revision (file &optional backend)
558
  "Return the repository version from which FILE was checked out.
559
If FILE is not registered, this function always returns nil."
Eric S. Raymond's avatar
Eric S. Raymond committed
560
  (or (vc-file-getprop file 'vc-working-revision)
561 562 563 564 565
      (progn
	(setq backend (or backend (vc-backend file)))
	(when backend
	  (vc-file-setprop file 'vc-working-revision
			   (vc-call-backend backend 'working-revision file))))))
566

567 568 569 570 571 572 573
;; Backward compatibility.
(define-obsolete-function-alias
  'vc-workfile-version 'vc-working-revision "23.1")
(defun vc-default-working-revision (backend file)
  (message
   "`working-revision' not found: using the old `workfile-version' instead")
  (vc-call-backend backend 'workfile-version file))
574

Gerd Moellmann's avatar
Gerd Moellmann committed
575 576 577 578
(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)))
    (unless (get backend 'vc-templates-grabbed)
579
      (put backend 'vc-templates-grabbed t))
Gerd Moellmann's avatar
Gerd Moellmann committed
580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597
    (let ((result (vc-check-master-templates file (symbol-value sym))))
      (if (stringp result)
	  (vc-file-setprop file 'vc-name result)
	nil))))				; Not registered

(defun vc-possible-master (s dirname basename)
  (cond
   ((stringp s) (format s dirname basename))
   ((functionp s)
    ;; The template is a function to invoke.  If the
    ;; function returns non-nil, that means it has found a
    ;; master.  For backward compatibility, we also handle
    ;; the case that the function throws a 'found atom
    ;; and a pair (cons MASTER-FILE BACKEND).
    (let ((result (catch 'found (funcall s dirname basename))))
      (if (consp result) (car result) result)))))

(defun vc-check-master-templates (file templates)
598
  "Return non-nil if there is a master corresponding to FILE.
Gerd Moellmann's avatar
Gerd Moellmann committed
599 600 601 602 603 604 605 606 607 608 609 610 611 612 613

TEMPLATES is a list of strings or functions.  If an element is a
string, it must be a control string as required by `format', with two
string placeholders, such as \"%sRCS/%s,v\".  The directory part of
FILE is substituted for the first placeholder, the basename of FILE
for the second.  If a file with the resulting name exists, it is taken
as the master of FILE, and returned.

If an element of TEMPLATES is a function, it is called with the
directory part and the basename of FILE as arguments.  It should
return non-nil if it finds a master; that value is then returned by
this function."
  (let ((dirname (or (file-name-directory file) ""))
        (basename (file-name-nondirectory file)))
    (catch 'found
Dave Love's avatar
Dave Love committed
614
      (mapcar
Gerd Moellmann's avatar
Gerd Moellmann committed
615 616
       (lambda (s)
	 (let ((trial (vc-possible-master s dirname basename)))
617 618 619 620 621 622 623 624 625 626 627
	   (when (and trial (file-exists-p trial)
		      ;; Make sure the file we found with name
		      ;; TRIAL is not the source file itself.
		      ;; That can happen with RCS-style names if
		      ;; the file name is truncated (e.g. to 14
		      ;; chars).  See if either directory or
		      ;; attributes differ.
		      (or (not (string= dirname
					(file-name-directory trial)))
			  (not (equal (file-attributes file)
				      (file-attributes trial)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
628 629
	       (throw 'found trial))))
       templates))))
630

631 632
(define-obsolete-function-alias
  'vc-toggle-read-only 'toggle-read-only "24.1")
Eric S. Raymond's avatar
Eric S. Raymond committed
633

634
(defun vc-default-make-version-backups-p (backend file)
635
  "Return non-nil if unmodified versions should be backed up locally.
636
The default is to switch off this feature."
637 638
  nil)

639 640 641 642 643
(defun vc-version-backup-file-name (file &optional rev manual regexp)
  "Return a backup file name for REV or the current version of FILE.
If MANUAL is non-nil it means that a name for backups created by
the user should be returned; if REGEXP is non-nil that means to return
a regexp for matching all such backup files, regardless of the version."
644 645
  (if regexp
      (concat (regexp-quote (file-name-nondirectory file))
646
              "\\.~.+" (unless manual "\\.") "~")
647
    (expand-file-name (concat (file-name-nondirectory file)
648
                              ".~" (subst-char-in-string
Eric S. Raymond's avatar
Eric S. Raymond committed
649
                                    ?/ ?_ (or rev (vc-working-revision file)))
650 651
                              (unless manual ".") "~")
                      (file-name-directory file))))
652 653 654

(defun vc-delete-automatic-version-backups (file)
  "Delete all existing automatic version backups for FILE."
655
  (condition-case nil
656
      (mapc
657
       'delete-file
658
       (directory-files (or (file-name-directory file) default-directory) t
659 660 661
			(vc-version-backup-file-name file nil nil t)))
    ;; Don't fail when the directory doesn't exist.
    (file-error nil)))
662 663 664 665

(defun vc-make-version-backup (file)
  "Make a backup copy of FILE, which is assumed in sync with the repository.
Before doing that, check if there are any old backups and get rid of them."
666
  (unless (and (fboundp 'msdos-long-file-names)
667
               (not (with-no-warnings (msdos-long-file-names))))
668
    (vc-delete-automatic-version-backups file)
669 670 671 672 673
    (condition-case nil
        (copy-file file (vc-version-backup-file-name file)
                   nil 'keep-date)
      ;; It's ok if it doesn't work (e.g. directory not writable),
      ;; since this is just for efficiency.
674
      (file-error
675 676 677
       (message
        (concat "Warning: Cannot make version backup; "
                "diff/revert therefore not local"))))))
678 679 680 681 682 683

(defun vc-before-save ()
  "Function to be called by `basic-save-buffer' (in files.el)."
  ;; If the file on disk is still in sync with the repository,
  ;; and version backups should be made, copy the file to
  ;; another name.  This enables local diffs and local reverting.
684 685
  (let ((file buffer-file-name)
        backend)
686
    (ignore-errors               ;Be careful not to prevent saving the file.
687 688
      (unless (file-exists-p file)
        (vc-file-clearprops file))
689
      (and (setq backend (vc-backend file))
690
           (vc-up-to-date-p file)
691
           (eq (vc-checkout-model backend (list file)) 'implicit)
692
           (vc-call-backend backend 'make-version-backups-p file)
693
           (vc-make-version-backup file)))))
694

Dan Nicolaescu's avatar
Dan Nicolaescu committed
695
(declare-function vc-dir-resynch-file "vc-dir" (&optional fname))
696

697 698
(defvar vc-dir-buffers nil "List of vc-dir buffers.")

699
(defun vc-after-save ()
Gerd Moellmann's avatar
Gerd Moellmann committed
700
  "Function to be called by `basic-save-buffer' (in files.el)."
Dave Love's avatar
Dave Love committed
701
  ;; If the file in the current buffer is under version control,
Gerd Moellmann's avatar
Gerd Moellmann committed
702 703
  ;; up-to-date, and locking is not used for the file, set
  ;; the state to 'edited and redisplay the mode line.
704 705
  (let* ((file buffer-file-name)
         (backend (vc-backend file)))
706 707 708 709 710 711 712 713 714 715 716 717 718 719 720
    (cond
     ((null backend))
     ((eq (vc-checkout-model backend (list file)) 'implicit)
      ;; If the file was saved in the same second in which it was
      ;; checked out, clear the checkout-time to avoid confusion.
      (if (equal (vc-file-getprop file 'vc-checkout-time)
		 (nth 5 (file-attributes file)))
	  (vc-file-setprop file 'vc-checkout-time nil))
      (if (vc-state-refresh file backend)
	  (vc-mode-line file backend)))
     ;; If we saved an unlocked file on a locking based VCS, that
     ;; file is not longer up-to-date.
     ((eq (vc-file-getprop file 'vc-state) 'up-to-date)
      (vc-file-setprop file 'vc-state nil)))
    ;; Resynch *vc-dir* buffers, if any are present.
721 722
    (when vc-dir-buffers
      (vc-dir-resynch-file file))))
723

Stefan Monnier's avatar
Stefan Monnier committed
724
(defvar vc-menu-entry
725
  `(menu-item ,(purecopy "Version Control") vc-menu-map
Stefan Monnier's avatar
Stefan Monnier committed
726 727 728 729 730 731 732 733
    :filter vc-menu-map-filter))

(when (boundp 'menu-bar-tools-menu)
  ;; We do not need to worry here about the placement of this entry
  ;; because menu-bar.el has already created the proper spot for us
  ;; and this will simply use it.
  (define-key menu-bar-tools-menu [vc] vc-menu-entry))

734 735
(defconst vc-mode-line-map
  (let ((map (make-sparse-keymap)))
Stefan Monnier's avatar
Stefan Monnier committed
736
    (define-key map [mode-line down-mouse-1] vc-menu-entry)
737 738
    map))

739
(defun vc-mode-line (file &optional backend)
Eric S. Raymond's avatar
Eric S. Raymond committed
740
  "Set `vc-mode' to display type of version control for FILE.
Eric S. Raymond's avatar
Eric S. Raymond committed
741
The value is set in the current buffer, which should be the buffer
742 743
visiting FILE.
If BACKEND is passed use it as the VC backend when computing the result."
744
  (interactive (list buffer-file-name))
745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774
  (setq backend (or backend (vc-backend file)))
  (if (not backend)
      (setq vc-mode nil)
    (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
	   (ml-echo (get-text-property 0 'help-echo ml-string)))
      (setq vc-mode
	    (concat
	     " "
	     (if (null vc-display-status)
		 (symbol-name backend)
	       (propertize
		ml-string
		'mouse-face 'mode-line-highlight
		'help-echo
		(concat (or ml-echo
			    (format "File under the %s version control system"
				    backend))
			"\nmouse-1: Version Control menu")
		'local-map vc-mode-line-map)))))
    ;; If the user is root, and the file is not owner-writable,
    ;; then pretend that we can't write it
    ;; even though we can (because root can write anything).
    ;; This way, even root cannot modify a file that isn't locked.
    (and (equal file buffer-file-name)
	 (not buffer-read-only)
	 (zerop (user-real-uid))
	 (zerop (logand (file-modes buffer-file-name) 128))
	 (setq buffer-read-only t)))
  (force-mode-line-update)
  backend)
Gerd Moellmann's avatar
Gerd Moellmann committed
775 776

(defun vc-default-mode-line-string (backend file)
777
  "Return a string for `vc-mode-line' to put in the mode line for FILE.
Gerd Moellmann's avatar
Gerd Moellmann committed
778 779 780 781 782
Format:

  \"BACKEND-REV\"        if the file is up-to-date
  \"BACKEND:REV\"        if the file is edited (or locked by the calling user)
  \"BACKEND:LOCKER:REV\" if the file is locked by somebody else
783 784 785
  \"BACKEND@REV\"        if the file was locally added
  \"BACKEND!REV\"        if the file contains conflicts or was removed
  \"BACKEND?REV\"        if the file is under VC, but is missing
Gerd Moellmann's avatar
Gerd Moellmann committed
786 787

This function assumes that the file is registered."
788 789 790 791
  (let* ((backend-name (symbol-name backend))
	 (state   (vc-state file backend))
	 (state-echo nil)
	 (rev     (vc-working-revision file backend)))
792 793
    (propertize
     (cond ((or (eq state 'up-to-date)
794
		(eq state 'needs-update))
795
	    (setq state-echo "Up to date file")
796
	    (concat backend-name "-" rev))
797 798
	   ((stringp state)
	    (setq state-echo (concat "File locked by" state))
799
	    (concat backend-name ":" state ":" rev))
800 801
           ((eq state 'added)
            (setq state-echo "Locally added file")
802
            (concat backend-name "@" rev))
803 804
           ((eq state 'conflict)
            (setq state-echo "File contains conflicts after the last merge")
805
            (concat backend-name "!" rev))
806 807
           ((eq state 'removed)
            (setq state-echo "File removed from the VC system")
808
            (concat backend-name "!" rev))
809 810
           ((eq state 'missing)
            (setq state-echo "File tracked by the VC system, but missing from the file system")
811
            (concat backend-name "?" rev))
812 813 814
	   (t
	    ;; Not just for the 'edited state, but also a fallback
	    ;; for all other states.  Think about different symbols
815
	    ;; for 'needs-update and 'needs-merge.
816
	    (setq state-echo "Locally modified file")
817 818
	    (concat backend-name ":" rev)))
     'help-echo (concat state-echo " under the " backend-name
819
			" version control system"))))
820

821
(defun vc-follow-link ()
Gerd Moellmann's avatar
Gerd Moellmann committed
822 823 824
  "If current buffer visits a symbolic link, visit the real file.
If the real file is already visited in another buffer, make that buffer
current, and kill the buffer that visits the link."
825
  (let* ((true-buffer (find-buffer-visiting buffer-file-truename))
826 827
	 (this-buffer (current-buffer)))
    (if (eq true-buffer this-buffer)
828
	(let ((truename buffer-file-truename))
829
	  (kill-buffer this-buffer)
830 831 832
	  ;; In principle, we could do something like set-visited-file-name.
	  ;; However, it can't be exactly the same as set-visited-file-name.
	  ;; I'm not going to work out the details right now. -- rms.
833
	  (set-buffer (find-file-noselect truename)))
834 835
      (set-buffer true-buffer)
      (kill-buffer this-buffer))))
836

837 838 839
(defun vc-default-find-file-hook (backend)
  nil)

Eric S. Raymond's avatar
Eric S. Raymond committed
840
(defun vc-find-file-hook ()
841
  "Function for `find-file-hook' activating VC mode if appropriate."
842 843
  ;; Recompute whether file is version controlled,
  ;; if user has killed the buffer and revisited.
844 845
  (when vc-mode
    (setq vc-mode nil))
Gerd Moellmann's avatar
Gerd Moellmann committed
846
  (when buffer-file-name
847
    (vc-file-clearprops buffer-file-name)
848 849
    ;; FIXME: Why use a hook?  Why pass it buffer-file-name?
    (add-hook 'vc-mode-line-hook 'vc-mode-line nil t)
850 851 852
    (let (backend)
      (cond
       ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
853
	;; Compute the state and put it in the mode line.
854 855 856 857 858 859 860
	(vc-mode-line buffer-file-name backend)
	(unless vc-make-backup-files
	  ;; Use this variable, not make-backup-files,
	  ;; because this is for things that depend on the file name.
	  (set (make-local-variable 'backup-inhibited) t))
	;; Let the backend setup any buffer-local things he needs.
	(vc-call-backend backend 'find-file-hook))