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

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

Gerd Moellmann's avatar
Gerd Moellmann committed
6 7
;; Author:     FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
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 34
(eval-when-compile
  (require 'cl))
35

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

38
(defvar vc-ignore-vc-files nil)
39
(make-obsolete-variable 'vc-ignore-vc-files
40 41
                        "set `vc-handled-backends' to nil to disable VC."
			"21.1")
42

43
(defvar vc-master-templates ())
44 45
(make-obsolete-variable 'vc-master-templates
 "to define master templates for a given BACKEND, use
46
vc-BACKEND-master-templates.  To enable or disable VC for a given
47 48
BACKEND, use `vc-handled-backends'."
 "21.1")
49

50
(defvar vc-header-alist ())
51
(make-obsolete-variable 'vc-header-alist 'vc-BACKEND-header "21.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
52

53 54 55
(defcustom vc-ignore-dir-regexp
  ;; Stop SMB, automounter, AFS, and DFS host lookups.
  "\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\\.\\.\\)/\\)\\'"
56
  "Regexp matching directory names that are not under VC's control.
57 58
The default regexp prevents fruitless and time-consuming attempts
to determine the VC status in directories in which filenames are
59 60 61
interpreted as hostnames."
  :type 'regexp
  :group 'vc)
62

Eric S. Raymond's avatar
Eric S. Raymond committed
63
(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch)
Stefan Monnier's avatar
Stefan Monnier committed
64 65 66
  ;; 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).
67
  "List of version control backends for which VC will be used.
Gerd Moellmann's avatar
Gerd Moellmann committed
68 69 70 71 72 73
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)
74
  :version "23.1"
Karl Heuer's avatar
Karl Heuer committed
75
  :group 'vc)
76

77
;; Note: we don't actually have a darcs back end yet.
Eric S. Raymond's avatar
Eric S. Raymond committed
78
;; Also, Meta-CVS (corresponsding to MCVS) is unsupported.
79 80
(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS"
					 ".svn" ".git" ".hg" ".bzr"
81
					 "_MTN" "_darcs" "{arch}")
82 83 84 85
  "List of directory names to be ignored when walking directory trees."
  :type '(repeat string)
  :group 'vc)

86
(defcustom vc-path nil
87
  "List of extra directories to search for version control commands."
Karl Heuer's avatar
Karl Heuer committed
88 89
  :type '(repeat directory)
  :group 'vc)
90

Karl Heuer's avatar
Karl Heuer committed
91
(defcustom vc-make-backup-files nil
92
  "If non-nil, backups of registered files are made as with other files.
Karl Heuer's avatar
Karl Heuer committed
93 94
If nil (the default), files covered by version control don't get backups."
  :type 'boolean
95 96
  :group 'vc
  :group 'backup)
Eric S. Raymond's avatar
Eric S. Raymond committed
97

Karl Heuer's avatar
Karl Heuer committed
98
(defcustom vc-follow-symlinks 'ask
99
  "What to do if visiting a symbolic link to a file under version control.
Gerd Moellmann's avatar
Gerd Moellmann committed
100 101 102 103
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,
104 105
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
106
visited and a warning displayed."
Gerd Moellmann's avatar
Gerd Moellmann committed
107 108 109
  :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
110
  :group 'vc)
111

Karl Heuer's avatar
Karl Heuer committed
112
(defcustom vc-display-status t
113
  "If non-nil, display revision number and lock status in modeline.
Karl Heuer's avatar
Karl Heuer committed
114 115 116 117
Otherwise, not displayed."
  :type 'boolean
  :group 'vc)

118

Karl Heuer's avatar
Karl Heuer committed
119
(defcustom vc-consult-headers t
120
  "If non-nil, identify work files by searching for version headers."
Karl Heuer's avatar
Karl Heuer committed
121 122
  :type 'boolean
  :group 'vc)
123

Karl Heuer's avatar
Karl Heuer committed
124
(defcustom vc-keep-workfiles t
125
  "If non-nil, don't delete working files after registering changes.
126
If the back-end is CVS, workfiles are always kept, regardless of the
Karl Heuer's avatar
Karl Heuer committed
127 128 129
value of this flag."
  :type 'boolean
  :group 'vc)
130

Karl Heuer's avatar
Karl Heuer committed
131
(defcustom vc-mistrust-permissions nil
132
  "If non-nil, don't assume permissions/ownership track version-control status.
Gerd Moellmann's avatar
Gerd Moellmann committed
133
If nil, do rely on the permissions.
Karl Heuer's avatar
Karl Heuer committed
134 135 136
See also variable `vc-consult-headers'."
  :type 'boolean
  :group 'vc)
137 138

(defun vc-mistrust-permissions (file)
Gerd Moellmann's avatar
Gerd Moellmann committed
139
  "Internal access function to variable `vc-mistrust-permissions' for FILE."
140 141
  (or (eq vc-mistrust-permissions 't)
      (and vc-mistrust-permissions
Gerd Moellmann's avatar
Gerd Moellmann committed
142
	   (funcall vc-mistrust-permissions
143 144
		    (vc-backend-subdirectory-name file)))))

145
(defcustom vc-stay-local t
146
  "Non-nil means use local operations when possible for remote repositories.
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.

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 "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"))))
162
  :version "22.1"
163 164 165 166
  :group 'vc)

(defun vc-stay-local-p (file)
  "Return non-nil if VC should stay local when handling FILE.
167 168 169
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."
170
  (if (listp file)
171
      (delq nil (mapcar 'vc-stay-local-p file))
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
    (let* ((backend (vc-backend file))
	   (sym (vc-make-backend-sym backend 'stay-local))
	   (stay-local (if (boundp sym) (symbol-value sym) t)))
      (if (eq stay-local t) (setq stay-local 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))))))))))))
197

198
;;; This is handled specially now.
Eric S. Raymond's avatar
Eric S. Raymond committed
199
;; Tell Emacs about this new kind of minor mode
200
;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
Eric S. Raymond's avatar
Eric S. Raymond committed
201

Eric S. Raymond's avatar
Eric S. Raymond committed
202
(make-variable-buffer-local 'vc-mode)
203
(put 'vc-mode 'permanent-local t)
Eric S. Raymond's avatar
Eric S. Raymond committed
204

205 206 207 208 209 210 211 212
(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}")

213
(defmacro vc-error-occurred (&rest body)
214
  `(condition-case nil (progn ,@body nil) (error t)))
215

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

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

225 226
(defvar vc-touched-properties nil)

Eric S. Raymond's avatar
Eric S. Raymond committed
227
(defun vc-file-setprop (file property value)
Gerd Moellmann's avatar
Gerd Moellmann committed
228
  "Set per-file VC PROPERTY for FILE to VALUE."
229 230 231 232
  (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
233 234 235
  (put (intern file vc-file-prop-obarray) property value))

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

239
(defun vc-file-clearprops (file)
Gerd Moellmann's avatar
Gerd Moellmann committed
240
  "Clear all VC properties of FILE."
241
  (setplist (intern file vc-file-prop-obarray) nil))
242

Gerd Moellmann's avatar
Gerd Moellmann committed
243 244 245 246 247 248 249 250 251 252 253

;; 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.
254
If there is no such implementation, return the default implementation;
Gerd Moellmann's avatar
Gerd Moellmann committed
255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
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."
276 277
  (let ((f (assoc function-name (get backend 'vc-functions))))
    (if f (setq f (cdr f))
Gerd Moellmann's avatar
Gerd Moellmann committed
278
      (setq f (vc-find-backend-function backend function-name))
279 280 281 282 283 284
      (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
285 286

(defmacro vc-call (fun file &rest args)
Jason Rumney's avatar
Jason Rumney committed
287 288
  "A convenience macro for calling VC backend functions.
Functions called by this macro must accept FILE as the first argument.
289 290
ARGS specifies any additional arguments.  FUN should be unquoted.
BEWARE!! FILE is evaluated twice!!"
Gerd Moellmann's avatar
Gerd Moellmann committed
291 292 293 294 295 296 297
  `(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)))
298

299
(defun vc-insert-file (file &optional limit blocksize)
Gerd Moellmann's avatar
Gerd Moellmann committed
300 301 302 303
  "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
304
occurrence of LIMIT is found.  Anything from the start of that occurrence
305 306
to the end of the buffer is then deleted.  The function returns
non-nil if FILE exists and its contents were successfully inserted."
307
  (erase-buffer)
308 309 310
  (when (file-exists-p file)
    (if (not limit)
        (insert-file-contents file)
311
      (unless blocksize (setq blocksize 8192))
312 313 314 315 316
      (let ((filepos 0))
        (while
	    (and (< 0 (cadr (insert-file-contents
			     file nil filepos (incf filepos blocksize))))
		 (progn (beginning-of-line)
317
                        (let ((pos (re-search-forward limit nil 'move)))
318 319
                          (when pos (delete-region (match-beginning 0)
						   (point-max)))
320
                          (not pos)))))))
321 322
    (set-buffer-modified-p nil)
    t))
323

324
(defun vc-find-root (file witness &optional invert)
325 326
  "Find the root of a checked out project.
The function walks up the directory tree from FILE looking for WITNESS.
327 328 329
If WITNESS if not found, return nil, otherwise return the root.
Optional arg INVERT non-nil reverses the sense of the check;
the root is the last directory for which WITNESS *is* found."
330 331 332
  ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
  ;; witnesses in /home or in /.
  (setq file (abbreviate-file-name file))
333
  (let ((root nil)
334
        (prev-file file)
335 336 337
        ;; `user' is not initialized outside the loop because
        ;; `file' may not exist, so we may have to walk up part of the
        ;; hierarchy before we find the "initial UID".
Miles Bader's avatar
Miles Bader committed
338
        (user nil)
339
        try)
340
    (while (not (or root
341 342 343 344 345 346
                    (null file)
                    ;; As a heuristic, we stop looking up the hierarchy of
                    ;; directories as soon as we find a directory belonging
                    ;; to another user.  This should save us from looking in
                    ;; things like /net and /afs.  This assumes that all the
                    ;; files inside a project belong to the same user.
347 348 349
                    (let ((prev-user user))
                      (setq user (nth 2 (file-attributes file)))
                      (and prev-user (not (equal user prev-user))))
350
                    (string-match vc-ignore-dir-regexp file)))
351 352 353 354 355 356 357 358 359 360 361
      (setq try (file-exists-p (expand-file-name witness file)))
      (cond ((and invert (not try)) (setq root prev-file))
            ((and (not invert) try) (setq root file))
            ((equal file (setq prev-file file
                               file (file-name-directory
                                     (directory-file-name file))))
             (setq file nil))))
    ;; Handle the case where ~/WITNESS exists and the original FILE is "~".
    ;; (This occurs, for example, when placing dotfiles under RCS.)
    (when (and (not root) invert prev-file)
      (setq root prev-file))
362 363
    root))

364 365 366
;; Access functions to file properties
;; (Properties should be _set_ using vc-file-setprop, but
;; _retrieved_ only through these functions, which decide
367
;; if the property is already known or not.  A property should
368 369
;; only be retrieved by vc-file-getprop if there is no
;; access function.)
370

371
;; properties indicating the backend being used for FILE
372

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

376 377 378 379
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
380
  (let (handler)
381
    (cond
382 383
     ((and (file-name-directory file) (string-match vc-ignore-dir-regexp (file-name-directory file)))
      nil)
384 385 386 387 388
     ((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
389 390 391
      ;; There is no file name handler.
      ;; Try vc-BACKEND-registered for each handled BACKEND.
      (catch 'found
392
	(let ((backend (vc-file-getprop file 'vc-backend)))
393
	  (mapc
394 395 396 397
	   (lambda (b)
	     (and (vc-call-backend b 'registered file)
		  (vc-file-setprop file 'vc-backend b)
		  (throw 'found t)))
398
	   (if (or (not backend) (eq backend 'none))
399 400
	       vc-handled-backends
	     (cons backend vc-handled-backends))))
Gerd Moellmann's avatar
Gerd Moellmann committed
401 402
        ;; File is not registered.
        (vc-file-setprop file 'vc-backend 'none)
403
        nil)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
404

405 406 407
(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
408
  ;; `file' can be nil in several places (typically due to the use of
409
  ;; code like (vc-backend buffer-file-name)).
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
  (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
425 426 427 428

(defun vc-backend-subdirectory-name (file)
  "Return where the master and lock FILEs for the current directory are kept."
  (symbol-name (vc-backend file)))
429

430
(defun vc-name (file)
Dave Love's avatar
Dave Love committed
431 432 433
  "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
434
  ;; in vc-hooks.
435
  (or (vc-file-getprop file 'vc-name)
436 437 438 439
      ;; force computation of the property by calling
      ;; vc-BACKEND-registered explicitly
      (if (and (vc-backend file)
	       (vc-call-backend (vc-backend file) 'registered file))
440
	  (vc-file-getprop file 'vc-name))))
441

442 443
(defun vc-checkout-model (backend files)
  "Indicate how FILES are checked out.
Gerd Moellmann's avatar
Gerd Moellmann committed
444

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

448
  'implicit   FILES are always writeable, and checked out `implicitly'
Gerd Moellmann's avatar
Gerd Moellmann committed
449 450
              when the user saves the first changes to the file.

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

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

460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475
(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
           (let ((default-directory (file-name-directory file)))
             (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
476 477 478 479

(defun vc-state (file)
  "Return the version control state of FILE.

480 481
If FILE is not registered, this function always returns nil.
For registered files, the value returned is one of:
Gerd Moellmann's avatar
Gerd Moellmann committed
482 483 484 485 486 487 488 489 490 491

  '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.

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

493
  'needs-update       The file has not been edited by the user, but there is
Gerd Moellmann's avatar
Gerd Moellmann committed
494 495 496 497 498 499 500 501
                     a more recent version on the current branch stored
                     in the master file.

  'needs-merge       The file has been edited by the user, and there is also
                     a more recent version on the current branch stored in
                     the master file.  This state can only occur if locking
                     is not used for the file.

Eric S. Raymond's avatar
Eric S. Raymond committed
502
  'unlocked-changes  The working version of the file is not locked,
Gerd Moellmann's avatar
Gerd Moellmann committed
503 504 505 506
                     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
507 508 509
                     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
510
                     Often represented by vc-working-revision = \"0\" in VCSes
511 512
                     with monotonic IDs like Subversion and Mercurial.

513
  'removed           Scheduled to be deleted from the repository on next commit.
514

515
  'conflict          The file contains conflicts as the result of a merge.
516 517
                     For now the conflicts are text conflicts.  In the
                     future this might be extended to deal with metadata
518 519
                     conflicts too.

520
  'missing           The file is not present in the file system, but the VC
521 522
                     system still tracks it.

523
  'ignored           The file showed up in a dir-status listing with a flag
524
                     indicating the version-control system is ignoring it,
525 526
                     Note: This property is not set reliably (some VCSes
                     don't have useful directory-status commands) so assume
527
                     that any file with vc-state nil might be ignorable
528
                     without VC knowing it.
529

530
  'unregistered      The file is not under version control.
531

532
A return of nil from this function means we have no information on the
533
status of this file."
Eric S. Raymond's avatar
Eric S. Raymond committed
534 535 536
  ;; 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
537

538 539
  ;; FIXME: New (sub)states needed (?):
  ;; - `copied' and `moved' (might be handled by `removed' and `added')
Gerd Moellmann's avatar
Gerd Moellmann committed
540
  (or (vc-file-getprop file 'vc-state)
541 542 543 544 545 546
      (when (> (length file) 0)
        (let ((backend (vc-backend file)))
          (when backend
            (vc-file-setprop
             file 'vc-state
             (vc-call-backend backend 'state-heuristic file)))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
547 548 549 550 551 552

(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)
553
  "Default implementation of vc-BACKEND-state-heuristic.
Dave Love's avatar
Dave Love committed
554 555
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
556
   (vc-call-backend backend 'state file))
557

558 559 560 561
(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))))
562 563 564
    (if (and checkout-time
             ;; Tramp and Ange-FTP return this when they don't know the time.
             (not (equal lastmod '(0 0))))
565 566 567 568 569 570 571 572
        (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 master version.
Return non-nil if FILE is unchanged."
573
  (zerop (condition-case err
574 575
             ;; If the implementation supports it, let the output
             ;; go to *vc*, not *vc-diff*, since this is an internal call.
576
             (vc-call-backend backend 'diff (list file) nil nil "*vc*")
577 578 579 580 581 582
           (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
583
                              (vc-find-backend-function backend 'diff))))
584 585
                    (not (eq (caddr err) 4)))
                (signal (car err) (cdr err))
586
              (vc-call-backend backend 'diff (list file)))))))
587

Eric S. Raymond's avatar
Eric S. Raymond committed
588
(defun vc-working-revision (file)
589
  "Return the repository version from which FILE was checked out.
590
If FILE is not registered, this function always returns nil."
Eric S. Raymond's avatar
Eric S. Raymond committed
591
  (or (vc-file-getprop file 'vc-working-revision)
592 593 594 595
      (let ((backend (vc-backend file)))
        (when backend
          (vc-file-setprop file 'vc-working-revision
                           (vc-call-backend backend 'working-revision file))))))
596

597 598 599
;; Backward compatibility.
(define-obsolete-function-alias
  'vc-workfile-version 'vc-working-revision "23.1")
600 601
(define-obsolete-function-alias
  'vc-previous-version 'vc-previous-revision "23.1")
602 603 604 605
(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))
606

Gerd Moellmann's avatar
Gerd Moellmann committed
607 608 609 610 611 612 613 614 615 616 617
(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)
      (put backend 'vc-templates-grabbed t)
      (set sym (append (delq nil
			     (mapcar
			      (lambda (template)
				(and (consp template)
				     (eq (cdr template) backend)
				     (car template)))
618 619
                              (with-no-warnings
                               vc-master-templates)))
Gerd Moellmann's avatar
Gerd Moellmann committed
620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638
		       (symbol-value sym))))
    (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)
639
  "Return non-nil if there is a master corresponding to FILE.
Gerd Moellmann's avatar
Gerd Moellmann committed
640 641 642 643 644 645 646 647 648 649 650 651 652 653 654

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
655
      (mapcar
Gerd Moellmann's avatar
Gerd Moellmann committed
656 657
       (lambda (s)
	 (let ((trial (vc-possible-master s dirname basename)))
658 659 660 661 662 663 664 665 666 667 668
	   (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
669 670
	       (throw 'found trial))))
       templates))))
671

672
(defun vc-toggle-read-only (&optional verbose)
673
  "Change read-only status of current buffer, perhaps via version control.
674

675
If the buffer is visiting a file registered with version control,
676 677
throw an error, because this is not a safe or really meaningful operation
on any version-control system newer than RCS.
678 679 680 681 682 683

Otherwise, just change the read-only flag of the buffer.

If you bind this function to \\[toggle-read-only], then Emacs
will properly intercept all attempts to toggle the read-only flag
on version-controlled buffer."
684
  (interactive "P")
685 686
  (if (vc-backend buffer-file-name)
      (error "Toggling the readability of a version controlled file is likely to wreak havoc.")
Eric S. Raymond's avatar
Eric S. Raymond committed
687 688
    (toggle-read-only)))

689
(defun vc-default-make-version-backups-p (backend file)
690
  "Return non-nil if unmodified versions should be backed up locally.
691
The default is to switch off this feature."
692 693
  nil)

694 695 696 697 698
(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."
699 700
  (if regexp
      (concat (regexp-quote (file-name-nondirectory file))
701
              "\\.~.+" (unless manual "\\.") "~")
702
    (expand-file-name (concat (file-name-nondirectory file)
703
                              ".~" (subst-char-in-string
Eric S. Raymond's avatar
Eric S. Raymond committed
704
                                    ?/ ?_ (or rev (vc-working-revision file)))
705 706
                              (unless manual ".") "~")
                      (file-name-directory file))))
707 708 709

(defun vc-delete-automatic-version-backups (file)
  "Delete all existing automatic version backups for FILE."
710
  (condition-case nil
711
      (mapc
712
       'delete-file
713
       (directory-files (or (file-name-directory file) default-directory) t
714 715 716
			(vc-version-backup-file-name file nil nil t)))
    ;; Don't fail when the directory doesn't exist.
    (file-error nil)))
717 718 719 720

(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."
721
  (unless (and (fboundp 'msdos-long-file-names)
722
               (not (with-no-warnings (msdos-long-file-names))))
723
    (vc-delete-automatic-version-backups file)
724 725 726 727 728
    (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.
729
      (file-error
730 731 732
       (message
        (concat "Warning: Cannot make version backup; "
                "diff/revert therefore not local"))))))
733 734 735 736 737 738

(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.
739 740
  (let ((file buffer-file-name)
        backend)
741
    (ignore-errors               ;Be careful not to prevent saving the file.
742
      (and (setq backend (vc-backend file))
743
           (vc-up-to-date-p file)
744
           (eq (vc-checkout-model backend (list file)) 'implicit)
745
           (vc-call-backend backend 'make-version-backups-p file)
746
           (vc-make-version-backup file)))))
747

748
(declare-function vc-dir-resynch-file "vc-dispatcher" (&optional fname))
749

750
(defun vc-after-save ()
Gerd Moellmann's avatar
Gerd Moellmann committed
751
  "Function to be called by `basic-save-buffer' (in files.el)."
Dave Love's avatar
Dave Love committed
752
  ;; If the file in the current buffer is under version control,
Gerd Moellmann's avatar
Gerd Moellmann committed
753 754
  ;; up-to-date, and locking is not used for the file, set
  ;; the state to 'edited and redisplay the mode line.
755 756 757
  (let* ((file buffer-file-name)
         (backend (vc-backend file)))
    (and backend
758 759 760 761 762 763 764
	 (or (and (equal (vc-file-getprop file 'vc-checkout-time)
			 (nth 5 (file-attributes file)))
		  ;; File has been saved in the same second in which
		  ;; it was checked out.  Clear the checkout-time
		  ;; to avoid confusion.
		  (vc-file-setprop file 'vc-checkout-time nil))
	     t)
Gerd Moellmann's avatar
Gerd Moellmann committed
765
         (vc-up-to-date-p file)
766
         (eq (vc-checkout-model backend (list file)) 'implicit)
Gerd Moellmann's avatar
Gerd Moellmann committed
767 768
         (vc-file-setprop file 'vc-state 'edited)
	 (vc-mode-line file)
769 770 771 772
	 ;; Try to avoid unnecessary work, a *vc-dir* buffer is only
	 ;; present if this is true.
	 (when (memq 'vc-dir-resynch-file after-save-hook)
	   (vc-dir-resynch-file file)))))
773

Stefan Monnier's avatar
Stefan Monnier committed
774 775 776 777 778 779 780 781 782 783
(defvar vc-menu-entry
  '(menu-item "Version Control" vc-menu-map
    :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))

784 785
(defconst vc-mode-line-map
  (let ((map (make-sparse-keymap)))
Stefan Monnier's avatar
Stefan Monnier committed
786
    (define-key map [mode-line down-mouse-1] vc-menu-entry)
787 788
    map))

Gerd Moellmann's avatar
Gerd Moellmann committed
789
(defun vc-mode-line (file)
Eric S. Raymond's avatar
Eric S. Raymond committed
790
  "Set `vc-mode' to display type of version control for FILE.
Eric S. Raymond's avatar
Eric S. Raymond committed
791
The value is set in the current buffer, which should be the buffer
Gerd Moellmann's avatar
Gerd Moellmann committed
792
visiting FILE."
793
  (interactive (list buffer-file-name))
794
  (let ((backend (vc-backend file)))
795 796
    (if (not backend)
	(setq vc-mode nil)
797
      (let* ((ml-string (vc-call-backend backend 'mode-line-string file))
798 799 800 801 802 803 804 805 806
             (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
807
                  'help-echo
808 809 810 811 812
                  (concat (or ml-echo
                              (format "File under the %s version control system"
                                      backend))
                          "\nmouse-1: Version Control menu")
                  'local-map vc-mode-line-map)))))
813 814 815 816 817 818 819 820 821
      ;; If the file is locked by some other user, make
      ;; the buffer read-only.  Like this, even root
      ;; cannot modify a file that someone else has locked.
      (and (equal file buffer-file-name)
	   (stringp (vc-state file))
	   (setq buffer-read-only t))
      ;; 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).
822 823 824
      ;; This way, even root cannot modify a file that isn't locked.
      (and (equal file buffer-file-name)
	   (not buffer-read-only)
825 826 827 828 829
	   (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
830 831 832 833 834 835 836 837 838 839 840 841

(defun vc-default-mode-line-string (backend file)
  "Return string for placement in modeline by `vc-mode-line' for FILE.
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

This function assumes that the file is registered."
  (setq backend (symbol-name backend))
  (let ((state   (vc-state file))
842
	(state-echo nil)
Eric S. Raymond's avatar
Eric S. Raymond committed
843
	(rev     (vc-working-revision file)))
844 845
    (propertize
     (cond ((or (eq state 'up-to-date)
846
		(eq state 'needs-update))
847 848 849 850 851
	    (setq state-echo "Up to date file")
	    (concat backend "-" rev))
	   ((stringp state)
	    (setq state-echo (concat "File locked by" state))
	    (concat backend ":" state ":" rev))
852 853 854
           ((eq state 'added)
            (setq state-echo "Locally added file")
            (concat backend "@" rev))
855 856 857
           ((eq state 'conflict)
            (setq state-echo "File contains conflicts after the last merge")
            (concat backend "!" rev))
858 859 860 861 862
           ((eq state 'removed)
            (setq state-echo "File removed from the VC system")
            (concat backend "!" rev))
           ((eq state 'missing)
            (setq state-echo "File tracked by the VC system, but missing from the file system")
863
            (concat backend "?" rev))
864 865 866
	   (t
	    ;; Not just for the 'edited state, but also a fallback
	    ;; for all other states.  Think about different symbols
867
	    ;; for 'needs-update and 'needs-merge.
868
	    (setq state-echo "Locally modified file")
869
	    (concat backend ":" rev)))
870
     'help-echo (concat state-echo " under the " backend
871
			" version control system"))))
872

873
(defun vc-follow-link ()
Gerd Moellmann's avatar
Gerd Moellmann committed
874 875 876
  "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."
877
  (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
878 879 880 881
         (true-buffer (find-buffer-visiting truename))
	 (this-buffer (current-buffer)))
    (if (eq true-buffer this-buffer)
	(progn
882
	  (kill-buffer this-buffer)
883 884 885
	  ;; 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.
886
	  (set-buffer (find-file-noselect truename)))
887 888
      (set-buffer true-buffer)
      (kill-buffer this-buffer))))
889

890 891 892
(defun vc-default-find-file-hook (backend)
  nil)

Eric S. Raymond's avatar
Eric S. Raymond committed
893
(defun vc-find-file-hook ()
894
  "Function for `find-file-hook' activating VC mode if appropriate."