Mercurial > emacs
comparison lisp/vc-rcs.el @ 31476:18bf0c070870
Doc fixes.
(vc-rcs-register-switches, vc-rcs-checkin-switches)
(vc-rcs-checkout-switches, vc-rcs-header)
(vc-rcs-master-templates): Add or change :version.
author | Dave Love <fx@gnu.org> |
---|---|
date | Thu, 07 Sep 2000 20:02:38 +0000 |
parents | f2ab9420390f |
children | f9d2d484e1e2 |
comparison
equal
deleted
inserted
replaced
31475:b25e22223eb9 | 31476:18bf0c070870 |
---|---|
3 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 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-rcs.el,v 1.1 2000/09/04 19:47:43 gerd Exp $ | 8 ;; $Id: vc-rcs.el,v 1.2 2000/09/05 20:08:21 monnier 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 |
35 (string :tag "Specified") | 35 (string :tag "Specified") |
36 (const :tag "Unknown" unknown)) | 36 (const :tag "Unknown" unknown)) |
37 :group 'vc) | 37 :group 'vc) |
38 | 38 |
39 (defcustom vc-rcs-register-switches nil | 39 (defcustom vc-rcs-register-switches nil |
40 "*A string or list of strings; extra switches for registering a file | 40 "*Extra switches for registering a file in RCS. |
41 in RCS. These are passed to the checkin program by | 41 A string or list of strings. These are passed to the checkin program |
42 \\[vc-rcs-register]." | 42 by \\[vc-rcs-register]." |
43 :type '(choice (const :tag "None" nil) | 43 :type '(choice (const :tag "None" nil) |
44 (string :tag "Argument String") | 44 (string :tag "Argument String") |
45 (repeat :tag "Argument List" | 45 (repeat :tag "Argument List" |
46 :value ("") | 46 :value ("") |
47 string)) | 47 string)) |
48 :version "21.1" | |
48 :group 'vc) | 49 :group 'vc) |
49 | 50 |
50 (defcustom vc-rcs-checkin-switches nil | 51 (defcustom vc-rcs-checkin-switches nil |
51 "*A string or list of strings specifying extra switches for RCS checkin. | 52 "*A string or list of strings specifying extra switches for RCS checkin. |
52 These are passed to the checkin program by \\[vc-rcs-checkin]." | 53 These are passed to the checkin program by \\[vc-rcs-checkin]." |
53 :type '(choice (const :tag "None" nil) | 54 :type '(choice (const :tag "None" nil) |
54 (string :tag "Argument String") | 55 (string :tag "Argument String") |
55 (repeat :tag "Argument List" | 56 (repeat :tag "Argument List" |
56 :value ("") | 57 :value ("") |
57 string)) | 58 string)) |
59 :version "21.1" | |
58 :group 'vc) | 60 :group 'vc) |
59 | 61 |
60 (defcustom vc-rcs-checkout-switches nil | 62 (defcustom vc-rcs-checkout-switches nil |
61 "*A string or list of strings specifying extra switches for RCS checkout. | 63 "*A string or list of strings specifying extra switches for RCS checkout. |
62 These are passed to the checkout program by \\[vc-rcs-checkout]." | 64 These are passed to the checkout program by \\[vc-rcs-checkout]." |
63 :type '(choice (const :tag "None" nil) | 65 :type '(choice (const :tag "None" nil) |
64 (string :tag "Argument String") | 66 (string :tag "Argument String") |
65 (repeat :tag "Argument List" | 67 (repeat :tag "Argument List" |
66 :value ("") | 68 :value ("") |
67 string)) | 69 string)) |
70 :version "21.1" | |
68 :group 'vc) | 71 :group 'vc) |
69 | 72 |
70 (defcustom vc-rcs-header (or (cdr (assoc 'RCS vc-header-alist)) '("\$Id\$")) | 73 (defcustom vc-rcs-header (or (cdr (assoc 'RCS vc-header-alist)) '("\$Id\$")) |
71 "*Header keywords to be inserted by `vc-insert-headers'." | 74 "*Header keywords to be inserted by `vc-insert-headers'." |
72 :type 'string | 75 :type 'string |
76 :version "21.1" | |
73 :group 'vc) | 77 :group 'vc) |
74 | 78 |
75 (defcustom vc-rcsdiff-knows-brief nil | 79 (defcustom vc-rcsdiff-knows-brief nil |
76 "*Indicates whether rcsdiff understands the --brief option. | 80 "*Indicates whether rcsdiff understands the --brief option. |
77 The value is either `yes', `no', or nil. If it is nil, VC tries | 81 The value is either `yes', `no', or nil. If it is nil, VC tries |
87 :type '(choice (const :tag "Use standard RCS file names" | 91 :type '(choice (const :tag "Use standard RCS file names" |
88 '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) | 92 '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) |
89 (repeat :tag "User-specified" | 93 (repeat :tag "User-specified" |
90 (choice string | 94 (choice string |
91 function))) | 95 function))) |
92 :version "20.5" | 96 :version "21.1" |
93 :group 'vc) | 97 :group 'vc) |
94 | 98 |
95 ;;;###autoload | 99 ;;;###autoload |
96 (progn (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))) | 100 (progn (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))) |
97 | 101 |
102 (vc-rcs-consult-headers file))) | 106 (vc-rcs-consult-headers file))) |
103 (let ((state | 107 (let ((state |
104 ;; vc-workfile-version might not be known; in that case the | 108 ;; vc-workfile-version might not be known; in that case the |
105 ;; property is nil. vc-rcs-fetch-master-state knows how to | 109 ;; property is nil. vc-rcs-fetch-master-state knows how to |
106 ;; handle that. | 110 ;; handle that. |
107 (vc-rcs-fetch-master-state file | 111 (vc-rcs-fetch-master-state file |
108 (vc-file-getprop file | 112 (vc-file-getprop file |
109 'vc-workfile-version)))) | 113 'vc-workfile-version)))) |
110 (if (eq state 'up-to-date) | 114 (if (eq state 'up-to-date) |
111 (if (vc-workfile-unchanged-p file) | 115 (if (vc-workfile-unchanged-p file) |
112 'up-to-date | 116 'up-to-date |
113 'unlocked-changes) | 117 'unlocked-changes) |
114 state))) | 118 state))) |
115 | 119 |
116 (defun vc-rcs-state-heuristic (file) | 120 (defun vc-rcs-state-heuristic (file) |
117 "State heuristic for RCS." | 121 "State heuristic for RCS." |
118 (let (vc-rcs-headers-result) | 122 (let (vc-rcs-headers-result) |
119 (if (and vc-consult-headers | 123 (if (and vc-consult-headers |
120 (setq vc-rcs-headers-result | 124 (setq vc-rcs-headers-result |
121 (vc-rcs-consult-headers file)) | 125 (vc-rcs-consult-headers file)) |
122 (eq vc-rcs-headers-result 'rev-and-lock)) | 126 (eq vc-rcs-headers-result 'rev-and-lock)) |
123 (let ((state (vc-file-getprop file 'vc-state))) | 127 (let ((state (vc-file-getprop file 'vc-state))) |
124 ;; If the headers say that the file is not locked, the | 128 ;; If the headers say that the file is not locked, the |
125 ;; permissions can tell us whether locking is used for | 129 ;; permissions can tell us whether locking is used for |
179 (setq latest-rev rev) | 183 (setq latest-rev rev) |
180 (setq value (match-string 1))))) | 184 (setq value (match-string 1))))) |
181 value)) | 185 value)) |
182 | 186 |
183 (defun vc-rcs-fetch-master-state (file &optional workfile-version) | 187 (defun vc-rcs-fetch-master-state (file &optional workfile-version) |
184 "Compute the master file's idea of the state of FILE. If a | 188 "Compute the master file's idea of the state of FILE. |
185 WORKFILE-VERSION is given, compute the state of that version, | 189 If a WORKFILE-VERSION is given, compute the state of that version, |
186 otherwise determine the workfile version based on the master file. | 190 otherwise determine the workfile version based on the master file. |
187 This function sets the properties `vc-workfile-version' and | 191 This function sets the properties `vc-workfile-version' and |
188 `vc-checkout-model' to their correct values, based on the master | 192 `vc-checkout-model' to their correct values, based on the master |
189 file." | 193 file." |
190 (with-temp-buffer | 194 (with-temp-buffer |
225 "[^0-9.]") | 229 "[^0-9.]") |
226 1))) | 230 1))) |
227 (cond | 231 (cond |
228 ;; not locked | 232 ;; not locked |
229 ((not locking-user) | 233 ((not locking-user) |
230 (if (or workfile-is-latest | 234 (if (or workfile-is-latest |
231 (vc-rcs-latest-on-branch-p file workfile-version)) | 235 (vc-rcs-latest-on-branch-p file workfile-version)) |
232 ;; workfile version is latest on branch | 236 ;; workfile version is latest on branch |
233 'up-to-date | 237 'up-to-date |
234 ;; workfile version is not latest on branch | 238 ;; workfile version is not latest on branch |
235 'needs-patch)) | 239 'needs-patch)) |
514 (defun vc-rcs-rename-file (old new) | 518 (defun vc-rcs-rename-file (old new) |
515 ;; Just move the master file (using vc-rcs-master-templates). | 519 ;; Just move the master file (using vc-rcs-master-templates). |
516 (vc-rename-master (vc-name old) new vc-rcs-master-templates)) | 520 (vc-rename-master (vc-name old) new vc-rcs-master-templates)) |
517 | 521 |
518 (defun vc-release-greater-or-equal (r1 r2) | 522 (defun vc-release-greater-or-equal (r1 r2) |
519 "Compare release numbers, represented as strings. Release | 523 "Compare release numbers, represented as strings. |
520 components are assumed cardinal numbers, not decimal fractions \(5.10 | 524 Release components are assumed cardinal numbers, not decimal fractions |
521 is a higher release than 5.9\). Omitted fields are considered lower | 525 \(5.10 is a higher release than 5.9\). Omitted fields are considered |
522 \(5.6.7 is earlier than 5.6.7.1\). Comparison runs till the end of | 526 lower \(5.6.7 is earlier than 5.6.7.1\). Comparison runs till the end |
523 the string is found, or a non-numeric component shows up \(5.6.7 is | 527 of the string is found, or a non-numeric component shows up \(5.6.7 is |
524 earlier than \"5.6.7 beta\", which is probably not what you want in | 528 earlier than \"5.6.7 beta\", which is probably not what you want in |
525 some cases\). This code is suitable for existing RCS release numbers. | 529 some cases\). This code is suitable for existing RCS release numbers. |
526 CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)." | 530 CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)." |
527 (let (v1 v2 i1 i2) | 531 (let (v1 v2 i1 i2) |
528 (catch 'done | 532 (catch 'done |
542 (or (and (string-match "^\\.?\\([0-9]+\\)" r2) | 546 (or (and (string-match "^\\.?\\([0-9]+\\)" r2) |
543 (throw 'done nil)) | 547 (throw 'done nil)) |
544 (throw 'done t))))) | 548 (throw 'done t))))) |
545 | 549 |
546 (defun vc-rcs-release-p (release) | 550 (defun vc-rcs-release-p (release) |
547 "Return t if we have RELEASE or better" | 551 "Return t if we have RELEASE or better." |
548 (let ((installation (vc-rcs-system-release))) | 552 (let ((installation (vc-rcs-system-release))) |
549 (if (and installation | 553 (if (and installation |
550 (not (eq installation 'unknown))) | 554 (not (eq installation 'unknown))) |
551 (vc-release-greater-or-equal installation release)))) | 555 (vc-release-greater-or-equal installation release)))) |
552 | 556 |
666 ;; (will be stored into the vc-name property) | 670 ;; (will be stored into the vc-name property) |
667 (vc-rcs-registered file) | 671 (vc-rcs-registered file) |
668 (vc-file-setprop file 'vc-name | 672 (vc-file-setprop file 'vc-name |
669 (if (file-name-absolute-p name) | 673 (if (file-name-absolute-p name) |
670 name | 674 name |
671 (expand-file-name | 675 (expand-file-name |
672 name | 676 name |
673 (file-name-directory file)))))) | 677 (file-name-directory file)))))) |
674 (vc-file-setprop file 'vc-workfile-version | 678 (vc-file-setprop file 'vc-workfile-version |
675 (if (re-search-forward | 679 (if (re-search-forward |
676 "^initial revision: \\([0-9.]+\\).*\n" | 680 "^initial revision: \\([0-9.]+\\).*\n" |
677 nil t) | 681 nil t) |
678 (match-string 1)))))) | 682 (match-string 1)))))) |
679 | 683 |
680 (defun vc-rcs-checkout (file &optional writable rev workfile) | 684 (defun vc-rcs-checkout (file &optional writable rev workfile) |
712 (current-buffer) 0 "co" (vc-name file) | 716 (current-buffer) 0 "co" (vc-name file) |
713 "-q" ;; suppress diagnostic output | 717 "-q" ;; suppress diagnostic output |
714 (if writable "-l") | 718 (if writable "-l") |
715 (concat "-p" rev) | 719 (concat "-p" rev) |
716 switches))) | 720 switches))) |
717 (set-file-modes filename | 721 (set-file-modes filename |
718 (logior (file-modes (vc-name file)) | 722 (logior (file-modes (vc-name file)) |
719 (if writable 128 0))) | 723 (if writable 128 0))) |
720 (setq failed nil)) | 724 (setq failed nil)) |
721 (and failed (file-exists-p filename) | 725 (and failed (file-exists-p filename) |
722 (delete-file filename)))) | 726 (delete-file filename)))) |
723 (let (new-version) | 727 (let (new-version) |
724 ;; if we should go to the head of the trunk, | 728 ;; if we should go to the head of the trunk, |
725 ;; clear the default branch first | 729 ;; clear the default branch first |
726 (and rev (string= rev "") | 730 (and rev (string= rev "") |