-(defun vc-backend-admin (file &optional rev comment)
- ;; Register a file into the version-control system
- ;; Automatically retrieves a read-only version of the file with
- ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
- ;; it deletes the workfile.
- (vc-file-clearprops file)
- (or vc-default-back-end
- (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
- (message "Registering %s..." file)
- (let* ((switches
- (if (stringp vc-register-switches)
- (list vc-register-switches)
- vc-register-switches))
- (project-dir)
- (backend
- (cond
- ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
- ((file-exists-p "RCS") 'RCS)
- ((file-exists-p "CVS") 'CVS)
- ((file-exists-p "SCCS") 'SCCS)
- ((setq project-dir (vc-sccs-project-dir)) 'SCCS)
- (t vc-default-back-end))))
- (cond ((eq backend 'SCCS)
- (let ((vc-name
- (if project-dir (concat project-dir
- "s." (file-name-nondirectory file))
- (format
- (car (rassq 'SCCS vc-master-templates))
- (or (file-name-directory file) "")
- (file-name-nondirectory file)))))
- (apply 'vc-do-command nil 0 "admin" nil nil ;; SCCS
- (and rev (concat "-r" rev))
- "-fb"
- (concat "-i" file)
- (and comment (concat "-y" comment))
- vc-name
- switches))
- (delete-file file)
- (if vc-keep-workfiles
- (vc-do-command nil 0 "get" file 'MASTER)))
- ((eq backend 'RCS)
- (apply 'vc-do-command nil 0 "ci" file 'WORKFILE ;; RCS
- ;; if available, use the secure registering option
- (and (vc-backend-release-p 'RCS "5.6.4") "-i")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (and comment (concat "-t-" comment))
- switches))
- ((eq backend 'CVS)
- (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS
- "add"
- (and comment (string-match "[^\t\n ]" comment)
- (concat "-m" comment))
- switches)
- )))
- (message "Registering %s...done" file)
- )
-
-(defun vc-backend-checkout (file &optional writable rev workfile)
- ;; Retrieve a copy of a saved version into a workfile
- (let ((filename (or workfile file))
- (file-buffer (get-file-buffer file))
- switches)
- (message "Checking out %s..." filename)
- (save-excursion
- ;; Change buffers to get local value of vc-checkout-switches.
- (if file-buffer (set-buffer file-buffer))
- (setq switches (if (stringp vc-checkout-switches)
- (list vc-checkout-switches)
- vc-checkout-switches))
- ;; Save this buffer's default-directory
- ;; and use save-excursion to make sure it is restored
- ;; in the same buffer it was saved in.
- (let ((default-directory default-directory))
- (save-excursion
- ;; Adjust the default-directory so that the check-out creates
- ;; the file in the right place.
- (setq default-directory (file-name-directory filename))
- (vc-backend-dispatch file
- (progn ;; SCCS
- (and rev (string= rev "") (setq rev nil))
- (if workfile
- ;; Some SCCS implementations allow checking out directly to a
- ;; file using the -G option, but then some don't so use the
- ;; least common denominator approach and use the -p option
- ;; ala RCS.
- (let ((vc-modes (logior (file-modes (vc-name file))
- (if writable 128 0)))
- (failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; Some shells make the "" dummy argument into $0
- ;; while others use the shell's name as $0 and
- ;; use the "" as $1. The if-statement
- ;; converts the latter case to the former.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
- umask %o; exec >\"$1\" || exit; \
- shift; umask %o; exec get \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-e")
- "-p"
- (and rev
- (concat "-r" (vc-lookup-triple file rev)))
- switches)
- (setq failed nil))
- (and failed (file-exists-p filename)
- (delete-file filename))))
- (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
- (if writable "-e")
- (and rev (concat "-r" (vc-lookup-triple file rev)))
- switches)
- (vc-file-setprop file 'vc-workfile-version nil)))
- (if workfile ;; RCS
- ;; RCS doesn't let us check out into arbitrary file names directly.
- ;; Use `co -p' and make stdout point to the correct file.
- (let ((vc-modes (logior (file-modes (vc-name file))
- (if writable 128 0)))
- (failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; See the SCCS case, above, regarding the
- ;; if-statement.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
- umask %o; exec >\"$1\" || exit; \
- shift; umask %o; exec co \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-l")
- (concat "-p" rev)
- switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- (let (new-version)
- ;; if we should go to the head of the trunk,
- ;; clear the default branch first
- (and rev (string= rev "")
- (vc-do-command nil 0 "rcs" file 'MASTER "-b"))
- ;; now do the checkout
- (apply 'vc-do-command
- nil 0 "co" file 'MASTER
- ;; If locking is not strict, force to overwrite
- ;; the writable workfile.
- (if (eq (vc-checkout-model file) 'implicit) "-f")
- (if writable "-l")
- (if rev (concat "-r" rev)
- ;; if no explicit revision was specified,
- ;; check out that of the working file
- (let ((workrev (vc-workfile-version file)))
- (if workrev (concat "-r" workrev)
- nil)))
- switches)
- ;; determine the new workfile version
- (save-excursion
- (set-buffer "*vc*")
- (goto-char (point-min))
- (setq new-version
- (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t)
- (buffer-substring (match-beginning 1) (match-end 1)))))
- (vc-file-setprop file 'vc-workfile-version new-version)
- ;; if necessary, adjust the default branch
- (and rev (not (string= rev ""))
- (vc-do-command nil 0 "rcs" file 'MASTER
- (concat "-b" (if (vc-latest-on-branch-p file)
- (if (vc-trunk-p new-version) nil
- (vc-branch-part new-version))
- new-version))))))
- (if workfile ;; CVS
- ;; CVS is much like RCS
- (let ((failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'WORKFILE "-c"
- "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
- "" ; dummy argument for shell's $0
- workfile
- (concat "-r" rev)
- "-p"
- switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- ;; default for verbose checkout: clear the sticky tag
- ;; so that the actual update will get the head of the trunk
- (and rev (string= rev "")
- (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
- ;; If a revision was specified, check that out.
- (if rev
- (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
- (and writable (eq (vc-checkout-model file) 'manual) "-w")
- "update"
- (and rev (not (string= rev ""))
- (concat "-r" rev))
- switches)
- ;; If no revision was specified, call "cvs edit" to make
- ;; the file writeable.
- (and writable (eq (vc-checkout-model file) 'manual)
- (vc-do-command nil 0 "cvs" file 'WORKFILE "edit")))
- (if rev (vc-file-setprop file 'vc-workfile-version nil))))
- (cond
- ((not workfile)
- (vc-file-clear-masterprops file)
- (if writable
- (vc-file-setprop file 'vc-locking-user (vc-user-login-name)))
- (vc-file-setprop file
- 'vc-checkout-time (nth 5 (file-attributes file)))))
- (message "Checking out %s...done" filename))))))
-
-(defun vc-backend-logentry-check (file)
- (vc-backend-dispatch file
- (if (>= (buffer-size) 512) ;; SCCS
- (progn
- (goto-char 512)
- (error
- "Log must be less than 512 characters; point is now at pos 512")))
- nil ;; RCS
- nil) ;; CVS
- )
-
-(defun vc-backend-checkin (file rev comment)
- ;; Register changes to FILE as level REV with explanatory COMMENT.
- ;; Automatically retrieves a read-only version of the file with
- ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
- ;; it deletes the workfile.
- ;; Adaptation for RCS branch support: if this is an explicit checkin,
- ;; or if the checkin creates a new branch, set the master file branch
- ;; accordingly.
- (message "Checking in %s..." file)
- ;; "This log message intentionally left almost blank".
- ;; RCS 5.7 gripes about white-space-only comments too.
- (or (and comment (string-match "[^\t\n ]" comment))
- (setq comment "*** empty log message ***"))
- (save-excursion
- ;; Change buffers to get local value of vc-checkin-switches.
- (set-buffer (or (get-file-buffer file) (current-buffer)))
- (let ((switches
- (if (stringp vc-checkin-switches)
- (list vc-checkin-switches)
- vc-checkin-switches)))
- ;; Clear the master-properties. Do that here, not at the
- ;; end, because if the check-in fails we want them to get
- ;; re-computed before the next try.
- (vc-file-clear-masterprops file)
- (vc-backend-dispatch file
- ;; SCCS
- (progn
- (apply 'vc-do-command nil 0 "delta" file 'MASTER
- (if rev (concat "-r" rev))
- (concat "-y" comment)
- switches)
- (vc-file-setprop file 'vc-locking-user 'none)
- (vc-file-setprop file 'vc-workfile-version nil)
- (if vc-keep-workfiles
- (vc-do-command nil 0 "get" file 'MASTER))
- )
- ;; RCS
- (let ((old-version (vc-workfile-version file)) new-version)
- (apply 'vc-do-command nil 0 "ci" file 'MASTER
- ;; if available, use the secure check-in option
- (and (vc-backend-release-p 'RCS "5.6.4") "-j")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (concat "-m" comment)
- switches)
- (vc-file-setprop file 'vc-locking-user 'none)
- (vc-file-setprop file 'vc-workfile-version nil)
-
- ;; determine the new workfile version
- (set-buffer "*vc*")
- (goto-char (point-min))
- (if (or (re-search-forward
- "new revision: \\([0-9.]+\\);" nil t)
- (re-search-forward
- "reverting to previous revision \\([0-9.]+\\)" nil t))
- (progn (setq new-version (buffer-substring (match-beginning 1)
- (match-end 1)))
- (vc-file-setprop file 'vc-workfile-version new-version)))
-
- ;; if we got to a different branch, adjust the default
- ;; branch accordingly
- (cond
- ((and old-version new-version
- (not (string= (vc-branch-part old-version)
- (vc-branch-part new-version))))
- (vc-do-command nil 0 "rcs" file 'MASTER
- (if (vc-trunk-p new-version) "-b"
- (concat "-b" (vc-branch-part new-version))))
- ;; If this is an old RCS release, we might have
- ;; to remove a remaining lock.
- (if (not (vc-backend-release-p 'RCS "5.6.2"))
- ;; exit status of 1 is also accepted.
- ;; It means that the lock was removed before.
- (vc-do-command nil 1 "rcs" file 'MASTER
- (concat "-u" old-version))))))
- ;; CVS
- (progn
- ;; explicit check-in to the trunk requires a
- ;; double check-in (first unexplicit) (CVS-1.3)
- (condition-case nil
- (progn
- (if (and rev (vc-trunk-p rev))
- (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
- "ci" "-m" "intermediate"
- switches))
- (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
- "ci" (if rev (concat "-r" rev))
- (concat "-m" comment)
- switches))
- (error (if (eq (vc-cvs-status file) 'needs-merge)
- ;; The CVS output will be on top of this message.
- (error "Type C-x 0 C-x C-q to merge in changes")
- (error "Check-in failed"))))
- ;; determine and store the new workfile version
- (set-buffer "*vc*")
- (goto-char (point-min))
- (if (re-search-forward
- "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)
- (vc-file-setprop file 'vc-workfile-version
- (buffer-substring (match-beginning 2)
- (match-end 2)))
- (vc-file-setprop file 'vc-workfile-version nil))
- ;; if this was an explicit check-in, remove the sticky tag
- (if rev
- (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
- ;; Forget the checkout model, because we might have assumed
- ;; a wrong one when we found the file. After commit, we can
- ;; tell it from the permissions of the file
- ;; (see vc-checkout-model).
- (vc-file-setprop file 'vc-checkout-model nil)
- (vc-file-setprop file 'vc-locking-user 'none)
- (vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file)))))))
- (message "Checking in %s...done" file))
-
-(defun vc-backend-revert (file)
- ;; Revert file to the version it was based on.
- (message "Reverting %s..." file)
- (vc-file-clear-masterprops file)
- (vc-backend-dispatch
- file
- ;; SCCS
- (progn
- (vc-do-command nil 0 "unget" file 'MASTER nil)
- (vc-do-command nil 0 "get" file 'MASTER nil)
- ;; Checking out explicit versions is not supported under SCCS, yet.
- ;; We always "revert" to the latest version; therefore
- ;; vc-workfile-version is cleared here so that it gets recomputed.
- (vc-file-setprop file 'vc-workfile-version nil))
- ;; RCS
- (vc-do-command nil 0 "co" file 'MASTER
- "-f" (concat "-u" (vc-workfile-version file)))
- ;; CVS
- ;; Check out via standard output (caused by the final argument
- ;; FILE below), so that no sticky tag is set.
- (vc-backend-checkout file nil (vc-workfile-version file) file))
- (vc-file-setprop file 'vc-locking-user 'none)
- (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
- (message "Reverting %s...done" file)
- )
-
-(defun vc-backend-steal (file &optional rev)
- ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M.
- (message "Stealing lock on %s..." file)
- (vc-backend-dispatch file
- (progn ;SCCS
- (vc-do-command nil 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev)))
- (vc-do-command nil 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev)))
- )
- (vc-do-command nil 0 "rcs" file 'MASTER ;RCS
- "-M" (concat "-u" rev) (concat "-l" rev))
- (error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS
- )
- (vc-file-setprop file 'vc-locking-user (vc-user-login-name))
- (message "Stealing lock on %s...done" file)
- )
-
-(defun vc-backend-uncheck (file target)
- ;; Undo the latest checkin.
- (message "Removing last change from %s..." file)
- (vc-backend-dispatch file
- (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target))
- (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target))
- nil ;; this is never reached under CVS
- )
- (message "Removing last change from %s...done" file)
- )
-
-(defun vc-backend-print-log (file)
- ;; Get change log associated with FILE.
- (vc-backend-dispatch
- file
- (vc-do-command nil 0 "prs" file 'MASTER)
- (vc-do-command nil 0 "rlog" file 'MASTER)
- (vc-do-command nil 0 "cvs" file 'WORKFILE "log")))
-
-(defun vc-backend-assign-name (file name)
- ;; Assign to a FILE's latest version a given NAME.
- (vc-backend-dispatch file
- (vc-add-triple name file (vc-latest-version file)) ;; SCCS
- (vc-do-command nil 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS
- (vc-do-command nil 0 "cvs" file 'WORKFILE "tag" name) ;; CVS
- )
- )
-
-(defun vc-backend-diff (file &optional oldvers newvers cmp)
- ;; Get a difference report between two versions of FILE.
- ;; Get only a brief comparison report if CMP, a difference report otherwise.
- (let ((backend (vc-backend file)) options status
- (diff-switches-list (if (listp diff-switches)
- diff-switches
- (list diff-switches))))
- (cond
- ((eq backend 'SCCS)
- (setq oldvers (vc-lookup-triple file oldvers))
- (setq newvers (vc-lookup-triple file newvers))
- (setq options (append (list (and cmp "--brief") "-q"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers)))
- (and (not cmp) diff-switches-list)))
- (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" file 'MASTER options))
- ((eq backend 'RCS)
- (if (not oldvers) (setq oldvers (vc-workfile-version file)))
- ;; If we know that --brief is not supported, don't try it.
- (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no))))
- (setq options (append (list (and cmp "--brief") "-q"
- (concat "-r" oldvers)
- (and newvers (concat "-r" newvers)))
- (and (not cmp) diff-switches-list)))
- (setq status (apply 'vc-do-command "*vc-diff*" 2
- "rcsdiff" file 'WORKFILE options))
- ;; If --brief didn't work, do a double-take and remember it
- ;; for the future.
- (if (eq status 2)
- (prog1
- (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE
- (if cmp (cdr options) options))
- (if cmp (setq vc-rcsdiff-knows-brief 'no)))
- ;; If --brief DID work, remember that, too.
- (and cmp (not vc-rcsdiff-knows-brief)
- (setq vc-rcsdiff-knows-brief 'yes))
- status))
- ;; CVS is different.
- ((eq backend 'CVS)
- (if (string= (vc-workfile-version file) "0")
- ;; This file is added but not yet committed; there is no master file.
- (if (or oldvers newvers)
- (error "No revisions of %s exist" file)
- (if cmp 1 ;; file is added but not committed,
- ;; we regard this as "changed".
- ;; diff it against /dev/null.
- (apply 'vc-do-command
- "*vc-diff*" 1 "diff" file 'WORKFILE
- (append (if (listp diff-switches)
- diff-switches
- (list diff-switches)) '("/dev/null")))))
- ;; cmp is not yet implemented -- we always do a full diff.
- (apply 'vc-do-command
- "*vc-diff*" 1 "cvs" file 'WORKFILE "diff"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers))
- (if (listp diff-switches)
- diff-switches
- (list diff-switches))))))))
-
-(defun vc-backend-merge-news (file)
- ;; Merge in any new changes made to FILE.
- (message "Merging changes into %s..." file)
- (prog1
- (vc-backend-dispatch
- file
- (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
- (error "vc-backend-merge-news not meaningful for RCS files") ;RCS
- (save-excursion ; CVS
- (vc-file-clear-masterprops file)
- (vc-file-setprop file 'vc-workfile-version nil)
- (vc-file-setprop file 'vc-locking-user nil)
- (vc-file-setprop file 'vc-checkout-time nil)
- (vc-do-command nil 0 "cvs" file 'WORKFILE "update")
- ;; Analyze the merge result reported by CVS, and set
- ;; file properties accordingly.
- (set-buffer (get-buffer "*vc*"))
- (goto-char (point-min))
- ;; get new workfile version
- (if (re-search-forward (concat "^Merging differences between "
- "[01234567890.]* and "
- "\\([01234567890.]*\\) into")
- nil t)
- (vc-file-setprop file 'vc-workfile-version (match-string 1)))
- ;; get file status
- (if (re-search-forward
- (concat "^\\([CMU]\\) "
- (regexp-quote (file-name-nondirectory file)))
- nil t)
- (cond
- ;; Merge successful, we are in sync with repository now
- ((string= (match-string 1) "U")
- (vc-file-setprop file 'vc-locking-user 'none)
- (vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file)))
- 0) ;; indicate success to the caller
- ;; Merge successful, but our own changes are still in the file
- ((string= (match-string 1) "M")
- (vc-file-setprop file 'vc-locking-user (vc-file-owner file))
- (vc-file-setprop file 'vc-checkout-time 0)
- 0) ;; indicate success to the caller
- ;; Conflicts detected!
- ((string= (match-string 1) "C")
- (vc-file-setprop file 'vc-locking-user (vc-file-owner file))
- (vc-file-setprop file 'vc-checkout-time 0)
- 1) ;; signal the error to the caller
- )
- (pop-to-buffer "*vc*")
- (error "Couldn't analyze cvs update result"))))
- (message "Merging changes into %s...done" file)))
-
-(defun vc-backend-merge (file first-version &optional second-version)
- ;; Merge the changes between FIRST-VERSION and SECOND-VERSION into
- ;; the current working copy of FILE. It is assumed that FILE is
- ;; locked and writable (vc-merge ensures this).
- (vc-backend-dispatch file
- ;; SCCS
- (error "Sorry, merging is not implemented for SCCS")
- ;; RCS
- (vc-do-command nil 1 "rcsmerge" file 'MASTER
- "-kk" ;; ignore keyword conflicts
- (concat "-r" first-version)
- (if second-version (concat "-r" second-version)))
- ;; CVS
- (progn
- (vc-do-command nil 0 "cvs" file 'WORKFILE
- "update" "-kk"
- (concat "-j" first-version)
- (concat "-j" second-version))
- (save-excursion
- (set-buffer (get-buffer "*vc*"))
- (goto-char (point-min))
- (if (re-search-forward "conflicts during merge" nil t)
- 1 ;; signal error
- 0 ;; signal success
- )))))