diff options
| -rw-r--r-- | lisp/vc-cvs.el | 179 |
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. | ||
| 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 | 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. |
| 236 | Compared to the default implementation, this function does two things: | 190 | Compared to the default implementation, this function handles the |
| 237 | Handle the special case of a CVS file that is added but not yet | 191 | special case of a CVS file that is added but not yet committed." |
| 238 | committed 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)." | |||
| 662 | NAME is the name of the snapshot; if it is empty, do a `cvs update'. | 602 | 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." | 603 | If 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. |
| 850 | Compare modification time to that of the FILE, set file properties | 726 | Compare 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")) |