(Fexpand_file_name): In the no-handler case, after
[bpt/emacs.git] / lisp / vc-cvs.el
index 815b9ab..9d1674c 100644 (file)
@@ -1,11 +1,11 @@
 ;;; vc-cvs.el --- non-resident support for CVS version-control
 
-;; Copyright (C) 1995,98,99,2000,2001  Free Software Foundation, Inc.
+;; Copyright (C) 1995,98,99,2000,2001,2002  Free Software Foundation, Inc.
 
 ;; Author:      FSF (see vc.el for full credits)
 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
 
-;; $Id: vc-cvs.el,v 1.37 2002/03/22 23:10:01 monnier Exp $
+;; $Id: vc-cvs.el,v 1.51 2003/02/17 08:11:13 spiegel Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -42,7 +42,7 @@
                 (repeat :tag "Argument List"
                         :value ("")
                         string))
-  :version "21.3"
+  :version "21.4"
   :group 'vc)
 
 (defcustom vc-cvs-register-switches nil
@@ -98,7 +98,7 @@ of a repository; then VC only stays local for hosts that match it."
 Format is according to `format-time-string'.  Only used if
 `vc-cvs-sticky-tag-display' is t."
   :type '(string)
-  :version "21.3"
+  :version "21.4"
   :group 'vc)
 
 (defcustom vc-cvs-sticky-tag-display t
@@ -114,30 +114,30 @@ Here's an example that will display the formatted date for sticky
 dates and the word \"Sticky\" for sticky tag names and revisions.
 
   (lambda (tag type)
-    (cond ((eq type 'date) (format-time-string 
+    (cond ((eq type 'date) (format-time-string
                               vc-cvs-sticky-date-format-string tag))
           ((eq type 'revision-number) \"Sticky\")
           ((eq type 'symbolic-name) \"Sticky\")))
 
 Here's an example that will abbreviate to the first character only,
-any text before the first occurence of `-' for sticky symbolic tags.
+any text before the first occurrence of `-' for sticky symbolic tags.
 If the sticky tag is a revision number, the word \"Sticky\" is
 displayed.  Date and time is displayed for sticky dates.
 
    (lambda (tag type)
      (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag))
            ((eq type 'revision-number) \"Sticky\")
-           ((eq type 'symbolic-name) 
+           ((eq type 'symbolic-name)
             (condition-case nil
                 (progn
                   (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
-                  (concat (substring (match-string 1 tag) 0 1) \":\" 
+                  (concat (substring (match-string 1 tag) 0 1) \":\"
                           (substring (match-string 2 tag) 1 nil)))
               (error tag)))))       ; Fall-back to given tag name.
 
 See also variable `vc-cvs-sticky-date-format-string'."
   :type '(choice boolean function)
-  :version "21.3"
+  :version "21.4"
   :group 'vc)
 
 ;;;
@@ -158,7 +158,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
 ;;;###autoload (defun vc-cvs-registered (f)
 ;;;###autoload   (when (file-readable-p (expand-file-name
 ;;;###autoload                           "CVS/Entries" (file-name-directory f)))
-;;;###autoload       (require 'vc-cvs)
+;;;###autoload       (load "vc-cvs")
 ;;;###autoload       (vc-cvs-registered f)))
 
 (defun vc-cvs-registered (file)
@@ -207,19 +207,21 @@ See also variable `vc-cvs-sticky-date-format-string'."
 
 (defun vc-cvs-dir-state (dir)
   "Find the CVS state of all files in DIR."
-  (if (vc-cvs-stay-local-p dir)
-      (vc-cvs-dir-state-heuristic dir)
-    (let ((default-directory dir))
-      ;; Don't specify DIR in this command, the default-directory is
-      ;; enough.  Otherwise it might fail with remote repositories.
-      (with-temp-buffer
-       (vc-cvs-command t 0 nil "status" "-l")
-       (goto-char (point-min))
-       (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
-         (narrow-to-region (match-beginning 0) (match-end 0))
-         (vc-cvs-parse-status)
-         (goto-char (point-max))
-         (widen))))))
+  ;; if DIR is not under CVS control, don't do anything
+  (if (file-readable-p (expand-file-name "CVS/Entries" dir))
+      (if (vc-cvs-stay-local-p dir)
+          (vc-cvs-dir-state-heuristic dir)
+        (let ((default-directory dir))
+          ;; Don't specify DIR in this command, the default-directory is
+          ;; enough.  Otherwise it might fail with remote repositories.
+          (with-temp-buffer
+            (vc-do-command t 0 "cvs" nil "status" "-l")
+            (goto-char (point-min))
+            (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
+              (narrow-to-region (match-beginning 0) (match-end 0))
+              (vc-cvs-parse-status)
+              (goto-char (point-max))
+              (widen)))))))
 
 (defun vc-cvs-workfile-version (file)
   "CVS-specific version of `vc-workfile-version'."
@@ -322,19 +324,19 @@ This is only possible if CVS is responsible for FILE's directory."
                      (list vc-checkin-switches)
                    vc-checkin-switches))
        status)
-    (if (not rev)
+    (if (or (not rev) (vc-cvs-valid-version-number-p rev))
         (setq status (apply 'vc-cvs-command nil 1 file
                             "ci" (if rev (concat "-r" rev))
                             (concat "-m" comment)
                             switches))
       (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
-          (error "%s is not a valid symbolic tag name")
+          (error "%s is not a valid symbolic tag name" rev)
         ;; If the input revison is a valid symbolic tag name, we create it
-        ;; as a branch, commit and switch to it.       
+        ;; as a branch, commit and switch to it.
         (apply 'vc-cvs-command nil 0 file "tag" "-b" (list rev))
         (apply 'vc-cvs-command nil 0 file "update" "-r" (list rev))
         (setq status (apply 'vc-cvs-command nil 1 file
-                            "ci" 
+                            "ci"
                             (concat "-m" comment)
                             switches))
         (vc-file-setprop file 'vc-cvs-sticky-tag rev)))
@@ -368,6 +370,18 @@ This is only possible if CVS is responsible for FILE's directory."
     (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
        (vc-cvs-command nil 0 file "update" "-A"))))
 
+(defun vc-cvs-find-version (file rev buffer)
+  (apply 'vc-cvs-command
+        buffer 0 file
+        "-Q"                           ; suppress diagnostic output
+        "update"
+        (and rev (not (string= rev ""))
+             (concat "-r" rev))
+        "-p"
+        (if (stringp vc-checkout-switches)
+            (list vc-checkout-switches)
+          vc-checkout-switches)))
+
 (defun vc-cvs-checkout (file &optional editable rev workfile)
   "Retrieve a revision of FILE into a WORKFILE.
 EDITABLE non-nil means that the file should be writable.
@@ -409,7 +423,8 @@ REV is the revision to check out into WORKFILE."
                                  (current-buffer) 0 file
                                  "-Q"  ; suppress diagnostic output
                                  "update"
-                                 (and rev (not (string= rev ""))
+                                 (and (stringp rev)
+                                      (not (string= rev ""))
                                       (concat "-r" rev))
                                  "-p"
                                  switches)))
@@ -426,14 +441,14 @@ REV is the revision to check out into WORKFILE."
            (if (and (file-exists-p file) (not rev))
                ;; If no revision was specified, just make the file writable
                ;; if necessary (using `cvs-edit' if requested).
-      (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
-                    (if vc-cvs-use-edit
-                        (vc-cvs-command nil 0 file "edit")
-                      (set-file-modes file (logior (file-modes file) 128))
-                      (if file-buffer (toggle-read-only -1))))
-             ;; Check out a particular version (or recreate the file).
-             (vc-file-setprop file 'vc-workfile-version nil)
-             (apply 'vc-cvs-command nil 0 file
+                (and editable (not (eq (vc-cvs-checkout-model file) 'implicit))
+                     (if vc-cvs-use-edit
+                         (vc-cvs-command nil 0 file "edit")
+                       (set-file-modes file (logior (file-modes file) 128))
+                       (if file-buffer (toggle-read-only -1))))
+              ;; Check out a particular version (or recreate the file).
+              (vc-file-setprop file 'vc-workfile-version nil)
+              (apply 'vc-cvs-command nil 0 file
                      (and editable
                           (or (not (file-exists-p file))
                               (not (eq (vc-cvs-checkout-model file)
@@ -442,10 +457,10 @@ REV is the revision to check out into WORKFILE."
                      "update"
                      ;; default for verbose checkout: clear the sticky tag so
                      ;; that the actual update will get the head of the trunk
-                    (if (or (not rev) (string= rev ""))
-                        "-A"
-                      (concat "-r" rev))
-                    switches))))
+                     (if (or (not rev) (eq rev t) (string= rev ""))
+                         "-A"
+                       (concat "-r" rev))
+                     switches))))
        (vc-mode-line file)
        (message "Checking out %s...done" filename)))))
 
@@ -537,37 +552,6 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
    (if (and (vc-cvs-stay-local-p file) (fboundp 'start-process)) 'async 0)
    file "log"))
 
-(defun vc-cvs-show-log-entry (version)
-  (when (re-search-forward
-        ;; also match some context, for safety
-        (concat "----\nrevision " version
-                "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
-    ;; set the display window so that
-    ;; the whole log entry is displayed
-    (let (start end lines)
-      (beginning-of-line) (forward-line -1) (setq start (point))
-      (if (not (re-search-forward "^----*\nrevision" nil t))
-         (setq end (point-max))
-       (beginning-of-line) (forward-line -1) (setq end (point)))
-      (setq lines (count-lines start end))
-      (cond
-       ;; if the global information and this log entry fit
-       ;; into the window, display from the beginning
-       ((< (count-lines (point-min) end) (window-height))
-       (goto-char (point-min))
-       (recenter 0)
-       (goto-char start))
-       ;; if the whole entry fits into the window,
-       ;; display it centered
-       ((< (1+ lines) (window-height))
-       (goto-char start)
-       (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
-       ;; otherwise (the entry is too large for the window),
-       ;; display from the start
-       (t
-       (goto-char start)
-       (recenter 0))))))
-
 (defun vc-cvs-diff (file &optional oldvers newvers)
   "Get a difference report using CVS between two versions of FILE."
   (let (options status (diff-switches-list (vc-diff-switches-list 'CVS)))
@@ -634,12 +618,12 @@ encoded as fractional days."
 (defun vc-cvs-annotate-time ()
   "Return the time of the next annotation (as fraction of days)
 systime, or nil if there is none."
-  (let ((time-stamp 
+  (let ((time-stamp
         "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): "))
     (if (looking-at time-stamp)
       (progn
        (let* ((day (string-to-number (match-string 1)))
-                (month (cdr (assoc (match-string 2) 
+                (month (cdr (assoc (match-string 2)
                                    vc-cvs-local-month-numbers)))
               (year-tmp (string-to-number (match-string 3)))
               ;; Years 0..68 are 2000..2068.
@@ -731,7 +715,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
 The difference to vc-do-command is that this function always invokes `cvs',
 and that it passes `vc-cvs-global-switches' to it before FLAGS."
   (apply 'vc-do-command buffer okstatus "cvs" file
-         (if (stringp vc-cvs-global-switches) 
+         (if (stringp vc-cvs-global-switches)
              (cons vc-cvs-global-switches flags)
            (append vc-cvs-global-switches
                    flags))))
@@ -782,7 +766,7 @@ essential information."
 \[\t ]+\\([0-9.]+\\)"
                     nil t))
               (vc-file-setprop file 'vc-latest-version (match-string 2)))
-          (vc-file-setprop 
+          (vc-file-setprop
            file 'vc-state
            (cond
             ((string-match "Up-to-date" status)
@@ -815,10 +799,14 @@ essential information."
   ;; lowercase letters, digits, `-', and `_'.
   (and (string-match "^[a-zA-Z]" tag)
        (not (string-match "[^a-z0-9A-Z-_]" tag))))
-      
+
+(defun vc-cvs-valid-version-number-p (tag)
+  "Return non-nil if TAG is a valid version number."
+  (and (string-match "^[0-9]" tag)
+       (not (string-match "[^0-9.]" tag))))
 
 (defun vc-cvs-parse-sticky-tag (match-type match-tag)
-  "Parse and return the sticky tag as a string.  
+  "Parse and return the sticky tag as a string.
 `match-data' is protected."
   (let ((data (match-data))
        (tag)
@@ -830,11 +818,11 @@ essential information."
                    (t nil))))
     (unwind-protect
        (progn
-         (cond 
-          ;; Sticky Date tag.  Convert to to a proper date value (`encode-time')
+         (cond
+          ;; Sticky Date tag.  Convert to a proper date value (`encode-time')
           ((eq type 'date)
-           (string-match 
-            "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)" 
+           (string-match
+            "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)"
             match-tag)
            (let* ((year-tmp (string-to-number (match-string 1 match-tag)))
                   (month    (string-to-number (match-string 2 match-tag)))
@@ -856,13 +844,13 @@ essential information."
           (t nil))
          (cond ((eq vc-cvs-sticky-tag-display nil) nil)
                ((eq vc-cvs-sticky-tag-display t)
-                (cond ((eq type 'date) (format-time-string 
+                (cond ((eq type 'date) (format-time-string
                                         vc-cvs-sticky-date-format-string
                                         tag))
                       ((eq type 'symbolic-name) tag)
                       ((eq type 'revision-number) tag)
                       (t nil)))
-               ((functionp vc-cvs-sticky-tag-display) 
+               ((functionp vc-cvs-sticky-tag-display)
                 (funcall vc-cvs-sticky-tag-display tag type))
                (t nil)))
 
@@ -884,10 +872,8 @@ is non-nil."
      (concat "/[^/]+"
             ;; revision
             "/\\([^/]*\\)"
-            ;; timestamp
-            "/\\([^/]*\\)"
-            ;; optional conflict field
-            "\\(+[^/]*\\)?/"
+            ;; timestamp and optional conflict field
+            "/\\([^/]*\\)/"
             ;; options
             "\\([^/]*\\)/"
             ;; sticky tag
@@ -895,17 +881,21 @@ is non-nil."
             "\\(.*\\)"))               ;Sticky tag
     (vc-file-setprop file 'vc-workfile-version (match-string 1))
     (vc-file-setprop file 'vc-cvs-sticky-tag
-                    (vc-cvs-parse-sticky-tag (match-string 5) (match-string 6)))
+                    (vc-cvs-parse-sticky-tag (match-string 4) (match-string 5)))
     ;; compare checkout time and modification time
-    (let ((mtime (nth 5 (file-attributes file)))
-         (system-time-locale "C"))
-      (cond ((equal (format-time-string "%c" mtime 'utc) (match-string 2))
-            (vc-file-setprop file 'vc-checkout-time mtime)
-            (if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
-           (t
-            (vc-file-setprop file 'vc-checkout-time 0)
-            (if set-state (vc-file-setprop file 'vc-state 'edited))))))))
-           
+    (let ((mtime (nth 5 (file-attributes file))))
+      (require 'parse-time)
+      (let ((parsed-time
+            (parse-time-string (concat (match-string 2) " +0000"))))
+       (cond ((and (not (string-match "\\+" (match-string 2)))
+                   (car parsed-time)
+                   (equal mtime (apply 'encode-time parsed-time)))
+              (vc-file-setprop file 'vc-checkout-time mtime)
+              (if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
+             (t
+              (vc-file-setprop file 'vc-checkout-time 0)
+              (if set-state (vc-file-setprop file 'vc-state 'edited)))))))))
+
 (provide 'vc-cvs)
 
 ;;; vc-cvs.el ends here