]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-cvs.el
*** empty log message ***
[gnu-emacs] / lisp / vc-cvs.el
index 400a1ffb1057cb14dd140c1547c4262cdeff0000..94fd3d0acd9b19bda9a264e0cb1afb1d52a1105b 100644 (file)
@@ -1,11 +1,12 @@
 ;;; vc-cvs.el --- non-resident support for CVS version-control
 
-;; Copyright (C) 1995,98,99,2000,2001,02,2003  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author:      FSF (see vc.el for full credits)
 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
 
-;; $Id: vc-cvs.el,v 1.66 2003/10/01 13:22:53 fx Exp $
+;; $Id$
 
 ;; This file is part of GNU Emacs.
 
@@ -21,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -42,7 +43,7 @@
                 (repeat :tag "Argument List"
                         :value ("")
                         string))
-  :version "21.4"
+  :version "22.1"
   :group 'vc)
 
 (defcustom vc-cvs-register-switches nil
@@ -89,12 +90,12 @@ and past information to determine the current status of a file.
 The value can also be a regular expression or list of regular
 expressions to match against the host name of a repository; then VC
 only stays local for hosts that match it.  Alternatively, the value
-can be a list of regular expressions where the first element is the 
-symbol `except'; then VC always stays local except for hosts matched 
+can be a list of regular expressions where the first element is the
+symbol `except'; then VC always stays local except for hosts matched
 by these regular expressions."
   :type '(choice (const :tag "Always stay local" t)
                 (const :tag "Don't stay local" nil)
-                 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." 
+                 (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
                        (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
                        (regexp :format " stay local,\n%t: %v" :tag "if it matches")
                        (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
@@ -106,7 +107,7 @@ by these regular expressions."
 Format is according to `format-time-string'.  Only used if
 `vc-cvs-sticky-tag-display' is t."
   :type '(string)
-  :version "21.4"
+  :version "22.1"
   :group 'vc)
 
 (defcustom vc-cvs-sticky-tag-display t
@@ -145,19 +146,13 @@ displayed.  Date and time is displayed for sticky dates.
 
 See also variable `vc-cvs-sticky-date-format-string'."
   :type '(choice boolean function)
-  :version "21.4"
+  :version "22.1"
   :group 'vc)
 
 ;;;
 ;;; Internal variables
 ;;;
 
-(defvar vc-cvs-local-month-numbers
-  '(("Jan" . 1) ("Feb" .  2) ("Mar" .  3) ("Apr" .  4)
-    ("May" . 5) ("Jun" .  6) ("Jul" .  7) ("Aug" .  8)
-    ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
-  "Local association list of month numbers.")
-
 
 ;;;
 ;;; State-querying functions
@@ -195,7 +190,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
       (let ((state (vc-file-getprop file 'vc-state)))
         ;; If we should stay local, use the heuristic but only if
         ;; we don't have a more precise state already available.
-       (if (memq state '(up-to-date edited))
+       (if (memq state '(up-to-date edited nil))
            (vc-cvs-state-heuristic file)
          state))
     (with-temp-buffer
@@ -241,16 +236,19 @@ See also variable `vc-cvs-sticky-date-format-string'."
 
 (defun vc-cvs-checkout-model (file)
   "CVS-specific version of `vc-checkout-model'."
-  (if (or (getenv "CVSREAD")
-          ;; If the file is not writable (despite CVSREAD being
-          ;; undefined), this is probably because the file is being
-          ;; "watched" by other developers.
-          ;; (If vc-mistrust-permissions was t, we actually shouldn't
-          ;; trust this, but there is no other way to learn this from CVS
-          ;; at the moment (version 1.9).)
-          (string-match "r-..-..-." (nth 8 (file-attributes file))))
+  (if (getenv "CVSREAD")
       'announce
-    'implicit))
+    (let ((attrib (file-attributes file)))
+      (if (and attrib ;; don't check further if FILE doesn't exist
+               ;; If the file is not writable (despite CVSREAD being
+               ;; undefined), this is probably because the file is being
+               ;; "watched" by other developers.
+               ;; (If vc-mistrust-permissions was t, we actually shouldn't
+               ;; trust this, but there is no other way to learn this from CVS
+               ;; at the moment (version 1.9).)
+               (string-match "r-..-..-." (nth 8 attrib)))
+          'announce
+        'implicit))))
 
 (defun vc-cvs-mode-line-string (file)
   "Return string for placement into the modeline for FILE.
@@ -454,7 +452,8 @@ REV is the revision to check out into WORKFILE."
        (message "Checking out %s...done" filename)))))
 
 (defun vc-cvs-delete-file (file)
-  (vc-cvs-command nil 0 file "remove" "-f"))
+  (vc-cvs-command nil 0 file "remove" "-f")
+  (vc-cvs-command nil 0 file "commit" "-mRemoved."))
 
 (defun vc-cvs-revert (file &optional contents-done)
   "Revert FILE to the version it was based on."
@@ -533,14 +532,14 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
 ;;; History functions
 ;;;
 
-(defun vc-cvs-print-log (file)
+(defun vc-cvs-print-log (file &optional buffer)
   "Get change log associated with FILE."
   (vc-cvs-command
-   nil
+   buffer
    (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
    file "log"))
 
-(defun vc-cvs-diff (file &optional oldvers newvers)
+(defun vc-cvs-diff (file &optional oldvers newvers buffer)
   "Get a difference report using CVS between two versions of FILE."
   (if (string= (vc-workfile-version file) "0")
       ;; This file is added but not yet committed; there is no master file.
@@ -549,13 +548,15 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
        ;; We regard this as "changed".
        ;; Diff it against /dev/null.
        ;; Note: this is NOT a "cvs diff".
-       (apply 'vc-do-command "*vc-diff*"
+       (apply 'vc-do-command (or buffer "*vc-diff*")
               1 "diff" file
               (append (vc-switches nil 'diff) '("/dev/null")))
        ;; Even if it's empty, it's locally modified.
        1)
-    (let* ((async (and (vc-stay-local-p file) (fboundp 'start-process)))
-          (status (apply 'vc-cvs-command "*vc-diff*"
+    (let* ((async (and (not vc-disable-async-diff)
+                       (vc-stay-local-p file)
+                       (fboundp 'start-process)))
+          (status (apply 'vc-cvs-command (or buffer "*vc-diff*")
                          (if async 'async 1)
                          file "diff"
                          (and oldvers (concat "-r" oldvers))
@@ -590,7 +591,11 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
 (defun vc-cvs-annotate-command (file buffer &optional version)
   "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
 Optional arg VERSION is a version to annotate from."
-  (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version))))
+  (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version)))
+  (with-current-buffer buffer
+    (goto-char (point-min))
+    (re-search-forward "^[0-9]")
+    (delete-region (point-min) (1- (point)))))
 
 (defun vc-cvs-annotate-current-time ()
   "Return the current time, based at midnight of the current day, and
@@ -601,29 +606,36 @@ 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
-        "^\\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)
-                                   vc-cvs-local-month-numbers)))
-              (year-tmp (string-to-number (match-string 3)))
-              ;; Years 0..68 are 2000..2068.
-              ;; Years 69..99 are 1969..1999.
-              (year (+ (cond ((> 69 year-tmp) 2000)
-                             ((> 100 year-tmp) 1900)
-                             (t 0))
-                       year-tmp)))
-         (goto-char (match-end 0)) ; Position at end makes for nicer overlay result
-           (vc-annotate-convert-time (encode-time 0 0 0 day month year))))
-    ;; If we did not look directly at an annotation, there might be
-    ;; some further down.  This is the case if we are positioned at
-    ;; the very top of the buffer, for instance.
-      (if (re-search-forward time-stamp nil t)
-       (progn
-         (beginning-of-line nil)
-           (vc-cvs-annotate-time))))))
+  (let* ((bol (point))
+         (cache (get-text-property bol 'vc-cvs-annotate-time))
+         buffer-read-only)
+    (cond
+     (cache)
+     ((looking-at
+       "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")
+      (let ((day (string-to-number (match-string 1)))
+            (month (cdr (assq (intern (match-string 2))
+                              '((Jan .  1) (Feb .  2) (Mar .  3)
+                                (Apr .  4) (May .  5) (Jun .  6)
+                                (Jul .  7) (Aug .  8) (Sep .  9)
+                                (Oct . 10) (Nov . 11) (Dec . 12)))))
+            (year (let ((tmp (string-to-number (match-string 3))))
+                    ;; Years 0..68 are 2000..2068.
+                    ;; Years 69..99 are 1969..1999.
+                    (+ (cond ((> 69 tmp) 2000)
+                             ((> 100 tmp) 1900)
+                             (t 0))
+                       tmp))))
+        (put-text-property
+         bol (1+ bol) 'vc-cvs-annotate-time
+         (setq cache (cons
+                      ;; Position at end makes for nicer overlay result.
+                      (match-end 0)
+                      (vc-annotate-convert-time
+                       (encode-time 0 0 0 day month year))))))))
+    (when cache
+      (goto-char (car cache))           ; fontify from here to eol
+      (cdr cache))))                    ; days (float)
 
 (defun vc-cvs-annotate-extract-revision-at-line ()
   (save-excursion
@@ -738,7 +750,7 @@ is `local'.
 The default METHOD for a CVS root of the form
   [USER@]HOSTNAME:/path/to/repository
 is `ext'.
-For an empty string, nil is returned (illegal CVS root)."
+For an empty string, nil is returned (invalid CVS root)."
   ;; Split CVS root into colon separated fields (0-4).
   ;; The `x:' makes sure, that leading colons are not lost;
   ;; `HOST:/PATH' is then different from `:METHOD:/PATH'.
@@ -839,7 +851,7 @@ CVS/Entries should only be accessed through this function."
   (let ((coding-system-for-read (or file-name-coding-system
                                     default-file-name-coding-system)))
     (vc-insert-file (expand-file-name "CVS/Entries" dir))))
-     
+
 (defun vc-cvs-valid-symbolic-tag-name-p (tag)
   "Return non-nil if TAG is a valid symbolic tag name."
   ;; According to the CVS manual, a valid symbolic tag must start with
@@ -929,7 +941,7 @@ 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 4) 
+                    (vc-cvs-parse-sticky-tag (match-string 4)
                                               (match-string 5)))
     ;; Compare checkout time and modification time.
     ;; This is intentionally different from the algorithm that CVS uses