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.21 2001/03/10 10:49:05 spiegel 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.  Turning this option on
  77 will instruct VC to use only heuristics and past information to
  78 determine the current status of a file.  The value can also be a
  79 regular expression to match against the host name of a repository;
  80 then VC only stays local for hosts that match it."
  81   :type '(choice (const :tag "Always stay local" t)
  82                  (string :tag "Host regexp")
  83                  (const :tag "Don't stay local" nil))
  84   :version "21.1"
  85   :group 'vc)
  86
  87
  88 ;;;
  89 ;;; Internal variables
  90 ;;;
  91
  92 (defvar vc-cvs-local-month-numbers
  93   '(("Jan" . 1) ("Feb" .  2) ("Mar" .  3) ("Apr" .  4)
  94     ("May" . 5) ("Jun" .  6) ("Jul" .  7) ("Aug" .  8)
  95     ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
  96   "Local association list of month numbers.")
  97
  98
  99 ;;;
 100 ;;; State-querying functions
 101 ;;;
 102
 103 ;;;###autoload (defun vc-cvs-registered (f)
 104 ;;;###autoload   (when (file-readable-p (expand-file-name
 105 ;;;###autoload                    "CVS/Entries" (file-name-directory f)))
 106 ;;;###autoload       (require 'vc-cvs)
 107 ;;;###autoload       (vc-cvs-registered f)))
 108
 109 (defun vc-cvs-registered (file)
 110   "Check if FILE is CVS registered."
 111   (let ((dirname (or (file-name-directory file) ""))
 112         (basename (file-name-nondirectory file))
 113         ;; make sure that the file name is searched case-sensitively
 114         (case-fold-search nil))
 115     (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
 116         (with-temp-buffer
 117           (vc-insert-file (expand-file-name "CVS/Entries" dirname))
 118           (goto-char (point-min))
 119           (cond
 120            ((re-search-forward
 121              (concat "^/" (regexp-quote basename) "/") nil t)
 122             (beginning-of-line)
 123             (vc-cvs-parse-entry file)
 124             t)
 125            (t nil)))
 126       nil)))
 127
 128 (defun vc-cvs-state (file)
 129   "CVS-specific version of `vc-state'."
 130   (if (vc-cvs-stay-local-p file)
 131       (let ((state (vc-file-getprop file 'vc-state)))
 132         ;; If we should stay local, use the heuristic but only if
 133         ;; we don't have a more precise state already available.
 134         (if (memq state '(up-to-date edited))
 135             (vc-cvs-state-heuristic file)
 136           state))
 137     (with-temp-buffer
 138       (cd (file-name-directory file))
 139       (vc-do-command t 0 "cvs" file "status")
 140       (vc-cvs-parse-status t))))
 141
 142 (defun vc-cvs-state-heuristic (file)
 143   "CVS-specific state heuristic."
 144   ;; If the file has not changed since checkout, consider it `up-to-date'.
 145   ;; Otherwise consider it `edited'.
 146   (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
 147         (lastmod (nth 5 (file-attributes file))))
 148     (if (equal checkout-time lastmod)
 149         'up-to-date
 150       'edited)))
 151
 152 (defun vc-cvs-dir-state (dir)
 153   "Find the CVS state of all files in DIR."
 154   (if (vc-cvs-stay-local-p dir)
 155       (vc-cvs-dir-state-heuristic dir)
 156     (let ((default-directory dir))
 157       ;; Don't specify DIR in this command, the default-directory is
 158       ;; enough.  Otherwise it might fail with remote repositories.
 159       (with-temp-buffer
 160         (vc-do-command t 0 "cvs" nil "status" "-l")
 161         (goto-char (point-min))
 162         (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
 163           (narrow-to-region (match-beginning 0) (match-end 0))
 164           (vc-cvs-parse-status)
 165           (goto-char (point-max))
 166           (widen))))))
 167
 168 (defun vc-cvs-workfile-version (file)
 169   "CVS-specific version of `vc-workfile-version'."
 170   ;; There is no need to consult RCS headers under CVS, because we
 171   ;; get the workfile version for free when we recognize that a file
 172   ;; is registered in CVS.
 173   (vc-cvs-registered file)
 174   (vc-file-getprop file 'vc-workfile-version))
 175
 176 (defun vc-cvs-checkout-model (file)
 177   "CVS-specific version of `vc-checkout-model'."
 178   (if (or (getenv "CVSREAD")
 179           ;; If the file is not writable (despite CVSREAD being
 180           ;; undefined), this is probably because the file is being
 181           ;; "watched" by other developers.
 182           ;; (If vc-mistrust-permissions was t, we actually shouldn't
 183           ;; trust this, but there is no other way to learn this from CVS
 184           ;; at the moment (version 1.9).)
 185           (string-match "r-..-..-." (nth 8 (file-attributes file))))
 186       'announce
 187     'implicit))
 188
 189 (defun vc-cvs-mode-line-string (file)
 190   "Return string for placement into the modeline for FILE.
 191 Compared to the default implementation, this function handles the
 192 special case of a CVS file that is added but not yet committed."
 193   (let ((state   (vc-state file))
 194         (rev     (vc-workfile-version file)))
 195     (cond ((string= rev "0")
 196            ;; A file that is added but not yet committed.
 197            "CVS @@")
 198           ((or (eq state 'up-to-date)
 199                (eq state 'needs-patch))
 200            (concat "CVS-" rev))
 201           ((stringp state)
 202            (concat "CVS:" state ":" rev))
 203           (t
 204            ;; Not just for the 'edited state, but also a fallback
 205            ;; for all other states.  Think about different symbols
 206            ;; for 'needs-patch and 'needs-merge.
 207            (concat "CVS:" rev)))))
 208
 209 (defun vc-cvs-dired-state-info (file)
 210   "CVS-specific version of `vc-dired-state-info'."
 211   (let* ((cvs-state (vc-state file))
 212          (state (cond ((eq cvs-state 'edited)    "modified")
 213                       ((eq cvs-state 'needs-patch)      "patch")
 214                       ((eq cvs-state 'needs-merge)         "merge")
 215                       ;; FIXME: those two states cannot occur right now
 216                       ((eq cvs-state 'unlocked-changes) "conflict")
 217                       ((eq cvs-state 'locally-added)       "added")
 218                       )))
 219     (if state (concat "(" state ")"))))
 220
 221
 222 ;;;
 223 ;;; State-changing functions
 224 ;;;
 225
 226 (defun vc-cvs-register (file &optional rev comment)
 227   "Register FILE into the CVS version-control system.
 228 COMMENT can be used to provide an initial description of FILE.
 229
 230 `vc-register-switches' and `vc-cvs-register-switches' are passed to
 231 the CVS command (in that order)."
 232     (let ((switches (list
 233                      (if (stringp vc-register-switches)
 234                          (list vc-register-switches)
 235                        vc-register-switches)
 236                      (if (stringp vc-cvs-register-switches)
 237                          (list vc-cvs-register-switches)
 238                        vc-cvs-register-switches))))
 239
 240       (apply 'vc-do-command nil 0 "cvs" file
 241              "add"
 242              (and comment (string-match "[^\t\n ]" comment)
 243                   (concat "-m" comment))
 244              switches)))
 245
 246 (defun vc-cvs-responsible-p (file)
 247   "Return non-nil if CVS thinks it is responsible for FILE."
 248   (file-directory-p (expand-file-name "CVS"
 249                                       (if (file-directory-p file)
 250                                           file
 251                                         (file-name-directory file)))))
 252
 253 (defun vc-cvs-could-register (file)
 254   "Return non-nil if FILE could be registered in CVS.
 255 This is only possible if CVS is responsible for FILE's directory."
 256   (vc-cvs-responsible-p file))
 257
 258 (defun vc-cvs-checkin (file rev comment)
 259   "CVS-specific version of `vc-backend-checkin'."
 260   (let ((switches (if (stringp vc-checkin-switches)
 261                       (list vc-checkin-switches)
 262                     vc-checkin-switches))
 263         status)
 264     ;; explicit check-in to the trunk requires a double check-in (first
 265     ;; unexplicit) (CVS-1.3)
 266     (if (and rev (vc-trunk-p rev))
 267         (apply 'vc-do-command nil 1 "cvs" file
 268                "ci" "-m" "intermediate"
 269                switches))
 270     (setq status (apply 'vc-do-command nil 1 "cvs" file
 271                         "ci" (if rev (concat "-r" rev))
 272                         (concat "-m" comment)
 273                         switches))
 274     (set-buffer "*vc*")
 275     (goto-char (point-min))
 276     (when (not (zerop status))
 277       ;; Check checkin problem.
 278       (cond
 279        ((re-search-forward "Up-to-date check failed" nil t)
 280         (vc-file-setprop file 'vc-state 'needs-merge)
 281         (error (substitute-command-keys
 282                 (concat "Up-to-date check failed: "
 283                         "type \\[vc-next-action] to merge in changes"))))
 284        (t
 285         (pop-to-buffer (current-buffer))
 286         (goto-char (point-min))
 287         (shrink-window-if-larger-than-buffer)
 288         (error "Check-in failed"))))
 289     ;; Update file properties
 290     (vc-file-setprop
 291      file 'vc-workfile-version
 292      (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
 293     ;; Forget the checkout model of the file, because we might have
 294     ;; guessed wrong when we found the file.  After commit, we can
 295     ;; tell it from the permissions of the file (see
 296     ;; vc-cvs-checkout-model).
 297     (vc-file-setprop file 'vc-checkout-model nil)
 298     ;; if this was an explicit check-in, remove the sticky tag
 299     (if rev (vc-do-command nil 0 "cvs" file "update" "-A"))))
 300
 301 (defun vc-cvs-checkout (file &optional editable rev workfile)
 302   "Retrieve a revision of FILE into a WORKFILE.
 303 EDITABLE non-nil means that the file should be writable.
 304 REV is the revision to check out into WORKFILE."
 305   (let ((filename (or workfile file))
 306         (file-buffer (get-file-buffer file))
 307         switches)
 308     (message "Checking out %s..." filename)
 309     (save-excursion
 310       ;; Change buffers to get local value of vc-checkout-switches.
 311       (if file-buffer (set-buffer file-buffer))
 312       (setq switches (if (stringp vc-checkout-switches)
 313                          (list vc-checkout-switches)
 314                        vc-checkout-switches))
 315       ;; Save this buffer's default-directory
 316       ;; and use save-excursion to make sure it is restored
 317       ;; in the same buffer it was saved in.
 318       (let ((default-directory default-directory))
 319         (save-excursion
 320           ;; Adjust the default-directory so that the check-out creates
 321           ;; the file in the right place.
 322           (setq default-directory (file-name-directory filename))
 323           (if workfile
 324               (let ((failed t)
 325                     (backup-name (if (string= file workfile)
 326                                      (car (find-backup-file-name filename)))))
 327                 (when backup-name
 328                   (copy-file filename backup-name
 329                              'ok-if-already-exists 'keep-date)
 330                   (unless (file-writable-p filename)
 331                     (set-file-modes filename
 332                                     (logior (file-modes filename) 128))))
 333                 (unwind-protect
 334                     (progn
 335                       (let ((coding-system-for-read 'no-conversion)
 336                             (coding-system-for-write 'no-conversion))
 337                         (with-temp-file filename
 338                           (apply 'vc-do-command
 339                                  (current-buffer) 0 "cvs" file
 340                                  "-Q"   ; suppress diagnostic output
 341                                  "update"
 342                                  (and rev (not (string= rev ""))
 343                                       (concat "-r" rev))
 344                                  "-p"
 345                                  switches)))
 346                       (setq failed nil))
 347                   (if failed
 348                       (if backup-name
 349                           (rename-file backup-name filename
 350                                        'ok-if-already-exists)
 351                         (if (file-exists-p filename)
 352                             (delete-file filename)))
 353                     (and backup-name
 354                          (not vc-make-backup-files)
 355                          (delete-file backup-name)))))
 356             (if (and (file-exists-p file) (not rev))
 357                 ;; If no revision was specified, just make the file writable
 358                 ;; if necessary (using `cvs-edit' if requested).
 359                 (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
 360                      (if vc-cvs-use-edit
 361                          (vc-do-command nil 0 "cvs" file "edit")
 362                        (set-file-modes file (logior (file-modes file) 128))
 363                        (if file-buffer (toggle-read-only -1))))
 364               ;; Check out a particular version (or recreate the file).
 365               (vc-file-setprop file 'vc-workfile-version nil)
 366               (apply 'vc-do-command nil 0 "cvs" file
 367                      (and editable
 368                           (or (not (file-exists-p file))
 369                               (not (eq (vc-cvs-checkout-model file)
 370                                        'implicit)))
 371                           "-w")
 372                      "update"
 373                      ;; default for verbose checkout: clear the sticky tag so
 374                      ;; that the actual update will get the head of the trunk
 375                      (if (or (not rev) (string= rev ""))
 376                          "-A"
 377                        (concat "-r" rev))
 378                      switches))))
 379         (vc-mode-line file)
 380         (message "Checking out %s...done" filename)))))
 381
 382 (defun vc-cvs-revert (file)
 383   "Revert FILE to the version it was based on."
 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   ;; If "cvs edit" was used to make the file writable,
 388   ;; call "cvs unedit" now to undo that.
 389   (if (and (not (eq (vc-cvs-checkout-model file) 'implicit))
 390            vc-cvs-use-edit)
 391       (vc-do-command nil 0 "cvs" file "unedit")))
 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