[Emacs-diffs] Changes to emacs/lisp/vc-cvs.el

[Andre Spiegel]

Index: emacs/lisp/vc-cvs.el
diff -c emacs/lisp/vc-cvs.el:1.31 emacs/lisp/vc-cvs.el:1.32
*** emacs/lisp/vc-cvs.el:1.31   Tue Jan  8 15:00:19 2002
--- emacs/lisp/vc-cvs.el        Fri Jan 11 16:09:39 2002
***************
*** 5,11 ****
  ;; Author:      FSF (see vc.el for full credits)
  ;; Maintainer:  Andre Spiegel <address@hidden>
  
! ;; $Id: vc-cvs.el,v 1.31 2002/01/08 20:00:19 spiegel Exp $
  
  ;; This file is part of GNU Emacs.
  
--- 5,11 ----
  ;; Author:      FSF (see vc.el for full credits)
  ;; Maintainer:  Andre Spiegel <address@hidden>
  
! ;; $Id: vc-cvs.el,v 1.32 2002/01/11 21:09:39 spiegel Exp $
  
  ;; This file is part of GNU Emacs.
  
***************
*** 83,134 ****
    :version "21.1"
    :group 'vc)
  
- (defcustom vc-cvs-sticky-date-format-string "%c"
-   "*Format string for mode-line display of sticky date.
- Format is according to `format-time-string'.  Only used if
- `vc-cvs-sticky-tag-display' is t."
-   :type '(string)
-   :version "21.3"
-   :group 'vc)
- 
- (defcustom vc-cvs-sticky-tag-display t
-   "*Specify the mode-line display of sticky tags.
- Value t means default display, nil means no display at all.  If the
- value is a function or macro, it is called with the sticky tag and
- its' type as parameters, in that order.  TYPE can have three different
- values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a
- string) and `date' (TAG is a date as returned by `encode-time').  The
- return value of the function or macro will be displayed as a string.
- 
- 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 
-                               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.
- 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) 
-             (condition-case nil
-                 (progn
-                   (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
-                   (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"
-   :group 'vc)
  
  ;;;
  ;;; Internal variables
--- 83,88 ----
***************
*** 233,260 ****
  
  (defun vc-cvs-mode-line-string (file)
    "Return string for placement into the modeline for FILE.
! Compared to the default implementation, this function does two things:
! Handle the special case of a CVS file that is added but not yet
! committed and support display of sticky tags."
!   (let* ((state   (vc-state file))
!        (rev     (vc-workfile-version file))
!        (sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag))
!        (sticky-tag-printable (and sticky-tag
!                                   (not (string= sticky-tag ""))
!                                   (concat "[" sticky-tag "]"))))
      (cond ((string= rev "0")
           ;; A file that is added but not yet committed.
           "CVS @@")
          ((or (eq state 'up-to-date)
               (eq state 'needs-patch))
!          (concat "CVS-" rev sticky-tag-printable))
            ((stringp state)
!          (concat "CVS:" state ":" rev sticky-tag-printable))
            (t
             ;; Not just for the 'edited state, but also a fallback
             ;; for all other states.  Think about different symbols
             ;; for 'needs-patch and 'needs-merge.
!            (concat "CVS:" rev sticky-tag-printable)))))
  
  (defun vc-cvs-dired-state-info (file)
    "CVS-specific version of `vc-dired-state-info'."
--- 187,209 ----
  
  (defun vc-cvs-mode-line-string (file)
    "Return string for placement into the modeline for FILE.
! Compared to the default implementation, this function handles the
! special case of a CVS file that is added but not yet committed."
!   (let ((state   (vc-state file))
!       (rev     (vc-workfile-version file)))
      (cond ((string= rev "0")
           ;; A file that is added but not yet committed.
           "CVS @@")
          ((or (eq state 'up-to-date)
               (eq state 'needs-patch))
!          (concat "CVS-" rev))
            ((stringp state)
!          (concat "CVS:" state ":" rev))
            (t
             ;; Not just for the 'edited state, but also a fallback
             ;; for all other states.  Think about different symbols
             ;; for 'needs-patch and 'needs-merge.
!            (concat "CVS:" rev)))))
  
  (defun vc-cvs-dired-state-info (file)
    "CVS-specific version of `vc-dired-state-info'."
***************
*** 311,332 ****
                      (list vc-checkin-switches)
                    vc-checkin-switches))
        status)
!     (if (not rev)
!         (setq status (apply 'vc-do-command nil 1 "cvs" 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")
!         ;; If the input revison is a valid symbolic tag name, we create it
!         ;; as a branch, commit and switch to it.       
!         (apply 'vc-do-command nil 0 "cvs" file "tag" "-b" (list rev))
!         (apply 'vc-do-command nil 0 "cvs" file "update" "-r" (list rev))
!         (setq status (apply 'vc-do-command nil 1 "cvs" file
!                             "ci" 
!                             (concat "-m" comment)
!                             switches))
!         (vc-file-setprop file 'vc-cvs-sticky-tag rev)))
      (set-buffer "*vc*")
      (goto-char (point-min))
      (when (not (zerop status))
--- 260,275 ----
                      (list vc-checkin-switches)
                    vc-checkin-switches))
        status)
!     ;; explicit check-in to the trunk requires a double check-in (first
!     ;; unexplicit) (CVS-1.3)
!     (if (and rev (vc-trunk-p rev))
!       (apply 'vc-do-command nil 1 "cvs" file
!              "ci" "-m" "intermediate"
!              switches))
!     (setq status (apply 'vc-do-command nil 1 "cvs" file
!                       "ci" (if rev (concat "-r" rev))
!                       (concat "-m" comment)
!                       switches))
      (set-buffer "*vc*")
      (goto-char (point-min))
      (when (not (zerop status))
***************
*** 351,361 ****
      ;; tell it from the permissions of the file (see
      ;; vc-cvs-checkout-model).
      (vc-file-setprop file 'vc-checkout-model nil)
! 
!     ;; if this was an explicit check-in (does not include creation of
!     ;; a branch), remove the sticky tag.
!     (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
!       (vc-do-command nil 0 "cvs" file "update" "-A"))))
  
  (defun vc-cvs-checkout (file &optional editable rev workfile)
    "Retrieve a revision of FILE into a WORKFILE.
--- 294,301 ----
      ;; tell it from the permissions of the file (see
      ;; vc-cvs-checkout-model).
      (vc-file-setprop file 'vc-checkout-model nil)
!     ;; if this was an explicit check-in, remove the sticky tag
!     (if rev (vc-do-command nil 0 "cvs" file "update" "-A"))))
  
  (defun vc-cvs-checkout (file &optional editable rev workfile)
    "Retrieve a revision of FILE into a WORKFILE.
***************
*** 662,674 ****
  NAME is the name of the snapshot; if it is empty, do a `cvs update'.
  If UPDATE is non-nil, then update (resynch) any affected buffers."
    (with-current-buffer (get-buffer-create "*vc*")
!     (let ((default-directory dir)
!         (sticky-tag))
        (erase-buffer)
        (if (or (not name) (string= name ""))
          (vc-do-command t 0 "cvs" nil "update")
!       (vc-do-command t 0 "cvs" nil "update" "-r" name)
!       (setq sticky-tag name))
        (when update
        (goto-char (point-min))
        (while (not (eobp))
--- 602,612 ----
  NAME is the name of the snapshot; if it is empty, do a `cvs update'.
  If UPDATE is non-nil, then update (resynch) any affected buffers."
    (with-current-buffer (get-buffer-create "*vc*")
!     (let ((default-directory dir))
        (erase-buffer)
        (if (or (not name) (string= name ""))
          (vc-do-command t 0 "cvs" nil "update")
!       (vc-do-command t 0 "cvs" nil "update" "-r" name))
        (when update
        (goto-char (point-min))
        (while (not (eobp))
***************
*** 689,695 ****
                    (vc-file-setprop file 'vc-state 'edited)
                    (vc-file-setprop file 'vc-workfile-version nil)
                    (vc-file-setprop file 'vc-checkout-time 0)))
-                 (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag)
                  (vc-resynch-buffer file t t))))
          (forward-line 1))))))
  
--- 627,632 ----
***************
*** 784,850 ****
            (vc-cvs-parse-entry file t))))
        (forward-line 1))))
  
- 
- (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
-   ;; an uppercase or lowercase letter and can contain uppercase and
-   ;; lowercase letters, digits, `-', and `_'.
-   (and (string-match "^[a-zA-Z]" tag)
-        (not (string-match "[^a-z0-9A-Z-_]" tag))))
-       
- 
- (defun vc-cvs-parse-sticky-tag (match-type match-tag)
-   "Parse and return the sticky tag as a string.  
- `match-data' is protected."
-   (let ((data (match-data))
-       (tag)
-       (type (cond ((string= match-type "D") 'date)
-                   ((string= match-type "T")
-                    (if (vc-cvs-valid-symbolic-tag-name-p match-tag)
-                        'symbolic-name
-                      'revision-number))
-                   (t nil))))
-     (unwind-protect
-       (progn
-         (cond 
-          ;; Sticky Date tag.  Convert to to a proper date value 
(`encode-time')
-          ((eq type 'date)
-           (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)))
-                  (day      (string-to-number (match-string 3 match-tag)))
-                  (hour     (string-to-number (match-string 4 match-tag)))
-                  (min      (string-to-number (match-string 5 match-tag)))
-                  (sec      (string-to-number (match-string 6 match-tag)))
-                  ;; 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)))
-             (setq tag (encode-time sec min hour day month year))))
-          ;; Sticky Tag name or revision number
-          ((eq type 'symbolic-name) (setq tag match-tag))
-          ((eq type 'revision-number) (setq tag match-tag))
-          ;; Default is no sticky tag at all
-          (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 
-                                        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) 
-                (funcall vc-cvs-sticky-tag-display tag type))
-               (t nil)))
- 
-       (set-match-data data))))
- 
  (defun vc-cvs-parse-entry (file &optional set-state)
    "Parse a line from CVS/Entries.
  Compare modification time to that of the FILE, set file properties
--- 721,726 ----
***************
*** 862,878 ****
             ;; revision
             "/\\([^/]*\\)"
             ;; timestamp
!            "/\\([^/]*\\)"
!            ;; optional conflict field
!            "\\(+[^/]*\\)?/"
!            ;; options
!            "\\([^/]*\\)/"
!            ;; sticky tag
!            "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty)
!            "\\(.*\\)"))               ;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)))
      ;; compare checkout time and modification time
      (let ((mtime (nth 5 (file-attributes file)))
          (system-time-locale "C"))
--- 738,745 ----
             ;; revision
             "/\\([^/]*\\)"
             ;; timestamp
!            "/\\([^/]*\\)"))
      (vc-file-setprop file 'vc-workfile-version (match-string 1))
      ;; compare checkout time and modification time
      (let ((mtime (nth 5 (file-attributes file)))
          (system-time-locale "C"))