emacs: lisp/vc-cvs.el comparison

comparison lisp/vc-cvs.el @ 43447:79cf46e34420

Patch by Martin.Lorentzson@telia.com. (vc-cvs-sticky-date-format-string): New variable. (vc-cvs-sticky-tag-display): New variable. (vc-cvs-mode-line-string): Add sticky-tag to the mode-line. (vc-cvs-checkin): If the input revision is a valid symbolic tag name, we create it as a branch, commit and switch to it. (vc-cvs-retrieve-snapshot): Set file-property sticky-tag. (vc-cvs-valid-symbolic-tag-name-p): New function. (vc-cvs-parse-sticky-tag): New function. (vc-cvs-parse-entry): Added parsing of sticky tags.

author	André Spiegel <spiegel@gnu.org>
date	Thu, 21 Feb 2002 20:16:47 +0000
parents	e5083d725922
children	d4dab5e8395f

comparison

equal deleted inserted replaced

-:0bd481e606f9
+:79cf46e34420
 ;; Copyright (C) 1995,98,99,2000,2001  Free Software Foundation, Inc.
 ;; Author:      FSF (see vc.el for full credits)
 ;; Maintainer:  Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-cvs.el,v 1.29 2001/12/20 18:46:37 pj Exp $
+;; $Id: vc-cvs.el,v 1.31 2002/01/08 20:00:19 spiegel Exp $
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 		 (string :tag "Host regexp")
 		 (const :tag "Don't stay local" nil))
 :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
 ;;;
 'announce
 'implicit))
 (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
+Compared to the default implementation, this function does two things:
-special case of a CVS file that is added but not yet committed."
+Handle the special case of a CVS file that is added but not yet
-(let ((state   (vc-state file))
+committed and support display of sticky tags."
-	(rev     (vc-workfile-version file)))
+(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))
+	   (concat "CVS-" rev sticky-tag-printable))
 ((stringp state)
-	   (concat "CVS:" state ":" rev))
+	   (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)))))
+(concat "CVS:" rev sticky-tag-printable)))))
 (defun vc-cvs-dired-state-info (file)
 "CVS-specific version of `vc-dired-state-info'."
 (let* ((cvs-state (vc-state file))
 	 (state (cond ((eq cvs-state 'edited)	"modified")
 "CVS-specific version of `vc-backend-checkin'."
 (let ((switches (if (stringp vc-checkin-switches)
 		      (list vc-checkin-switches)
 		    vc-checkin-switches))
 	status)
-;; explicit check-in to the trunk requires a double check-in (first
+(if (not rev)
-;; unexplicit) (CVS-1.3)
+(setq status (apply 'vc-do-command nil 1 "cvs" file
-(if (and rev (vc-trunk-p rev))
+"ci" (if rev (concat "-r" rev))
-	(apply 'vc-do-command nil 1 "cvs" file
+(concat "-m" comment)
-	       "ci" "-m" "intermediate"
+switches))
-	       switches))
+(if (not (vc-cvs-valid-symbolic-tag-name-p rev))
-(setq status (apply 'vc-do-command nil 1 "cvs" file
+(error "%s is not a valid symbolic tag name")
-			"ci" (if rev (concat "-r" rev))
+;; If the input revison is a valid symbolic tag name, we create it
-			(concat "-m" comment)
+;; as a branch, commit and switch to it.
-			switches))
+(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))
 ;; Check checkin problem.
 (cond
 ;; Forget the checkout model of the file, because we might have
 ;; guessed wrong when we found the file.  After commit, we can
 ;; 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"))))
+;; 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.
 EDITABLE non-nil means that the file should be writable.
 REV is the revision to check out into WORKFILE."
 (defun vc-cvs-retrieve-snapshot (dir name update)
 "Retrieve a snapshot at and below DIR.
 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))
+(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))
+	(vc-do-command t 0 "cvs" nil "update" "-r" name)
+	(setq sticky-tag name))
 (when update
 	(goto-char (point-min))
 	(while (not (eobp))
 	  (if (looking-at "\\([CMUP]\\) \\(.*\\)")
 	      (let* ((file (expand-file-name (match-string 2) dir))
 		   ((or (string= state "M")
 			(string= state "C"))
 		    (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))))))
 ;;;
 	(let ((file (expand-file-name (match-string 1) dir)))
 	  (unless (vc-file-getprop file 'vc-state)
 	    (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
 accordingly.  However, `vc-state' is set only if optional arg SET-STATE
 is non-nil."
 ((looking-at
 (concat "/[^/]+"
 	     ;; 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"))
 (cond ((equal (format-time-string "%c" mtime 'utc) (match-string 2))
 	     (vc-file-setprop file 'vc-checkout-time mtime)

Mercurial > emacs

comparison lisp/vc-cvs.el @ 43447:79cf46e34420