Mercurial > emacs
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
43446:0bd481e606f9 | 43447:79cf46e34420 |
---|---|
3 ;; Copyright (C) 1995,98,99,2000,2001 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1995,98,99,2000,2001 Free Software Foundation, Inc. |
4 | 4 |
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.29 2001/12/20 18:46:37 pj Exp $ | 8 ;; $Id: vc-cvs.el,v 1.31 2002/01/08 20:00:19 spiegel Exp $ |
9 | 9 |
10 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
11 | 11 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
81 (string :tag "Host regexp") | 81 (string :tag "Host regexp") |
82 (const :tag "Don't stay local" nil)) | 82 (const :tag "Don't stay local" nil)) |
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. | |
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) | |
86 | 132 |
87 ;;; | 133 ;;; |
88 ;;; Internal variables | 134 ;;; Internal variables |
89 ;;; | 135 ;;; |
90 | 136 |
185 'announce | 231 'announce |
186 'implicit)) | 232 'implicit)) |
187 | 233 |
188 (defun vc-cvs-mode-line-string (file) | 234 (defun vc-cvs-mode-line-string (file) |
189 "Return string for placement into the modeline for FILE. | 235 "Return string for placement into the modeline for FILE. |
190 Compared to the default implementation, this function handles the | 236 Compared to the default implementation, this function does two things: |
191 special case of a CVS file that is added but not yet committed." | 237 Handle the special case of a CVS file that is added but not yet |
192 (let ((state (vc-state file)) | 238 committed and support display of sticky tags." |
193 (rev (vc-workfile-version file))) | 239 (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 "]")))) | |
194 (cond ((string= rev "0") | 245 (cond ((string= rev "0") |
195 ;; A file that is added but not yet committed. | 246 ;; A file that is added but not yet committed. |
196 "CVS @@") | 247 "CVS @@") |
197 ((or (eq state 'up-to-date) | 248 ((or (eq state 'up-to-date) |
198 (eq state 'needs-patch)) | 249 (eq state 'needs-patch)) |
199 (concat "CVS-" rev)) | 250 (concat "CVS-" rev sticky-tag-printable)) |
200 ((stringp state) | 251 ((stringp state) |
201 (concat "CVS:" state ":" rev)) | 252 (concat "CVS:" state ":" rev sticky-tag-printable)) |
202 (t | 253 (t |
203 ;; Not just for the 'edited state, but also a fallback | 254 ;; Not just for the 'edited state, but also a fallback |
204 ;; for all other states. Think about different symbols | 255 ;; for all other states. Think about different symbols |
205 ;; for 'needs-patch and 'needs-merge. | 256 ;; for 'needs-patch and 'needs-merge. |
206 (concat "CVS:" rev))))) | 257 (concat "CVS:" rev sticky-tag-printable))))) |
207 | 258 |
208 (defun vc-cvs-dired-state-info (file) | 259 (defun vc-cvs-dired-state-info (file) |
209 "CVS-specific version of `vc-dired-state-info'." | 260 "CVS-specific version of `vc-dired-state-info'." |
210 (let* ((cvs-state (vc-state file)) | 261 (let* ((cvs-state (vc-state file)) |
211 (state (cond ((eq cvs-state 'edited) "modified") | 262 (state (cond ((eq cvs-state 'edited) "modified") |
258 "CVS-specific version of `vc-backend-checkin'." | 309 "CVS-specific version of `vc-backend-checkin'." |
259 (let ((switches (if (stringp vc-checkin-switches) | 310 (let ((switches (if (stringp vc-checkin-switches) |
260 (list vc-checkin-switches) | 311 (list vc-checkin-switches) |
261 vc-checkin-switches)) | 312 vc-checkin-switches)) |
262 status) | 313 status) |
263 ;; explicit check-in to the trunk requires a double check-in (first | 314 (if (not rev) |
264 ;; unexplicit) (CVS-1.3) | 315 (setq status (apply 'vc-do-command nil 1 "cvs" file |
265 (if (and rev (vc-trunk-p rev)) | 316 "ci" (if rev (concat "-r" rev)) |
266 (apply 'vc-do-command nil 1 "cvs" file | 317 (concat "-m" comment) |
267 "ci" "-m" "intermediate" | 318 switches)) |
268 switches)) | 319 (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) |
269 (setq status (apply 'vc-do-command nil 1 "cvs" file | 320 (error "%s is not a valid symbolic tag name") |
270 "ci" (if rev (concat "-r" rev)) | 321 ;; If the input revison is a valid symbolic tag name, we create it |
271 (concat "-m" comment) | 322 ;; as a branch, commit and switch to it. |
272 switches)) | 323 (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))) | |
273 (set-buffer "*vc*") | 330 (set-buffer "*vc*") |
274 (goto-char (point-min)) | 331 (goto-char (point-min)) |
275 (when (not (zerop status)) | 332 (when (not (zerop status)) |
276 ;; Check checkin problem. | 333 ;; Check checkin problem. |
277 (cond | 334 (cond |
292 ;; Forget the checkout model of the file, because we might have | 349 ;; Forget the checkout model of the file, because we might have |
293 ;; guessed wrong when we found the file. After commit, we can | 350 ;; guessed wrong when we found the file. After commit, we can |
294 ;; tell it from the permissions of the file (see | 351 ;; tell it from the permissions of the file (see |
295 ;; vc-cvs-checkout-model). | 352 ;; vc-cvs-checkout-model). |
296 (vc-file-setprop file 'vc-checkout-model nil) | 353 (vc-file-setprop file 'vc-checkout-model nil) |
297 ;; if this was an explicit check-in, remove the sticky tag | 354 |
298 (if rev (vc-do-command nil 0 "cvs" file "update" "-A")))) | 355 ;; 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")))) | |
299 | 359 |
300 (defun vc-cvs-checkout (file &optional editable rev workfile) | 360 (defun vc-cvs-checkout (file &optional editable rev workfile) |
301 "Retrieve a revision of FILE into a WORKFILE. | 361 "Retrieve a revision of FILE into a WORKFILE. |
302 EDITABLE non-nil means that the file should be writable. | 362 EDITABLE non-nil means that the file should be writable. |
303 REV is the revision to check out into WORKFILE." | 363 REV is the revision to check out into WORKFILE." |
600 (defun vc-cvs-retrieve-snapshot (dir name update) | 660 (defun vc-cvs-retrieve-snapshot (dir name update) |
601 "Retrieve a snapshot at and below DIR. | 661 "Retrieve a snapshot at and below DIR. |
602 NAME is the name of the snapshot; if it is empty, do a `cvs update'. | 662 NAME is the name of the snapshot; if it is empty, do a `cvs update'. |
603 If UPDATE is non-nil, then update (resynch) any affected buffers." | 663 If UPDATE is non-nil, then update (resynch) any affected buffers." |
604 (with-current-buffer (get-buffer-create "*vc*") | 664 (with-current-buffer (get-buffer-create "*vc*") |
605 (let ((default-directory dir)) | 665 (let ((default-directory dir) |
666 (sticky-tag)) | |
606 (erase-buffer) | 667 (erase-buffer) |
607 (if (or (not name) (string= name "")) | 668 (if (or (not name) (string= name "")) |
608 (vc-do-command t 0 "cvs" nil "update") | 669 (vc-do-command t 0 "cvs" nil "update") |
609 (vc-do-command t 0 "cvs" nil "update" "-r" name)) | 670 (vc-do-command t 0 "cvs" nil "update" "-r" name) |
671 (setq sticky-tag name)) | |
610 (when update | 672 (when update |
611 (goto-char (point-min)) | 673 (goto-char (point-min)) |
612 (while (not (eobp)) | 674 (while (not (eobp)) |
613 (if (looking-at "\\([CMUP]\\) \\(.*\\)") | 675 (if (looking-at "\\([CMUP]\\) \\(.*\\)") |
614 (let* ((file (expand-file-name (match-string 2) dir)) | 676 (let* ((file (expand-file-name (match-string 2) dir)) |
625 ((or (string= state "M") | 687 ((or (string= state "M") |
626 (string= state "C")) | 688 (string= state "C")) |
627 (vc-file-setprop file 'vc-state 'edited) | 689 (vc-file-setprop file 'vc-state 'edited) |
628 (vc-file-setprop file 'vc-workfile-version nil) | 690 (vc-file-setprop file 'vc-workfile-version nil) |
629 (vc-file-setprop file 'vc-checkout-time 0))) | 691 (vc-file-setprop file 'vc-checkout-time 0))) |
692 (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag) | |
630 (vc-resynch-buffer file t t)))) | 693 (vc-resynch-buffer file t t)))) |
631 (forward-line 1)))))) | 694 (forward-line 1)))))) |
632 | 695 |
633 | 696 |
634 ;;; | 697 ;;; |
719 (let ((file (expand-file-name (match-string 1) dir))) | 782 (let ((file (expand-file-name (match-string 1) dir))) |
720 (unless (vc-file-getprop file 'vc-state) | 783 (unless (vc-file-getprop file 'vc-state) |
721 (vc-cvs-parse-entry file t)))) | 784 (vc-cvs-parse-entry file t)))) |
722 (forward-line 1)))) | 785 (forward-line 1)))) |
723 | 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 | |
724 (defun vc-cvs-parse-entry (file &optional set-state) | 848 (defun vc-cvs-parse-entry (file &optional set-state) |
725 "Parse a line from CVS/Entries. | 849 "Parse a line from CVS/Entries. |
726 Compare modification time to that of the FILE, set file properties | 850 Compare modification time to that of the FILE, set file properties |
727 accordingly. However, `vc-state' is set only if optional arg SET-STATE | 851 accordingly. However, `vc-state' is set only if optional arg SET-STATE |
728 is non-nil." | 852 is non-nil." |
736 ((looking-at | 860 ((looking-at |
737 (concat "/[^/]+" | 861 (concat "/[^/]+" |
738 ;; revision | 862 ;; revision |
739 "/\\([^/]*\\)" | 863 "/\\([^/]*\\)" |
740 ;; timestamp | 864 ;; timestamp |
741 "/\\([^/]*\\)")) | 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 | |
742 (vc-file-setprop file 'vc-workfile-version (match-string 1)) | 873 (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))) | |
743 ;; compare checkout time and modification time | 876 ;; compare checkout time and modification time |
744 (let ((mtime (nth 5 (file-attributes file))) | 877 (let ((mtime (nth 5 (file-attributes file))) |
745 (system-time-locale "C")) | 878 (system-time-locale "C")) |
746 (cond ((equal (format-time-string "%c" mtime 'utc) (match-string 2)) | 879 (cond ((equal (format-time-string "%c" mtime 'utc) (match-string 2)) |
747 (vc-file-setprop file 'vc-checkout-time mtime) | 880 (vc-file-setprop file 'vc-checkout-time mtime) |