(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))
:group 'vc)
(defcustom vc-path
(if (file-directory-p "/usr/sccs")
'("/usr/sccs")
nil)
"*List of extra directories to search for version control commands."
: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."
:type 'boolean
: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,
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))
:group 'vc)
(defcustom vc-display-status t
"*If non-nil, display revision number and lock status in modeline.
Otherwise, not displayed."
:type 'boolean
:group 'vc)
(defcustom vc-consult-headers t
"*If non-nil, identify work files by searching for version headers."
:type 'boolean
:group 'vc)
(defcustom vc-keep-workfiles t
"*If non-nil, don't delete working files after registering changes.
If the back-end is CVS, workfiles are always kept, regardless of the
value of this flag."
:type 'boolean
: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.
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)
(or (eq vc-mistrust-permissions 't)
(and vc-mistrust-permissions
(funcall vc-mistrust-permissions
(vc-backend-subdirectory-name file)))))
(if (not (assoc 'vc-mode minor-mode-alist))
(setq minor-mode-alist (cons '(vc-mode vc-mode)
minor-mode-alist)))
(make-variable-buffer-local 'vc-mode)
(put 'vc-mode 'permanent-local t)
(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]
"Obarray for per-file properties.")
(defvar vc-buffer-backend t)
(make-variable-buffer-local 'vc-buffer-backend)
(defun vc-file-setprop (file property value)
(put (intern file vc-file-prop-obarray) property value))
(defun vc-file-getprop (file property)
(get (intern file vc-file-prop-obarray) property))
(defun vc-file-clearprops (file)
(setplist (intern file vc-file-prop-obarray) nil))
(defun vc-match-substring (bn)
(buffer-substring (match-beginning bn) (match-end bn)))
(defun vc-lock-file (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)
(mapcar (function (lambda (p)
(goto-char (point-min))
(cond
((eq (length p) 2) (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) (let ((latest-date "") (latest-val))
(while (re-search-forward (car p) nil t)
(let ((date (vc-match-substring (elt p 2))))
(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)
)
(defun vc-insert-file (file &optional limit blocksize)
(erase-buffer)
(cond ((file-exists-p file)
(cond (limit
(if (not blocksize) (setq blocksize 8192))
(let (found s)
(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)))))
(progn (beginning-of-line)
(re-search-forward limit nil t)))))))
(t (insert-file-contents file)))
(set-buffer-modified-p nil)
(auto-save-mode nil)
t)
(t nil)))
(defun vc-parse-locks (file 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)
(save-excursion (set-buffer (get-buffer-create "*vc-info*"))
(erase-buffer))
(let ((exec-path (append vc-path exec-path)) exec-status
(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)
(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)
(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))
(let ((default-branch (vc-file-getprop file 'vc-default-branch)))
(cond
((or (not default-branch) (string= "" default-branch))
(vc-file-setprop file 'vc-master-workfile-version
(vc-file-getprop file 'vc-head-version)))
((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
default-branch)
(vc-file-setprop file 'vc-master-workfile-version 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)))))
(vc-parse-locks file (vc-file-getprop file 'vc-master-locks)))
((eq (vc-backend file) 'CVS)
(save-excursion
(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*")))))
(defun vc-consult-rcs-headers (file)
(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
((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))
(setq version (buffer-substring-no-properties (match-beginning 1)
(match-end 1)))
(cond
((looking-at
(concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " "[^ ]+ [^ ]+ ")) (goto-char (match-end 0)) (cond
((looking-at "\\$")
(setq locking-user 'none)
(setq status 'rev-and-lock))
((looking-at "\\([^ ]+\\) \\$")
(setq locking-user
(buffer-substring-no-properties (match-beginning 1)
(match-end 1)))
(setq status 'rev-and-lock))
(nil)))
(nil)))
((re-search-forward (concat "\\$"
"Revision: \\([0-9.]+\\) \\$")
nil t)
(setq version (buffer-substring-no-properties (match-beginning 1)
(match-end 1)))
(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)))
(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)
(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))))
(defun vc-backend-subdirectory-name (&optional file)
(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-name (file)
"Return the master name of a file, nil if it is not registered.
For CVS, the full name of CVS/Entries is returned."
(or (vc-file-getprop file 'vc-name)
(if (vc-backend file)
(vc-file-getprop file 'vc-name))))
(defun vc-backend (file)
"Return the version-control type of a file, nil if it is not registered."
(if file
(let ((property (vc-file-getprop file 'vc-backend))
(name-and-type))
(cond ((eq property 'none) nil)
(property)
(t (setq name-and-type (vc-registered file))
(if name-and-type
(progn
(vc-file-setprop file 'vc-name (car name-and-type))
(vc-file-setprop file 'vc-backend (cdr name-and-type)))
(vc-file-setprop file 'vc-backend 'none)
nil))))))
(defun vc-checkout-model (file)
(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
(cond
((getenv "CVSREAD") 'manual)
((string-match "r-..-..-." (nth 8 (file-attributes file)))
'manual)
(t 'implicit)))))))
(defun vc-cvs-status (file)
(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)
(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)
(let ((master-locks (vc-master-locks file)) lock)
(if (eq master-locks 'none) 'none
(setq lock (assoc (vc-workfile-version file) master-locks))
(cond (lock (cdr lock))
('none)))))
(defun vc-lock-from-permissions (file)
(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 (vc-user-login-name)))
(nil)))))
(defun vc-user-login-name (&optional uid)
(or (user-login-name uid)
(and uid (number-to-string uid))
(number-to-string (user-uid))))
(defun vc-file-owner (file)
(vc-user-login-name (nth 2 (file-attributes file))))
(defun vc-rcs-lock-from-diff (file)
(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)
(let ((locking-user (vc-file-getprop file 'vc-locking-user)))
(if locking-user
(if (eq locking-user 'none) nil locking-user)
(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))
(vc-file-setprop file 'vc-locking-user (vc-file-owner file))))
((eq (vc-backend file) 'RCS)
(let (p-lock)
(or (eq (vc-consult-rcs-headers file) 'rev-and-lock)
(and (setq p-lock (vc-lock-from-permissions file))
(if (eq p-lock 'none)
(vc-file-setprop file 'vc-checkout-model 'manual)
(eq (vc-checkout-model file) 'manual)))
(vc-file-setprop file 'vc-locking-user
(vc-master-locking-user file)))
(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)))))
(setq locking-user (vc-file-getprop file 'vc-locking-user))
(if (eq locking-user 'none) nil locking-user))))
(defun vc-latest-version (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)
(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)
(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)
(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 (vc-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))
))
(defun vc-workfile-version (file)
(cond ((vc-file-getprop file 'vc-workfile-version))
((eq (vc-backend file) 'SCCS) (vc-latest-version file))
((eq (vc-backend file) 'RCS)
(if (vc-consult-rcs-headers file)
(vc-file-getprop file 'vc-workfile-version)
(let ((rev (cond ((vc-master-workfile-version file))
((vc-latest-version file)))))
(vc-file-setprop file 'vc-workfile-version rev)
rev)))
((eq (vc-backend file) 'CVS)
(if (vc-consult-rcs-headers file) (vc-file-getprop file 'vc-workfile-version)
(catch 'found
(vc-find-cvs-master (file-name-directory file)
(file-name-nondirectory file)))
(vc-file-getprop file 'vc-workfile-version)))))
(defun vc-registered (file)
(let (handler handlers)
(if (boundp 'file-name-handler-alist)
(setq handler (find-file-name-handler file 'vc-registered)))
(if handler
(funcall handler 'vc-registered file)
(let ((dirname (or (file-name-directory file) ""))
(basename (file-name-nondirectory file)))
(catch 'found
(mapcar
(function (lambda (s)
(if (atom s)
(funcall s dirname basename)
(let ((trial (format (car s) dirname basename)))
(if (and (file-exists-p trial)
(or (not (string= dirname
(file-name-directory trial)))
(not (equal
(file-attributes file)
(file-attributes trial)))))
(throw 'found (cons trial (cdr s))))))))
vc-master-templates)
nil)))))
(defun vc-sccs-project-dir ()
(let ((project-dir (getenv "PROJECTDIR")))
(and project-dir
(if (eq (elt project-dir 0) ?/)
(if (file-exists-p (concat project-dir "/SCCS"))
(concat project-dir "/SCCS/")
(if (file-exists-p project-dir)
project-dir))
(setq project-dir (expand-file-name (concat "~" project-dir)))
(let (trial)
(setq trial (concat project-dir "/src/SCCS"))
(if (file-exists-p trial)
(concat trial "/")
(setq trial (concat project-dir "/src"))
(if (file-exists-p trial)
(concat trial "/")
(setq trial (concat project-dir "/source/SCCS"))
(if (file-exists-p trial)
(concat trial "/")
(setq trial (concat project-dir "/source/"))
(if (file-exists-p trial)
(concat trial "/"))))))))))
(defun vc-search-sccs-project-dir (dirname basename)
(let* ((project-dir (vc-sccs-project-dir))
(master-file (and project-dir (concat project-dir "s." basename))))
(and master-file
(file-exists-p master-file)
(throw 'found (cons master-file 'SCCS)))))
(defun vc-find-cvs-master (dirname basename)
(if (and vc-handle-cvs
(file-directory-p (concat dirname "CVS/"))
(file-readable-p (concat dirname "CVS/Entries")))
(let ((file (concat dirname basename))
buffer)
(unwind-protect
(save-excursion
(setq buffer (set-buffer (get-buffer-create "*vc-info*")))
(vc-insert-file (concat dirname "CVS/Entries"))
(goto-char (point-min))
(setq case-fold-search nil)
(cond
((re-search-forward
(concat "^/" (regexp-quote basename) "/0/") nil t)
(vc-file-setprop file 'vc-checkout-time 0)
(vc-file-setprop file 'vc-workfile-version "0")
(throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
((re-search-forward
(concat "^/" (regexp-quote basename)
"/\\([^/]*\\)"
"/[A-Z][a-z][a-z]" " \\([A-Z][a-z][a-z]\\)" " *\\([0-9]*\\)" " \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)" " \\([0-9]*\\)" "\\(+[^/]*\\)?/")
nil t)
(vc-file-setprop file
'vc-workfile-version
(match-string 1))
(let ((mtime (nth 5 (file-attributes file)))
(second (string-to-number (match-string 6)))
(minute (string-to-number (match-string 5)))
(hour (string-to-number (match-string 4)))
(day (string-to-number (match-string 3)))
(year (string-to-number (match-string 7))))
(if (equal mtime
(encode-time
second minute hour day
(/ (string-match
(match-string 2)
"xxxJanFebMarAprMayJunJulAugSepOctNovDec")
3)
year 0))
(vc-file-setprop file 'vc-checkout-time mtime)
(vc-file-setprop file 'vc-checkout-time 0)))
(throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
((re-search-forward
(concat "^/" (regexp-quote basename)
"/\\([^/]*\\)"
"/[^/]*"
"\\(+[^/]*\\)?/")
nil t)
(vc-file-setprop file 'vc-workfile-version (match-string 1))
(vc-file-setprop file 'vc-checkout-time 0)
(throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
(t nil)))
(kill-buffer buffer)))))
(defun vc-buffer-backend ()
"Return the version-control type of the visited file, or nil if none."
(if (eq vc-buffer-backend t)
(setq vc-buffer-backend (vc-backend (buffer-file-name)))
vc-buffer-backend))
(defun vc-toggle-read-only (&optional verbose)
"Change read-only status of current buffer, perhaps via version control.
If the buffer is visiting a file registered with version control,
then check the file in or out. Otherwise, just change the read-only flag
of the buffer.
With prefix argument, ask for version number to check in or check out.
Check-out of a specified version number does not lock the file;
to do that, use this command a second time with no argument."
(interactive "P")
(if (or (and (boundp 'vc-dired-mode) vc-dired-mode)
(vc-backend (buffer-file-name)))
(vc-next-action verbose)
(toggle-read-only)))
(define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
(defun vc-after-save ()
(let ((file (buffer-file-name)))
(and (vc-backend file)
(or (and (equal (vc-file-getprop file 'vc-checkout-time)
(nth 5 (file-attributes file)))
(vc-file-setprop file 'vc-checkout-time nil))
t)
(not (vc-locking-user file))
(eq (vc-checkout-model file) 'implicit)
(vc-file-setprop file 'vc-locking-user (vc-user-login-name))
(or (and (eq (vc-backend file) 'CVS)
(vc-file-setprop file 'vc-cvs-status nil))
t)
(vc-mode-line file))))
(defun vc-mode-line (file &optional label)
"Set `vc-mode' to display type of version control for FILE.
The value is set in the current buffer, which should be the buffer
visiting FILE. Second optional arg LABEL is put in place of version
control system name."
(interactive (list buffer-file-name nil))
(let ((vc-type (vc-backend file)))
(setq vc-mode
(and vc-type
(concat " " (or label (symbol-name vc-type))
(and vc-display-status (vc-status file)))))
(and vc-type
(equal file (buffer-file-name))
(vc-locking-user file)
(not (string= (vc-user-login-name) (vc-locking-user file)))
(setq buffer-read-only t))
(and vc-type
(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)
vc-type))
(defun vc-status (file)
(let ((locker (vc-locking-user file))
(rev (vc-workfile-version file)))
(cond ((string= "0" rev)
" @@")
((not locker)
(concat "-" rev))
((string= locker (vc-user-login-name))
(concat ":" rev))
(t
(concat ":" locker ":" rev)))))
(defun vc-follow-link ()
(let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
(true-buffer (find-buffer-visiting truename))
(this-buffer (current-buffer)))
(if (eq true-buffer this-buffer)
(progn
(kill-buffer this-buffer)
(set-buffer (find-file-noselect truename)))
(set-buffer true-buffer)
(kill-buffer this-buffer))))
(defun vc-find-file-hook ()
(cond
((and (not vc-ignore-vc-files) buffer-file-name)
(vc-file-clearprops buffer-file-name)
(cond
((vc-backend buffer-file-name)
(vc-mode-line buffer-file-name)
(cond ((not vc-make-backup-files)
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t))))
((let* ((link (file-symlink-p buffer-file-name))
(link-type (and link (vc-backend (file-chase-links link)))))
(if link-type
(cond ((eq vc-follow-symlinks nil)
(message
"Warning: symbolic link to %s-controlled source file" link-type))
((or (not (eq vc-follow-symlinks 'ask))
(get-file-buffer
(abbreviate-file-name (file-chase-links buffer-file-name))))
(vc-follow-link)
(message "Followed link to %s" buffer-file-name)
(vc-find-file-hook))
(t
(if (yes-or-no-p (format
"Symbolic link to %s-controlled source file; follow link? " link-type))
(progn (vc-follow-link)
(message "Followed link to %s" buffer-file-name)
(vc-find-file-hook))
(message
"Warning: editing through the link bypasses version control")
))))))))))
(add-hook 'find-file-hooks 'vc-find-file-hook)
(defun vc-file-not-found-hook ()
"When file is not found, try to check it out from RCS or SCCS.
Returns t if checkout was successful, nil otherwise."
(vc-file-clearprops buffer-file-name)
(if (and (not vc-ignore-vc-files)
(vc-backend buffer-file-name))
(save-excursion
(require 'vc)
(setq default-directory (file-name-directory (buffer-file-name)))
(not (vc-error-occurred (vc-checkout buffer-file-name))))))
(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
(defun vc-kill-buffer-hook ()
(if (stringp (buffer-file-name))
(progn
(vc-file-clearprops (buffer-file-name))
(kill-local-variable 'vc-buffer-backend))))
(setq vc-prefix-map (lookup-key global-map "\C-xv"))
(if (not (keymapp vc-prefix-map))
(progn
(setq vc-prefix-map (make-sparse-keymap))
(define-key global-map "\C-xv" vc-prefix-map)
(define-key vc-prefix-map "a" 'vc-update-change-log)
(define-key vc-prefix-map "c" 'vc-cancel-version)
(define-key vc-prefix-map "d" 'vc-directory)
(define-key vc-prefix-map "g" 'vc-annotate)
(define-key vc-prefix-map "h" 'vc-insert-headers)
(define-key vc-prefix-map "i" 'vc-register)
(define-key vc-prefix-map "l" 'vc-print-log)
(define-key vc-prefix-map "m" 'vc-merge)
(define-key vc-prefix-map "r" 'vc-retrieve-snapshot)
(define-key vc-prefix-map "s" 'vc-create-snapshot)
(define-key vc-prefix-map "u" 'vc-revert-buffer)
(define-key vc-prefix-map "v" 'vc-next-action)
(define-key vc-prefix-map "=" 'vc-diff)
(define-key vc-prefix-map "~" 'vc-version-other-window)))
(if (not (boundp 'vc-menu-map))
()
(define-key vc-menu-map [vc-retrieve-snapshot]
'("Retrieve Snapshot" . vc-retrieve-snapshot))
(define-key vc-menu-map [vc-create-snapshot]
'("Create Snapshot" . vc-create-snapshot))
(define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory))
(define-key vc-menu-map [separator1] '("----"))
(define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate))
(define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
(define-key vc-menu-map [vc-version-other-window]
'("Show Other Version" . vc-version-other-window))
(define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
(define-key vc-menu-map [vc-update-change-log]
'("Update ChangeLog" . vc-update-change-log))
(define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
(define-key vc-menu-map [separator2] '("----"))
(define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
(define-key vc-menu-map [vc-revert-buffer]
'("Revert to Last Version" . vc-revert-buffer))
(define-key vc-menu-map [vc-insert-header]
'("Insert Header" . vc-insert-headers))
(define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
(define-key vc-menu-map [vc-register] '("Register" . vc-register)))
(provide 'vc-hooks)