vc-cvs.el 49.2 KB
Newer Older
Stefan Monnier's avatar
Stefan Monnier committed
1
;;; vc-cvs.el --- non-resident support for CVS version-control  -*- lexical-binding: t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1995, 1998-2020 Free Software Foundation, Inc.
4

Paul Eggert's avatar
Paul Eggert committed
5
;; Author: FSF (see vc.el for full credits)
6
;; Package: vc
7 8 9

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
14 15 16 17 18 19 20

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
22 23 24 25 26

;;; Commentary:

;;; Code:

27
(eval-when-compile (require 'vc))
Sam Steingold's avatar
Sam Steingold committed
28

Paul Eggert's avatar
Paul Eggert committed
29 30 31 32 33 34
(declare-function vc-branch-p "vc" (rev))
(declare-function vc-checkout "vc" (file &optional rev))
(declare-function vc-expand-dirs "vc" (file-or-dir-list backend))
(declare-function vc-read-revision "vc"
                  (prompt &optional files backend default initial-input))

35 36 37 38
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(put 'CVS 'vc-functions nil)

39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
;;; Properties of the backend.

(defun vc-cvs-revision-granularity () 'file)

(defun vc-cvs-checkout-model (files)
  "CVS-specific version of `vc-checkout-model'."
  (if (getenv "CVSREAD")
      'announce
    (let* ((file (if (consp files) (car files) files))
           (attrib (file-attributes file)))
      (or (vc-file-getprop file 'vc-checkout-model)
          (vc-file-setprop
           file 'vc-checkout-model
           (if (and attrib ;; don't check further if FILE doesn't exist
                    ;; If the file is not writable (despite CVSREAD being
                    ;; undefined), this is probably because the file is being
                    ;; "watched" by other developers.
56 57 58
                    ;; (We actually shouldn't trust this, but there is
                    ;; no other way to learn this from CVS at the
                    ;; moment (version 1.9).)
Paul Eggert's avatar
Paul Eggert committed
59
		    (string-match "r-..-..-." (file-attribute-modes attrib)))
60 61 62
               'announce
             'implicit))))))

Sam Steingold's avatar
Sam Steingold committed
63
;;;
André Spiegel's avatar
André Spiegel committed
64 65 66
;;; Customization options
;;;

67 68 69 70 71
(defgroup vc-cvs nil
  "VC CVS backend."
  :version "24.1"
  :group 'vc)

72
(defcustom vc-cvs-global-switches nil
Lute Kamstra's avatar
Lute Kamstra committed
73
  "Global switches to pass to any CVS command."
74 75 76 77 78
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
79
  :version "22.1"
80
  :group 'vc-cvs)
81

82
(defcustom vc-cvs-register-switches nil
83
  "Switches for registering a file into CVS.
84
A string or list of strings passed to the checkin program by
85 86 87 88
\\[vc-register].  If nil, use the value of `vc-register-switches'.
If t, use no switches."
  :type '(choice (const :tag "Unspecified" nil)
		 (const :tag "None" t)
89
		 (string :tag "Argument String")
90
		 (repeat :tag "Argument List" :value ("") string))
Dave Love's avatar
Dave Love committed
91
  :version "21.1"
92
  :group 'vc-cvs)
93

94
(defcustom vc-cvs-diff-switches nil
95 96 97 98 99 100
  "String or list of strings specifying switches for CVS diff under VC.
If nil, use the value of `vc-diff-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))
101
  :version "21.1"
102
  :group 'vc-cvs)
103

104 105 106 107 108 109 110 111 112 113 114
(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)

115
(defcustom vc-cvs-header '("$Id\ $")
Lute Kamstra's avatar
Lute Kamstra committed
116
  "Header keywords to be inserted by `vc-insert-headers'."
117
  :version "24.1"     ; no longer consult the obsolete vc-header-alist
Dave Love's avatar
Dave Love committed
118
  :type '(repeat string)
119
  :group 'vc-cvs)
120 121

(defcustom vc-cvs-use-edit t
Lute Kamstra's avatar
Lute Kamstra committed
122
  "Non-nil means to use `cvs edit' to \"check out\" a file.
123 124 125
This is only meaningful if you don't use the implicit checkout model
\(i.e. if you have $CVSREAD set)."
  :type 'boolean
Dave Love's avatar
Dave Love committed
126
  :version "21.1"
127
  :group 'vc-cvs)
128

129
(defcustom vc-cvs-stay-local 'only-file
Lute Kamstra's avatar
Lute Kamstra committed
130
  "Non-nil means use local operations when possible for remote repositories.
Stefan Monnier's avatar
Stefan Monnier committed
131 132
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.
133

Xue Fuqiao's avatar
Xue Fuqiao committed
134
If value is the symbol `only-file', `vc-dir' will connect to the
135 136 137
server, but heuristics will be used to determine the status for
all other VC operations.

138
The value can also be a regular expression or list of regular
139 140 141 142 143
expressions to match against the host name of a repository; then
vc-cvs only stays local for hosts that match it.  Alternatively,
the value can be a list of regular expressions where the first
element is the symbol `except'; then vc-cvs always stays local
except for hosts matched by these regular expressions."
144
  :type '(choice (const :tag "Always stay local" t)
145
		 (const :tag "Only for file operations" only-file)
146
		 (const :tag "Don't stay local" nil)
147 148 149 150 151 152
                 (list :format "\nExamine hostname and %v"
                       :tag "Examine hostname ..."
                       (set :format "%v" :inline t
                            (const :format "%t" :tag "don't" except))
                       (regexp :format " stay local,\n%t: %v"
                               :tag "if it matches")
153
                       (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
154
  :version "23.1"
155
  :group 'vc-cvs)
156

157
(defcustom vc-cvs-sticky-date-format-string "%c"
Lute Kamstra's avatar
Lute Kamstra committed
158
  "Format string for mode-line display of sticky date.
159 160 161
Format is according to `format-time-string'.  Only used if
`vc-cvs-sticky-tag-display' is t."
  :type '(string)
162
  :version "22.1"
163
  :group 'vc-cvs)
164 165

(defcustom vc-cvs-sticky-tag-display t
Lute Kamstra's avatar
Lute Kamstra committed
166
  "Specify the mode-line display of sticky tags.
167 168
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
169
its type as parameters, in that order.  TYPE can have three different
170 171 172 173 174 175 176 177
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.

Here's an example that will display the formatted date for sticky
dates and the word \"Sticky\" for sticky tag names and revisions.

  (lambda (tag type)
178
    (cond ((eq type \\='date) (format-time-string
179
                              vc-cvs-sticky-date-format-string tag))
180 181
          ((eq type \\='revision-number) \"Sticky\")
          ((eq type \\='symbolic-name) \"Sticky\")))
182 183

Here's an example that will abbreviate to the first character only,
184
any text before the first occurrence of `-' for sticky symbolic tags.
185 186 187 188
If the sticky tag is a revision number, the word \"Sticky\" is
displayed.  Date and time is displayed for sticky dates.

   (lambda (tag type)
189 190 191
     (cond ((eq type \\='date) (format-time-string \"%Y%m%d %H:%M\" tag))
           ((eq type \\='revision-number) \"Sticky\")
           ((eq type \\='symbolic-name)
192 193 194
            (condition-case nil
                (progn
                  (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
195
                  (concat (substring (match-string 1 tag) 0 1) \":\"
196 197 198 199 200
                          (substring (match-string 2 tag) 1 nil)))
              (error tag)))))       ; Fall-back to given tag name.

See also variable `vc-cvs-sticky-date-format-string'."
  :type '(choice boolean function)
201
  :version "22.1"
202
  :group 'vc-cvs)
Sam Steingold's avatar
Sam Steingold committed
203

André Spiegel's avatar
André Spiegel committed
204 205 206 207
;;;
;;; Internal variables
;;;

Sam Steingold's avatar
Sam Steingold committed
208

André Spiegel's avatar
André Spiegel committed
209
;;;
Sam Steingold's avatar
Sam Steingold committed
210
;;; State-querying functions
André Spiegel's avatar
André Spiegel committed
211 212
;;;

213 214
;;;###autoload(defun vc-cvs-registered (f)
;;;###autoload   "Return non-nil if file F is registered with CVS."
215 216
;;;###autoload   (when (file-readable-p (expand-file-name
;;;###autoload 			  "CVS/Entries" (file-name-directory f)))
217
;;;###autoload       (load "vc-cvs" nil t)
218 219 220 221 222 223 224 225 226
;;;###autoload       (vc-cvs-registered f)))

(defun vc-cvs-registered (file)
  "Check if FILE is CVS registered."
  (let ((dirname (or (file-name-directory file) ""))
	(basename (file-name-nondirectory file))
        ;; make sure that the file name is searched case-sensitively
        (case-fold-search nil))
    (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
227 228 229 230 231 232 233 234 235 236
        (or (string= basename "")
            (with-temp-buffer
              (vc-cvs-get-entries dirname)
              (goto-char (point-min))
              (cond ((re-search-forward
                      (concat "^/" (regexp-quote basename) "/[^/]") nil t)
                     (beginning-of-line)
                     (vc-cvs-parse-entry file)
                     t)
                    (t nil))))
237 238 239 240
      nil)))

(defun vc-cvs-state (file)
  "CVS-specific version of `vc-state'."
241
  (if (vc-cvs-stay-local-p file)
242 243 244
      (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.
245
	(if (memq state '(up-to-date edited nil))
246 247 248 249
	    (vc-cvs-state-heuristic file)
	  state))
    (with-temp-buffer
      (cd (file-name-directory file))
250 251
      (let (process-file-side-effects)
	(vc-cvs-command t 0 file "status"))
252 253 254 255 256 257 258
      (vc-cvs-parse-status t))))

(defun vc-cvs-state-heuristic (file)
  "CVS-specific state heuristic."
  ;; If the file has not changed since checkout, consider it `up-to-date'.
  ;; Otherwise consider it `edited'.
  (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
Paul Eggert's avatar
Paul Eggert committed
259
        (lastmod (file-attribute-modification-time (file-attributes file))))
260 261 262
    (cond
     ((equal checkout-time lastmod) 'up-to-date)
     ((string= (vc-working-revision file) "0") 'added)
263
     ((null checkout-time) 'unregistered)
264
     (t 'edited))))
265

Eric S. Raymond's avatar
Eric S. Raymond committed
266 267
(defun vc-cvs-working-revision (file)
  "CVS-specific version of `vc-working-revision'."
André Spiegel's avatar
André Spiegel committed
268 269 270 271
  ;; There is no need to consult RCS headers under CVS, because we
  ;; get the workfile version for free when we recognize that a file
  ;; is registered in CVS.
  (vc-cvs-registered file)
Eric S. Raymond's avatar
Eric S. Raymond committed
272
  (vc-file-getprop file 'vc-working-revision))
André Spiegel's avatar
André Spiegel committed
273

274
(defun vc-cvs-mode-line-string (file)
275
  "Return a string for `vc-mode-line' to put in the mode line for FILE.
276 277 278
Compared to the default implementation, this function does two things:
Handle the special case of a CVS file that is added but not yet
committed and support display of sticky tags."
279 280
  (let* ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag))
	 help-echo
281 282
	 (string
          (let ((def-ml (vc-default-mode-line-string 'CVS file)))
283
            (setq help-echo
284 285
                  (get-text-property 0 'help-echo def-ml))
            def-ml)))
286
    (propertize
287 288
     (if (zerop (length sticky-tag))
	 string
289
       (setq help-echo (format-message "%s on the `%s' branch"
290
                                       help-echo sticky-tag))
291 292
       (concat string "[" sticky-tag "]"))
     'help-echo help-echo)))
293

Sam Steingold's avatar
Sam Steingold committed
294

André Spiegel's avatar
André Spiegel committed
295 296 297
;;;
;;; State-changing functions
;;;
298

299 300
(autoload 'vc-switches "vc")

301
(defun vc-cvs-register (files &optional comment)
302 303
  "Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
304 305
Passes either `vc-cvs-register-switches' or `vc-register-switches'
to the CVS command."
306 307 308 309 310 311 312 313 314 315 316 317
  ;; Register the directories if needed.
  (let (dirs)
    (dolist (file files)
      (and (not (vc-cvs-responsible-p file))
           (vc-cvs-could-register file)
           (push (directory-file-name (file-name-directory file)) dirs)))
    (if dirs (vc-cvs-register dirs)))
  (apply 'vc-cvs-command nil 0 files
         "add"
         (and comment (string-match "[^\t\n ]" comment)
              (concat "-m" comment))
         (vc-switches 'CVS 'register)))
318

André Spiegel's avatar
André Spiegel committed
319 320 321 322 323 324
(defun vc-cvs-responsible-p (file)
  "Return non-nil if CVS thinks it is responsible for FILE."
  (file-directory-p (expand-file-name "CVS"
				      (if (file-directory-p file)
					  file
					(file-name-directory file)))))
325

326
(defun vc-cvs-could-register (file)
André Spiegel's avatar
André Spiegel committed
327
  "Return non-nil if FILE could be registered in CVS.
328 329 330 331 332 333
This is only possible if CVS is managing FILE's directory or one of
its parents."
  (let ((dir file))
    (while (and (stringp dir)
                (not (equal dir (setq dir (file-name-directory dir))))
                dir)
334
      (setq dir (if (file-exists-p
335
                     (expand-file-name "CVS/Entries" dir))
336 337
                    t
                  (directory-file-name dir))))
338
    (eq dir t)))
339

340
(defun vc-cvs-checkin (files comment &optional rev)
341
  "CVS-specific version of `vc-backend-checkin'."
342 343 344 345 346 347 348 349 350
 (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)))
351
  (let ((status (apply 'vc-cvs-command nil 1 files
352 353
		       "ci" (if rev (concat "-r" rev))
                       (concat "-m" comment)
354
		       (vc-switches 'CVS 'checkin))))
355 356
    (set-buffer "*vc*")
    (goto-char (point-min))
357 358 359 360
    (when (not (zerop status))
      ;; Check checkin problem.
      (cond
       ((re-search-forward "Up-to-date check failed" nil t)
361 362
	(mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
	      files)
Deepak Goel's avatar
Deepak Goel committed
363
        (error "%s" (substitute-command-keys
364 365 366 367 368 369 370
                (concat "Up-to-date check failed: "
                        "type \\[vc-next-action] to merge in changes"))))
       (t
        (pop-to-buffer (current-buffer))
        (goto-char (point-min))
        (shrink-window-if-larger-than-buffer)
        (error "Check-in failed"))))
Eric S. Raymond's avatar
Eric S. Raymond committed
371
    ;; Single-file commit?  Then update the revision by parsing the buffer.
372 373 374 375
    ;; Otherwise we can't necessarily tell what goes with what; clear
    ;; its properties so they have to be refetched.
    (if (= (length files) 1)
	(vc-file-setprop
Eric S. Raymond's avatar
Eric S. Raymond committed
376
	 (car files) 'vc-working-revision
377
	 (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
378
      (mapc 'vc-file-clearprops files))
379
    ;; Anyway, forget the checkout model of the file, because we might have
380 381 382
    ;; guessed wrong when we found the file.  After commit, we can
    ;; tell it from the permissions of the file (see
    ;; vc-cvs-checkout-model).
383
    (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
384 385 386 387 388
	  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"))))
389

Eric S. Raymond's avatar
Eric S. Raymond committed
390
(defun vc-cvs-find-revision (file rev buffer)
391 392 393 394 395 396 397
  (apply 'vc-cvs-command
	 buffer 0 file
	 "-Q"				; suppress diagnostic output
	 "update"
	 (and rev (not (string= rev ""))
	      (concat "-r" rev))
	 "-p"
398
	 (vc-switches 'CVS 'checkout)))
399

400
(defun vc-cvs-checkout (file &optional rev)
401 402 403 404 405 406 407 408
  "Checkout a revision of FILE into the working area.
REV is the revision to check out."
  (message "Checking out %s..." file)
  ;; Change buffers to get local value of vc-checkout-switches.
  (with-current-buffer (or (get-file-buffer file) (current-buffer))
    (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).
409
        (and (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
410 411 412
             (if vc-cvs-use-edit
                 (vc-cvs-command nil 0 file "edit")
               (set-file-modes file (logior (file-modes file) 128))
413
               (if (equal file buffer-file-name) (read-only-mode -1))))
Eric S. Raymond's avatar
Eric S. Raymond committed
414 415
      ;; Check out a particular revision (or recreate the file).
      (vc-file-setprop file 'vc-working-revision nil)
416
      (apply 'vc-cvs-command nil 0 file
417
             "-w"
418 419 420 421 422 423 424 425 426 427
             "update"
             (when rev
               (unless (eq rev t)
                 ;; default for verbose checkout: clear the
                 ;; sticky tag so that the actual update will
                 ;; get the head of the trunk
                 (if (string= rev "")
                     "-A"
                   (concat "-r" rev))))
             (vc-switches 'CVS 'checkout)))
428
    (vc-mode-line file 'CVS))
429
  (message "Checking out %s...done" file))
430

431
(defun vc-cvs-delete-file (file)
432
  (vc-cvs-command nil 0 file "remove" "-f"))
433

434 435
(autoload 'vc-default-revert "vc")

436
(defun vc-cvs-revert (file &optional contents-done)
Eric S. Raymond's avatar
Eric S. Raymond committed
437
  "Revert FILE to the working revision on which it was based."
438
  (vc-default-revert 'CVS file contents-done)
439
  (unless (eq (vc-cvs-checkout-model (list file)) 'implicit)
440
    (if vc-cvs-use-edit
441
        (vc-cvs-command nil 0 file "unedit")
442
      ;; Make the file read-only by switching off all w-bits
443
      (set-file-modes file (logand (file-modes file) #o7555)))))
André Spiegel's avatar
André Spiegel committed
444

445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473
(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))

Eric S. Raymond's avatar
Eric S. Raymond committed
474
(defun vc-cvs-merge (file first-revision &optional second-revision)
André Spiegel's avatar
André Spiegel committed
475
  "Merge changes into current working copy of FILE.
Eric S. Raymond's avatar
Eric S. Raymond committed
476
The changes are between FIRST-REVISION and SECOND-REVISION."
477
  (vc-cvs-command nil 0 file
André Spiegel's avatar
André Spiegel committed
478
                 "update" "-kk"
Eric S. Raymond's avatar
Eric S. Raymond committed
479 480
                 (concat "-j" first-revision)
                 (concat "-j" second-revision))
André Spiegel's avatar
André Spiegel committed
481
  (vc-file-setprop file 'vc-state 'edited)
482
  (with-current-buffer (get-buffer "*vc*")
André Spiegel's avatar
André Spiegel committed
483 484
    (goto-char (point-min))
    (if (re-search-forward "conflicts during merge" nil t)
485
	(progn
486 487 488 489 490 491
	  (vc-file-setprop file 'vc-state 'conflict)
	  ;; signal error
	  1)
      (vc-file-setprop file 'vc-state 'edited)
      ;; signal success
      0)))
André Spiegel's avatar
André Spiegel committed
492 493 494 495

(defun vc-cvs-merge-news (file)
  "Merge in any new changes made to FILE."
  (message "Merging changes into %s..." file)
Eric S. Raymond's avatar
Eric S. Raymond committed
496
  ;; (vc-file-setprop file 'vc-working-revision nil)
497
  (vc-file-setprop file 'vc-checkout-time 0)
498
  (vc-cvs-command nil nil file "update")
499 500 501
  ;; Analyze the merge result reported by CVS, and set
  ;; file properties accordingly.
  (with-current-buffer (get-buffer "*vc*")
André Spiegel's avatar
André Spiegel committed
502
    (goto-char (point-min))
Eric S. Raymond's avatar
Eric S. Raymond committed
503
    ;; get new working revision
504 505
    (if (re-search-forward
	 "^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t)
Eric S. Raymond's avatar
Eric S. Raymond committed
506 507
	(vc-file-setprop file 'vc-working-revision (match-string 1))
      (vc-file-setprop file 'vc-working-revision nil))
André Spiegel's avatar
André Spiegel committed
508 509 510 511 512 513
    ;; get file status
    (prog1
        (if (eq (buffer-size) 0)
            0 ;; there were no news; indicate success
          (if (re-search-forward
               (concat "^\\([CMUP] \\)?"
514
                       (regexp-quote
515 516
                        (substring file (1+ (length (expand-file-name
                                                     "." default-directory)))))
André Spiegel's avatar
André Spiegel committed
517 518 519 520 521 522 523 524 525
                       "\\( already contains the differences between \\)?")
               nil t)
              (cond
               ;; Merge successful, we are in sync with repository now
               ((or (match-string 2)
                    (string= (match-string 1) "U ")
                    (string= (match-string 1) "P "))
                (vc-file-setprop file 'vc-state 'up-to-date)
                (vc-file-setprop file 'vc-checkout-time
Paul Eggert's avatar
Paul Eggert committed
526 527
				 (file-attribute-modification-time
				  (file-attributes file)))
André Spiegel's avatar
André Spiegel committed
528 529 530 531 532 533 534
                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-state 'edited)
                0);; indicate success to the caller
               ;; Conflicts detected!
               (t
535
                (vc-file-setprop file 'vc-state 'conflict)
André Spiegel's avatar
André Spiegel committed
536 537 538 539 540 541
                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))))

542
(defun vc-cvs-modify-change-comment (files rev comment)
543
  "Modify the change comments for FILES on a specified REV.
544
Will fail unless you have administrative privileges on the repo."
545
  (vc-cvs-command nil 0 files "admin" (concat "-m" rev ":" comment)))
Sam Steingold's avatar
Sam Steingold committed
546

André Spiegel's avatar
André Spiegel committed
547 548 549 550
;;;
;;; History functions
;;;

551
(declare-function vc-rcs-print-log-cleanup "vc-rcs" ())
552 553
;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
554

Stefan Monnier's avatar
Stefan Monnier committed
555
(defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit)
556 557
  "Print commit log associated with FILES into specified BUFFER.
Remaining arguments are ignored."
558
  (require 'vc-rcs)
Eric S. Raymond's avatar
Eric S. Raymond committed
559
  ;; It's just the catenation of the individual logs.
560
  (vc-cvs-command
561
   buffer
562
   (if (vc-cvs-stay-local-p files) 'async 0)
563 564
   files "log")
  (with-current-buffer buffer
565
    (vc-run-delayed (vc-rcs-print-log-cleanup)))
566
  (when limit 'limit-unsupported))
567

568 569 570
(defun vc-cvs-comment-history (file)
  "Get comment history of a file."
  (vc-call-backend 'RCS 'comment-history file))
André Spiegel's avatar
André Spiegel committed
571

572 573 574
(autoload 'vc-version-backup-file "vc")
(declare-function vc-coding-system-for-diff "vc" (file))

575
(defun vc-cvs-diff (files &optional oldvers newvers buffer async)
Eric S. Raymond's avatar
Eric S. Raymond committed
576
  "Get a difference report using CVS between two revisions of FILE."
577
  (let* (process-file-side-effects
578
	 (async (and async (vc-cvs-stay-local-p files)))
579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596
	 (invoke-cvs-diff-list nil)
	 status)
    ;; Look through the file list and see if any files have backups
    ;; that can be used to do a plain "diff" instead of "cvs diff".
    (dolist (file files)
      (let ((ov oldvers)
	    (nv newvers))
	(when (or (not ov) (string-equal ov ""))
	  (setq ov (vc-working-revision file)))
	(when (string-equal nv "")
	  (setq nv nil))
	(let ((file-oldvers (vc-version-backup-file file ov))
	      (file-newvers (if (not nv)
				file
			      (vc-version-backup-file file nv)))
	      (coding-system-for-read (vc-coding-system-for-diff file)))
	  (if (and file-oldvers file-newvers)
	      (progn
597 598 599
		;; This used to append diff-switches and vc-diff-switches,
		;; which was consistent with the vc-diff-switches doc at that
		;; time, but not with the actual behavior of any other VC diff.
600
		(apply 'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil
601 602
		       ;; Not a CVS diff, does not use vc-cvs-diff-switches.
		       (append (vc-switches nil 'diff)
603 604 605 606 607 608
			       (list (file-relative-name file-oldvers)
				     (file-relative-name file-newvers))))
		(setq status 0))
	    (push file invoke-cvs-diff-list)))))
    (when invoke-cvs-diff-list
      (setq status (apply 'vc-cvs-command (or buffer "*vc-diff*")
609
			  (if async 'async 1)
610
			  invoke-cvs-diff-list "diff"
611 612 613
			  (and oldvers (concat "-r" oldvers))
			  (and newvers (concat "-r" newvers))
			  (vc-switches 'CVS 'diff))))
614 615
    (if async 1 status))) ; async diff, pessimistic assumption

616 617
(defconst vc-cvs-annotate-first-line-re "^[0-9]")

618
(defun vc-cvs-annotate-process-filter (filter process string)
619 620 621 622
  (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)
623 624
    (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
    (funcall filter process (substring string (match-beginning 0)))))
625

Eric S. Raymond's avatar
Eric S. Raymond committed
626
(defun vc-cvs-annotate-command (file buffer &optional revision)
André Spiegel's avatar
André Spiegel committed
627
  "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
Eric S. Raymond's avatar
Eric S. Raymond committed
628
Optional arg REVISION is a revision to annotate from."
629 630 631 632 633 634
  (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)))))
635 636 637 638
  ;; Strip the leading few lines.
  (let ((proc (get-buffer-process buffer)))
    (if proc
        ;; If running asynchronously, use a process filter.
639 640
        (add-function :around (process-filter proc)
                      #'vc-cvs-annotate-process-filter)
641 642 643 644
      (with-current-buffer buffer
        (goto-char (point-min))
        (re-search-forward vc-cvs-annotate-first-line-re)
        (delete-region (point-min) (1- (point)))))))
645

646
(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
647

648 649 650 651
(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
Paul Eggert's avatar
Paul Eggert committed
652
   (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
653 654 655

(defun vc-cvs-annotate-time ()
  "Return the time of the next annotation (as fraction of days)
Pavel Janík's avatar
Pavel Janík committed
656
systime, or nil if there is none."
657 658
  (let* ((bol (point))
         (cache (get-text-property bol 'vc-cvs-annotate-time))
659 660
         (inhibit-read-only t)
         (inhibit-modification-hooks t))
661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681
    (cond
     (cache)
     ((looking-at
       "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")
      (let ((day (string-to-number (match-string 1)))
            (month (cdr (assq (intern (match-string 2))
                              '((Jan .  1) (Feb .  2) (Mar .  3)
                                (Apr .  4) (May .  5) (Jun .  6)
                                (Jul .  7) (Aug .  8) (Sep .  9)
                                (Oct . 10) (Nov . 11) (Dec . 12)))))
            (year (let ((tmp (string-to-number (match-string 3))))
                    ;; Years 0..68 are 2000..2068.
                    ;; Years 69..99 are 1969..1999.
                    (+ (cond ((> 69 tmp) 2000)
                             ((> 100 tmp) 1900)
                             (t 0))
                       tmp))))
        (put-text-property
         bol (1+ bol) 'vc-cvs-annotate-time
         (setq cache (cons
                      ;; Position at end makes for nicer overlay result.
682 683 684 685
                      ;; Don't put actual buffer pos here, but only relative
                      ;; distance, so we don't ever move backward in the
                      ;; goto-char below, even if the text is moved.
                      (- (match-end 0) (match-beginning 0))
686 687 688
                      (vc-annotate-convert-time
                       (encode-time 0 0 0 day month year))))))))
    (when cache
689
      (goto-char (+ bol (car cache)))   ; Fontify from here to eol.
690
      (cdr cache))))                    ; days (float)
Sam Steingold's avatar
Sam Steingold committed
691

692 693 694 695 696 697 698 699
(defun vc-cvs-annotate-extract-revision-at-line ()
  (save-excursion
    (beginning-of-line)
    (if (re-search-forward "^\\([0-9]+\\.[0-9]+\\(\\.[0-9]+\\)*\\) +("
			   (line-end-position) t)
	(match-string-no-properties 1)
      nil)))

700 701 702 703 704 705 706 707 708 709
(defun vc-cvs-previous-revision (file rev)
  (vc-call-backend 'RCS 'previous-revision file rev))

(defun vc-cvs-next-revision (file rev)
  (vc-call-backend 'RCS 'next-revision file rev))

;; FIXME: This should probably be replaced by code using cvs2cl.
(defun vc-cvs-update-changelog (files)
  (vc-call-backend 'RCS 'update-changelog files))

André Spiegel's avatar
André Spiegel committed
710
;;;
711
;;; Tag system
André Spiegel's avatar
André Spiegel committed
712 713
;;;

714
(defun vc-cvs-create-tag (dir name branchp)
Eric S. Raymond's avatar
Eric S. Raymond committed
715
  "Assign to DIR's current revision a given NAME.
André Spiegel's avatar
André Spiegel committed
716 717
If BRANCHP is non-nil, the name is created as a branch (and the current
workspace is immediately moved to that new branch)."
718 719
  (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name)
  (when branchp (vc-cvs-command nil 0 dir "update" "-r" name)))
André Spiegel's avatar
André Spiegel committed
720

721 722 723 724
;; 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))

725 726 727
(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'.
André Spiegel's avatar
André Spiegel committed
728 729
If UPDATE is non-nil, then update (resynch) any affected buffers."
  (with-current-buffer (get-buffer-create "*vc*")
730 731
    (let ((default-directory dir)
	  (sticky-tag))
André Spiegel's avatar
André Spiegel committed
732 733
      (erase-buffer)
      (if (or (not name) (string= name ""))
734 735
	  (vc-cvs-command t 0 nil "update")
	(vc-cvs-command t 0 nil "update" "-r" name)
736
	(setq sticky-tag name))
André Spiegel's avatar
André Spiegel committed
737 738 739 740 741 742 743 744 745 746 747 748
      (when update
	(goto-char (point-min))
	(while (not (eobp))
	  (if (looking-at "\\([CMUP]\\) \\(.*\\)")
	      (let* ((file (expand-file-name (match-string 2) dir))
		     (state (match-string 1))
		     (buffer (find-buffer-visiting file)))
		(when buffer
		  (cond
		   ((or (string= state "U")
			(string= state "P"))
		    (vc-file-setprop file 'vc-state 'up-to-date)
Eric S. Raymond's avatar
Eric S. Raymond committed
749
		    (vc-file-setprop file 'vc-working-revision nil)
André Spiegel's avatar
André Spiegel committed
750
		    (vc-file-setprop file 'vc-checkout-time
Paul Eggert's avatar
Paul Eggert committed
751 752
				     (file-attribute-modification-time
				      (file-attributes file))))
André Spiegel's avatar
André Spiegel committed
753 754 755
		   ((or (string= state "M")
			(string= state "C"))
		    (vc-file-setprop file 'vc-state 'edited)
Eric S. Raymond's avatar
Eric S. Raymond committed
756
		    (vc-file-setprop file 'vc-working-revision nil)
André Spiegel's avatar
André Spiegel committed
757
		    (vc-file-setprop file 'vc-checkout-time 0)))
758
		  (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag)
André Spiegel's avatar
André Spiegel committed
759 760 761
		  (vc-resynch-buffer file t t))))
	  (forward-line 1))))))

Sam Steingold's avatar
Sam Steingold committed
762

André Spiegel's avatar
André Spiegel committed
763 764 765 766
;;;
;;; Miscellaneous
;;;

767 768
(defun vc-cvs-make-version-backups-p (file)
  "Return non-nil if version backups should be made for FILE."
769
  (vc-cvs-stay-local-p file))
André Spiegel's avatar
André Spiegel committed
770 771 772 773 774 775 776 777

(defun vc-cvs-check-headers ()
  "Check if the current file has any headers in it."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))

Sam Steingold's avatar
Sam Steingold committed
778

André Spiegel's avatar
André Spiegel committed
779 780 781 782
;;;
;;; Internal functions
;;;

783
(defun vc-cvs-command (buffer okstatus files &rest flags)
784 785 786
  "A wrapper around `vc-do-command' for use in vc-cvs.el.
The difference to vc-do-command is that this function always invokes `cvs',
and that it passes `vc-cvs-global-switches' to it before FLAGS."
787
  (apply 'vc-do-command (or buffer "*vc*") okstatus "cvs" files
788
         (if (stringp vc-cvs-global-switches)
789 790 791 792
             (cons vc-cvs-global-switches flags)
           (append vc-cvs-global-switches
                   flags))))

793 794 795 796 797 798
(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))
799
    (let ((stay-local vc-cvs-stay-local))
800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819
      (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))))))))))))
820 821 822 823 824 825 826 827 828 829 830 831 832 833

(defun vc-cvs-repository-hostname (dirname)
  "Hostname of the CVS server associated to workarea DIRNAME."
  (let ((rootname (expand-file-name "CVS/Root" dirname)))
    (when (file-readable-p rootname)
      (with-temp-buffer
	(let ((coding-system-for-read
	       (or file-name-coding-system
		   default-file-name-coding-system)))
	  (vc-insert-file rootname))
	(goto-char (point-min))
	(nth 2 (vc-cvs-parse-root
		(buffer-substring (point)
				  (line-end-position))))))))
834

835 836 837 838 839 840
(defun vc-cvs-parse-uhp (path)
  "parse user@host/path into (user@host /path)"
  (if (string-match "\\([^/]+\\)\\(/.*\\)" path)
      (list (match-string 1 path) (match-string 2 path))
      (list nil path)))

841
(defun vc-cvs-parse-root (root)
842 843
  "Split CVS ROOT specification string into a list of fields.
A CVS root specification of the form
844
  [:METHOD:][[USER@]HOSTNAME]:?/path/to/repository
845 846 847 848 849 850 851 852
is converted to a normalized record with the following structure:
  \(METHOD USER HOSTNAME CVS-ROOT).
The default METHOD for a CVS root of the form
  /path/to/repository
is `local'.
The default METHOD for a CVS root of the form
  [USER@]HOSTNAME:/path/to/repository
is `ext'.
853
For an empty string, nil is returned (invalid CVS root)."
854 855 856 857 858 859 860 861 862 863 864 865
  ;; Split CVS root into colon separated fields (0-4).
  ;; The `x:' makes sure, that leading colons are not lost;
  ;; `HOST:/PATH' is then different from `:METHOD:/PATH'.
  (let* ((root-list (cdr (split-string (concat "x:" root) ":")))
         (len (length root-list))
         ;; All syntactic varieties will get a proper METHOD.
         (root-list
          (cond
           ((= len 0)
            ;; Invalid CVS root
            nil)
           ((= len 1)
866 867
            (let ((uhp (vc-cvs-parse-uhp (car root-list))))
              (cons (if (car uhp) "ext" "local") uhp)))
868 869 870 871 872
           ((= len 2)
            ;; [USER@]HOST:PATH => method `ext'
            (and (not (equal (car root-list) ""))
                 (cons "ext" root-list)))
           ((= len 3)
873
            ;; :METHOD:PATH or :METHOD:USER@HOSTNAME/PATH
874
            (cons (cadr root-list)
875
                  (vc-cvs-parse-uhp (nth 2 root-list))))
876 877 878 879 880 881 882 883 884 885 886 887 888 889 890
           (t
            ;; :METHOD:[USER@]HOST:PATH
            (cdr root-list)))))
    (if root-list
        (let ((method (car root-list))
              (uhost (or (cadr root-list) ""))
              (root (nth 2 root-list))
              user host)
          ;; Split USER@HOST
          (if (string-match "\\(.*\\)@\\(.*\\)" uhost)
              (setq user (match-string 1 uhost)
                    host (match-string 2 uhost))
            (setq host uhost))
          ;; Remove empty HOST
          (and (equal host "")
891
               (setq host nil))
892 893 894
          ;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir'
          (and host
               (equal method "local")
895
               (setq root (concat host ":" root) host nil))
896 897
          ;; Normalize CVS root record
          (list method user host root)))))
André Spiegel's avatar
André Spiegel committed
898

899 900 901 902
;; XXX: This does not work correctly for subdirectories.  "cvs status"
;; information is context sensitive, it contains lines like:
;; cvs status: Examining DIRNAME
;; and the file entries after that don't show the full path.
903 904
;; Because of this VC directory listings only show changed files
;; at the top level for CVS.
André Spiegel's avatar
André Spiegel committed
905 906 907
(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
908
essential information. Note that this can never set the `ignored'
909
state."
910
  (let (file status missing)
André Spiegel's avatar
André Spiegel committed
911
    (goto-char (point-min))
912
    (while (looking-at "\\? \\(.*\\)")
913 914 915
      (setq file (expand-file-name (match-string 1)))
      (vc-file-setprop file 'vc-state 'unregistered)
      (forward-line 1))
916 917 918 919 920 921
    (when (re-search-forward "^File: " nil t)
      (when (setq missing (looking-at "no file "))
	(goto-char (match-end 0)))
      (cond
       ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
	(setq file (expand-file-name (match-string 1)))
922 923
	(setq status(if (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)
                        (match-string 1) "Unknown"))
924 925 926
	(when (and full
		   (re-search-forward
		    "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
927
[\t ]+\\([0-9.]+\\)"
928
		    nil t))
929 930 931 932 933 934
	    (vc-file-setprop file 'vc-latest-revision (match-string 2)))
	(vc-file-setprop
	 file 'vc-state
	 (cond
	  ((string-match "Up-to-date" status)
	   (vc-file-setprop file 'vc-checkout-time
Paul Eggert's avatar
Paul Eggert committed
935 936
			    (file-attribute-modification-time
			     (file-attributes file)))
937 938 939 940
	   'up-to-date)
	  ((string-match "Locally Modified" status)             'edited)
	  ((string-match "Needs Merge" status)                  'needs-merge)
	  ((string-match "Needs \\(Checkout\\|Patch\\)" status)
941
	   (if missing 'missing 'needs-update))
942 943
	  ((string-match "Locally Added" status)                'added)
	  ((string-match "Locally Removed" status)              'removed)
944
	  ((string-match "File had conflicts " status)          'conflict)
945
          ((string-match "Unknown" status)			'unregistered)
946
	  (t 'edited))))))))
André Spiegel's avatar
André Spiegel committed
947

948
(defun vc-cvs-after-dir-status (update-function)
949 950 951 952 953 954 955 956
  (let ((result nil)
        (translation '((?? . unregistered)
                       (?A . added)
                       (?C . conflict)
                       (?M . edited)
                       (?P . needs-merge)
                       (?R . removed)
                       (?U . needs-update))))
957
    (goto-char (point-min))
958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974
    (while (not (eobp))
      (if (looking-at "^[ACMPRU?] \\(.*\\)$")
          (push (list (match-string 1)
                      (cdr (assoc (char-after) translation)))
                result)
        (cond
         ((looking-at "cvs update: warning: \\(.*\\) was lost")
          ;; Format is:
          ;; cvs update: warning: FILENAME was lost
          ;; U FILENAME
          (push (list (match-string 1) 'missing) result)
          ;; Skip the "U" line
          (forward-line 1))
         ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored")
          (push (list (match-string 1) 'unregistered) result))))
      (forward-line 1))
    (funcall update-function result)))
975

976
;; Based on vc-cvs-dir-state-heuristic from Emacs 22.
977
;; FIXME does not mention unregistered files.
978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005
(defun vc-cvs-dir-status-heuristic (dir update-function &optional basedir)
  "Find the CVS state of all files in DIR, using only local information."
  (let (file basename status result dirlist)
    (with-temp-buffer
      (vc-cvs-get-entries dir)
      (goto-char (point-min))
      (while (not (eobp))
        (if (looking-at "D/\\([^/]*\\)////")
            (push (expand-file-name (match-string 1) dir) dirlist)
          ;; CVS-removed files are not taken under VC control.
          (when (looking-at "/\\([^/]*\\)/[^/-]")
            (setq basename (match-string 1)
                  file (expand-file-name basename dir)
                  status (or (vc-file-getprop file 'vc-state)
                             (vc-cvs-parse-entry file t)))
            (unless (eq status 'up-to-date)
              (push (list (if basedir
                              (file-relative-name file basedir)
                            basename)
                          status) result))))
        (forward-line 1)))
    (dolist (subdir dirlist)
      (setq result (append result
                           (vc-cvs-dir-status-heuristic subdir nil
                                                        (or basedir dir)))))
    (if basedir result
      (funcall update-function result))))

1006 1007 1008
(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."
1009
  (let ((local (vc-cvs-stay-local-p dir)))
1010
    (if (and (not files) local (not (eq local 'only-file)))
1011 1012 1013 1014 1015 1016
        (vc-cvs-dir-status-heuristic dir update-function))
    (vc-cvs-command (current-buffer) 'async
                    files
                    "-f" "-n" "-q" "update")
    (vc-run-delayed
      (vc-cvs-after-dir-status update-function))))
1017

1018 1019 1020 1021 1022 1023 1024 1025 1026
(defun vc-cvs-file-to-string (file)
  "Read the content of FILE and return it as a string."
  (condition-case nil
      (with-temp-buffer
	(insert-file-contents file)
	(goto-char (point-min))
	(buffer-substring (point) (point-max)))
    (file-error nil)))

Stefan Monnier's avatar
Stefan Monnier committed
1027
(defun vc-cvs-dir-extra-headers (_dir)
1028
  "Extract and represent per-directory properties of a CVS working copy."
1029
  (let ((repo
1030 1031 1032 1033
	 (condition-case nil
	     (with-temp-buffer
	       (insert-file-contents "CVS/Root")
	       (goto-char (point-min))
1034
	       (and (looking-at ":ext:") (delete-char 5))
Nick Roberts's avatar