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