- ;; Return version level of the current workfile FILE
- ;; This is attempted by first looking at the RCS keywords.
- ;; If there are no keywords in the working file,
- ;; vc-master-workfile-version is taken.
- ;; Note that this property is cached, that is, it is only
- ;; looked up if it is nil.
- ;; For SCCS, this property is equivalent to vc-latest-version.
- (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) ;; CVS
- (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)))))
-
-;;; actual version-control code starts here
-
-(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)
- ;; Search for a master corresponding to the given 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)
- ;; 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)))))
- (throw 'found (cons trial (cdr s))))))))
- vc-master-templates)
- nil)))))
-
-(defun vc-sccs-project-dir ()
- ;; Return the full pathname of the SCCS PROJECTDIR, if it exists,
- ;; otherwise nil. The PROJECTDIR is indicated by the environment
- ;; variable of the same name. If its value starts with a slash,
- ;; it must be an absolute path name that points to the
- ;; directory where SCCS history files reside. If it does not
- ;; begin with a slash, it is taken as the name of a user,
- ;; and history files reside in an "src" or "source" subdirectory
- ;; of that user's home directory.
- (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)
- ;; Check if there is a master file for BASENAME in the
- ;; SCCS project directory. If yes, throw `found' as
- ;; expected by vc-registered. If not, return nil.
- (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)
- ;; Check if DIRNAME/BASENAME is handled by CVS.
- ;; If it is, do a (throw 'found (cons MASTER-FILE 'CVS)).
- ;; Note: This function throws the name of CVS/Entries
- ;; NOT that of the RCS master file (because we wouldn't be able
- ;; to access it under remote CVS).
- ;; The function returns nil if DIRNAME/BASENAME is not handled by CVS.
- (if (and vc-handle-cvs
- (file-directory-p (concat dirname "CVS/"))
- (file-readable-p (concat dirname "CVS/Entries")))
- (let ((file (concat dirname basename))
- ;; make sure that the file name is searched
- ;; case-sensitively
- (case-fold-search nil)
- 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))
- (cond
- ;; entry for a "locally added" file (not yet committed)
- ((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)))
- ;; normal entry
- ((re-search-forward
- (concat "^/" (regexp-quote basename)
- ;; revision
- "/\\([^/]*\\)"
- ;; timestamp
- "/[A-Z][a-z][a-z]" ;; week day (irrelevant)
- " \\([A-Z][a-z][a-z]\\)" ;; month name
- " *\\([0-9]*\\)" ;; day of month
- " \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)" ;; hms
- " \\([0-9]*\\)" ;; year
- ;; optional conflict field
- "\\(+[^/]*\\)?/")
- nil t)
- ;; We found it. Store away version number now that we
- ;; are anyhow so close to finding it.
- (vc-file-setprop file
- 'vc-workfile-version
- (match-string 1))
- ;; If the file hasn't been modified since checkout,
- ;; store the checkout-time.
- (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)))
- ;; entry with arbitrary text as timestamp
- ;; (this means we should consider it modified)
- ((re-search-forward
- (concat "^/" (regexp-quote basename)
- ;; revision
- "/\\([^/]*\\)"
- ;; timestamp (arbitrary text)
- "/[^/]*"
- ;; optional conflict field
- "\\(+[^/]*\\)?/")
- nil t)
- ;; We found it. Store away version number now that we
- ;; are anyhow so close to finding it.
- (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))
+ "Return the version level of the current workfile FILE.
+If FILE is not registered, this function always returns nil."
+ (or (vc-file-getprop file 'vc-workfile-version)
+ (if (vc-backend file)
+ (vc-file-setprop file 'vc-workfile-version
+ (vc-call workfile-version file)))))
+
+(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)))
+ (with-no-warnings
+ vc-master-templates)))
+ (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)
+ "Return non-nil if there is a master corresponding to FILE.
+
+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
+ (mapcar
+ (lambda (s)
+ (let ((trial (vc-possible-master s dirname basename)))
+ (if (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)))))
+ (throw 'found trial))))
+ templates))))