lisp/vc-cvs.el

   1 ;;; vc-cvs.el --- non-resident support for CVS version-control
   2
   3 ;; Copyright (C) 1995,98,99,2000,2001  Free Software Foundation, Inc.
   4
   5 ;; Author:      FSF (see vc.el for full credits)
   6 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
   7
   8 ;; $Id: vc-cvs.el,v 1.22 2001/04/17 05:59:57 eliz Exp $
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 (eval-when-compile
  32   (require 'vc))
  33
  34 ;;;
  35 ;;; Customization options
  36 ;;;
  37
  38 (defcustom vc-cvs-register-switches nil
  39   "*Extra switches for registering a file into CVS.
  40 A string or list of strings passed to the checkin program by
  41 \\[vc-register]."
  42   :type '(choice (const :tag "None" nil)
  43                  (string :tag "Argument String")
  44                  (repeat :tag "Argument List"
  45                          :value ("")
  46                          string))
  47   :version "21.1"
  48   :group 'vc)
  49
  50 (defcustom vc-cvs-diff-switches nil
  51   "*A string or list of strings specifying extra switches for cvs diff under VC."
  52     :type '(choice (const :tag "None" nil)
  53                  (string :tag "Argument String")
  54                  (repeat :tag "Argument List"
  55                          :value ("")
  56                          string))
  57   :version "21.1"
  58   :group 'vc)
  59
  60 (defcustom vc-cvs-header (or (cdr (assoc 'CVS vc-header-alist)) '("\$Id\$"))
  61   "*Header keywords to be inserted by `vc-insert-headers'."
  62   :version "21.1"
  63   :type '(repeat string)
  64   :group 'vc)
  65
  66 (defcustom vc-cvs-use-edit t
  67   "*Non-nil means to use `cvs edit' to \"check out\" a file.
  68 This is only meaningful if you don't use the implicit checkout model
  69 \(i.e. if you have $CVSREAD set)."
  70   :type 'boolean
  71   :version "21.1"
  72   :group 'vc)
  73
  74 (defcustom vc-cvs-stay-local t
  75   "*Non-nil means use local operations when possible for remote repositories.
  76 This avoids slow queries over the network and instead uses heuristics
  77 and past information to determine the current status of a file.
  78 The value can also be a regular expression to match against the host name
  79 of a repository; then VC only stays local for hosts that match it."
  80   :type '(choice (const :tag "Always stay local" t)
  81                  (string :tag "Host regexp")
  82                  (const :tag "Don't stay local" nil))
  83   :version "21.1"
  84   :group 'vc)
  85
  86
  87 ;;;
  88 ;;; Internal variables
  89 ;;;
  90
  91 (defvar vc-cvs-local-month-numbers
  92   '(("Jan" . 1) ("Feb" .  2) ("Mar" .  3) ("Apr" .  4)
  93     ("May" . 5) ("Jun" .  6) ("Jul" .  7) ("Aug" .  8)
  94     ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
  95   "Local association list of month numbers.")
  96
  97
  98 ;;;
  99 ;;; State-querying functions
 100 ;;;
 101
 102 ;;;###autoload (defun vc-cvs-registered (f)
 103 ;;;###autoload   (when (file-readable-p (expand-file-name
 104 ;;;###autoload                    "CVS/Entries" (file-name-directory f)))
 105 ;;;###autoload       (require 'vc-cvs)
 106 ;;;###autoload       (vc-cvs-registered f)))
 107
 108 (defun vc-cvs-registered (file)
 109   "Check if FILE is CVS registered."
 110   (let ((dirname (or (file-name-directory file) ""))
 111         (basename (file-name-nondirectory file))
 112         ;; make sure that the file name is searched case-sensitively
 113         (case-fold-search nil))
 114     (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
 115         (with-temp-buffer
 116           (vc-insert-file (expand-file-name "CVS/Entries" dirname))
 117           (goto-char (point-min))
 118           (cond
 119            ((re-search-forward
 120              (concat "^/" (regexp-quote basename) "/") nil t)
 121             (beginning-of-line)
 122             (vc-cvs-parse-entry file)
 123             t)
 124            (t nil)))
 125       nil)))
 126
 127 (defun vc-cvs-state (file)
 128   "CVS-specific version of `vc-state'."
 129   (if (vc-cvs-stay-local-p file)
 130       (let ((state (vc-file-getprop file 'vc-state)))
 131         ;; If we should stay local, use the heuristic but only if
 132         ;; we don't have a more precise state already available.
 133         (if (memq state '(up-to-date edited))
 134             (vc-cvs-state-heuristic file)
 135           state))
 136     (with-temp-buffer
 137       (cd (file-name-directory file))
 138       (vc-do-command t 0 "cvs" file "status")
 139       (vc-cvs-parse-status t))))
 140
 141 (defun vc-cvs-state-heuristic (file)
 142   "CVS-specific state heuristic."
 143   ;; If the file has not changed since checkout, consider it `up-to-date'.
 144   ;; Otherwise consider it `edited'.
 145   (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
 146         (lastmod (nth 5 (file-attributes file))))
 147     (if (equal checkout-time lastmod)
 148         'up-to-date
 149       'edited)))
 150
 151 (defun vc-cvs-dir-state (dir)
 152   "Find the CVS state of all files in DIR."
 153   (if (vc-cvs-stay-local-p dir)
 154       (vc-cvs-dir-state-heuristic dir)
 155     (let ((default-directory dir))
 156       ;; Don't specify DIR in this command, the default-directory is
 157       ;; enough.  Otherwise it might fail with remote repositories.
 158       (with-temp-buffer
 159         (vc-do-command t 0 "cvs" nil "status" "-l")
 160         (goto-char (point-min))
 161         (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
 162           (narrow-to-region (match-beginning 0) (match-end 0))
 163           (vc-cvs-parse-status)
 164           (goto-char (point-max))
 165           (widen))))))
 166
 167 (defun vc-cvs-workfile-version (file)
 168   "CVS-specific version of `vc-workfile-version'."
 169   ;; There is no need to consult RCS headers under CVS, because we
 170   ;; get the workfile version for free when we recognize that a file
 171   ;; is registered in CVS.
 172   (vc-cvs-registered file)
 173   (vc-file-getprop file 'vc-workfile-version))
 174
 175 (defun vc-cvs-checkout-model (file)
 176   "CVS-specific version of `vc-checkout-model'."
 177   (if (or (getenv "CVSREAD")
 178           ;; If the file is not writable (despite CVSREAD being
 179           ;; undefined), this is probably because the file is being
 180           ;; "watched" by other developers.
 181           ;; (If vc-mistrust-permissions was t, we actually shouldn't
 182           ;; trust this, but there is no other way to learn this from CVS
 183           ;; at the moment (version 1.9).)
 184           (string-match "r-..-..-." (nth 8 (file-attributes file))))
 185       'announce
 186     'implicit))
 187
 188 (defun vc-cvs-mode-line-string (file)
 189   "Return string for placement into the modeline for FILE.
 190 Compared to the default implementation, this function handles the
 191 special case of a CVS file that is added but not yet committed."
 192   (let ((state   (vc-state file))
 193         (rev     (vc-workfile-version file)))
 194     (cond ((string= rev "0")
 195            ;; A file that is added but not yet committed.
 196            "CVS @@")
 197           ((or (eq state 'up-to-date)
 198                (eq state 'needs-patch))
 199            (concat "CVS-" rev))
 200           ((stringp state)
 201            (concat "CVS:" state ":" rev))
 202           (t
 203            ;; Not just for the 'edited state, but also a fallback
 204            ;; for all other states.  Think about different symbols
 205            ;; for 'needs-patch and 'needs-merge.
 206            (concat "CVS:" rev)))))
 207
 208 (defun vc-cvs-dired-state-info (file)
 209   "CVS-specific version of `vc-dired-state-info'."
 210   (let* ((cvs-state (vc-state file))
 211          (state (cond ((eq cvs-state 'edited)   "modified")
 212                       ((eq cvs-state 'needs-patch)      "patch")
 213                       ((eq cvs-state 'needs-merge)      "merge")
 214                       ;; FIXME: those two states cannot occur right now
 215                       ((eq cvs-state 'unlocked-changes) "conflict")
 216                       ((eq cvs-state 'locally-added)    "added")
 217                       )))
 218     (if state (concat "(" state ")"))))
 219
 220
 221 ;;;
 222 ;;; State-changing functions
 223 ;;;
 224
 225 (defun vc-cvs-register (file &optional rev comment)
 226   "Register FILE into the CVS version-control system.
 227 COMMENT can be used to provide an initial description of FILE.
 228
 229 `vc-register-switches' and `vc-cvs-register-switches' are passed to
 230 the CVS command (in that order)."
 231     (let ((switches (list
 232                      (if (stringp vc-register-switches)
 233                          (list vc-register-switches)
 234                        vc-register-switches)
 235                      (if (stringp vc-cvs-register-switches)
 236                          (list vc-cvs-register-switches)
 237                        vc-cvs-register-switches))))
 238
 239       (apply 'vc-do-command nil 0 "cvs" file
 240              "add"
 241              (and comment (string-match "[^\t\n ]" comment)
 242                   (concat "-m" comment))
 243              switches)))
 244
 245 (defun vc-cvs-responsible-p (file)
 246   "Return non-nil if CVS thinks it is responsible for FILE."
 247   (file-directory-p (expand-file-name "CVS"
 248                                       (if (file-directory-p file)
 249                                           file
 250                                         (file-name-directory file)))))
 251
 252 (defun vc-cvs-could-register (file)
 253   "Return non-nil if FILE could be registered in CVS.
 254 This is only possible if CVS is responsible for FILE's directory."
 255   (vc-cvs-responsible-p file))
 256
 257 (defun vc-cvs-checkin (file rev comment)
 258   "CVS-specific version of `vc-backend-checkin'."
 259   (let ((switches (if (stringp vc-checkin-switches)
 260                       (list vc-checkin-switches)
 261                     vc-checkin-switches))
 262         status)
 263     ;; explicit check-in to the trunk requires a double check-in (first
 264     ;; unexplicit) (CVS-1.3)
 265     (if (and rev (vc-trunk-p rev))
 266         (apply 'vc-do-command nil 1 "cvs" file
 267                "ci" "-m" "intermediate"
 268                switches))
 269     (setq status (apply 'vc-do-command nil 1 "cvs" file
 270                         "ci" (if rev (concat "-r" rev))
 271                         (concat "-m" comment)
 272                         switches))
 273     (set-buffer "*vc*")
 274     (goto-char (point-min))
 275     (when (not (zerop status))
 276       ;; Check checkin problem.
 277       (cond
 278        ((re-search-forward "Up-to-date check failed" nil t)
 279         (vc-file-setprop file 'vc-state 'needs-merge)
 280         (error (substitute-command-keys
 281                 (concat "Up-to-date check failed: "
 282                         "type \\[vc-next-action] to merge in changes"))))
 283        (t
 284         (pop-to-buffer (current-buffer))
 285         (goto-char (point-min))
 286         (shrink-window-if-larger-than-buffer)
 287         (error "Check-in failed"))))
 288     ;; Update file properties
 289     (vc-file-setprop
 290      file 'vc-workfile-version
 291      (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
 292     ;; Forget the checkout model of the file, because we might have
 293     ;; guessed wrong when we found the file.  After commit, we can
 294     ;; tell it from the permissions of the file (see
 295     ;; vc-cvs-checkout-model).
 296     (vc-file-setprop file 'vc-checkout-model nil)
 297     ;; if this was an explicit check-in, remove the sticky tag
 298     (if rev (vc-do-command nil 0 "cvs" file "update" "-A"))))
 299
 300 (defun vc-cvs-checkout (file &optional editable rev workfile)
 301   "Retrieve a revision of FILE into a WORKFILE.
 302 EDITABLE non-nil means that the file should be writable.
 303 REV is the revision to check out into WORKFILE."
 304   (let ((filename (or workfile file))
 305         (file-buffer (get-file-buffer file))
 306         switches)
 307     (message "Checking out %s..." filename)
 308     (save-excursion
 309       ;; Change buffers to get local value of vc-checkout-switches.
 310       (if file-buffer (set-buffer file-buffer))
 311       (setq switches (if (stringp vc-checkout-switches)
 312                          (list vc-checkout-switches)
 313                        vc-checkout-switches))
 314       ;; Save this buffer's default-directory
 315       ;; and use save-excursion to make sure it is restored
 316       ;; in the same buffer it was saved in.
 317       (let ((default-directory default-directory))
 318         (save-excursion
 319           ;; Adjust the default-directory so that the check-out creates
 320           ;; the file in the right place.
 321           (setq default-directory (file-name-directory filename))
 322           (if workfile
 323               (let ((failed t)
 324                     (backup-name (if (string= file workfile)
 325                                      (car (find-backup-file-name filename)))))
 326                 (when backup-name
 327                   (copy-file filename backup-name
 328                              'ok-if-already-exists 'keep-date)
 329                   (unless (file-writable-p filename)
 330                     (set-file-modes filename
 331                                     (logior (file-modes filename) 128))))
 332                 (unwind-protect
 333                     (progn
 334                       (let ((coding-system-for-read 'no-conversion)
 335                             (coding-system-for-write 'no-conversion))
 336                         (with-temp-file filename
 337                           (apply 'vc-do-command
 338                                  (current-buffer) 0 "cvs" file
 339                                  "-Q"   ; suppress diagnostic output
 340          "update"
 341                                  (and rev (not (string= rev ""))
 342                                       (concat "-r" rev))
 343                                  "-p"
 344                                  switches)))
 345                       (setq failed nil))
 346                   (if failed
 347                       (if backup-name
 348                           (rename-file backup-name filename
 349                                        'ok-if-already-exists)
 350                         (if (file-exists-p filename)
 351                             (delete-file filename)))
 352                     (and backup-name
 353                          (not vc-make-backup-files)
 354                          (delete-file backup-name)))))
 355             (if (and (file-exists-p file) (not rev))
 356                 ;; If no revision was specified, just make the file writable
 357                 ;; if necessary (using `cvs-edit' if requested).
 358       (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
 359                      (if vc-cvs-use-edit
 360                          (vc-do-command nil 0 "cvs" file "edit")
 361                        (set-file-modes file (logior (file-modes file) 128))
 362                        (if file-buffer (toggle-read-only -1))))
 363               ;; Check out a particular version (or recreate the file).
 364               (vc-file-setprop file 'vc-workfile-version nil)
 365               (apply 'vc-do-command nil 0 "cvs" file
 366            (and editable
 367                 (or (not (file-exists-p file))
 368                     (not (eq (vc-cvs-checkout-model file)
 369                              'implicit)))
 370                 "-w")
 371            "update"
 372            ;; default for verbose checkout: clear the sticky tag so
 373            ;; that the actual update will get the head of the trunk
 374                      (if (or (not rev) (string= rev ""))
 375                          "-A"
 376                        (concat "-r" rev))
 377                      switches))))
 378         (vc-mode-line file)
 379         (message "Checking out %s...done" filename)))))
 380
 381 (defun vc-cvs-revert (file)
 382   "Revert FILE to the version it was based on."
 383   ;; Check out via standard output (caused by the final argument
 384   ;; FILE below), so that no sticky tag is set.
 385   (vc-cvs-checkout file nil (vc-workfile-version file) file)
 386   ;; If "cvs edit" was used to make the file writable,
 387   ;; call "cvs unedit" now to undo that.
 388   (if (and (not (eq (vc-cvs-checkout-model file) 'implicit))
 389            vc-cvs-use-edit)
 390       (vc-do-command nil 0 "cvs" file "unedit")))
 391
 392 (defun vc-cvs-merge (file first-version &optional second-version)
 393   "Merge changes into current working copy of FILE.
 394 The changes are between FIRST-VERSION and SECOND-VERSION."
 395   (vc-do-command nil 0 "cvs" file
 396                  "update" "-kk"
 397                  (concat "-j" first-version)
 398                  (concat "-j" second-version))
 399   (vc-file-setprop file 'vc-state 'edited)
 400   (save-excursion
 401     (set-buffer (get-buffer "*vc*"))
 402     (goto-char (point-min))
 403     (if (re-search-forward "conflicts during merge" nil t)
 404         1                               ; signal error
 405       0)))                              ; signal success
 406
 407 (defun vc-cvs-merge-news (file)
 408   "Merge in any new changes made to FILE."
 409   (message "Merging changes into %s..." file)
 410   (save-excursion
 411     ;; (vc-file-setprop file 'vc-workfile-version nil)
 412     (vc-file-setprop file 'vc-checkout-time 0)
 413     (vc-do-command nil 0 "cvs" file "update")
 414     ;; Analyze the merge result reported by CVS, and set
 415     ;; file properties accordingly.
 416     (set-buffer (get-buffer "*vc*"))
 417     (goto-char (point-min))
 418     ;; get new workfile version
 419     (if (re-search-forward (concat "^Merging differences between "
 420                                    "[01234567890.]* and "
 421                                    "\\([01234567890.]*\\) into")
 422                            nil t)
 423         (vc-file-setprop file 'vc-workfile-version (match-string 1))
 424       (vc-file-setprop file 'vc-workfile-version nil))
 425     ;; get file status
 426     (prog1
 427         (if (eq (buffer-size) 0)
 428             0 ;; there were no news; indicate success
 429           (if (re-search-forward
 430                (concat "^\\([CMUP] \\)?"
 431                        (regexp-quote (file-name-nondirectory file))
 432                        "\\( already contains the differences between \\)?")
 433                nil t)
 434               (cond
 435                ;; Merge successful, we are in sync with repository now
 436                ((or (match-string 2)
 437                     (string= (match-string 1) "U ")
 438                     (string= (match-string 1) "P "))
 439                 (vc-file-setprop file 'vc-state 'up-to-date)
 440                 (vc-file-setprop file 'vc-checkout-time
 441                                  (nth 5 (file-attributes file)))
 442                 0);; indicate success to the caller
 443                ;; Merge successful, but our own changes are still in the file
 444                ((string= (match-string 1) "M ")
 445                 (vc-file-setprop file 'vc-state 'edited)
 446                 0);; indicate success to the caller
 447                ;; Conflicts detected!
 448                (t
 449                 (vc-file-setprop file 'vc-state 'edited)
 450                 1);; signal the error to the caller
 451                )
 452             (pop-to-buffer "*vc*")
 453             (error "Couldn't analyze cvs update result")))
 454       (message "Merging changes into %s...done" file))))
 455
 456
 457 ;;;
 458 ;;; History functions
 459 ;;;
 460
 461 (defun vc-cvs-print-log (file)
 462   "Get change log associated with FILE."
 463   (vc-do-command
 464    nil
 465    (if (and (vc-cvs-stay-local-p file) (fboundp 'start-process)) 'async 0)
 466    "cvs" file "log"))
 467
 468 (defun vc-cvs-show-log-entry (version)
 469   (when (re-search-forward
 470          ;; also match some context, for safety
 471          (concat "----\nrevision " version
 472                  "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
 473     ;; set the display window so that
 474     ;; the whole log entry is displayed
 475     (let (start end lines)
 476       (beginning-of-line) (forward-line -1) (setq start (point))
 477       (if (not (re-search-forward "^----*\nrevision" nil t))
 478           (setq end (point-max))
 479         (beginning-of-line) (forward-line -1) (setq end (point)))
 480       (setq lines (count-lines start end))
 481       (cond
 482        ;; if the global information and this log entry fit
 483        ;; into the window, display from the beginning
 484        ((< (count-lines (point-min) end) (window-height))
 485         (goto-char (point-min))
 486         (recenter 0)
 487         (goto-char start))
 488        ;; if the whole entry fits into the window,
 489        ;; display it centered
 490        ((< (1+ lines) (window-height))
 491         (goto-char start)
 492         (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
 493        ;; otherwise (the entry is too large for the window),
 494        ;; display from the start
 495        (t
 496         (goto-char start)
 497         (recenter 0))))))
 498
 499 (defun vc-cvs-diff (file &optional oldvers newvers)
 500   "Get a difference report using CVS between two versions of FILE."
 501   (let (options status (diff-switches-list (vc-diff-switches-list cvs)))
 502     (if (string= (vc-workfile-version file) "0")
 503         ;; This file is added but not yet committed; there is no master file.
 504         (if (or oldvers newvers)
 505             (error "No revisions of %s exist" file)
 506           ;; we regard this as "changed".
 507           ;; diff it against /dev/null.
 508           (apply 'vc-do-command "*vc-diff*"
 509                  1 "diff" file
 510                  (append diff-switches-list '("/dev/null"))))
 511       (setq status
 512             (apply 'vc-do-command "*vc-diff*"
 513                    (if (and (vc-cvs-stay-local-p file)
 514                             (fboundp 'start-process))
 515                        'async
 516                      1)
 517                    "cvs" file "diff"
 518                    (and oldvers (concat "-r" oldvers))
 519                    (and newvers (concat "-r" newvers))
 520                    diff-switches-list))
 521       (if (vc-cvs-stay-local-p file)
 522           1 ;; async diff, pessimistic assumption
 523         status))))
 524
 525 (defun vc-cvs-annotate-command (file buffer &optional version)
 526   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
 527 Optional arg VERSION is a version to annotate from."
 528   (vc-do-command buffer 0 "cvs" file "annotate" (if version
 529                                                     (concat "-r" version))))
 530
 531 (defun vc-cvs-annotate-difference (point)
 532   "Return the difference between the time of the line and the current time.
 533 Return values are as defined for `current-time'."
 534   ;; We need a list of months and their corresponding numbers.
 535   (if (looking-at "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")
 536       (progn
 537         (let* ((day (string-to-number (match-string 1)))
 538                (month (cdr (assoc (match-string 2) vc-cvs-local-month-numbers)))
 539                (year-tmp (string-to-number (match-string 3)))
 540                ;; Years 0..68 are 2000..2068.
 541                ;; Years 69..99 are 1969..1999.
 542                (year (+ (cond ((> 69 year-tmp) 2000)
 543                               ((> 100 year-tmp) 1900)
 544                               (t 0))
 545                         year-tmp)))
 546           (goto-char (match-end 0)) ; Position at end makes for nicer overlay result
 547           (- (car (current-time))
 548              (car (encode-time 0 0 0 day month year)))))
 549     ;; If we did not look directly at an annotation, there might be
 550     ;; some further down.  This is the case if we are positioned at
 551     ;; the very top of the buffer, for instance.
 552     (if (re-search-forward
 553          "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): " nil t)
 554         (progn
 555           (beginning-of-line nil)
 556           (vc-cvs-annotate-difference (point))))))
 557
 558
 559 ;;;
 560 ;;; Snapshot system
 561 ;;;
 562
 563 (defun vc-cvs-create-snapshot (dir name branchp)
 564   "Assign to DIR's current version a given NAME.
 565 If BRANCHP is non-nil, the name is created as a branch (and the current
 566 workspace is immediately moved to that new branch)."
 567   (vc-do-command nil 0 "cvs" dir "tag" "-c" (if branchp "-b") name)
 568   (when branchp (vc-do-command nil 0 "cvs" dir "update" "-r" name)))
 569
 570 (defun vc-cvs-retrieve-snapshot (dir name update)
 571   "Retrieve a snapshot at and below DIR.
 572 NAME is the name of the snapshot; if it is empty, do a `cvs update'.
 573 If UPDATE is non-nil, then update (resynch) any affected buffers."
 574   (with-current-buffer (get-buffer-create "*vc*")
 575     (let ((default-directory dir))
 576       (erase-buffer)
 577       (if (or (not name) (string= name ""))
 578           (vc-do-command t 0 "cvs" nil "update")
 579         (vc-do-command t 0 "cvs" nil "update" "-r" name))
 580       (when update
 581         (goto-char (point-min))
 582         (while (not (eobp))
 583           (if (looking-at "\\([CMUP]\\) \\(.*\\)")
 584               (let* ((file (expand-file-name (match-string 2) dir))
 585                      (state (match-string 1))
 586                      (buffer (find-buffer-visiting file)))
 587                 (when buffer
 588                   (cond
 589                    ((or (string= state "U")
 590                         (string= state "P"))
 591                     (vc-file-setprop file 'vc-state 'up-to-date)
 592                     (vc-file-setprop file 'vc-workfile-version nil)
 593                     (vc-file-setprop file 'vc-checkout-time
 594                                      (nth 5 (file-attributes file))))
 595                    ((or (string= state "M")
 596                         (string= state "C"))
 597                     (vc-file-setprop file 'vc-state 'edited)
 598                     (vc-file-setprop file 'vc-workfile-version nil)
 599                     (vc-file-setprop file 'vc-checkout-time 0)))
 600                   (vc-resynch-buffer file t t))))
 601           (forward-line 1))))))
 602
 603
 604 ;;;
 605 ;;; Miscellaneous
 606 ;;;
 607
 608 (defun vc-cvs-make-version-backups-p (file)
 609   "Return non-nil if version backups should be made for FILE."
 610   (vc-cvs-stay-local-p file))
 611
 612 (defun vc-cvs-check-headers ()
 613   "Check if the current file has any headers in it."
 614   (save-excursion
 615     (goto-char (point-min))
 616     (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
 617 \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
 618
 619
 620 ;;;
 621 ;;; Internal functions
 622 ;;;
 623
 624 (defun vc-cvs-stay-local-p (file)
 625   "Return non-nil if VC should stay local when handling FILE."
 626   (if vc-cvs-stay-local
 627       (let* ((dirname (if (file-directory-p file)
 628                           (directory-file-name file)
 629                         (file-name-directory file)))
 630              (prop
 631               (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
 632                   (let ((rootname (expand-file-name "CVS/Root" dirname)))
 633                     (vc-file-setprop
 634                      dirname 'vc-cvs-stay-local-p
 635                      (when (file-readable-p rootname)
 636                        (with-temp-buffer
 637                          (vc-insert-file rootname)
 638                          (goto-char (point-min))
 639                          (if (looking-at "\\([^:]*\\):")
 640                              (if (not (stringp vc-cvs-stay-local))
 641                                  'yes
 642                                (let ((hostname (match-string 1)))
 643                                  (if (string-match vc-cvs-stay-local hostname)
 644                                      'yes
 645                                    'no)))
 646                            'no))))))))
 647         (if (eq prop 'yes) t nil))))
 648
 649 (defun vc-cvs-parse-status (&optional full)
 650   "Parse output of \"cvs status\" command in the current buffer.
 651 Set file properties accordingly.  Unless FULL is t, parse only
 652 essential information."
 653   (let (file status)
 654     (goto-char (point-min))
 655     (if (re-search-forward "^File: " nil t)
 656         (cond
 657          ((looking-at "no file") nil)
 658          ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
 659           (setq file (expand-file-name (match-string 1)))
 660           (vc-file-setprop file 'vc-backend 'CVS)
 661           (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
 662               (setq status "Unknown")
 663             (setq status (match-string 1)))
 664           (if (and full
 665                    (re-search-forward
 666                     "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
 667 \[\t ]+\\([0-9.]+\\)"
 668                     nil t))
 669               (vc-file-setprop file 'vc-latest-version (match-string 2)))
 670           (cond
 671            ((string-match "Up-to-date" status)
 672             (vc-file-setprop file 'vc-checkout-time
 673                              (nth 5 (file-attributes file)))
 674             'up-to-date)
 675            ((string-match "Locally Modified"    status) 'edited)
 676            ((string-match "Needs Merge"         status) 'needs-merge)
 677            ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-patch)
 678            (t 'edited)))))))
 679
 680 (defun vc-cvs-dir-state-heuristic (dir)
 681   "Find the CVS state of all files in DIR, using only local information."
 682   (with-temp-buffer
 683     (vc-insert-file (expand-file-name "CVS/Entries" dir))
 684     (goto-char (point-min))
 685     (while (not (eobp))
 686       (when (looking-at "/\\([^/]*\\)/")
 687         (let ((file (expand-file-name (match-string 1) dir)))
 688           (unless (vc-file-getprop file 'vc-state)
 689             (vc-cvs-parse-entry file t))))
 690       (forward-line 1))))
 691
 692 (defun vc-cvs-parse-entry (file &optional set-state)
 693   "Parse a line from CVS/Entries.
 694 Compare modification time to that of the FILE, set file properties
 695 accordingly.  However, `vc-state' is set only if optional arg SET-STATE
 696 is non-nil."
 697   (cond
 698    ;; entry for a "locally added" file (not yet committed)
 699    ((looking-at "/[^/]+/0/")
 700     (vc-file-setprop file 'vc-checkout-time 0)
 701     (vc-file-setprop file 'vc-workfile-version "0")
 702     (if set-state (vc-file-setprop file 'vc-state 'edited)))
 703    ;; normal entry
 704    ((looking-at
 705      (concat "/[^/]+"
 706              ;; revision
 707              "/\\([^/]*\\)"
 708              ;; timestamp
 709              "/[A-Z][a-z][a-z]"       ;; week day (irrelevant)
 710              " \\([A-Z][a-z][a-z]\\)" ;; month name
 711              " *\\([0-9]*\\)"         ;; day of month
 712              " \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)"  ;; hms
 713              " \\([0-9]*\\)"          ;; year
 714              ;; optional conflict field
 715              "\\(+[^/]*\\)?/"))
 716     (vc-file-setprop file 'vc-workfile-version (match-string 1))
 717     ;; compare checkout time and modification time
 718     (let ((second (string-to-number (match-string 6)))
 719           (minute (string-to-number (match-string 5)))
 720           (hour (string-to-number (match-string 4)))
 721           (day (string-to-number (match-string 3)))
 722           (year (string-to-number (match-string 7)))
 723           (month (/ (string-match
 724                      (match-string 2)
 725                      "xxxJanFebMarAprMayJunJulAugSepOctNovDec")
 726                     3))
 727           (mtime (nth 5 (file-attributes file))))
 728       (cond ((equal mtime
 729                     (encode-time second minute hour day month year 0))
 730              (vc-file-setprop file 'vc-checkout-time mtime)
 731              (if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
 732             (t
 733              (vc-file-setprop file 'vc-checkout-time 0)
 734              (if set-state (vc-file-setprop file 'vc-state 'edited))))))
 735    ;; entry with arbitrary text as timestamp
 736    ;; (this means we should consider it modified)
 737    ((looking-at
 738      (concat "/[^/]+"
 739              ;; revision
 740              "/\\([^/]*\\)"
 741              ;; timestamp (arbitrary text)
 742              "/[^/]*"
 743              ;; optional conflict field
 744              "\\(+[^/]*\\)?/"))
 745     (vc-file-setprop file 'vc-workfile-version (match-string 1))
 746     (vc-file-setprop file 'vc-checkout-time 0)
 747     (if set-state (vc-file-setprop file 'vc-state 'edited)))))
 748
 749 (provide 'vc-cvs)
 750
 751 ;;; vc-cvs.el ends here