aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/vc-cvs.el179
1 files changed, 23 insertions, 156 deletions
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index cf22fce4ed2..017055a059f 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -5,7 +5,7 @@
5;; Author: FSF (see vc.el for full credits) 5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org> 6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7 7
8;; $Id: vc-cvs.el,v 1.30 2002/01/08 19:57:57 spiegel Exp $ 8;; $Id: vc-cvs.el,v 1.29 2001/12/20 18:46:37 pj Exp $
9 9
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11 11
@@ -83,52 +83,6 @@ of a repository; then VC only stays local for hosts that match it."
83 :version "21.1" 83 :version "21.1"
84 :group 'vc) 84 :group 'vc)
85 85
86(defcustom vc-cvs-sticky-date-format-string "%c"
87 "*Format string for mode-line display of sticky date.
88Format is according to `format-time-string'. Only used if
89`vc-cvs-sticky-tag-display' is t."
90 :type '(string)
91 :version "21.3"
92 :group 'vc)
93
94(defcustom vc-cvs-sticky-tag-display t
95 "*Specify the mode-line display of sticky tags.
96Value t means default display, nil means no display at all. If the
97value is a function or macro, it is called with the sticky tag and
98its' type as parameters, in that order. TYPE can have three different
99values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a
100string) and `date' (TAG is a date as returned by `encode-time'). The
101return value of the function or macro will be displayed as a string.
102
103Here's an example that will display the formatted date for sticky
104dates and the word \"Sticky\" for sticky tag names and revisions.
105
106 (lambda (tag type)
107 (cond ((eq type 'date) (format-time-string
108 vc-cvs-sticky-date-format-string tag))
109 ((eq type 'revision-number) \"Sticky\")
110 ((eq type 'symbolic-name) \"Sticky\")))
111
112Here's an example that will abbreviate to the first character only,
113any text before the first occurence of `-' for sticky symbolic tags.
114If the sticky tag is a revision number, the word \"Sticky\" is
115displayed. Date and time is displayed for sticky dates.
116
117 (lambda (tag type)
118 (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag))
119 ((eq type 'revision-number) \"Sticky\")
120 ((eq type 'symbolic-name)
121 (condition-case nil
122 (progn
123 (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag)
124 (concat (substring (match-string 1 tag) 0 1) \":\"
125 (substring (match-string 2 tag) 1 nil)))
126 (error tag))))) ; Fall-back to given tag name.
127
128See also variable `vc-cvs-sticky-date-format-string'."
129 :type '(choice boolean function)
130 :version "21.3"
131 :group 'vc)
132 86
133;;; 87;;;
134;;; Internal variables 88;;; Internal variables
@@ -233,28 +187,23 @@ See also variable `vc-cvs-sticky-date-format-string'."
233 187
234(defun vc-cvs-mode-line-string (file) 188(defun vc-cvs-mode-line-string (file)
235 "Return string for placement into the modeline for FILE. 189 "Return string for placement into the modeline for FILE.
236Compared to the default implementation, this function does two things: 190Compared to the default implementation, this function handles the
237Handle the special case of a CVS file that is added but not yet 191special case of a CVS file that is added but not yet committed."
238committed and support display of sticky tags." 192 (let ((state (vc-state file))
239 (let* ((state (vc-state file)) 193 (rev (vc-workfile-version file)))
240 (rev (vc-workfile-version file))
241 (sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag))
242 (sticky-tag-printable (and sticky-tag
243 (not (string= sticky-tag ""))
244 (concat "[" sticky-tag "]"))))
245 (cond ((string= rev "0") 194 (cond ((string= rev "0")
246 ;; A file that is added but not yet committed. 195 ;; A file that is added but not yet committed.
247 "CVS @@") 196 "CVS @@")
248 ((or (eq state 'up-to-date) 197 ((or (eq state 'up-to-date)
249 (eq state 'needs-patch)) 198 (eq state 'needs-patch))
250 (concat "CVS-" rev sticky-tag-printable)) 199 (concat "CVS-" rev))
251 ((stringp state) 200 ((stringp state)
252 (concat "CVS:" state ":" rev sticky-tag-printable)) 201 (concat "CVS:" state ":" rev))
253 (t 202 (t
254 ;; Not just for the 'edited state, but also a fallback 203 ;; Not just for the 'edited state, but also a fallback
255 ;; for all other states. Think about different symbols 204 ;; for all other states. Think about different symbols
256 ;; for 'needs-patch and 'needs-merge. 205 ;; for 'needs-patch and 'needs-merge.
257 (concat "CVS:" rev sticky-tag-printable))))) 206 (concat "CVS:" rev)))))
258 207
259(defun vc-cvs-dired-state-info (file) 208(defun vc-cvs-dired-state-info (file)
260 "CVS-specific version of `vc-dired-state-info'." 209 "CVS-specific version of `vc-dired-state-info'."
@@ -311,22 +260,16 @@ This is only possible if CVS is responsible for FILE's directory."
311 (list vc-checkin-switches) 260 (list vc-checkin-switches)
312 vc-checkin-switches)) 261 vc-checkin-switches))
313 status) 262 status)
314 (if (not rev) 263 ;; explicit check-in to the trunk requires a double check-in (first
315 (setq status (apply 'vc-do-command nil 1 "cvs" file 264 ;; unexplicit) (CVS-1.3)
316 "ci" (if rev (concat "-r" rev)) 265 (if (and rev (vc-trunk-p rev))
317 (concat "-m" comment) 266 (apply 'vc-do-command nil 1 "cvs" file
318 switches)) 267 "ci" "-m" "intermediate"
319 (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) 268 switches))
320 (error "%s is not a valid symbolic tag name") 269 (setq status (apply 'vc-do-command nil 1 "cvs" file
321 ;; If the input revison is a valid symbolic tag name, we create it 270 "ci" (if rev (concat "-r" rev))
322 ;; as a branch, commit and switch to it. 271 (concat "-m" comment)
323 (apply 'vc-do-command nil 0 "cvs" file "tag" "-b" (list rev)) 272 switches))
324 (apply 'vc-do-command nil 0 "cvs" file "update" "-r" (list rev))
325 (setq status (apply 'vc-do-command nil 1 "cvs" file
326 "ci"
327 (concat "-m" comment)
328 switches))
329 (vc-file-setprop file 'vc-cvs-sticky-tag rev)))
330 (set-buffer "*vc*") 273 (set-buffer "*vc*")
331 (goto-char (point-min)) 274 (goto-char (point-min))
332 (when (not (zerop status)) 275 (when (not (zerop status))
@@ -351,11 +294,8 @@ This is only possible if CVS is responsible for FILE's directory."
351 ;; tell it from the permissions of the file (see 294 ;; tell it from the permissions of the file (see
352 ;; vc-cvs-checkout-model). 295 ;; vc-cvs-checkout-model).
353 (vc-file-setprop file 'vc-checkout-model nil) 296 (vc-file-setprop file 'vc-checkout-model nil)
354 297 ;; if this was an explicit check-in, remove the sticky tag
355 ;; if this was an explicit check-in (does not include creation of 298 (if rev (vc-do-command nil 0 "cvs" file "update" "-A"))))
356 ;; a branch), remove the sticky tag.
357 (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
358 (vc-do-command nil 0 "cvs" file "update" "-A"))))
359 299
360(defun vc-cvs-checkout (file &optional editable rev workfile) 300(defun vc-cvs-checkout (file &optional editable rev workfile)
361 "Retrieve a revision of FILE into a WORKFILE. 301 "Retrieve a revision of FILE into a WORKFILE.
@@ -662,13 +602,11 @@ workspace is immediately moved to that new branch)."
662NAME is the name of the snapshot; if it is empty, do a `cvs update'. 602NAME is the name of the snapshot; if it is empty, do a `cvs update'.
663If UPDATE is non-nil, then update (resynch) any affected buffers." 603If UPDATE is non-nil, then update (resynch) any affected buffers."
664 (with-current-buffer (get-buffer-create "*vc*") 604 (with-current-buffer (get-buffer-create "*vc*")
665 (let ((default-directory dir) 605 (let ((default-directory dir))
666 (sticky-tag))
667 (erase-buffer) 606 (erase-buffer)
668 (if (or (not name) (string= name "")) 607 (if (or (not name) (string= name ""))
669 (vc-do-command t 0 "cvs" nil "update") 608 (vc-do-command t 0 "cvs" nil "update")
670 (vc-do-command t 0 "cvs" nil "update" "-r" name) 609 (vc-do-command t 0 "cvs" nil "update" "-r" name))
671 (setq sticky-tag name))
672 (when update 610 (when update
673 (goto-char (point-min)) 611 (goto-char (point-min))
674 (while (not (eobp)) 612 (while (not (eobp))
@@ -689,7 +627,6 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
689 (vc-file-setprop file 'vc-state 'edited) 627 (vc-file-setprop file 'vc-state 'edited)
690 (vc-file-setprop file 'vc-workfile-version nil) 628 (vc-file-setprop file 'vc-workfile-version nil)
691 (vc-file-setprop file 'vc-checkout-time 0))) 629 (vc-file-setprop file 'vc-checkout-time 0)))
692 (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag)
693 (vc-resynch-buffer file t t)))) 630 (vc-resynch-buffer file t t))))
694 (forward-line 1)))))) 631 (forward-line 1))))))
695 632
@@ -784,67 +721,6 @@ essential information."
784 (vc-cvs-parse-entry file t)))) 721 (vc-cvs-parse-entry file t))))
785 (forward-line 1)))) 722 (forward-line 1))))
786 723
787
788(defun vc-cvs-valid-symbolic-tag-name-p (tag)
789 "Return non-nil if TAG is a valid symbolic tag name."
790 ;; According to the CVS manual, a valid symbolic tag must start with
791 ;; an uppercase or lowercase letter and can contain uppercase and
792 ;; lowercase letters, digits, `-', and `_'.
793 (and (string-match "^[a-zA-Z]" tag)
794 (not (string-match "[^a-z0-9A-Z-_]" tag))))
795
796
797(defun vc-cvs-parse-sticky-tag (match-type match-tag)
798 "Parse and return the sticky tag as a string.
799`match-data' is protected."
800 (let ((data (match-data))
801 (tag)
802 (type (cond ((string= match-type "D") 'date)
803 ((string= match-type "T")
804 (if (vc-cvs-valid-symbolic-tag-name-p match-tag)
805 'symbolic-name
806 'revision-number))
807 (t nil))))
808 (unwind-protect
809 (progn
810 (cond
811 ;; Sticky Date tag. Convert to to a proper date value (`encode-time')
812 ((eq type 'date)
813 (string-match
814 "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)"
815 match-tag)
816 (let* ((year-tmp (string-to-number (match-string 1 match-tag)))
817 (month (string-to-number (match-string 2 match-tag)))
818 (day (string-to-number (match-string 3 match-tag)))
819 (hour (string-to-number (match-string 4 match-tag)))
820 (min (string-to-number (match-string 5 match-tag)))
821 (sec (string-to-number (match-string 6 match-tag)))
822 ;; Years 0..68 are 2000..2068.
823 ;; Years 69..99 are 1969..1999.
824 (year (+ (cond ((> 69 year-tmp) 2000)
825 ((> 100 year-tmp) 1900)
826 (t 0))
827 year-tmp)))
828 (setq tag (encode-time sec min hour day month year))))
829 ;; Sticky Tag name or revision number
830 ((eq type 'symbolic-name) (setq tag match-tag))
831 ((eq type 'revision-number) (setq tag match-tag))
832 ;; Default is no sticky tag at all
833 (t nil))
834 (cond ((eq vc-cvs-sticky-tag-display nil) nil)
835 ((eq vc-cvs-sticky-tag-display t)
836 (cond ((eq type 'date) (format-time-string
837 vc-cvs-sticky-date-format-string
838 tag))
839 ((eq type 'symbolic-name) tag)
840 ((eq type 'revision-number) tag)
841 (t nil)))
842 ((functionp vc-cvs-sticky-tag-display)
843 (funcall vc-cvs-sticky-tag-display tag type))
844 (t nil)))
845
846 (set-match-data data))))
847
848(defun vc-cvs-parse-entry (file &optional set-state) 724(defun vc-cvs-parse-entry (file &optional set-state)
849 "Parse a line from CVS/Entries. 725 "Parse a line from CVS/Entries.
850Compare modification time to that of the FILE, set file properties 726Compare modification time to that of the FILE, set file properties
@@ -862,17 +738,8 @@ is non-nil."
862 ;; revision 738 ;; revision
863 "/\\([^/]*\\)" 739 "/\\([^/]*\\)"
864 ;; timestamp 740 ;; timestamp
865 "/\\([^/]*\\)" 741 "/\\([^/]*\\)"))
866 ;; optional conflict field
867 "\\(+[^/]*\\)?/"
868 ;; options
869 "\\([^/]*\\)/"
870 ;; sticky tag
871 "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty)
872 "\\(.*\\)")) ;Sticky tag
873 (vc-file-setprop file 'vc-workfile-version (match-string 1)) 742 (vc-file-setprop file 'vc-workfile-version (match-string 1))
874 (vc-file-setprop file 'vc-cvs-sticky-tag
875 (vc-cvs-parse-sticky-tag (match-string 5) (match-string 6)))
876 ;; compare checkout time and modification time 743 ;; compare checkout time and modification time
877 (let ((mtime (nth 5 (file-attributes file))) 744 (let ((mtime (nth 5 (file-attributes file)))
878 (system-time-locale "C")) 745 (system-time-locale "C"))