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.23 2001/07/04 15:51:18 monnier 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 &optional contents-done)
 382   "Revert FILE to the version it was based on."
 383   (unless contents-done
 384     ;; Check out via standard output (caused by the final argument
 385     ;; FILE below), so that no sticky tag is set.
 386     (vc-cvs-checkout file nil (vc-workfile-version file) file))
 387   (unless (eq (vc-checkout-model file) 'implicit)
 388     (if vc-cvs-use-edit
 389         (vc-do-command nil 0 "cvs" file "unedit")
 390       ;; Make the file read-only by switching off all w-bits
 391       (set-file-modes file (logand (file-modes file) 3950)))))
 392
 393 (defun vc-cvs-merge (file first-version &optional second-version)
 394   "Merge changes into current working copy of FILE.
 395 The changes are between FIRST-VERSION and SECOND-VERSION."
 396   (vc-do-command nil 0 "cvs" file
 397                  "update" "-kk"
 398                  (concat "-j" first-version)
 399                  (concat "-j" second-version))
 400   (vc-file-setprop file 'vc-state 'edited)
 401   (save-excursion
 402     (set-buffer (get-buffer "*vc*"))
 403     (goto-char (point-min))
 404     (if (re-search-forward "conflicts during merge" nil t)
 405         1                               ; signal error
 406       0)))                              ; signal success
 407
 408 (defun vc-cvs-merge-news (file)
 409   "Merge in any new changes made to FILE."
 410   (message "Merging changes into %s..." file)
 411   (save-excursion
 412     ;; (vc-file-setprop file 'vc-workfile-version nil)
 413     (vc-file-setprop file 'vc-checkout-time 0)
 414     (vc-do-command nil 0 "cvs" file "update")
 415     ;; Analyze the merge result reported by CVS, and set
 416     ;; file properties accordingly.
 417     (set-buffer (get-buffer "*vc*"))
 418     (goto-char (point-min))
 419     ;; get new workfile version
 420     (if (re-search-forward (concat "^Merging differences between "
 421                                    "[01234567890.]* and "
 422                                    "\\([01234567890.]*\\) into")
 423                            nil t)
 424         (vc-file-setprop file 'vc-workfile-version (match-string 1))
 425       (vc-file-setprop file 'vc-workfile-version nil))
 426     ;; get file status
 427     (prog1
 428         (if (eq (buffer-size) 0)
 429             0 ;; there were no news; indicate success
 430           (if (re-search-forward
 431                (concat "^\\([CMUP] \\)?"
 432                        (regexp-quote (file-name-nondirectory file))
 433                        "\\( already contains the differences between \\)?")
 434                nil t)
 435               (cond
 436                ;; Merge successful, we are in sync with repository now
 437                ((or (match-string 2)
 438                     (string= (match-string 1) "U ")
 439                     (string= (match-string 1) "P "))
 440                 (vc-file-setprop file 'vc-state 'up-to-date)
 441                 (vc-file-setprop file 'vc-checkout-time
 442                                  (nth 5 (file-attributes file)))
 443                 0);; indicate success to the caller
 444                ;; Merge successful, but our own changes are still in the file
 445                ((string= (match-string 1) "M ")
 446                 (vc-file-setprop file 'vc-state 'edited)
 447                 0);; indicate success to the caller
 448                ;; Conflicts detected!
 449                (t
 450                 (vc-file-setprop file 'vc-state 'edited)
 451                 1);; signal the error to the caller
 452                )
 453             (pop-to-buffer "*vc*")
 454             (error "Couldn't analyze cvs update result")))
 455       (message "Merging changes into %s...done" file))))
 456
 457
 458 ;;;
 459 ;;; History functions
 460 ;;;
 461
 462 (defun vc-cvs-print-log (file)
 463   "Get change log associated with FILE."
 464   (vc-do-command
 465    nil
 466    (if (and (vc-cvs-stay-local-p file) (fboundp 'start-process)) 'async 0)
 467    "cvs" file "log"))
 468
 469 (defun vc-cvs-show-log-entry (version)
 470   (when (re-search-forward
 471          ;; also match some context, for safety
 472          (concat "----\nrevision " version
 473                  "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
 474     ;; set the display window so that
 475     ;; the whole log entry is displayed
 476     (let (start end lines)
 477       (beginning-of-line) (forward-line -1) (setq start (point))
 478       (if (not (re-search-forward "^----*\nrevision" nil t))
 479           (setq end (point-max))
 480         (beginning-of-line) (forward-line -1) (setq end (point)))
 481       (setq lines (count-lines start end))
 482       (cond
 483        ;; if the global information and this log entry fit
 484        ;; into the window, display from the beginning
 485        ((< (count-lines (point-min) end) (window-height))
 486         (goto-char (point-min))
 487         (recenter 0)
 488         (goto-char start))
 489        ;; if the whole entry fits into the window,
 490        ;; display it centered
 491        ((< (1+ lines) (window-height))
 492         (goto-char start)
 493         (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
 494        ;; otherwise (the entry is too large for the window),
 495        ;; display from the start
 496        (t
 497         (goto-char start)
 498         (recenter 0))))))
 499
 500 (defun vc-cvs-diff (file &optional oldvers newvers)
 501   "Get a difference report using CVS between two versions of FILE."
 502   (let (options status (diff-switches-list (vc-diff-switches-list cvs)))
 503     (if (string= (vc-workfile-version file) "0")
 504         ;; This file is added but not yet committed; there is no master file.
 505         (if (or oldvers newvers)
 506             (error "No revisions of %s exist" file)
 507           ;; we regard this as "changed".
 508           ;; diff it against /dev/null.
 509           (apply 'vc-do-command "*vc-diff*"
 510                  1 "diff" file
 511                  (append diff-switches-list '("/dev/null"))))
 512       (setq status
 513             (apply 'vc-do-command "*vc-diff*"
 514                    (if (and (vc-cvs-stay-local-p file)
 515                             (fboundp 'start-process))
 516                        'async
 517                      1)
 518                    "cvs" file "diff"
 519                    (and oldvers (concat "-r" oldvers))
 520                    (and newvers (concat "-r" newvers))
 521                    diff-switches-list))
 522       (if (vc-cvs-stay-local-p file)
 523           1 ;; async diff, pessimistic assumption
 524         status))))
 525
 526 (defun vc-cvs-annotate-command (file buffer &optional version)
 527   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
 528 Optional arg VERSION is a version to annotate from."
 529   (vc-do-command buffer 0 "cvs" file "annotate" (if version
 530                                                     (concat "-r" version))))
 531
 532 (defun vc-cvs-annotate-difference (point)
 533   "Return the difference between the time of the line and the current time.
 534 Return values are as defined for `current-time'."
 535   ;; We need a list of months and their corresponding numbers.
 536   (if (looking-at "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")
 537       (progn
 538         (let* ((day (string-to-number (match-string 1)))
 539                (month (cdr (assoc (match-string 2) vc-cvs-local-month-numbers)))
 540                (year-tmp (string-to-number (match-string 3)))
 541                ;; Years 0..68 are 2000..2068.
 542                ;; Years 69..99 are 1969..1999.
 543                (year (+ (cond ((> 69 year-tmp) 2000)
 544                               ((> 100 year-tmp) 1900)
 545                               (t 0))
 546                         year-tmp)))
 547           (goto-char (match-end 0)) ; Position at end makes for nicer overlay result
 548           (- (car (current-time))
 549              (car (encode-time 0 0 0 day month year)))))
 550     ;; If we did not look directly at an annotation, there might be
 551     ;; some further down.  This is the case if we are positioned at
 552     ;; the very top of the buffer, for instance.
 553     (if (re-search-forward
 554          "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): " nil t)
 555         (progn
 556           (beginning-of-line nil)
 557           (vc-cvs-annotate-difference (point))))))
 558
 559
 560 ;;;
 561 ;;; Snapshot system
 562 ;;;
 563
 564 (defun vc-cvs-create-snapshot (dir name branchp)
 565   "Assign to DIR's current version a given NAME.
 566 If BRANCHP is non-nil, the name is created as a branch (and the current
 567 workspace is immediately moved to that new branch)."
 568   (vc-do-command nil 0 "cvs" dir "tag" "-c" (if branchp "-b") name)
 569   (when branchp (vc-do-command nil 0 "cvs" dir "update" "-r" name)))
 570
 571 (defun vc-cvs-retrieve-snapshot (dir name update)
 572   "Retrieve a snapshot at and below DIR.
 573 NAME is the name of the snapshot; if it is empty, do a `cvs update'.
 574 If UPDATE is non-nil, then update (resynch) any affected buffers."
 575   (with-current-buffer (get-buffer-create "*vc*")
 576     (let ((default-directory dir))
 577       (erase-buffer)
 578       (if (or (not name) (string= name ""))
 579           (vc-do-command t 0 "cvs" nil "update")
 580         (vc-do-command t 0 "cvs" nil "update" "-r" name))
 581       (when update
 582         (goto-char (point-min))
 583         (while (not (eobp))
 584           (if (looking-at "\\([CMUP]\\) \\(.*\\)")
 585               (let* ((file (expand-file-name (match-string 2) dir))
 586                      (state (match-string 1))
 587                      (buffer (find-buffer-visiting file)))
 588                 (when buffer
 589                   (cond
 590                    ((or (string= state "U")
 591                         (string= state "P"))
 592                     (vc-file-setprop file 'vc-state 'up-to-date)
 593                     (vc-file-setprop file 'vc-workfile-version nil)
 594                     (vc-file-setprop file 'vc-checkout-time
 595                                      (nth 5 (file-attributes file))))
 596                    ((or (string= state "M")
 597                         (string= state "C"))
 598                     (vc-file-setprop file 'vc-state 'edited)
 599                     (vc-file-setprop file 'vc-workfile-version nil)
 600                     (vc-file-setprop file 'vc-checkout-time 0)))
 601                   (vc-resynch-buffer file t t))))
 602           (forward-line 1))))))
 603
 604
 605 ;;;
 606 ;;; Miscellaneous
 607 ;;;
 608
 609 (defun vc-cvs-make-version-backups-p (file)
 610   "Return non-nil if version backups should be made for FILE."
 611   (vc-cvs-stay-local-p file))
 612
 613 (defun vc-cvs-check-headers ()
 614   "Check if the current file has any headers in it."
 615   (save-excursion
 616     (goto-char (point-min))
 617     (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
 618 \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
 619
 620
 621 ;;;
 622 ;;; Internal functions
 623 ;;;
 624
 625 (defun vc-cvs-stay-local-p (file)
 626   "Return non-nil if VC should stay local when handling FILE."
 627   (if vc-cvs-stay-local
 628       (let* ((dirname (if (file-directory-p file)
 629                           (directory-file-name file)
 630                         (file-name-directory file)))
 631              (prop
 632               (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
 633                   (let ((rootname (expand-file-name "CVS/Root" dirname)))
 634                     (vc-file-setprop
 635                      dirname 'vc-cvs-stay-local-p
 636                      (when (file-readable-p rootname)
 637                        (with-temp-buffer
 638                          (vc-insert-file rootname)
 639                          (goto-char (point-min))
 640                          (if (looking-at "\\([^:]*\\):")
 641                              (if (not (stringp vc-cvs-stay-local))
 642                                  'yes
 643                                (let ((hostname (match-string 1)))
 644                                  (if (string-match vc-cvs-stay-local hostname)
 645                                      'yes
 646                                    'no)))
 647                            'no))))))))
 648         (if (eq prop 'yes) t nil))))
 649
 650 (defun vc-cvs-parse-status (&optional full)
 651   "Parse output of \"cvs status\" command in the current buffer.
 652 Set file properties accordingly.  Unless FULL is t, parse only
 653 essential information."
 654   (let (file status)
 655     (goto-char (point-min))
 656     (if (re-search-forward "^File: " nil t)
 657         (cond
 658          ((looking-at "no file") nil)
 659          ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
 660           (setq file (expand-file-name (match-string 1)))
 661           (vc-file-setprop file 'vc-backend 'CVS)
 662           (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
 663               (setq status "Unknown")
 664             (setq status (match-string 1)))
 665           (if (and full
 666                    (re-search-forward
 667                     "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
 668 \[\t ]+\\([0-9.]+\\)"
 669                     nil t))
 670               (vc-file-setprop file 'vc-latest-version (match-string 2)))
 671           (cond
 672            ((string-match "Up-to-date" status)
 673             (vc-file-setprop file 'vc-checkout-time
 674                              (nth 5 (file-attributes file)))
 675             'up-to-date)
 676            ((string-match "Locally Modified"    status) 'edited)
 677            ((string-match "Needs Merge"         status) 'needs-merge)
 678            ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-patch)
 679            (t 'edited)))))))
 680
 681 (defun vc-cvs-dir-state-heuristic (dir)
 682   "Find the CVS state of all files in DIR, using only local information."
 683   (with-temp-buffer
 684     (vc-insert-file (expand-file-name "CVS/Entries" dir))
 685     (goto-char (point-min))
 686     (while (not (eobp))
 687       (when (looking-at "/\\([^/]*\\)/")
 688         (let ((file (expand-file-name (match-string 1) dir)))
 689           (unless (vc-file-getprop file 'vc-state)
 690             (vc-cvs-parse-entry file t))))
 691       (forward-line 1))))
 692
 693 (defun vc-cvs-parse-entry (file &optional set-state)
 694   "Parse a line from CVS/Entries.
 695 Compare modification time to that of the FILE, set file properties
 696 accordingly.  However, `vc-state' is set only if optional arg SET-STATE
 697 is non-nil."
 698   (cond
 699    ;; entry for a "locally added" file (not yet committed)
 700    ((looking-at "/[^/]+/0/")
 701     (vc-file-setprop file 'vc-checkout-time 0)
 702     (vc-file-setprop file 'vc-workfile-version "0")
 703     (if set-state (vc-file-setprop file 'vc-state 'edited)))
 704    ;; normal entry
 705    ((looking-at
 706      (concat "/[^/]+"
 707              ;; revision
 708              "/\\([^/]*\\)"
 709              ;; timestamp
 710              "/[A-Z][a-z][a-z]"       ;; week day (irrelevant)
 711              " \\([A-Z][a-z][a-z]\\)" ;; month name
 712              " *\\([0-9]*\\)"         ;; day of month
 713              " \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)"  ;; hms
 714              " \\([0-9]*\\)"          ;; year
 715              ;; optional conflict field
 716              "\\(+[^/]*\\)?/"))
 717     (vc-file-setprop file 'vc-workfile-version (match-string 1))
 718     ;; compare checkout time and modification time
 719     (let ((second (string-to-number (match-string 6)))
 720           (minute (string-to-number (match-string 5)))
 721           (hour (string-to-number (match-string 4)))
 722           (day (string-to-number (match-string 3)))
 723           (year (string-to-number (match-string 7)))
 724           (month (/ (string-match
 725                      (match-string 2)
 726                      "xxxJanFebMarAprMayJunJulAugSepOctNovDec")
 727                     3))
 728           (mtime (nth 5 (file-attributes file))))
 729       (cond ((equal mtime
 730                     (encode-time second minute hour day month year 0))
 731              (vc-file-setprop file 'vc-checkout-time mtime)
 732              (if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
 733             (t
 734              (vc-file-setprop file 'vc-checkout-time 0)
 735              (if set-state (vc-file-setprop file 'vc-state 'edited))))))
 736    ;; entry with arbitrary text as timestamp
 737    ;; (this means we should consider it modified)
 738    ((looking-at
 739      (concat "/[^/]+"
 740              ;; revision
 741              "/\\([^/]*\\)"
 742              ;; timestamp (arbitrary text)
 743              "/[^/]*"
 744              ;; optional conflict field
 745              "\\(+[^/]*\\)?/"))
 746     (vc-file-setprop file 'vc-workfile-version (match-string 1))
 747     (vc-file-setprop file 'vc-checkout-time 0)
 748     (if set-state (vc-file-setprop file 'vc-state 'edited)))))
 749
 750 (provide 'vc-cvs)
 751
 752 ;;; vc-cvs.el ends here