Commit 0e0d9831 authored by Gerd Moellmann's avatar Gerd Moellmann
Browse files

Minor doc fixes.

(vc-default-mode-line-string): Show state
`needs-patch' as a `-' too.
(vc-after-save): Call vc-dired-resynch-file.
(vc-file-not-found-hook): Ask the user whether to
check out a non-existing file.
(vc-find-backend-function): If function doesn't
exist, return nil instead of error.
(vc-call-backend): Doc fix.
(vc-prefix-map): Move the autoload from vc.el.
(vc-simple-command): Removed.
(vc-handled-backends): Docstring change.
(vc-ignore-vc-files): Mark obsolete.
(vc-registered): Check vc-ignore-vc-files.
(vc-find-file-hook, vc-file-not-found-hook): Don't check
vc-ignore-vc-files.
(vc-parse-buffer): Lobotomize the monster.
(vc-simple-command): Docstring fix.
(vc-registered): Align the way the file-handler is called with the
way the function itself works.
(vc-file-owner): Remove.
(vc-header-alist): Move the dummy def from vc.el.
(vc-backend-hook-functions): Remove.
(vc-find-backend-function): Don't try to load vc-X-hooks anymore.
(vc-backend): Reintroduce the test for `file = nil' now that I
know why it was there (and added a comment to better remember).
 Update Copyright.
(vc-backend): Don't accept a nil argument any more.
(vc-up-to-date-p): Turn into a defsubst.
(vc-possible-master): New function.
(vc-check-master-templates): Use `vc-possible-master' and allow
funs in vc-X-master-templates to return a non-existent file.
(vc-loadup): Remove.
(vc-find-backend-function): Use `require'.  Also, handle the case
where vc-BACKEND-hooks.el doesn't exist.
(vc-call-backend): Cleanup.
(vc-find-backend-function): Return a cons cell if
using the default function.
(vc-call-backend): If calling the default function, pass it the
backend as first argument.  Update the docstring accordingly.
(vc-default-state-heuristic, vc-default-mode-line-string): Update
for the new backend argument.
(vc-make-backend-sym): Renamed from vc-make-backend-function.
(vc-find-backend-function): Use the new name.
(vc-default-registered): New function.
(vc-backend-functions): Remove.
(vc-loadup): Don't setup 'vc-functions.
(vc-find-backend-function): New function.
(vc-call-backend): Use above fun and populate 'vc-functions
lazily.
(vc-backend-defines): Remove.
(vc-backend-hook-functions, vc-backend-functions)
(vc-make-backend-function, vc-call): Pass names without leading
`vc-' to vc-call-backend so we can blindly prefix them with
vc-BACKEND.
(vc-loadup): Don't load vc-X-hooks if vc-X is requested.
(vc-call-backend): Always try to load vc-X-hooks.
(vc-registered): Remove vc- in call to vc-call-backend.
(vc-default-back-end, vc-buffer-backend): Remove.
(vc-kill-buffer-hook): Remove `vc-buffer-backend' handling.
(vc-loadup): Load files quietly.
(vc-call-backend): Oops, brain fart.
(vc-locking-user): If locked by the calling user,
return that name.  Redocumented.
(vc-user-login-name): Simplify the code a tiny bit.
(vc-state): Don't use 'reserved any more.  Just use the same
convention as the one used for vc-<backend>-state where the
locking user (as a string) is returned.
(vc-locking-user): Update, based on the above convention. The
'vc-locking-user property has disappeared.
(vc-mode-line, vc-default-mode-line-string): Adapt to new
`vc-state'.
(vc-backend-functions): Removed vc-toggle-read-only.
(vc-toggle-read-only): Undid prev change.
(vc-master-templates): Def the obsolete var.
(vc-file-prop-obarray): Use `make-vector'.
(vc-backend-functions): Add new hookable functions
vc-toggle-read-only, vc-record-rename and vc-merge-news.
(vc-loadup): If neither backend nor default functions exist, use
the backend function rather than nil.
(vc-call-backend): If the function if not bound yet, try to load
the non-hook file to see if it provides it.
(vc-call): New macro plus use it wherever possible.
(vc-backend-subdirectory-name): Use neither `vc-default-back-end'
nor `vc-find-binary' since it's only called from
vc-mistrust-permission which is only used once the backend is
known.
(vc-checkout-model): Fix parenthesis.
(vc-recompute-state, vc-prefix-map): Move to vc.el.
(vc-backend-functions): Renamed `vc-steal' to
`vc-steal-lock'.
(vc-call-backend): Changed error message.
(vc-state): Added description of state `unlocked-changes'.
(vc-backend-hook-functions, vc-backend-functions):
Updated function lists.
(vc-call-backend): Fixed typo.
(vc-backend-hook-functions): Renamed vc-uses-locking
to vc-checkout-model.
(vc-checkout-required): Renamed to vc-checkout-model.
Re-implemented and re-commented.
(vc-after-save): Use vc-checkout-model.
(vc-backend-functions): Added `vc-diff' to the list
of functions possibly implemented in a vc-BACKEND library.
(vc-checkout-required): Bug fixed that caused an error to be
signaled during `vc-after-save'.
(vc-backend-hook-functions): `vc-checkout-required'
updated to `vc-uses-locking'.
(vc-checkout-required): Call to backend function
`vc-checkout-required' updated to `vc-uses-locking' instead.
(vc-parse-buffer): Bug found and fixed.
(vc-backend-functions): `vc-annotate-command',
`vc-annotate-difference' added to supported backend functions.
 vc-state-heuristic added to
vc-backend-hook-functions.
 Implemented new state model.
(vc-state, vc-state-heuristic, vc-default-state-heuristic): New
functions.
(vc-locking-user): Simplified.  Now only needed if the file is
locked by somebody else.
(vc-lock-from-permissions): Removed.  Functionality is in
vc-sccs-hooks.el and vc-rcs-hooks.el now.
(vc-mode-line-string): New name for former vc-status.  Adapted.
(vc-mode-line): Adapted to use the above.  Removed optional
parameter.
(vc-master-templates): Is really obsolete.
Commented out the definition for now.  What is the right procedure
to get rid of it?
(vc-registered, vc-backend, vc-buffer-backend, vc-name): Largely
rewritten.
(vc-default-registered): Removed.
(vc-check-master-templates): New function; does mostly what the
above did before.
(vc-locking-user): Don't rely on the backend to set the property.
(vc-latest-version, vc-your-latest-version): Removed.
(vc-backend-hook-functions): Removed them from this list, too.
(vc-fetch-properties): Removed.
(vc-workfile-version): Doc fix.
(vc-consult-rcs-headers):
Moved into vc-rcs-hooks.el, under the name
vc-rcs-consult-headers.
(vc-master-locks, vc-master-locking-user):
Moved into both
vc-rcs-hooks.el and vc-sccs-hooks.el.  These properties and access
functions are implementation details of those two backends.
(vc-parse-locks, vc-fetch-master-properties): Split
into back-end specific parts and removed.  Callers not updated
yet; because I guess these callers will disappear into back-end
specific files anyway.
(vc-checkout-model): Renamed to vc-uses-locking.
Store yes/no in the property, and return t/nil.  Updated all
callers.
(vc-checkout-model): Punt to backends.
(vc-default-locking-user): New function.
(vc-locking-user, vc-workfile-version): Punt to backends.
(vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff)
(vc-master-workfile-version): Moved from vc-hooks.
(vc-lock-file): Moved to vc-sccs-hooks and renamed.
(vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status):
Moved to vc-cvs-hooks.
 Add doc strings in various places.  Simplify the
minor mode setup.
(vc-handled-backends): New user variable.
(vc-parse-buffer, vc-insert-file, vc-default-registered): Minor
simplification.
(vc-backend-hook-functions, vc-backend-functions):
New variable.
(vc-make-backend-function, vc-loadup, vc-call-backend)
(vc-backend-defines): New functions.
 Various doc fixes.
(vc-default-back-end, vc-follow-symlinks): Custom fix.
(vc-match-substring): Function removed.  Callers changed to use
match-string.
(vc-lock-file, vc-consult-rcs-headers, vc-kill-buffer-hook):
Simplify.
 vc-registered has been renamed
vc-default-registered.  Some functions have been moved to the
backend specific files.  they all support the
vc-BACKEND-registered functions.
 This is 1998-11-11T18:47:32Z!kwzh@gnu.org from the emacs sources
parent 0769107a
;;; vc-hooks.el --- resident support for version-control
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998 Free Software Foundation, Inc.
;; Copyright (C) 1992,93,94,95,96,98,99,2000 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; $Id: vc-hooks.el,v 1.1 2000/01/10 13:25:12 gerd Exp gerd $
;; $Id: vc-hooks.el,v 1.53 2000/08/13 11:36:46 spiegel Exp $
;; This file is part of GNU Emacs.
......@@ -26,32 +26,28 @@
;;; Commentary:
;; This is the always-loaded portion of VC.
;; It takes care 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.
;; 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.
;;; Code:
;; Customization Variables (the rest is in vc.el)
(defcustom vc-default-back-end nil
"*Back-end actually used by this interface; may be SCCS or RCS.
The value is only computed when needed to avoid an expensive search."
:type '(choice (const nil) (const RCS) (const SCCS))
:group 'vc)
(defcustom vc-handle-cvs t
"*If non-nil, use VC for files managed with CVS.
If it is nil, don't use VC for those files."
:type 'boolean
:group 'vc)
(defcustom vc-rcsdiff-knows-brief nil
"*Indicates whether rcsdiff understands the --brief option.
The value is either `yes', `no', or nil. If it is nil, VC tries
to use --brief and sets this variable to remember whether it worked."
:type '(choice (const nil) (const yes) (const no))
(defvar vc-ignore-vc-files nil "Obsolete -- use `vc-handled-backends'.")
(defvar vc-master-templates () "Obsolete -- use vc-BACKEND-master-templates.")
(defvar vc-header-alist () "Obsolete -- use vc-BACKEND-header.")
(defcustom vc-handled-backends '(RCS CVS SCCS)
"*List of version control backends for which VC will be used.
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)
:version "20.5"
:group 'vc)
(defcustom vc-path
......@@ -62,18 +58,6 @@ to use --brief and sets this variable to remember whether it worked."
:type '(repeat directory)
:group 'vc)
(defcustom vc-master-templates
'(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
vc-find-cvs-master
vc-search-sccs-project-dir)
"*Where to look for version-control master files.
The first pair corresponding to a given back end is used as a template
when creating new masters.
Setting this variable to nil turns off use of VC entirely."
:type '(repeat sexp)
:group 'vc)
(defcustom vc-make-backup-files nil
"*If non-nil, backups of registered files are made as with other files.
If nil (the default), files covered by version control don't get backups."
......@@ -81,15 +65,17 @@ If nil (the default), files covered by version control don't get backups."
:group 'vc)
(defcustom vc-follow-symlinks 'ask
"*Indicates what to do if you visit a symbolic link to a file
that is under version control. 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,
"*What to do if visiting a symbolic link to a file under version control.
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,
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
visited and a warning displayed."
:type '(choice (const ask) (const nil) (const t))
:type '(choice (const :tag "Ask for confirmation" ask)
(const :tag "Visit link and warn" nil)
(const :tag "Follow link" t))
:group 'vc)
(defcustom vc-display-status t
......@@ -112,133 +98,109 @@ value of this flag."
:group 'vc)
(defcustom vc-mistrust-permissions nil
"*If non-nil, don't assume that permissions and ownership track
version-control status. If nil, do rely on the permissions.
"*If non-nil, don't assume permissions/ownership track version-control status.
If nil, do rely on the permissions.
See also variable `vc-consult-headers'."
:type 'boolean
:group 'vc)
(defcustom vc-ignore-vc-files nil
"*If non-nil don't look for version control information when finding files.
It may be useful to set this if (say) you edit files in a directory
containing corresponding RCS files but don't have RCS available;
similarly for other version control systems."
:type 'boolean
:group 'vc
:version "20.3")
(defun vc-mistrust-permissions (file)
;; Access function to the above.
"Internal access function to variable `vc-mistrust-permissions' for FILE."
(or (eq vc-mistrust-permissions 't)
(and vc-mistrust-permissions
(funcall vc-mistrust-permissions
(funcall vc-mistrust-permissions
(vc-backend-subdirectory-name file)))))
;; Tell Emacs about this new kind of minor mode
(if (not (assoc 'vc-mode minor-mode-alist))
(setq minor-mode-alist (cons '(vc-mode vc-mode)
minor-mode-alist)))
(add-to-list 'minor-mode-alist '(vc-mode vc-mode))
(make-variable-buffer-local 'vc-mode)
(put 'vc-mode 'permanent-local t)
;; We need a notion of per-file properties because the version
;; control state of a file is expensive to derive --- we compute
;; them when the file is initially found, keep them up to date
;; them when the file is initially found, keep them up to date
;; during any subsequent VC operations, and forget them when
;; the buffer is killed.
(defmacro vc-error-occurred (&rest body)
(list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
(defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
(defvar vc-file-prop-obarray (make-vector 16 0)
"Obarray for per-file properties.")
(defvar vc-buffer-backend t)
(make-variable-buffer-local 'vc-buffer-backend)
(defun vc-file-setprop (file property value)
;; set per-file property
"Set per-file VC PROPERTY for FILE to VALUE."
(put (intern file vc-file-prop-obarray) property value))
(defun vc-file-getprop (file property)
;; get per-file property
"get per-file VC PROPERTY for FILE."
(get (intern file vc-file-prop-obarray) property))
(defun vc-file-clearprops (file)
;; clear all properties of a given file
"Clear all VC properties of FILE."
(setplist (intern file vc-file-prop-obarray) nil))
;;; Functions that determine property values, by examining the
;;; working file, the master file, or log program output
(defun vc-match-substring (bn)
(buffer-substring (match-beginning bn) (match-end bn)))
(defun vc-lock-file (file)
;; Generate lock file name corresponding to FILE
(let ((master (vc-name file)))
(and
master
(string-match "\\(.*/\\)s\\.\\(.*\\)" master)
(concat
(substring master (match-beginning 1) (match-end 1))
"p."
(substring master (match-beginning 2) (match-end 2))))))
(defun vc-parse-buffer (patterns &optional file properties)
;; Use PATTERNS to parse information out of the current buffer.
;; Each element of PATTERNS is a list of 2 to 3 elements. The first element
;; is the pattern to be matched, and the second (an integer) is the
;; number of the subexpression that should be returned. If there's
;; a third element (also the number of a subexpression), that
;; subexpression is assumed to be a date field and we want the most
;; recent entry matching the template; this works for RCS format dates only.
;; If FILE and PROPERTIES are given, the latter must be a list of
;; properties of the same length as PATTERNS; each property is assigned
;; the corresponding value.
(mapcar (function (lambda (p)
(goto-char (point-min))
(cond
((eq (length p) 2) ;; search for first entry
(let ((value nil))
(if (re-search-forward (car p) nil t)
(setq value (vc-match-substring (elt p 1))))
(if file
(progn (vc-file-setprop file (car properties) value)
(setq properties (cdr properties))))
value))
((eq (length p) 3) ;; search for latest entry
(let ((latest-date "") (latest-val))
(while (re-search-forward (car p) nil t)
(let ((date (vc-match-substring (elt p 2))))
;; Most (but not all) versions of RCS use two-digit years
;; to represent dates in the range 1900 through 1999.
;; The two-digit and four-digit notations can both appear
;; in the same file. Normalize the two-digit versions.
(save-match-data
(if (string-match "\\`[0-9][0-9]\\." date)
(setq date (concat "19" date))))
(if (string< latest-date date)
(progn
(setq latest-date date)
(setq latest-val
(vc-match-substring (elt p 1)))))))
(if file
(progn (vc-file-setprop file (car properties) latest-val)
(setq properties (cdr properties))))
latest-val)))))
patterns)
)
;; 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.
If there is no such implementation, return the default implementation;
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."
(let ((f (cdr (assoc function-name (get backend 'vc-functions)))))
(unless f
(setq f (vc-find-backend-function backend function-name))
(put backend 'vc-functions (cons (cons function-name f)
(get backend 'vc-functions))))
(if (consp f)
(apply (car f) (cdr f) args)
(apply f args))))
(defmacro vc-call (fun file &rest args)
;; BEWARE!! `file' is evaluated twice!!
`(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)))
(defun vc-insert-file (file &optional limit blocksize)
;; 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 occurrence of
;; LIMIT is found. The function returns nil if FILE
;; doesn't exist.
"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
occurrence of LIMIT is found. The function returns nil if FILE doesn't
exist."
(erase-buffer)
(cond ((file-exists-p file)
(cond (limit
......@@ -247,10 +209,9 @@ similarly for other version control systems."
(while (not found)
(setq s (buffer-size))
(goto-char (1+ s))
(setq found
(or (zerop (car (cdr
(insert-file-contents file nil s
(+ s blocksize)))))
(setq found
(or (zerop (cadr (insert-file-contents
file nil s (+ s blocksize))))
(progn (beginning-of-line)
(re-search-forward limit nil t)))))))
(t (insert-file-contents file)))
......@@ -259,712 +220,213 @@ similarly for other version control systems."
t)
(t nil)))
(defun vc-parse-locks (file locks)
;; Parse RCS or SCCS locks.
;; The result is a list of the form ((VERSION USER) (VERSION USER) ...),
;; which is returned and stored into the property `vc-master-locks'.
(if (not locks)
(vc-file-setprop file 'vc-master-locks 'none)
(let ((found t) (index 0) master-locks version user)
(cond ((eq (vc-backend file) 'SCCS)
(while (string-match "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?"
locks index)
(setq version (substring locks
(match-beginning 1) (match-end 1)))
(setq user (substring locks
(match-beginning 2) (match-end 2)))
(setq master-locks (append master-locks
(list (cons version user))))
(setq index (match-end 0))))
((eq (vc-backend file) 'RCS)
(while (string-match "[ \t\n]*\\([^:]+\\):\\([0-9.]+\\)"
locks index)
(setq version (substring locks
(match-beginning 2) (match-end 2)))
(setq user (substring locks
(match-beginning 1) (match-end 1)))
(setq master-locks (append master-locks
(list (cons version user))))
(setq index (match-end 0)))
(if (string-match ";[ \t\n]+strict;" locks index)
(vc-file-setprop file 'vc-checkout-model 'manual)
(vc-file-setprop file 'vc-checkout-model 'implicit))))
(vc-file-setprop file 'vc-master-locks (or master-locks 'none)))))
(defun vc-simple-command (okstatus command file &rest args)
;; Simple version of vc-do-command, for use in vc-hooks only.
;; Don't switch to the *vc-info* buffer before running the
;; command, because that would change its default directory
(save-excursion (set-buffer (get-buffer-create "*vc-info*"))
(erase-buffer))
(let ((exec-path (append vc-path exec-path)) exec-status
;; Add vc-path to PATH for the execution of this command.
(process-environment
(cons (concat "PATH=" (getenv "PATH")
path-separator
(mapconcat 'identity vc-path path-separator))
process-environment)))
(setq exec-status
(apply 'call-process command nil "*vc-info*" nil
(append args (list file))))
(cond ((> exec-status okstatus)
(switch-to-buffer (get-file-buffer file))
(shrink-window-if-larger-than-buffer
(display-buffer "*vc-info*"))
(error "Couldn't find version control information")))
exec-status))
(defun vc-parse-cvs-status (&optional full)
;; Parse output of "cvs status" command in the current buffer and
;; set file properties accordingly. Unless FULL is t, parse only
;; essential information.
(let (file status)
(goto-char (point-min))
(if (re-search-forward "^File: " nil t)
(cond
((looking-at "no file") nil)
((re-search-forward "\\=\\([^ \t]+\\)" nil t)
(setq file (concat default-directory (match-string 1)))
(vc-file-setprop file 'vc-backend 'CVS)
(if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
(setq status "Unknown")
(setq status (match-string 1)))
(if (and full
(re-search-forward
"\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)"
nil t))
(vc-file-setprop file 'vc-latest-version (match-string 2)))
(cond
((string-match "Up-to-date" status)
(vc-file-setprop file 'vc-cvs-status 'up-to-date)
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file))))
((vc-file-setprop file 'vc-cvs-status
(cond
((string-match "Locally Modified" status) 'locally-modified)
((string-match "Needs Merge" status) 'needs-merge)
((string-match "Needs \\(Checkout\\|Patch\\)" status)
'needs-checkout)
((string-match "Unresolved Conflict" status)
'unresolved-conflict)
((string-match "File had conflicts on merge" status)
'unresolved-conflict)
((string-match "Locally Added" status) 'locally-added)
((string-match "New file!" status) 'locally-added)
(t 'unknown))))))))))
(defun vc-fetch-master-properties (file)
;; Fetch those properties of FILE that are stored in the master file.
;; For an RCS file, we don't get vc-latest-version vc-your-latest-version
;; here because that is slow.
;; That gets done if/when the functions vc-latest-version
;; and vc-your-latest-version get called.
(save-excursion
(cond
((eq (vc-backend file) 'SCCS)
(set-buffer (get-buffer-create "*vc-info*"))
(if (vc-insert-file (vc-lock-file file))
(vc-parse-locks file (buffer-string))
(vc-file-setprop file 'vc-master-locks 'none))
(vc-insert-file (vc-name file) "^\001e")
(vc-parse-buffer
(list '("^\001d D \\([^ ]+\\)" 1)
(list (concat "^\001d D \\([^ ]+\\) .* "
(regexp-quote (vc-user-login-name)) " ") 1))
file
'(vc-latest-version vc-your-latest-version)))
((eq (vc-backend file) 'RCS)
(set-buffer (get-buffer-create "*vc-info*"))
(vc-insert-file (vc-name file) "^[0-9]")
(vc-parse-buffer
(list '("^head[ \t\n]+\\([^;]+\\);" 1)
'("^branch[ \t\n]+\\([^;]+\\);" 1)
'("^locks[ \t\n]*\\([^;]*;\\([ \t\n]*strict;\\)?\\)" 1))
file
'(vc-head-version
vc-default-branch
vc-master-locks))
;; determine vc-master-workfile-version: it is either the head
;; of the trunk, the head of the default branch, or the
;; "default branch" itself, if that is a full revision number.
(let ((default-branch (vc-file-getprop file 'vc-default-branch)))
(cond
;; no default branch
((or (not default-branch) (string= "" default-branch))
(vc-file-setprop file 'vc-master-workfile-version
(vc-file-getprop file 'vc-head-version)))
;; default branch is actually a revision
((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
default-branch)
(vc-file-setprop file 'vc-master-workfile-version default-branch))
;; else, search for the head of the default branch
(t (vc-insert-file (vc-name file) "^desc")
(vc-parse-buffer (list (list
(concat "^\\("
(regexp-quote default-branch)
"\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))
file '(vc-master-workfile-version)))))
;; translate the locks
(vc-parse-locks file (vc-file-getprop file 'vc-master-locks)))
((eq (vc-backend file) 'CVS)
(save-excursion
;; Call "cvs status" in the right directory, passing only the
;; nondirectory part of the file name -- otherwise CVS might
;; silently give a wrong result.
(let ((default-directory (file-name-directory file)))
(vc-simple-command 0 "cvs" (file-name-nondirectory file) "status"))
(set-buffer (get-buffer "*vc-info*"))
(vc-parse-cvs-status t))))
(if (get-buffer "*vc-info*")
(kill-buffer (get-buffer "*vc-info*")))))
;;; Functions that determine property values, by examining the
;;; working file, the master file, or log program output
(defun vc-consult-rcs-headers (file)
;; Search for RCS headers in FILE, and set properties
;; accordingly. This function can be disabled by setting
;; vc-consult-headers to nil.
;; Returns: nil if no headers were found
;; (or if the feature is disabled,
;; or if there is currently no buffer
;; visiting FILE)
;; 'rev if a workfile revision was found
;; 'rev-and-lock if revision and lock info was found
(cond
((or (not vc-consult-headers)
(not (get-file-buffer file))) nil)
((let (status version locking-user)
(save-excursion
(set-buffer (get-file-buffer file))
(goto-char (point-min))
(cond
;; search for $Id or $Header
;; -------------------------
;; The `\ 's below avoid an RCS 5.7 bug when checking in this file.
((or (and (search-forward "$Id\ : " nil t)
(looking-at "[^ ]+ \\([0-9.]+\\) "))
(and (progn (goto-char (point-min))
(search-forward "$Header\ : " nil t))
(looking-at "[^ ]+ \\([0-9.]+\\) ")))
(goto-char (match-end 0))
;; if found, store the revision number ...
(setq version (buffer-substring-no-properties (match-beginning 1)
(match-end 1)))
;; ... and check for the locking state
(cond
((looking-at
(concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date
"[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
"[^ ]+ [^ ]+ ")) ; author & state
(goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
(cond
;; unlocked revision
((looking-at "\\$")
(setq locking-user 'none)
(setq status 'rev-and-lock))
;; revision is locked by some user
((looking-at "\\([^ ]+\\) \\$")
(setq locking-user
(buffer-substring-no-properties (match-beginning 1)
(match-end 1)))
(setq status 'rev-and-lock))
;; everything else: false
(nil)))
;; unexpected information in
;; keyword string --> quit
(nil)))
;; search for $Revision
;; --------------------
((re-search-forward (concat "\\$"
"Revision: \\([0-9.]+\\) \\$")
nil t)
;; if found, store the revision number ...
(setq version (buffer-substring-no-properties (match-beginning 1)
(match-end 1)))
;; and see if there's any lock information
(goto-char (point-min))
(if (re-search-forward (concat "\\$" "Locker:") nil t)
(cond ((looking-at " \\([^ ]+\\) \\$")
(setq locking-user (buffer-substring-no-properties
(match-beginning 1)
(match-end 1)))
(setq status 'rev-and-lock))
((looking-at " *\\$")
(setq locking-user 'none)
(setq status 'rev-and-lock))
(t
(setq locking-user 'none)
(setq status 'rev-and-lock)))
(setq status 'rev)))
;; else: nothing found
;; -------------------
(t nil)))
(if status (vc-file-setprop file 'vc-workfile-version version))
(and (eq status 'rev-and-lock)
(eq (vc-backend file) 'RCS)
(vc-file-setprop file 'vc-locking-user locking-user)
;; If the file has headers, we don't want to query the master file,
;; because that would eliminate all the performance gain the headers
;; brought us. We therefore use a heuristic for the checkout model
;; now: If we trust the file permissions, and the file is not
;; locked, then if the file is read-only the checkout model is
;; `manual', otherwise `implicit'.
(not (vc-mistrust-permissions file))
(not (vc-locking-user file))
(if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
(vc-file-setprop file 'vc-checkout-model 'manual)
(vc-file-setprop file 'vc-checkout-model 'implicit)))
status))))
;;; Access functions to file properties
;;; (Properties should be _set_ using vc-file-setprop, but
;;; _retrieved_ only through these functions, which decide
;;; if the property is already known or not. A property should
;;; only be retrieved by vc-file-getprop if there is no
;;; only be retrieved by vc-file-getprop if there is no
;;; access function.)
;;; properties indicating the backend
;;; being used for FILE
;;; properties indicating the backend being used for FILE
(defun vc-backend-subdirectory-name (&optional file)
;; Where the master and lock files for the current directory are kept
(symbol-name
(or
(and file (vc-backend file))
vc-default-back-end
(setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))))
(defun vc-registered (file)
"Return non-nil if FILE is registered in a version control system.
This function does not cache its result; it performs the test each
time it is invoked on a file. For a caching check whether a file is
registered, use `vc-backend'."
(let (handler)
(if (boundp 'file-name-handler-alist)
(setq handler (find-file-name-handler file 'vc-registered)))
(if handler
;; handler should set vc-backend and return t if registered
(funcall handler 'vc-registered file)
;; There is no file name handler.