;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; If the file is not writable (despite CVSREAD being
;; undefined), this is probably because the file is being
;; "watched" by other developers.
- ;; (If vc-mistrust-permissions was t, we actually shouldn't
- ;; trust this, but there is no other way to learn this from
- ;; CVS at the moment (version 1.9).)
+ ;; (We actually shouldn't trust this, but there is
+ ;; no other way to learn this from CVS at the
+ ;; moment (version 1.9).)
(string-match "r-..-..-." (nth 8 attrib)))
'announce
'implicit))))))
:version "21.1"
:group 'vc-cvs)
-(defcustom vc-cvs-stay-local 'only-file
+(defcustom vc-stay-local 'only-file
"Non-nil means use local operations when possible for remote repositories.
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.
-If value is the symbol `only-file' `vc-dir' will connect to the
+If value is the symbol `only-file', `vc-dir' will connect to the
server, but heuristics will be used to determine the status for
all other VC operations.
(defun vc-cvs-state (file)
"CVS-specific version of `vc-state'."
- (if (vc-stay-local-p file 'CVS)
+ (if (vc-cvs-stay-local-p file)
(let ((state (vc-file-getprop file 'vc-state)))
;; If we should stay local, use the heuristic but only if
;; we don't have a more precise state already available.
(autoload 'vc-switches "vc")
-(defun vc-cvs-register (files &optional _rev comment)
+(defun vc-cvs-register (files &optional comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
(directory-file-name dir))))
(eq dir t)))
-(defun vc-cvs-checkin (files rev comment)
+;; vc-cvs-checkin used to take a 'rev' second argument that allowed
+;; checking in onto a specified branch tip rather than the current
+;; default branch, but nothing in the entire rest of VC exercised
+;; this code. Removing it simplifies the backend interface for all
+;; modes.
+;;
+;; Here's the setup code preserved in amber, in case the logic needs
+;; to be broken out into a method someday; (if rev (concat "-r" rev))
+;; used to be part of the switches passed to vc-cvs-command.
+;;
+;; (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
+;; (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
+;; (error "%s is not a valid symbolic tag name" rev)
+;; ;; If the input revision is a valid symbolic tag name, we create it
+;; ;; as a branch, commit and switch to it.
+;; (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
+;; (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
+;; (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
+;; files)))
+;;
+;; The following postamble cleaned up after the branch change:
+;;
+;; ;; if this was an explicit check-in (does not include creation of
+;; ;; a branch), remove the sticky tag.
+;; (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
+;; (vc-cvs-command nil 0 files "update" "-A"))))
+;; files)))
+;;
+(defun vc-cvs-checkin (files comment)
"CVS-specific version of `vc-backend-checkin'."
- (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
- (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
- (error "%s is not a valid symbolic tag name" rev)
- ;; If the input revision is a valid symbolic tag name, we create it
- ;; as a branch, commit and switch to it.
- (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
- (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
- (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
- files)))
(let ((status (apply 'vc-cvs-command nil 1 files
- "ci" (if rev (concat "-r" rev))
- (concat "-m" comment)
+ "ci" (concat "-m" comment)
(vc-switches 'CVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
;; tell it from the permissions of the file (see
;; vc-cvs-checkout-model).
(mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
- files)
-
- ;; if this was an explicit check-in (does not include creation of
- ;; a branch), remove the sticky tag.
- (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
- (vc-cvs-command nil 0 files "update" "-A"))))
+ files)))
(defun vc-cvs-find-revision (file rev buffer)
(apply 'vc-cvs-command
"-p"
(vc-switches 'CVS 'checkout)))
-(defun vc-cvs-checkout (file &optional editable rev)
+(defun vc-cvs-checkout (file &optional rev)
"Checkout a revision of FILE into the working area.
-EDITABLE non-nil means that the file should be writable.
REV is the revision to check out."
(message "Checking out %s..." file)
;; Change buffers to get local value of vc-checkout-switches.
(if (and (file-exists-p file) (not rev))
;; If no revision was specified, just make the file writable
;; if necessary (using `cvs-edit' if requested).
- (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
+ (and (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
(if vc-cvs-use-edit
(vc-cvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-cvs-command nil 0 file
- (and editable "-w")
+ "-w"
"update"
(when rev
(unless (eq rev t)
;; Make the file read-only by switching off all w-bits
(set-file-modes file (logand (file-modes file) 3950)))))
+(defun vc-cvs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from branch or revision "
+ "(default news on current branch): ")
+ (list file)
+ 'CVS))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-cvs-merge-news file)))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second revision: "
+ (list file) 'CVS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-cvs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))
+ (setq status (vc-cvs-merge file first-revision second-revision))))
+ status))
+
(defun vc-cvs-merge (file first-revision &optional second-revision)
"Merge changes into current working copy of FILE.
The changes are between FIRST-REVISION and SECOND-REVISION."
;; It's just the catenation of the individual logs.
(vc-cvs-command
buffer
- (if (vc-stay-local-p files 'CVS) 'async 0)
+ (if (vc-cvs-stay-local-p files) 'async 0)
files "log")
(with-current-buffer buffer
- (vc-exec-after (vc-rcs-print-log-cleanup)))
+ (vc-run-delayed (vc-rcs-print-log-cleanup)))
(when limit 'limit-unsupported))
(defun vc-cvs-comment-history (file)
(autoload 'vc-version-backup-file "vc")
(declare-function vc-coding-system-for-diff "vc" (file))
-(defun vc-cvs-diff (files &optional oldvers newvers buffer)
+(defun vc-cvs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using CVS between two revisions of FILE."
(let* (process-file-side-effects
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'CVS)))
+ (async (and async (vc-cvs-stay-local-p files)))
(invoke-cvs-diff-list nil)
status)
;; Look through the file list and see if any files have backups
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
(vc-cvs-command buffer
- (if (vc-stay-local-p file 'CVS)
+ (if (vc-cvs-stay-local-p file)
'async 0)
file "annotate"
(if revision (concat "-r" revision)))
"Return the current time, based at midnight of the current day, and
encoded as fractional days."
(vc-annotate-convert-time
- (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+ (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
(defun vc-cvs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
(defun vc-cvs-make-version-backups-p (file)
"Return non-nil if version backups should be made for FILE."
- (vc-stay-local-p file 'CVS))
+ (vc-cvs-stay-local-p file))
(defun vc-cvs-check-headers ()
"Check if the current file has any headers in it."
(append vc-cvs-global-switches
flags))))
-(defun vc-cvs-stay-local-p (file) ;Back-compatibility.
- (vc-stay-local-p file 'CVS))
+(defun vc-cvs-stay-local-p (file)
+ "Return non-nil if VC should stay local when handling FILE.
+If FILE is a list of files, return non-nil if any of them
+individually should stay local."
+ (if (listp file)
+ (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file))
+ (let* ((sym (vc-make-backend-sym 'CVS 'stay-local))
+ (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
+ (if (symbolp stay-local) stay-local
+ (let ((dirname (if (file-directory-p file)
+ (directory-file-name file)
+ (file-name-directory file))))
+ (eq 'yes
+ (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
+ (vc-file-setprop
+ dirname 'vc-cvs-stay-local-p
+ (let ((hostname (vc-cvs-repository-hostname dirname)))
+ (if (not hostname)
+ 'no
+ (let ((default t))
+ (if (eq (car-safe stay-local) 'except)
+ (setq default nil stay-local (cdr stay-local)))
+ (when (consp stay-local)
+ (setq stay-local
+ (mapconcat 'identity stay-local "\\|")))
+ (if (if (string-match stay-local hostname)
+ default (not default))
+ 'yes 'no))))))))))))
(defun vc-cvs-repository-hostname (dirname)
"Hostname of the CVS server associated to workarea DIRNAME."
(if basedir result
(funcall update-function result))))
-(defun vc-cvs-dir-status (dir update-function)
- "Create a list of conses (file . state) for DIR."
- ;; FIXME check all files in DIR instead?
- (let ((local (vc-stay-local-p dir 'CVS)))
- (if (and local (not (eq local 'only-file)))
+(defun vc-cvs-dir-status-files (dir files update-function)
+ "Create a list of conses (file . state) for FILES in DIR.
+Query all files in DIR if files is nil."
+ (let ((local (vc-cvs-stay-local-p dir)))
+ (if (and (not files) local (not (eq local 'only-file)))
(vc-cvs-dir-status-heuristic dir update-function)
- (vc-cvs-command (current-buffer) 'async dir "-f" "status")
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
+ (vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
;; Alternative implementation: use the "update" command instead of
;; the "status" command.
;; (vc-cvs-command (current-buffer) 'async
;; (file-relative-name dir)
;; "-f" "-n" "update" "-d" "-P")
- (vc-exec-after
- `(vc-cvs-after-dir-status (quote ,update-function))))))
-
-(defun vc-cvs-dir-status-files (dir files _default-state update-function)
- "Create a list of conses (file . state) for DIR."
- (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
- (vc-exec-after
- `(vc-cvs-after-dir-status (quote ,update-function))))
+ (vc-run-delayed
+ (vc-cvs-after-dir-status update-function)))))
(defun vc-cvs-file-to-string (file)
"Read the content of FILE and return it as a string."
table (lambda () (vc-cvs-revision-table (car files))))))
table))
+(defun vc-cvs-find-admin-dir (file)
+ "Return the administrative directory of FILE."
+ (vc-find-root file "CVS"))
+
+(defun vc-cvs-ignore (file &optional _directory _remove)
+ "Ignore FILE under CVS."
+ (vc-cvs-append-to-ignore (file-name-directory file) file))
+
+(defun vc-cvs-append-to-ignore (dir str &optional old-dir)
+ "In DIR, add STR to the .cvsignore file.
+If OLD-DIR is non-nil, then this is a directory that we don't want
+to hear about anymore."
+ (with-current-buffer
+ (find-file-noselect (expand-file-name ".cvsignore" dir))
+ (when (ignore-errors
+ (and buffer-read-only
+ (eq 'CVS (vc-backend buffer-file-name))
+ (not (vc-editable-p buffer-file-name))))
+ ;; CVSREAD=on special case
+ (vc-checkout buffer-file-name t))
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))
+ (insert str (if old-dir "/\n" "\n"))
+ ;; FIXME this is a pcvs variable.
+ (if (bound-and-true-p cvs-sort-ignore-file)
+ (sort-lines nil (point-min) (point-max)))
+ (save-buffer)))
(provide 'vc-cvs)