83 |
:version "21.1" |
:version "21.1" |
84 |
:group 'vc) |
:group 'vc) |
85 |
|
|
86 |
|
(defcustom vc-cvs-sticky-date-format-string "%c" |
87 |
|
"*Format string for mode-line display of sticky date. |
88 |
|
Format 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. |
96 |
|
Value t means default display, nil means no display at all. If the |
97 |
|
value is a function or macro, it is called with the sticky tag and |
98 |
|
its' type as parameters, in that order. TYPE can have three different |
99 |
|
values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a |
100 |
|
string) and `date' (TAG is a date as returned by `encode-time'). The |
101 |
|
return value of the function or macro will be displayed as a string. |
102 |
|
|
103 |
|
Here's an example that will display the formatted date for sticky |
104 |
|
dates 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 |
|
|
112 |
|
Here's an example that will abbreviate to the first character only, |
113 |
|
any text before the first occurence of `-' for sticky symbolic tags. |
114 |
|
If the sticky tag is a revision number, the word \"Sticky\" is |
115 |
|
displayed. 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 |
|
|
128 |
|
See also variable `vc-cvs-sticky-date-format-string'." |
129 |
|
:type '(choice boolean function) |
130 |
|
:version "21.3" |
131 |
|
:group 'vc) |
132 |
|
|
133 |
;;; |
;;; |
134 |
;;; Internal variables |
;;; Internal variables |
233 |
|
|
234 |
(defun vc-cvs-mode-line-string (file) |
(defun vc-cvs-mode-line-string (file) |
235 |
"Return string for placement into the modeline for FILE. |
"Return string for placement into the modeline for FILE. |
236 |
Compared to the default implementation, this function handles the |
Compared to the default implementation, this function does two things: |
237 |
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 |
238 |
(let ((state (vc-state file)) |
committed and support display of sticky tags." |
239 |
(rev (vc-workfile-version file))) |
(let* ((state (vc-state 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") |
(cond ((string= rev "0") |
246 |
;; A file that is added but not yet committed. |
;; A file that is added but not yet committed. |
247 |
"CVS @@") |
"CVS @@") |
248 |
((or (eq state 'up-to-date) |
((or (eq state 'up-to-date) |
249 |
(eq state 'needs-patch)) |
(eq state 'needs-patch)) |
250 |
(concat "CVS-" rev)) |
(concat "CVS-" rev sticky-tag-printable)) |
251 |
((stringp state) |
((stringp state) |
252 |
(concat "CVS:" state ":" rev)) |
(concat "CVS:" state ":" rev sticky-tag-printable)) |
253 |
(t |
(t |
254 |
;; Not just for the 'edited state, but also a fallback |
;; Not just for the 'edited state, but also a fallback |
255 |
;; for all other states. Think about different symbols |
;; for all other states. Think about different symbols |
256 |
;; for 'needs-patch and 'needs-merge. |
;; for 'needs-patch and 'needs-merge. |
257 |
(concat "CVS:" rev))))) |
(concat "CVS:" rev sticky-tag-printable))))) |
258 |
|
|
259 |
(defun vc-cvs-dired-state-info (file) |
(defun vc-cvs-dired-state-info (file) |
260 |
"CVS-specific version of `vc-dired-state-info'." |
"CVS-specific version of `vc-dired-state-info'." |
311 |
(list vc-checkin-switches) |
(list vc-checkin-switches) |
312 |
vc-checkin-switches)) |
vc-checkin-switches)) |
313 |
status) |
status) |
314 |
;; explicit check-in to the trunk requires a double check-in (first |
(if (not rev) |
315 |
;; unexplicit) (CVS-1.3) |
(setq status (apply 'vc-do-command nil 1 "cvs" file |
316 |
(if (and rev (vc-trunk-p rev)) |
"ci" (if rev (concat "-r" rev)) |
317 |
(apply 'vc-do-command nil 1 "cvs" file |
(concat "-m" comment) |
318 |
"ci" "-m" "intermediate" |
switches)) |
319 |
switches)) |
(if (not (vc-cvs-valid-symbolic-tag-name-p rev)) |
320 |
(setq status (apply 'vc-do-command nil 1 "cvs" file |
(error "%s is not a valid symbolic tag name") |
321 |
"ci" (if rev (concat "-r" rev)) |
;; If the input revison is a valid symbolic tag name, we create it |
322 |
(concat "-m" comment) |
;; as a branch, commit and switch to it. |
323 |
switches)) |
(apply 'vc-do-command nil 0 "cvs" file "tag" "-b" (list rev)) |
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*") |
(set-buffer "*vc*") |
331 |
(goto-char (point-min)) |
(goto-char (point-min)) |
332 |
(when (not (zerop status)) |
(when (not (zerop status)) |
351 |
;; tell it from the permissions of the file (see |
;; tell it from the permissions of the file (see |
352 |
;; vc-cvs-checkout-model). |
;; vc-cvs-checkout-model). |
353 |
(vc-file-setprop file 'vc-checkout-model nil) |
(vc-file-setprop file 'vc-checkout-model nil) |
354 |
;; if this was an explicit check-in, remove the sticky tag |
|
355 |
(if rev (vc-do-command nil 0 "cvs" file "update" "-A")))) |
;; if this was an explicit check-in (does not include creation of |
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 |
|
|
360 |
(defun vc-cvs-checkout (file &optional editable rev workfile) |
(defun vc-cvs-checkout (file &optional editable rev workfile) |
361 |
"Retrieve a revision of FILE into a WORKFILE. |
"Retrieve a revision of FILE into a WORKFILE. |
662 |
NAME is the name of the snapshot; if it is empty, do a `cvs update'. |
NAME is the name of the snapshot; if it is empty, do a `cvs update'. |
663 |
If UPDATE is non-nil, then update (resynch) any affected buffers." |
If UPDATE is non-nil, then update (resynch) any affected buffers." |
664 |
(with-current-buffer (get-buffer-create "*vc*") |
(with-current-buffer (get-buffer-create "*vc*") |
665 |
(let ((default-directory dir)) |
(let ((default-directory dir) |
666 |
|
(sticky-tag)) |
667 |
(erase-buffer) |
(erase-buffer) |
668 |
(if (or (not name) (string= name "")) |
(if (or (not name) (string= name "")) |
669 |
(vc-do-command t 0 "cvs" nil "update") |
(vc-do-command t 0 "cvs" nil "update") |
670 |
(vc-do-command t 0 "cvs" nil "update" "-r" name)) |
(vc-do-command t 0 "cvs" nil "update" "-r" name) |
671 |
|
(setq sticky-tag name)) |
672 |
(when update |
(when update |
673 |
(goto-char (point-min)) |
(goto-char (point-min)) |
674 |
(while (not (eobp)) |
(while (not (eobp)) |
689 |
(vc-file-setprop file 'vc-state 'edited) |
(vc-file-setprop file 'vc-state 'edited) |
690 |
(vc-file-setprop file 'vc-workfile-version nil) |
(vc-file-setprop file 'vc-workfile-version nil) |
691 |
(vc-file-setprop file 'vc-checkout-time 0))) |
(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)))) |
(vc-resynch-buffer file t t)))) |
694 |
(forward-line 1)))))) |
(forward-line 1)))))) |
695 |
|
|
784 |
(vc-cvs-parse-entry file t)))) |
(vc-cvs-parse-entry file t)))) |
785 |
(forward-line 1)))) |
(forward-line 1)))) |
786 |
|
|
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) |
(defun vc-cvs-parse-entry (file &optional set-state) |
849 |
"Parse a line from CVS/Entries. |
"Parse a line from CVS/Entries. |
850 |
Compare modification time to that of the FILE, set file properties |
Compare modification time to that of the FILE, set file properties |
862 |
;; revision |
;; revision |
863 |
"/\\([^/]*\\)" |
"/\\([^/]*\\)" |
864 |
;; timestamp |
;; timestamp |
865 |
"/\\([^/]*\\)")) |
"/\\([^/]*\\)" |
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)) |
(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 |
;; compare checkout time and modification time |
877 |
(let ((mtime (nth 5 (file-attributes file))) |
(let ((mtime (nth 5 (file-attributes file))) |
878 |
(system-time-locale "C")) |
(system-time-locale "C")) |