;;; 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-2016 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-header '("\$Id\$")
+(defcustom vc-cvs-annotate-switches nil
+ "String or list of strings specifying switches for cvs annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-cvs)
+
+(defcustom vc-cvs-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
:type '(repeat string)
: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.
"Specify the mode-line display of sticky tags.
Value t means default display, nil means no display at all. If the
value is a function or macro, it is called with the sticky tag and
-its' type as parameters, in that order. TYPE can have three different
+its type as parameters, in that order. TYPE can have three different
values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a
string) and `date' (TAG is a date as returned by `encode-time'). The
return value of the function or macro will be displayed as a string.
dates and the word \"Sticky\" for sticky tag names and revisions.
(lambda (tag type)
- (cond ((eq type 'date) (format-time-string
+ (cond ((eq type \\='date) (format-time-string
vc-cvs-sticky-date-format-string tag))
- ((eq type 'revision-number) \"Sticky\")
- ((eq type 'symbolic-name) \"Sticky\")))
+ ((eq type \\='revision-number) \"Sticky\")
+ ((eq type \\='symbolic-name) \"Sticky\")))
Here's an example that will abbreviate to the first character only,
any text before the first occurrence of `-' for sticky symbolic tags.
displayed. Date and time is displayed for sticky dates.
(lambda (tag type)
- (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag))
- ((eq type 'revision-number) \"Sticky\")
- ((eq type 'symbolic-name)
+ (cond ((eq type \\='date) (format-time-string \"%Y%m%d %H:%M\" tag))
+ ((eq type \\='revision-number) \"Sticky\")
+ ((eq type \\='symbolic-name)
(condition-case nil
(progn
(string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
(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.
(propertize
(if (zerop (length sticky-tag))
string
- (setq help-echo (format "%s on the '%s' branch"
- help-echo sticky-tag))
+ (setq help-echo (format-message "%s on the `%s' branch"
+ help-echo sticky-tag))
(concat string "[" sticky-tag "]"))
'help-echo help-echo)))
;;; State-changing functions
;;;
-(defun vc-cvs-register (files &optional _rev comment)
+(autoload 'vc-switches "vc")
+
+(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)
+(defun vc-cvs-checkin (files comment &optional rev)
"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))
+ (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))
+ ;; 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)
+ (concat "-m" comment)
(vc-switches 'CVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
;; 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)))
"-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)
(defun vc-cvs-delete-file (file)
(vc-cvs-command nil 0 file "remove" "-f"))
+(autoload 'vc-default-revert "vc")
+
(defun vc-cvs-revert (file &optional contents-done)
"Revert FILE to the working revision on which it was based."
(vc-default-revert 'CVS file contents-done)
;; 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."
;;;
(declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
+;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
+(declare-function vc-exec-after "vc-dispatcher" (code))
(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
- "Get change logs associated with FILES."
+ "Print commit log associated with FILES into specified BUFFER.
+Remaining arguments are ignored."
(require 'vc-rcs)
;; 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)
"Get comment history of a file."
(vc-call-backend 'RCS 'comment-history file))
-(defun vc-cvs-diff (files &optional oldvers newvers buffer)
+(autoload 'vc-version-backup-file "vc")
+(declare-function vc-coding-system-for-diff "vc" (file))
+
+(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
(defconst vc-cvs-annotate-first-line-re "^[0-9]")
-(defun vc-cvs-annotate-process-filter (process string)
+(defun vc-cvs-annotate-process-filter (filter process string)
(setq string (concat (process-get process 'output) string))
(if (not (string-match vc-cvs-annotate-first-line-re string))
;; Still waiting for the first real line.
(process-put process 'output string)
- (let ((vc-filter (process-get process 'vc-filter)))
- (set-process-filter process vc-filter)
- (funcall vc-filter process (substring string (match-beginning 0))))))
+ (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
+ (funcall filter process (substring string (match-beginning 0)))))
(defun vc-cvs-annotate-command (file buffer &optional revision)
"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)
- 'async 0)
- file "annotate"
- (if revision (concat "-r" revision)))
+ (apply #'vc-cvs-command buffer
+ (if (vc-cvs-stay-local-p file)
+ 'async 0)
+ file "annotate"
+ (append (vc-switches 'cvs 'annotate)
+ (if revision (list (concat "-r" revision)))))
;; Strip the leading few lines.
(let ((proc (get-buffer-process buffer)))
(if proc
;; If running asynchronously, use a process filter.
- (progn
- (process-put proc 'vc-filter (process-filter proc))
- (set-process-filter proc 'vc-cvs-annotate-process-filter))
+ (add-function :around (process-filter proc)
+ #'vc-cvs-annotate-process-filter)
(with-current-buffer buffer
(goto-char (point-min))
(re-search-forward vc-cvs-annotate-first-line-re)
(delete-region (point-min) (1- (point)))))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-cvs-annotate-current-time ()
"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)
(vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name)
(when branchp (vc-cvs-command nil 0 dir "update" "-r" name)))
+;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
+(declare-function vc-resynch-buffer "vc-dispatcher"
+ (file &optional keep noquery reset-vc-info))
+
(defun vc-cvs-retrieve-tag (dir name update)
"Retrieve a tag at and below DIR.
NAME is the name of the tag; if it is empty, do a `cvs update'.
(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."
(setq host uhost))
;; Remove empty HOST
(and (equal host "")
- (setq host))
+ (setq host nil))
;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir'
(and host
(equal method "local")
- (setq root (concat host ":" root) host))
+ (setq root (concat host ":" root) host nil))
;; Normalize CVS root record
(list method user host root)))))
(defun vc-cvs-parse-status (&optional full)
"Parse output of \"cvs status\" command in the current buffer.
Set file properties accordingly. Unless FULL is t, parse only
-essential information. Note that this can never set the 'ignored
+essential information. Note that this can never set the `ignored'
state."
(let (file status missing)
(goto-char (point-min))
(when (and full
(re-search-forward
"\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
-\[\t ]+\\([0-9.]+\\)"
+[\t ]+\\([0-9.]+\\)"
nil t))
(vc-file-setprop file 'vc-latest-revision (match-string 2)))
(vc-file-setprop
(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 files "-f" "status")
;; 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)