lisp/vc-cvs.el

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