- ;; Return `manual' if the user has to type C-x C-q to check out FILE.
- ;; Return `implicit' if the file can be modified without locking it first.
- (or
- (vc-file-getprop file 'vc-checkout-model)
- (cond
- ((eq (vc-backend file) 'SCCS)
- (vc-file-setprop file 'vc-checkout-model 'manual))
- ((eq (vc-backend file) 'RCS)
- (vc-consult-rcs-headers file)
- (or (vc-file-getprop file 'vc-checkout-model)
- (progn (vc-fetch-master-properties file)
- (vc-file-getprop file 'vc-checkout-model))))
- ((eq (vc-backend file) 'CVS)
- (vc-file-setprop file 'vc-checkout-model
- (if (getenv "CVSREAD") 'manual 'implicit))))))
-
-;;; properties indicating the locking state
-
-(defun vc-cvs-status (file)
- ;; Return the cvs status of FILE
- ;; (Status field in output of "cvs status")
- (cond ((vc-file-getprop file 'vc-cvs-status))
- (t (vc-fetch-master-properties file)
- (vc-file-getprop file 'vc-cvs-status))))
-
-(defun vc-master-locks (file)
- ;; Return the lock entries in the master of FILE.
- ;; Return 'none if there are no such entries, and a list
- ;; of the form ((VERSION USER) (VERSION USER) ...) otherwise.
- (cond ((vc-file-getprop file 'vc-master-locks))
- (t (vc-fetch-master-properties file)
- (vc-file-getprop file 'vc-master-locks))))
-
-(defun vc-master-locking-user (file)
- ;; Return the master file's idea of who is locking
- ;; the current workfile version of FILE.
- ;; Return 'none if it is not locked.
- (let ((master-locks (vc-master-locks file)) lock)
- (if (eq master-locks 'none) 'none
- ;; search for a lock on the current workfile version
- (setq lock (assoc (vc-workfile-version file) master-locks))
- (cond (lock (cdr lock))
- ('none)))))
-
-(defun vc-lock-from-permissions (file)
- ;; If the permissions can be trusted for this file, determine the
- ;; locking state from them. Returns (user-login-name), `none', or nil.
- ;; This implementation assumes that any file which is under version
- ;; control and has -rw-r--r-- is locked by its owner. This is true
- ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
- ;; We have to be careful not to exclude files with execute bits on;
- ;; scripts can be under version control too. Also, we must ignore the
- ;; group-read and other-read bits, since paranoid users turn them off.
- ;; This hack wins because calls to the somewhat expensive
- ;; `vc-fetch-master-properties' function only have to be made if
- ;; (a) the file is locked by someone other than the current user,
- ;; or (b) some untoward manipulation behind vc's back has changed
- ;; the owner or the `group' or `other' write bits.
- (let ((attributes (file-attributes file)))
- (if (not (vc-mistrust-permissions file))
- (cond ((string-match ".r-..-..-." (nth 8 attributes))
- (vc-file-setprop file 'vc-locking-user 'none))
- ((and (= (nth 2 attributes) (user-uid))
- (string-match ".rw..-..-." (nth 8 attributes)))
- (vc-file-setprop file 'vc-locking-user (user-login-name)))
- (nil)))))
-
-(defun vc-file-owner (file)
- ;; The expression below should return the username of the owner
- ;; of the file. It doesn't. It returns the username if it is
- ;; you, or otherwise the UID of the owner of the file. The
- ;; return value from this function is only used by
- ;; vc-dired-reformat-line, and it does the proper thing if a UID
- ;; is returned.
- ;; The *proper* way to fix this would be to implement a built-in
- ;; function in Emacs, say, (username UID), that returns the
- ;; username of a given UID.
- ;; The result of this hack is that vc-directory will print the
- ;; name of the owner of the file for any files that are
- ;; modified.
- (let ((uid (nth 2 (file-attributes file))))
- (if (= uid (user-uid)) (user-login-name) uid)))
-
-(defun vc-rcs-lock-from-diff (file)
- ;; Diff the file against the master version. If differences are found,
- ;; mark the file locked. This is only used for RCS with non-strict
- ;; locking. (If "rcsdiff" doesn't understand --brief, we do a double-take
- ;; and remember the fact for the future.)
- (let* ((version (concat "-r" (vc-workfile-version file)))
- (status (if (eq vc-rcsdiff-knows-brief 'no)
- (vc-simple-command 1 "rcsdiff" file version)
- (vc-simple-command 2 "rcsdiff" file "--brief" version))))
- (if (eq status 2)
- (if (not vc-rcsdiff-knows-brief)
- (setq vc-rcsdiff-knows-brief 'no
- status (vc-simple-command 1 "rcsdiff" file version))
- (error "rcsdiff failed."))
- (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes)))
- (if (zerop status)
- (vc-file-setprop file 'vc-locking-user 'none)
- (vc-file-setprop file 'vc-locking-user (vc-file-owner file)))))
-
-(defun vc-locking-user (file)
- ;; Return the name of the person currently holding a lock on FILE.
- ;; Return nil if there is no such person. (Sometimes, not the name
- ;; of the locking user but his uid will be returned.)
- ;; Under CVS, a file is considered locked if it has been modified since
- ;; it was checked out.
- ;; The property is cached. It is only looked up if it is currently nil.
- ;; Note that, for a file that is not locked, the actual property value
- ;; is `none', to distinguish it from an unknown locking state. That value
- ;; is converted to nil by this function, and returned to the caller.
- (let ((locking-user (vc-file-getprop file 'vc-locking-user)))
- (if locking-user
- ;; if we already know the property, return it
- (if (eq locking-user 'none) nil locking-user)
-
- ;; otherwise, infer the property...
- (cond
- ((eq (vc-backend file) 'CVS)
- (or (and (eq (vc-checkout-model file) 'manual)
- (vc-lock-from-permissions file))
- (and (equal (vc-file-getprop file 'vc-checkout-time)
- (nth 5 (file-attributes file)))
- (vc-file-setprop file 'vc-locking-user 'none))
- (let ((locker (vc-file-owner file)))
- (vc-file-setprop file 'vc-locking-user
- (if (stringp locker) locker
- (format "%d" locker))))))
-
- ((eq (vc-backend file) 'RCS)
- (let (p-lock)
-
- ;; Check for RCS headers first
- (or (eq (vc-consult-rcs-headers file) 'rev-and-lock)
-
- ;; If there are no headers, try to learn it
- ;; from the permissions.
- (and (setq p-lock (vc-lock-from-permissions file))
- (if (eq p-lock 'none)
-
- ;; If the permissions say "not locked", we know
- ;; that the checkout model must be `manual'.
- (vc-file-setprop file 'vc-checkout-model 'manual)
-
- ;; If the permissions say "locked", we can only trust
- ;; this *if* the checkout model is `manual'.
- (eq (vc-checkout-model file) 'manual)))
-
- ;; Otherwise, use lock information from the master file.
- (vc-file-setprop file 'vc-locking-user
- (vc-master-locking-user file)))
-
- ;; Finally, if the file is not explicitly locked
- ;; it might still be locked implicitly.
- (and (eq (vc-file-getprop file 'vc-locking-user) 'none)
- (eq (vc-checkout-model file) 'implicit)
- (vc-rcs-lock-from-diff file))))
-
- ((eq (vc-backend file) 'SCCS)
- (or (vc-lock-from-permissions file)
- (vc-file-setprop file 'vc-locking-user
- (vc-master-locking-user file)))))
-
- ;; convert a possible 'none value
- (setq locking-user (vc-file-getprop file 'vc-locking-user))
- (if (eq locking-user 'none) nil locking-user))))
-
-;;; properties to store current and recent version numbers
-
-(defun vc-latest-version (file)
- ;; Return version level of the latest version of FILE
- (cond ((vc-file-getprop file 'vc-latest-version))
- (t (vc-fetch-properties file)
- (vc-file-getprop file 'vc-latest-version))))
-
-(defun vc-your-latest-version (file)
- ;; Return version level of the latest version of FILE checked in by you
- (cond ((vc-file-getprop file 'vc-your-latest-version))
- (t (vc-fetch-properties file)
- (vc-file-getprop file 'vc-your-latest-version))))
-
-(defun vc-master-workfile-version (file)
- ;; Return the master file's idea of what is the current workfile version.
- ;; This property is defined for RCS only.
- (cond ((vc-file-getprop file 'vc-master-workfile-version))
- (t (vc-fetch-master-properties file)
- (vc-file-getprop file 'vc-master-workfile-version))))
-
-(defun vc-fetch-properties (file)
- ;; Fetch vc-latest-version and vc-your-latest-version
- ;; if that wasn't already done.
- (cond
- ((eq (vc-backend file) 'RCS)
- (save-excursion
- (set-buffer (get-buffer-create "*vc-info*"))
- (vc-insert-file (vc-name file) "^desc")
- (vc-parse-buffer
- (list '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2)
- (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n"
- "date[ \t]+\\([0-9.]+\\);[ \t]+"
- "author[ \t]+"
- (regexp-quote (user-login-name)) ";") 1 2))
- file
- '(vc-latest-version vc-your-latest-version))
- (if (get-buffer "*vc-info*")
- (kill-buffer (get-buffer "*vc-info*")))))
- (t (vc-fetch-master-properties file))
- ))
+ "Indicate how FILE is checked out.
+
+If FILE is not registered, this function always returns nil.
+For registered files, the possible values are:
+
+ 'implicit FILE is always writeable, and checked out `implicitly'
+ when the user saves the first changes to the file.
+
+ 'locking FILE is read-only if up-to-date; user must type
+ \\[vc-next-action] before editing. Strict locking
+ is assumed.
+
+ 'announce FILE is read-only if up-to-date; user must type
+ \\[vc-next-action] before editing. But other users
+ may be editing at the same time."
+ (or (vc-file-getprop file 'vc-checkout-model)
+ (if (vc-backend file)
+ (vc-file-setprop file 'vc-checkout-model
+ (vc-call checkout-model file)))))
+
+(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))))
+
+(defun vc-state (file)
+ "Return the version control state of FILE.
+
+If FILE is not registered, this function always returns nil.
+For registered files, the value returned is one of:
+
+ '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).
+
+ 'needs-patch The file has not been edited by the user, but there is
+ 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.
+
+ 'unlocked-changes The current version of the working file is not locked,
+ 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
+ prompt the user to do it)."
+ ;; FIXME: New (sub)states needed (?):
+ ;; - `added' (i.e. `edited' but with no base version yet,
+ ;; typically represented by vc-workfile-version = "0")
+ ;; - `conflict' (i.e. `edited' with conflict markers)
+ ;; - `removed'
+ ;; - `copied' and `moved' (might be handled by `removed' and `added')
+ (or (vc-file-getprop file 'vc-state)
+ (if (vc-backend file)
+ (vc-file-setprop file 'vc-state
+ (vc-call state-heuristic file)))))
+
+(defun vc-recompute-state (file)
+ "Recompute the version control state of FILE, and return it.
+This calls the possibly expensive function vc-BACKEND-state,
+rather than the heuristic."
+ (vc-file-setprop file 'vc-state (vc-call 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-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))))
+ (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 master 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 diff 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 (vc-backend file)
+ 'diff))))
+ (not (eq (caddr err) 4)))
+ (signal (car err) (cdr err))
+ (vc-call diff file))))))