1 |
;;; vc-cvs.el --- non-resident support for CVS version-control |
;;; vc-cvs.el --- non-resident support for CVS version-control |
2 |
|
|
3 |
;; Copyright (C) 1995,98,99,2000,2001 Free Software Foundation, Inc. |
;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, |
4 |
|
;; 2004, 2005 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: FSF (see vc.el for full credits) |
;; Author: FSF (see vc.el for full credits) |
7 |
;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
;; Maintainer: Andre Spiegel <spiegel@gnu.org> |
22 |
|
|
23 |
;; You should have received a copy of the GNU General Public License |
;; You should have received a copy of the GNU General Public License |
24 |
;; along with GNU Emacs; see the file COPYING. If not, write to the |
;; along with GNU Emacs; see the file COPYING. If not, write to the |
25 |
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 |
;; Boston, MA 02111-1307, USA. |
;; Boston, MA 02110-1301, USA. |
27 |
|
|
28 |
;;; Commentary: |
;;; Commentary: |
29 |
|
|
36 |
;;; Customization options |
;;; Customization options |
37 |
;;; |
;;; |
38 |
|
|
39 |
|
(defcustom vc-cvs-global-switches nil |
40 |
|
"*Global switches to pass to any CVS command." |
41 |
|
:type '(choice (const :tag "None" nil) |
42 |
|
(string :tag "Argument String") |
43 |
|
(repeat :tag "Argument List" |
44 |
|
:value ("") |
45 |
|
string)) |
46 |
|
:version "22.1" |
47 |
|
:group 'vc) |
48 |
|
|
49 |
(defcustom vc-cvs-register-switches nil |
(defcustom vc-cvs-register-switches nil |
50 |
"*Extra switches for registering a file into CVS. |
"*Extra switches for registering a file into CVS. |
51 |
A string or list of strings passed to the checkin program by |
A string or list of strings passed to the checkin program by |
86 |
"*Non-nil means use local operations when possible for remote repositories. |
"*Non-nil means use local operations when possible for remote repositories. |
87 |
This avoids slow queries over the network and instead uses heuristics |
This avoids slow queries over the network and instead uses heuristics |
88 |
and past information to determine the current status of a file. |
and past information to determine the current status of a file. |
89 |
The value can also be a regular expression to match against the host name |
|
90 |
of a repository; then VC only stays local for hosts that match it." |
The value can also be a regular expression or list of regular |
91 |
|
expressions to match against the host name of a repository; then VC |
92 |
|
only stays local for hosts that match it. Alternatively, the value |
93 |
|
can be a list of regular expressions where the first element is the |
94 |
|
symbol `except'; then VC always stays local except for hosts matched |
95 |
|
by these regular expressions." |
96 |
:type '(choice (const :tag "Always stay local" t) |
:type '(choice (const :tag "Always stay local" t) |
97 |
(string :tag "Host regexp") |
(const :tag "Don't stay local" nil) |
98 |
(const :tag "Don't stay local" nil)) |
(list :format "\nExamine hostname and %v" :tag "Examine hostname ..." |
99 |
|
(set :format "%v" :inline t (const :format "%t" :tag "don't" except)) |
100 |
|
(regexp :format " stay local,\n%t: %v" :tag "if it matches") |
101 |
|
(repeat :format "%v%i\n" :inline t (regexp :tag "or")))) |
102 |
:version "21.1" |
:version "21.1" |
103 |
:group 'vc) |
:group 'vc) |
104 |
|
|
105 |
|
(defcustom vc-cvs-sticky-date-format-string "%c" |
106 |
|
"*Format string for mode-line display of sticky date. |
107 |
|
Format is according to `format-time-string'. Only used if |
108 |
|
`vc-cvs-sticky-tag-display' is t." |
109 |
|
:type '(string) |
110 |
|
:version "22.1" |
111 |
|
:group 'vc) |
112 |
|
|
113 |
|
(defcustom vc-cvs-sticky-tag-display t |
114 |
|
"*Specify the mode-line display of sticky tags. |
115 |
|
Value t means default display, nil means no display at all. If the |
116 |
|
value is a function or macro, it is called with the sticky tag and |
117 |
|
its' type as parameters, in that order. TYPE can have three different |
118 |
|
values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a |
119 |
|
string) and `date' (TAG is a date as returned by `encode-time'). The |
120 |
|
return value of the function or macro will be displayed as a string. |
121 |
|
|
122 |
|
Here's an example that will display the formatted date for sticky |
123 |
|
dates and the word \"Sticky\" for sticky tag names and revisions. |
124 |
|
|
125 |
|
(lambda (tag type) |
126 |
|
(cond ((eq type 'date) (format-time-string |
127 |
|
vc-cvs-sticky-date-format-string tag)) |
128 |
|
((eq type 'revision-number) \"Sticky\") |
129 |
|
((eq type 'symbolic-name) \"Sticky\"))) |
130 |
|
|
131 |
|
Here's an example that will abbreviate to the first character only, |
132 |
|
any text before the first occurrence of `-' for sticky symbolic tags. |
133 |
|
If the sticky tag is a revision number, the word \"Sticky\" is |
134 |
|
displayed. Date and time is displayed for sticky dates. |
135 |
|
|
136 |
|
(lambda (tag type) |
137 |
|
(cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag)) |
138 |
|
((eq type 'revision-number) \"Sticky\") |
139 |
|
((eq type 'symbolic-name) |
140 |
|
(condition-case nil |
141 |
|
(progn |
142 |
|
(string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag) |
143 |
|
(concat (substring (match-string 1 tag) 0 1) \":\" |
144 |
|
(substring (match-string 2 tag) 1 nil))) |
145 |
|
(error tag))))) ; Fall-back to given tag name. |
146 |
|
|
147 |
|
See also variable `vc-cvs-sticky-date-format-string'." |
148 |
|
:type '(choice boolean function) |
149 |
|
:version "22.1" |
150 |
|
:group 'vc) |
151 |
|
|
152 |
;;; |
;;; |
153 |
;;; Internal variables |
;;; Internal variables |
154 |
;;; |
;;; |
155 |
|
|
|
(defvar vc-cvs-local-month-numbers |
|
|
'(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) |
|
|
("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) |
|
|
("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)) |
|
|
"Local association list of month numbers.") |
|
|
|
|
156 |
|
|
157 |
;;; |
;;; |
158 |
;;; State-querying functions |
;;; State-querying functions |
161 |
;;;###autoload (defun vc-cvs-registered (f) |
;;;###autoload (defun vc-cvs-registered (f) |
162 |
;;;###autoload (when (file-readable-p (expand-file-name |
;;;###autoload (when (file-readable-p (expand-file-name |
163 |
;;;###autoload "CVS/Entries" (file-name-directory f))) |
;;;###autoload "CVS/Entries" (file-name-directory f))) |
164 |
;;;###autoload (require 'vc-cvs) |
;;;###autoload (load "vc-cvs") |
165 |
;;;###autoload (vc-cvs-registered f))) |
;;;###autoload (vc-cvs-registered f))) |
166 |
|
|
167 |
(defun vc-cvs-registered (file) |
(defun vc-cvs-registered (file) |
172 |
(case-fold-search nil)) |
(case-fold-search nil)) |
173 |
(if (file-readable-p (expand-file-name "CVS/Entries" dirname)) |
(if (file-readable-p (expand-file-name "CVS/Entries" dirname)) |
174 |
(with-temp-buffer |
(with-temp-buffer |
175 |
(vc-insert-file (expand-file-name "CVS/Entries" dirname)) |
(vc-cvs-get-entries dirname) |
176 |
(goto-char (point-min)) |
(goto-char (point-min)) |
177 |
(cond |
(cond |
178 |
((re-search-forward |
((re-search-forward |
179 |
(concat "^/" (regexp-quote basename) "/") nil t) |
;; CVS-removed files are not taken under VC control. |
180 |
|
(concat "^/" (regexp-quote basename) "/[^/-]") nil t) |
181 |
(beginning-of-line) |
(beginning-of-line) |
182 |
(vc-cvs-parse-entry file) |
(vc-cvs-parse-entry file) |
183 |
t) |
t) |
186 |
|
|
187 |
(defun vc-cvs-state (file) |
(defun vc-cvs-state (file) |
188 |
"CVS-specific version of `vc-state'." |
"CVS-specific version of `vc-state'." |
189 |
(if (vc-cvs-stay-local-p file) |
(if (vc-stay-local-p file) |
190 |
(let ((state (vc-file-getprop file 'vc-state))) |
(let ((state (vc-file-getprop file 'vc-state))) |
191 |
;; If we should stay local, use the heuristic but only if |
;; If we should stay local, use the heuristic but only if |
192 |
;; we don't have a more precise state already available. |
;; we don't have a more precise state already available. |
193 |
(if (memq state '(up-to-date edited)) |
(if (memq state '(up-to-date edited nil)) |
194 |
(vc-cvs-state-heuristic file) |
(vc-cvs-state-heuristic file) |
195 |
state)) |
state)) |
196 |
(with-temp-buffer |
(with-temp-buffer |
197 |
(cd (file-name-directory file)) |
(cd (file-name-directory file)) |
198 |
(vc-do-command t 0 "cvs" file "status") |
(vc-cvs-command t 0 file "status") |
199 |
(vc-cvs-parse-status t)))) |
(vc-cvs-parse-status t)))) |
200 |
|
|
201 |
(defun vc-cvs-state-heuristic (file) |
(defun vc-cvs-state-heuristic (file) |
210 |
|
|
211 |
(defun vc-cvs-dir-state (dir) |
(defun vc-cvs-dir-state (dir) |
212 |
"Find the CVS state of all files in DIR." |
"Find the CVS state of all files in DIR." |
213 |
(if (vc-cvs-stay-local-p dir) |
;; if DIR is not under CVS control, don't do anything. |
214 |
(vc-cvs-dir-state-heuristic dir) |
(when (file-readable-p (expand-file-name "CVS/Entries" dir)) |
215 |
(let ((default-directory dir)) |
(if (vc-stay-local-p dir) |
216 |
;; Don't specify DIR in this command, the default-directory is |
(vc-cvs-dir-state-heuristic dir) |
217 |
;; enough. Otherwise it might fail with remote repositories. |
(let ((default-directory dir)) |
218 |
(with-temp-buffer |
;; Don't specify DIR in this command, the default-directory is |
219 |
(vc-do-command t 0 "cvs" nil "status" "-l") |
;; enough. Otherwise it might fail with remote repositories. |
220 |
(goto-char (point-min)) |
(with-temp-buffer |
221 |
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t) |
(vc-cvs-command t 0 nil "status" "-l") |
222 |
(narrow-to-region (match-beginning 0) (match-end 0)) |
(goto-char (point-min)) |
223 |
(vc-cvs-parse-status) |
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t) |
224 |
(goto-char (point-max)) |
(narrow-to-region (match-beginning 0) (match-end 0)) |
225 |
(widen)))))) |
(vc-cvs-parse-status) |
226 |
|
(goto-char (point-max)) |
227 |
|
(widen))))))) |
228 |
|
|
229 |
(defun vc-cvs-workfile-version (file) |
(defun vc-cvs-workfile-version (file) |
230 |
"CVS-specific version of `vc-workfile-version'." |
"CVS-specific version of `vc-workfile-version'." |
236 |
|
|
237 |
(defun vc-cvs-checkout-model (file) |
(defun vc-cvs-checkout-model (file) |
238 |
"CVS-specific version of `vc-checkout-model'." |
"CVS-specific version of `vc-checkout-model'." |
239 |
(if (or (getenv "CVSREAD") |
(if (getenv "CVSREAD") |
|
;; If the file is not writable (despite CVSREAD being |
|
|
;; undefined), this is probably because the file is being |
|
|
;; "watched" by other developers. |
|
|
;; (If vc-mistrust-permissions was t, we actually shouldn't |
|
|
;; trust this, but there is no other way to learn this from CVS |
|
|
;; at the moment (version 1.9).) |
|
|
(string-match "r-..-..-." (nth 8 (file-attributes file)))) |
|
240 |
'announce |
'announce |
241 |
'implicit)) |
(let ((attrib (file-attributes file))) |
242 |
|
(if (and attrib ;; don't check further if FILE doesn't exist |
243 |
|
;; If the file is not writable (despite CVSREAD being |
244 |
|
;; undefined), this is probably because the file is being |
245 |
|
;; "watched" by other developers. |
246 |
|
;; (If vc-mistrust-permissions was t, we actually shouldn't |
247 |
|
;; trust this, but there is no other way to learn this from CVS |
248 |
|
;; at the moment (version 1.9).) |
249 |
|
(string-match "r-..-..-." (nth 8 attrib))) |
250 |
|
'announce |
251 |
|
'implicit)))) |
252 |
|
|
253 |
(defun vc-cvs-mode-line-string (file) |
(defun vc-cvs-mode-line-string (file) |
254 |
"Return string for placement into the modeline for FILE. |
"Return string for placement into the modeline for FILE. |
255 |
Compared to the default implementation, this function handles the |
Compared to the default implementation, this function does two things: |
256 |
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 |
257 |
(let ((state (vc-state file)) |
committed and support display of sticky tags." |
258 |
(rev (vc-workfile-version file))) |
(let ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag)) |
259 |
(cond ((string= rev "0") |
(string (if (string= (vc-workfile-version file) "0") |
260 |
;; A file that is added but not yet committed. |
;; A file that is added but not yet committed. |
261 |
"CVS @@") |
"CVS @@" |
262 |
((or (eq state 'up-to-date) |
(vc-default-mode-line-string 'CVS file)))) |
263 |
(eq state 'needs-patch)) |
(if (zerop (length sticky-tag)) |
264 |
(concat "CVS-" rev)) |
string |
265 |
((stringp state) |
(concat string "[" sticky-tag "]")))) |
|
(concat "CVS:" state ":" rev)) |
|
|
(t |
|
|
;; Not just for the 'edited state, but also a fallback |
|
|
;; for all other states. Think about different symbols |
|
|
;; for 'needs-patch and 'needs-merge. |
|
|
(concat "CVS:" rev))))) |
|
266 |
|
|
267 |
(defun vc-cvs-dired-state-info (file) |
(defun vc-cvs-dired-state-info (file) |
268 |
"CVS-specific version of `vc-dired-state-info'." |
"CVS-specific version of `vc-dired-state-info'." |
269 |
(let* ((cvs-state (vc-state file)) |
(let ((cvs-state (vc-state file))) |
270 |
(state (cond ((eq cvs-state 'edited) "modified") |
(cond ((eq cvs-state 'edited) |
271 |
((eq cvs-state 'needs-patch) "patch") |
(if (equal (vc-workfile-version file) "0") |
272 |
((eq cvs-state 'needs-merge) "merge") |
"(added)" "(modified)")) |
273 |
;; FIXME: those two states cannot occur right now |
((eq cvs-state 'needs-patch) "(patch)") |
274 |
((eq cvs-state 'unlocked-changes) "conflict") |
((eq cvs-state 'needs-merge) "(merge)")))) |
|
((eq cvs-state 'locally-added) "added") |
|
|
))) |
|
|
(if state (concat "(" state ")")))) |
|
275 |
|
|
276 |
|
|
277 |
;;; |
;;; |
284 |
|
|
285 |
`vc-register-switches' and `vc-cvs-register-switches' are passed to |
`vc-register-switches' and `vc-cvs-register-switches' are passed to |
286 |
the CVS command (in that order)." |
the CVS command (in that order)." |
287 |
(let ((switches (list |
(when (and (not (vc-cvs-responsible-p file)) |
288 |
(if (stringp vc-register-switches) |
(vc-cvs-could-register file)) |
289 |
(list vc-register-switches) |
;; Register the directory if needed. |
290 |
vc-register-switches) |
(vc-cvs-register (directory-file-name (file-name-directory file)))) |
291 |
(if (stringp vc-cvs-register-switches) |
(apply 'vc-cvs-command nil 0 file |
292 |
(list vc-cvs-register-switches) |
"add" |
293 |
vc-cvs-register-switches)))) |
(and comment (string-match "[^\t\n ]" comment) |
294 |
|
(concat "-m" comment)) |
295 |
(apply 'vc-do-command nil 0 "cvs" file |
(vc-switches 'CVS 'register))) |
|
"add" |
|
|
(and comment (string-match "[^\t\n ]" comment) |
|
|
(concat "-m" comment)) |
|
|
switches))) |
|
296 |
|
|
297 |
(defun vc-cvs-responsible-p (file) |
(defun vc-cvs-responsible-p (file) |
298 |
"Return non-nil if CVS thinks it is responsible for FILE." |
"Return non-nil if CVS thinks it is responsible for FILE." |
303 |
|
|
304 |
(defun vc-cvs-could-register (file) |
(defun vc-cvs-could-register (file) |
305 |
"Return non-nil if FILE could be registered in CVS. |
"Return non-nil if FILE could be registered in CVS. |
306 |
This is only possible if CVS is responsible for FILE's directory." |
This is only possible if CVS is managing FILE's directory or one of |
307 |
(vc-cvs-responsible-p file)) |
its parents." |
308 |
|
(let ((dir file)) |
309 |
|
(while (and (stringp dir) |
310 |
|
(not (equal dir (setq dir (file-name-directory dir)))) |
311 |
|
dir) |
312 |
|
(setq dir (if (file-directory-p |
313 |
|
(expand-file-name "CVS/Entries" dir)) |
314 |
|
t (directory-file-name dir)))) |
315 |
|
(eq dir t))) |
316 |
|
|
317 |
(defun vc-cvs-checkin (file rev comment) |
(defun vc-cvs-checkin (file rev comment) |
318 |
"CVS-specific version of `vc-backend-checkin'." |
"CVS-specific version of `vc-backend-checkin'." |
319 |
(let ((switches (if (stringp vc-checkin-switches) |
(unless (or (not rev) (vc-cvs-valid-version-number-p rev)) |
320 |
(list vc-checkin-switches) |
(if (not (vc-cvs-valid-symbolic-tag-name-p rev)) |
321 |
vc-checkin-switches)) |
(error "%s is not a valid symbolic tag name" rev) |
322 |
status) |
;; If the input revison is a valid symbolic tag name, we create it |
323 |
;; explicit check-in to the trunk requires a double check-in (first |
;; as a branch, commit and switch to it. |
324 |
;; unexplicit) (CVS-1.3) |
(apply 'vc-cvs-command nil 0 file "tag" "-b" (list rev)) |
325 |
(if (and rev (vc-trunk-p rev)) |
(apply 'vc-cvs-command nil 0 file "update" "-r" (list rev)) |
326 |
(apply 'vc-do-command nil 1 "cvs" file |
(vc-file-setprop file 'vc-cvs-sticky-tag rev))) |
327 |
"ci" "-m" "intermediate" |
(let ((status (apply 'vc-cvs-command nil 1 file |
328 |
switches)) |
"ci" (if rev (concat "-r" rev)) |
329 |
(setq status (apply 'vc-do-command nil 1 "cvs" file |
(concat "-m" comment) |
330 |
"ci" (if rev (concat "-r" rev)) |
(vc-switches 'CVS 'checkin)))) |
|
(concat "-m" comment) |
|
|
switches)) |
|
331 |
(set-buffer "*vc*") |
(set-buffer "*vc*") |
332 |
(goto-char (point-min)) |
(goto-char (point-min)) |
333 |
(when (not (zerop status)) |
(when (not (zerop status)) |
352 |
;; tell it from the permissions of the file (see |
;; tell it from the permissions of the file (see |
353 |
;; vc-cvs-checkout-model). |
;; vc-cvs-checkout-model). |
354 |
(vc-file-setprop file 'vc-checkout-model nil) |
(vc-file-setprop file 'vc-checkout-model nil) |
355 |
;; if this was an explicit check-in, remove the sticky tag |
|
356 |
(if rev (vc-do-command nil 0 "cvs" file "update" "-A")))) |
;; if this was an explicit check-in (does not include creation of |
357 |
|
;; a branch), remove the sticky tag. |
358 |
|
(if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) |
359 |
|
(vc-cvs-command nil 0 file "update" "-A")))) |
360 |
|
|
361 |
|
(defun vc-cvs-find-version (file rev buffer) |
362 |
|
(apply 'vc-cvs-command |
363 |
|
buffer 0 file |
364 |
|
"-Q" ; suppress diagnostic output |
365 |
|
"update" |
366 |
|
(and rev (not (string= rev "")) |
367 |
|
(concat "-r" rev)) |
368 |
|
"-p" |
369 |
|
(vc-switches 'CVS 'checkout))) |
370 |
|
|
371 |
(defun vc-cvs-checkout (file &optional editable rev workfile) |
(defun vc-cvs-checkout (file &optional editable rev workfile) |
372 |
"Retrieve a revision of FILE into a WORKFILE. |
"Retrieve a revision of FILE into a WORKFILE. |
379 |
(save-excursion |
(save-excursion |
380 |
;; Change buffers to get local value of vc-checkout-switches. |
;; Change buffers to get local value of vc-checkout-switches. |
381 |
(if file-buffer (set-buffer file-buffer)) |
(if file-buffer (set-buffer file-buffer)) |
382 |
(setq switches (if (stringp vc-checkout-switches) |
(setq switches (vc-switches 'CVS 'checkout)) |
|
(list vc-checkout-switches) |
|
|
vc-checkout-switches)) |
|
383 |
;; Save this buffer's default-directory |
;; Save this buffer's default-directory |
384 |
;; and use save-excursion to make sure it is restored |
;; and use save-excursion to make sure it is restored |
385 |
;; in the same buffer it was saved in. |
;; in the same buffer it was saved in. |
403 |
(let ((coding-system-for-read 'no-conversion) |
(let ((coding-system-for-read 'no-conversion) |
404 |
(coding-system-for-write 'no-conversion)) |
(coding-system-for-write 'no-conversion)) |
405 |
(with-temp-file filename |
(with-temp-file filename |
406 |
(apply 'vc-do-command |
(apply 'vc-cvs-command |
407 |
(current-buffer) 0 "cvs" file |
(current-buffer) 0 file |
408 |
"-Q" ; suppress diagnostic output |
"-Q" ; suppress diagnostic output |
409 |
"update" |
"update" |
410 |
(and (stringp rev) |
(and (stringp rev) |
425 |
(if (and (file-exists-p file) (not rev)) |
(if (and (file-exists-p file) (not rev)) |
426 |
;; If no revision was specified, just make the file writable |
;; If no revision was specified, just make the file writable |
427 |
;; if necessary (using `cvs-edit' if requested). |
;; if necessary (using `cvs-edit' if requested). |
428 |
(and editable (not (eq (vc-cvs-checkout-model file) 'implicit)) |
(and editable (not (eq (vc-cvs-checkout-model file) 'implicit)) |
429 |
(if vc-cvs-use-edit |
(if vc-cvs-use-edit |
430 |
(vc-do-command nil 0 "cvs" file "edit") |
(vc-cvs-command nil 0 file "edit") |
431 |
(set-file-modes file (logior (file-modes file) 128)) |
(set-file-modes file (logior (file-modes file) 128)) |
432 |
(if file-buffer (toggle-read-only -1)))) |
(if file-buffer (toggle-read-only -1)))) |
433 |
;; Check out a particular version (or recreate the file). |
;; Check out a particular version (or recreate the file). |
434 |
(vc-file-setprop file 'vc-workfile-version nil) |
(vc-file-setprop file 'vc-workfile-version nil) |
435 |
(apply 'vc-do-command nil 0 "cvs" file |
(apply 'vc-cvs-command nil 0 file |
436 |
(and editable |
(and editable |
437 |
(or (not (file-exists-p file)) |
(or (not (file-exists-p file)) |
438 |
(not (eq (vc-cvs-checkout-model file) |
(not (eq (vc-cvs-checkout-model file) |
439 |
'implicit))) |
'implicit))) |
440 |
"-w") |
"-w") |
441 |
"update" |
"update" |
442 |
;; default for verbose checkout: clear the sticky tag so |
(when rev |
443 |
;; that the actual update will get the head of the trunk |
(unless (eq rev t) |
444 |
(if (or (not rev) (eq rev t) (string= rev "")) |
;; default for verbose checkout: clear the |
445 |
"-A" |
;; sticky tag so that the actual update will |
446 |
(concat "-r" rev)) |
;; get the head of the trunk |
447 |
|
(if (string= rev "") |
448 |
|
"-A" |
449 |
|
(concat "-r" rev)))) |
450 |
switches)))) |
switches)))) |
451 |
(vc-mode-line file) |
(vc-mode-line file) |
452 |
(message "Checking out %s...done" filename))))) |
(message "Checking out %s...done" filename))))) |
453 |
|
|
454 |
|
(defun vc-cvs-delete-file (file) |
455 |
|
(vc-cvs-command nil 0 file "remove" "-f")) |
456 |
|
|
457 |
(defun vc-cvs-revert (file &optional contents-done) |
(defun vc-cvs-revert (file &optional contents-done) |
458 |
"Revert FILE to the version it was based on." |
"Revert FILE to the version it was based on." |
459 |
(unless contents-done |
(unless contents-done |
462 |
(vc-cvs-checkout file nil (vc-workfile-version file) file)) |
(vc-cvs-checkout file nil (vc-workfile-version file) file)) |
463 |
(unless (eq (vc-checkout-model file) 'implicit) |
(unless (eq (vc-checkout-model file) 'implicit) |
464 |
(if vc-cvs-use-edit |
(if vc-cvs-use-edit |
465 |
(vc-do-command nil 0 "cvs" file "unedit") |
(vc-cvs-command nil 0 file "unedit") |
466 |
;; Make the file read-only by switching off all w-bits |
;; Make the file read-only by switching off all w-bits |
467 |
(set-file-modes file (logand (file-modes file) 3950))))) |
(set-file-modes file (logand (file-modes file) 3950))))) |
468 |
|
|
469 |
(defun vc-cvs-merge (file first-version &optional second-version) |
(defun vc-cvs-merge (file first-version &optional second-version) |
470 |
"Merge changes into current working copy of FILE. |
"Merge changes into current working copy of FILE. |
471 |
The changes are between FIRST-VERSION and SECOND-VERSION." |
The changes are between FIRST-VERSION and SECOND-VERSION." |
472 |
(vc-do-command nil 0 "cvs" file |
(vc-cvs-command nil 0 file |
473 |
"update" "-kk" |
"update" "-kk" |
474 |
(concat "-j" first-version) |
(concat "-j" first-version) |
475 |
(concat "-j" second-version)) |
(concat "-j" second-version)) |
476 |
(vc-file-setprop file 'vc-state 'edited) |
(vc-file-setprop file 'vc-state 'edited) |
477 |
(save-excursion |
(with-current-buffer (get-buffer "*vc*") |
|
(set-buffer (get-buffer "*vc*")) |
|
478 |
(goto-char (point-min)) |
(goto-char (point-min)) |
479 |
(if (re-search-forward "conflicts during merge" nil t) |
(if (re-search-forward "conflicts during merge" nil t) |
480 |
1 ; signal error |
1 ; signal error |
483 |
(defun vc-cvs-merge-news (file) |
(defun vc-cvs-merge-news (file) |
484 |
"Merge in any new changes made to FILE." |
"Merge in any new changes made to FILE." |
485 |
(message "Merging changes into %s..." file) |
(message "Merging changes into %s..." file) |
486 |
(save-excursion |
;; (vc-file-setprop file 'vc-workfile-version nil) |
487 |
;; (vc-file-setprop file 'vc-workfile-version nil) |
(vc-file-setprop file 'vc-checkout-time 0) |
488 |
(vc-file-setprop file 'vc-checkout-time 0) |
(vc-cvs-command nil 0 file "update") |
489 |
(vc-do-command nil 0 "cvs" file "update") |
;; Analyze the merge result reported by CVS, and set |
490 |
;; Analyze the merge result reported by CVS, and set |
;; file properties accordingly. |
491 |
;; file properties accordingly. |
(with-current-buffer (get-buffer "*vc*") |
|
(set-buffer (get-buffer "*vc*")) |
|
492 |
(goto-char (point-min)) |
(goto-char (point-min)) |
493 |
;; get new workfile version |
;; get new workfile version |
494 |
(if (re-search-forward (concat "^Merging differences between " |
(if (re-search-forward |
495 |
"[01234567890.]* and " |
"^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t) |
|
"\\([01234567890.]*\\) into") |
|
|
nil t) |
|
496 |
(vc-file-setprop file 'vc-workfile-version (match-string 1)) |
(vc-file-setprop file 'vc-workfile-version (match-string 1)) |
497 |
(vc-file-setprop file 'vc-workfile-version nil)) |
(vc-file-setprop file 'vc-workfile-version nil)) |
498 |
;; get file status |
;; get file status |
531 |
;;; History functions |
;;; History functions |
532 |
;;; |
;;; |
533 |
|
|
534 |
(defun vc-cvs-print-log (file) |
(defun vc-cvs-print-log (file &optional buffer) |
535 |
"Get change log associated with FILE." |
"Get change log associated with FILE." |
536 |
(vc-do-command |
(vc-cvs-command |
537 |
nil |
buffer |
538 |
(if (and (vc-cvs-stay-local-p file) (fboundp 'start-process)) 'async 0) |
(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) |
539 |
"cvs" file "log")) |
file "log")) |
|
|
|
|
(defun vc-cvs-show-log-entry (version) |
|
|
(when (re-search-forward |
|
|
;; also match some context, for safety |
|
|
(concat "----\nrevision " version |
|
|
"\\(\tlocked by:.*\n\\|\n\\)date: ") nil t) |
|
|
;; set the display window so that |
|
|
;; the whole log entry is displayed |
|
|
(let (start end lines) |
|
|
(beginning-of-line) (forward-line -1) (setq start (point)) |
|
|
(if (not (re-search-forward "^----*\nrevision" nil t)) |
|
|
(setq end (point-max)) |
|
|
(beginning-of-line) (forward-line -1) (setq end (point))) |
|
|
(setq lines (count-lines start end)) |
|
|
(cond |
|
|
;; if the global information and this log entry fit |
|
|
;; into the window, display from the beginning |
|
|
((< (count-lines (point-min) end) (window-height)) |
|
|
(goto-char (point-min)) |
|
|
(recenter 0) |
|
|
(goto-char start)) |
|
|
;; if the whole entry fits into the window, |
|
|
;; display it centered |
|
|
((< (1+ lines) (window-height)) |
|
|
(goto-char start) |
|
|
(recenter (1- (- (/ (window-height) 2) (/ lines 2))))) |
|
|
;; otherwise (the entry is too large for the window), |
|
|
;; display from the start |
|
|
(t |
|
|
(goto-char start) |
|
|
(recenter 0)))))) |
|
540 |
|
|
541 |
(defun vc-cvs-diff (file &optional oldvers newvers) |
(defun vc-cvs-diff (file &optional oldvers newvers buffer) |
542 |
"Get a difference report using CVS between two versions of FILE." |
"Get a difference report using CVS between two versions of FILE." |
543 |
(let (options status (diff-switches-list (vc-diff-switches-list cvs))) |
(if (string= (vc-workfile-version file) "0") |
544 |
(if (string= (vc-workfile-version file) "0") |
;; This file is added but not yet committed; there is no master file. |
545 |
;; This file is added but not yet committed; there is no master file. |
(if (or oldvers newvers) |
546 |
(if (or oldvers newvers) |
(error "No revisions of %s exist" file) |
547 |
(error "No revisions of %s exist" file) |
;; We regard this as "changed". |
548 |
;; we regard this as "changed". |
;; Diff it against /dev/null. |
549 |
;; diff it against /dev/null. |
;; Note: this is NOT a "cvs diff". |
550 |
(apply 'vc-do-command "*vc-diff*" |
(apply 'vc-do-command (or buffer "*vc-diff*") |
551 |
1 "diff" file |
1 "diff" file |
552 |
(append diff-switches-list '("/dev/null")))) |
(append (vc-switches nil 'diff) '("/dev/null"))) |
553 |
(setq status |
;; Even if it's empty, it's locally modified. |
554 |
(apply 'vc-do-command "*vc-diff*" |
1) |
555 |
(if (and (vc-cvs-stay-local-p file) |
(let* ((async (and (not vc-disable-async-diff) |
556 |
(fboundp 'start-process)) |
(vc-stay-local-p file) |
557 |
'async |
(fboundp 'start-process))) |
558 |
1) |
(status (apply 'vc-cvs-command (or buffer "*vc-diff*") |
559 |
"cvs" file "diff" |
(if async 'async 1) |
560 |
(and oldvers (concat "-r" oldvers)) |
file "diff" |
561 |
(and newvers (concat "-r" newvers)) |
(and oldvers (concat "-r" oldvers)) |
562 |
diff-switches-list)) |
(and newvers (concat "-r" newvers)) |
563 |
(if (vc-cvs-stay-local-p file) |
(vc-switches 'CVS 'diff)))) |
564 |
1 ;; async diff, pessimistic assumption |
(if async 1 status)))) ; async diff, pessimistic assumption |
|
status)))) |
|
565 |
|
|
566 |
(defun vc-cvs-diff-tree (dir &optional rev1 rev2) |
(defun vc-cvs-diff-tree (dir &optional rev1 rev2) |
567 |
"Diff all files at and below DIR." |
"Diff all files at and below DIR." |
568 |
(with-current-buffer "*vc-diff*" |
(with-current-buffer "*vc-diff*" |
569 |
(setq default-directory dir) |
(setq default-directory dir) |
570 |
(if (vc-cvs-stay-local-p dir) |
(if (vc-stay-local-p dir) |
571 |
;; local diff: do it filewise, and only for files that are modified |
;; local diff: do it filewise, and only for files that are modified |
572 |
(vc-file-tree-walk |
(vc-file-tree-walk |
573 |
dir |
dir |
578 |
;; in the tree via vc-cvs-dir-state-heuristic |
;; in the tree via vc-cvs-dir-state-heuristic |
579 |
(unless (vc-up-to-date-p ',f) |
(unless (vc-up-to-date-p ',f) |
580 |
(message "Looking at %s" ',f) |
(message "Looking at %s" ',f) |
581 |
(vc-diff-internal ',f ',rel1 ',rel2)))))) |
(vc-diff-internal ',f ',rev1 ',rev2)))))) |
582 |
;; cvs diff: use a single call for the entire tree |
;; cvs diff: use a single call for the entire tree |
583 |
(let ((coding-system-for-read |
(let ((coding-system-for-read |
584 |
(or coding-system-for-read 'undecided))) |
(or coding-system-for-read 'undecided))) |
585 |
(apply 'vc-do-command "*vc-diff*" 1 "cvs" nil "diff" |
(apply 'vc-cvs-command "*vc-diff*" 1 nil "diff" |
586 |
(and rel1 (concat "-r" rel1)) |
(and rev1 (concat "-r" rev1)) |
587 |
(and rel2 (concat "-r" rel2)) |
(and rev2 (concat "-r" rev2)) |
588 |
(vc-diff-switches-list cvs)))))) |
(vc-switches 'CVS 'diff)))))) |
589 |
|
|
590 |
(defun vc-cvs-annotate-command (file buffer &optional version) |
(defun vc-cvs-annotate-command (file buffer &optional version) |
591 |
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. |
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. |
592 |
Optional arg VERSION is a version to annotate from." |
Optional arg VERSION is a version to annotate from." |
593 |
(vc-do-command buffer 0 "cvs" file "annotate" (if version |
(vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version))) |
594 |
(concat "-r" version)))) |
(with-current-buffer buffer |
595 |
|
(goto-char (point-min)) |
596 |
|
(re-search-forward "^[0-9]") |
597 |
|
(delete-region (point-min) (1- (point))))) |
598 |
|
|
599 |
(defun vc-cvs-annotate-difference (point) |
(defun vc-cvs-annotate-current-time () |
600 |
"Return the difference between the time of the line and the current time. |
"Return the current time, based at midnight of the current day, and |
601 |
Return values are as defined for `current-time'." |
encoded as fractional days." |
602 |
;; We need a list of months and their corresponding numbers. |
(vc-annotate-convert-time |
603 |
(if (looking-at "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ") |
(apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) |
604 |
(progn |
|
605 |
(let* ((day (string-to-number (match-string 1))) |
(defun vc-cvs-annotate-time () |
606 |
(month (cdr (assoc (match-string 2) vc-cvs-local-month-numbers))) |
"Return the time of the next annotation (as fraction of days) |
607 |
(year-tmp (string-to-number (match-string 3))) |
systime, or nil if there is none." |
608 |
;; Years 0..68 are 2000..2068. |
(let* ((bol (point)) |
609 |
;; Years 69..99 are 1969..1999. |
(cache (get-text-property bol 'vc-cvs-annotate-time)) |
610 |
(year (+ (cond ((> 69 year-tmp) 2000) |
buffer-read-only) |
611 |
((> 100 year-tmp) 1900) |
(cond |
612 |
(t 0)) |
(cache) |
613 |
year-tmp))) |
((looking-at |
614 |
(goto-char (match-end 0)) ; Position at end makes for nicer overlay result |
"^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ") |
615 |
(- (car (current-time)) |
(let ((day (string-to-number (match-string 1))) |
616 |
(car (encode-time 0 0 0 day month year))))) |
(month (cdr (assq (intern (match-string 2)) |
617 |
;; If we did not look directly at an annotation, there might be |
'((Jan . 1) (Feb . 2) (Mar . 3) |
618 |
;; some further down. This is the case if we are positioned at |
(Apr . 4) (May . 5) (Jun . 6) |
619 |
;; the very top of the buffer, for instance. |
(Jul . 7) (Aug . 8) (Sep . 9) |
620 |
(if (re-search-forward |
(Oct . 10) (Nov . 11) (Dec . 12))))) |
621 |
"^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): " nil t) |
(year (let ((tmp (string-to-number (match-string 3)))) |
622 |
(progn |
;; Years 0..68 are 2000..2068. |
623 |
(beginning-of-line nil) |
;; Years 69..99 are 1969..1999. |
624 |
(vc-cvs-annotate-difference (point)))))) |
(+ (cond ((> 69 tmp) 2000) |
625 |
|
((> 100 tmp) 1900) |
626 |
|
(t 0)) |
627 |
|
tmp)))) |
628 |
|
(put-text-property |
629 |
|
bol (1+ bol) 'vc-cvs-annotate-time |
630 |
|
(setq cache (cons |
631 |
|
;; Position at end makes for nicer overlay result. |
632 |
|
(match-end 0) |
633 |
|
(vc-annotate-convert-time |
634 |
|
(encode-time 0 0 0 day month year)))))))) |
635 |
|
(when cache |
636 |
|
(goto-char (car cache)) ; fontify from here to eol |
637 |
|
(cdr cache)))) ; days (float) |
638 |
|
|
639 |
|
(defun vc-cvs-annotate-extract-revision-at-line () |
640 |
|
(save-excursion |
641 |
|
(beginning-of-line) |
642 |
|
(if (re-search-forward "^\\([0-9]+\\.[0-9]+\\(\\.[0-9]+\\)*\\) +(" |
643 |
|
(line-end-position) t) |
644 |
|
(match-string-no-properties 1) |
645 |
|
nil))) |
646 |
|
|
647 |
;;; |
;;; |
648 |
;;; Snapshot system |
;;; Snapshot system |
652 |
"Assign to DIR's current version a given NAME. |
"Assign to DIR's current version a given NAME. |
653 |
If BRANCHP is non-nil, the name is created as a branch (and the current |
If BRANCHP is non-nil, the name is created as a branch (and the current |
654 |
workspace is immediately moved to that new branch)." |
workspace is immediately moved to that new branch)." |
655 |
(vc-do-command nil 0 "cvs" dir "tag" "-c" (if branchp "-b") name) |
(vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name) |
656 |
(when branchp (vc-do-command nil 0 "cvs" dir "update" "-r" name))) |
(when branchp (vc-cvs-command nil 0 dir "update" "-r" name))) |
657 |
|
|
658 |
(defun vc-cvs-retrieve-snapshot (dir name update) |
(defun vc-cvs-retrieve-snapshot (dir name update) |
659 |
"Retrieve a snapshot at and below DIR. |
"Retrieve a snapshot at and below DIR. |
660 |
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'. |
661 |
If UPDATE is non-nil, then update (resynch) any affected buffers." |
If UPDATE is non-nil, then update (resynch) any affected buffers." |
662 |
(with-current-buffer (get-buffer-create "*vc*") |
(with-current-buffer (get-buffer-create "*vc*") |
663 |
(let ((default-directory dir)) |
(let ((default-directory dir) |
664 |
|
(sticky-tag)) |
665 |
(erase-buffer) |
(erase-buffer) |
666 |
(if (or (not name) (string= name "")) |
(if (or (not name) (string= name "")) |
667 |
(vc-do-command t 0 "cvs" nil "update") |
(vc-cvs-command t 0 nil "update") |
668 |
(vc-do-command t 0 "cvs" nil "update" "-r" name)) |
(vc-cvs-command t 0 nil "update" "-r" name) |
669 |
|
(setq sticky-tag name)) |
670 |
(when update |
(when update |
671 |
(goto-char (point-min)) |
(goto-char (point-min)) |
672 |
(while (not (eobp)) |
(while (not (eobp)) |
687 |
(vc-file-setprop file 'vc-state 'edited) |
(vc-file-setprop file 'vc-state 'edited) |
688 |
(vc-file-setprop file 'vc-workfile-version nil) |
(vc-file-setprop file 'vc-workfile-version nil) |
689 |
(vc-file-setprop file 'vc-checkout-time 0))) |
(vc-file-setprop file 'vc-checkout-time 0))) |
690 |
|
(vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag) |
691 |
(vc-resynch-buffer file t t)))) |
(vc-resynch-buffer file t t)))) |
692 |
(forward-line 1)))))) |
(forward-line 1)))))) |
693 |
|
|
696 |
;;; Miscellaneous |
;;; Miscellaneous |
697 |
;;; |
;;; |
698 |
|
|
699 |
(defun vc-cvs-make-version-backups-p (file) |
(defalias 'vc-cvs-make-version-backups-p 'vc-stay-local-p |
700 |
"Return non-nil if version backups should be made for FILE." |
"Return non-nil if version backups should be made for FILE.") |
|
(vc-cvs-stay-local-p file)) |
|
701 |
|
|
702 |
(defun vc-cvs-check-headers () |
(defun vc-cvs-check-headers () |
703 |
"Check if the current file has any headers in it." |
"Check if the current file has any headers in it." |
711 |
;;; Internal functions |
;;; Internal functions |
712 |
;;; |
;;; |
713 |
|
|
714 |
(defun vc-cvs-stay-local-p (file) |
(defun vc-cvs-command (buffer okstatus file &rest flags) |
715 |
"Return non-nil if VC should stay local when handling FILE." |
"A wrapper around `vc-do-command' for use in vc-cvs.el. |
716 |
(if vc-cvs-stay-local |
The difference to vc-do-command is that this function always invokes `cvs', |
717 |
(let* ((dirname (if (file-directory-p file) |
and that it passes `vc-cvs-global-switches' to it before FLAGS." |
718 |
(directory-file-name file) |
(apply 'vc-do-command buffer okstatus "cvs" file |
719 |
(file-name-directory file))) |
(if (stringp vc-cvs-global-switches) |
720 |
(prop |
(cons vc-cvs-global-switches flags) |
721 |
(or (vc-file-getprop dirname 'vc-cvs-stay-local-p) |
(append vc-cvs-global-switches |
722 |
(let ((rootname (expand-file-name "CVS/Root" dirname))) |
flags)))) |
723 |
(vc-file-setprop |
|
724 |
dirname 'vc-cvs-stay-local-p |
(defalias 'vc-cvs-stay-local-p 'vc-stay-local-p) ;Back-compatibility. |
725 |
(when (file-readable-p rootname) |
|
726 |
(with-temp-buffer |
(defun vc-cvs-repository-hostname (dirname) |
727 |
(vc-insert-file rootname) |
"Hostname of the CVS server associated to workarea DIRNAME." |
728 |
(goto-char (point-min)) |
(let ((rootname (expand-file-name "CVS/Root" dirname))) |
729 |
(if (looking-at "\\([^:]*\\):") |
(when (file-readable-p rootname) |
730 |
(if (not (stringp vc-cvs-stay-local)) |
(with-temp-buffer |
731 |
'yes |
(let ((coding-system-for-read |
732 |
(let ((hostname (match-string 1))) |
(or file-name-coding-system |
733 |
(if (string-match vc-cvs-stay-local hostname) |
default-file-name-coding-system))) |
734 |
'yes |
(vc-insert-file rootname)) |
735 |
'no))) |
(goto-char (point-min)) |
736 |
'no)))))))) |
(nth 2 (vc-cvs-parse-root |
737 |
(if (eq prop 'yes) t nil)))) |
(buffer-substring (point) |
738 |
|
(line-end-position)))))))) |
739 |
|
|
740 |
|
(defun vc-cvs-parse-root (root) |
741 |
|
"Split CVS ROOT specification string into a list of fields. |
742 |
|
A CVS root specification of the form |
743 |
|
[:METHOD:][[USER@]HOSTNAME:]/path/to/repository |
744 |
|
is converted to a normalized record with the following structure: |
745 |
|
\(METHOD USER HOSTNAME CVS-ROOT). |
746 |
|
The default METHOD for a CVS root of the form |
747 |
|
/path/to/repository |
748 |
|
is `local'. |
749 |
|
The default METHOD for a CVS root of the form |
750 |
|
[USER@]HOSTNAME:/path/to/repository |
751 |
|
is `ext'. |
752 |
|
For an empty string, nil is returned (invalid CVS root)." |
753 |
|
;; Split CVS root into colon separated fields (0-4). |
754 |
|
;; The `x:' makes sure, that leading colons are not lost; |
755 |
|
;; `HOST:/PATH' is then different from `:METHOD:/PATH'. |
756 |
|
(let* ((root-list (cdr (split-string (concat "x:" root) ":"))) |
757 |
|
(len (length root-list)) |
758 |
|
;; All syntactic varieties will get a proper METHOD. |
759 |
|
(root-list |
760 |
|
(cond |
761 |
|
((= len 0) |
762 |
|
;; Invalid CVS root |
763 |
|
nil) |
764 |
|
((= len 1) |
765 |
|
;; Simple PATH => method `local' |
766 |
|
(cons "local" |
767 |
|
(cons nil root-list))) |
768 |
|
((= len 2) |
769 |
|
;; [USER@]HOST:PATH => method `ext' |
770 |
|
(and (not (equal (car root-list) "")) |
771 |
|
(cons "ext" root-list))) |
772 |
|
((= len 3) |
773 |
|
;; :METHOD:PATH |
774 |
|
(cons (cadr root-list) |
775 |
|
(cons nil (cddr root-list)))) |
776 |
|
(t |
777 |
|
;; :METHOD:[USER@]HOST:PATH |
778 |
|
(cdr root-list))))) |
779 |
|
(if root-list |
780 |
|
(let ((method (car root-list)) |
781 |
|
(uhost (or (cadr root-list) "")) |
782 |
|
(root (nth 2 root-list)) |
783 |
|
user host) |
784 |
|
;; Split USER@HOST |
785 |
|
(if (string-match "\\(.*\\)@\\(.*\\)" uhost) |
786 |
|
(setq user (match-string 1 uhost) |
787 |
|
host (match-string 2 uhost)) |
788 |
|
(setq host uhost)) |
789 |
|
;; Remove empty HOST |
790 |
|
(and (equal host "") |
791 |
|
(setq host)) |
792 |
|
;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir' |
793 |
|
(and host |
794 |
|
(equal method "local") |
795 |
|
(setq root (concat host ":" root) host)) |
796 |
|
;; Normalize CVS root record |
797 |
|
(list method user host root))))) |
798 |
|
|
799 |
(defun vc-cvs-parse-status (&optional full) |
(defun vc-cvs-parse-status (&optional full) |
800 |
"Parse output of \"cvs status\" command in the current buffer. |
"Parse output of \"cvs status\" command in the current buffer. |
817 |
\[\t ]+\\([0-9.]+\\)" |
\[\t ]+\\([0-9.]+\\)" |
818 |
nil t)) |
nil t)) |
819 |
(vc-file-setprop file 'vc-latest-version (match-string 2))) |
(vc-file-setprop file 'vc-latest-version (match-string 2))) |
820 |
(vc-file-setprop |
(vc-file-setprop |
821 |
file 'vc-state |
file 'vc-state |
822 |
(cond |
(cond |
823 |
((string-match "Up-to-date" status) |
((string-match "Up-to-date" status) |
832 |
(defun vc-cvs-dir-state-heuristic (dir) |
(defun vc-cvs-dir-state-heuristic (dir) |
833 |
"Find the CVS state of all files in DIR, using only local information." |
"Find the CVS state of all files in DIR, using only local information." |
834 |
(with-temp-buffer |
(with-temp-buffer |
835 |
(vc-insert-file (expand-file-name "CVS/Entries" dir)) |
(vc-cvs-get-entries dir) |
836 |
(goto-char (point-min)) |
(goto-char (point-min)) |
837 |
(while (not (eobp)) |
(while (not (eobp)) |
838 |
(when (looking-at "/\\([^/]*\\)/") |
;; CVS-removed files are not taken under VC control. |
839 |
|
(when (looking-at "/\\([^/]*\\)/[^/-]") |
840 |
(let ((file (expand-file-name (match-string 1) dir))) |
(let ((file (expand-file-name (match-string 1) dir))) |
841 |
(unless (vc-file-getprop file 'vc-state) |
(unless (vc-file-getprop file 'vc-state) |
842 |
(vc-cvs-parse-entry file t)))) |
(vc-cvs-parse-entry file t)))) |
843 |
(forward-line 1)))) |
(forward-line 1)))) |
844 |
|
|
845 |
|
(defun vc-cvs-get-entries (dir) |
846 |
|
"Insert the CVS/Entries file from below DIR into the current buffer. |
847 |
|
This function ensures that the correct coding system is used for that, |
848 |
|
which may not be the one that is used for the files' contents. |
849 |
|
CVS/Entries should only be accessed through this function." |
850 |
|
(let ((coding-system-for-read (or file-name-coding-system |
851 |
|
default-file-name-coding-system))) |
852 |
|
(vc-insert-file (expand-file-name "CVS/Entries" dir)))) |
853 |
|
|
854 |
|
(defun vc-cvs-valid-symbolic-tag-name-p (tag) |
855 |
|
"Return non-nil if TAG is a valid symbolic tag name." |
856 |
|
;; According to the CVS manual, a valid symbolic tag must start with |
857 |
|
;; an uppercase or lowercase letter and can contain uppercase and |
858 |
|
;; lowercase letters, digits, `-', and `_'. |
859 |
|
(and (string-match "^[a-zA-Z]" tag) |
860 |
|
(not (string-match "[^a-z0-9A-Z-_]" tag)))) |
861 |
|
|
862 |
|
(defun vc-cvs-valid-version-number-p (tag) |
863 |
|
"Return non-nil if TAG is a valid version number." |
864 |
|
(and (string-match "^[0-9]" tag) |
865 |
|
(not (string-match "[^0-9.]" tag)))) |
866 |
|
|
867 |
|
(defun vc-cvs-parse-sticky-tag (match-type match-tag) |
868 |
|
"Parse and return the sticky tag as a string. |
869 |
|
`match-data' is protected." |
870 |
|
(let ((data (match-data)) |
871 |
|
(tag) |
872 |
|
(type (cond ((string= match-type "D") 'date) |
873 |
|
((string= match-type "T") |
874 |
|
(if (vc-cvs-valid-symbolic-tag-name-p match-tag) |
875 |
|
'symbolic-name |
876 |
|
'revision-number)) |
877 |
|
(t nil)))) |
878 |
|
(unwind-protect |
879 |
|
(progn |
880 |
|
(cond |
881 |
|
;; Sticky Date tag. Convert to a proper date value (`encode-time') |
882 |
|
((eq type 'date) |
883 |
|
(string-match |
884 |
|
"\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)" |
885 |
|
match-tag) |
886 |
|
(let* ((year-tmp (string-to-number (match-string 1 match-tag))) |
887 |
|
(month (string-to-number (match-string 2 match-tag))) |
888 |
|
(day (string-to-number (match-string 3 match-tag))) |
889 |
|
(hour (string-to-number (match-string 4 match-tag))) |
890 |
|
(min (string-to-number (match-string 5 match-tag))) |
891 |
|
(sec (string-to-number (match-string 6 match-tag))) |
892 |
|
;; Years 0..68 are 2000..2068. |
893 |
|
;; Years 69..99 are 1969..1999. |
894 |
|
(year (+ (cond ((> 69 year-tmp) 2000) |
895 |
|
((> 100 year-tmp) 1900) |
896 |
|
(t 0)) |
897 |
|
year-tmp))) |
898 |
|
(setq tag (encode-time sec min hour day month year)))) |
899 |
|
;; Sticky Tag name or revision number |
900 |
|
((eq type 'symbolic-name) (setq tag match-tag)) |
901 |
|
((eq type 'revision-number) (setq tag match-tag)) |
902 |
|
;; Default is no sticky tag at all |
903 |
|
(t nil)) |
904 |
|
(cond ((eq vc-cvs-sticky-tag-display nil) nil) |
905 |
|
((eq vc-cvs-sticky-tag-display t) |
906 |
|
(cond ((eq type 'date) (format-time-string |
907 |
|
vc-cvs-sticky-date-format-string |
908 |
|
tag)) |
909 |
|
((eq type 'symbolic-name) tag) |
910 |
|
((eq type 'revision-number) tag) |
911 |
|
(t nil))) |
912 |
|
((functionp vc-cvs-sticky-tag-display) |
913 |
|
(funcall vc-cvs-sticky-tag-display tag type)) |
914 |
|
(t nil))) |
915 |
|
|
916 |
|
(set-match-data data)))) |
917 |
|
|
918 |
(defun vc-cvs-parse-entry (file &optional set-state) |
(defun vc-cvs-parse-entry (file &optional set-state) |
919 |
"Parse a line from CVS/Entries. |
"Parse a line from CVS/Entries. |
920 |
Compare modification time to that of the FILE, set file properties |
Compare modification time to that of the FILE, set file properties |
931 |
(concat "/[^/]+" |
(concat "/[^/]+" |
932 |
;; revision |
;; revision |
933 |
"/\\([^/]*\\)" |
"/\\([^/]*\\)" |
934 |
;; timestamp |
;; timestamp and optional conflict field |
935 |
"/[A-Z][a-z][a-z]" ;; week day (irrelevant) |
"/\\([^/]*\\)/" |
936 |
" \\([A-Z][a-z][a-z]\\)" ;; month name |
;; options |
937 |
" *\\([0-9]*\\)" ;; day of month |
"\\([^/]*\\)/" |
938 |
" \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)" ;; hms |
;; sticky tag |
939 |
" \\([0-9]*\\)" ;; year |
"\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) |
940 |
;; optional conflict field |
"\\(.*\\)")) ;Sticky tag |
|
"\\(+[^/]*\\)?/")) |
|
|
(vc-file-setprop file 'vc-workfile-version (match-string 1)) |
|
|
;; compare checkout time and modification time |
|
|
(let ((second (string-to-number (match-string 6))) |
|
|
(minute (string-to-number (match-string 5))) |
|
|
(hour (string-to-number (match-string 4))) |
|
|
(day (string-to-number (match-string 3))) |
|
|
(year (string-to-number (match-string 7))) |
|
|
(month (/ (string-match |
|
|
(match-string 2) |
|
|
"xxxJanFebMarAprMayJunJulAugSepOctNovDec") |
|
|
3)) |
|
|
(mtime (nth 5 (file-attributes file)))) |
|
|
(cond ((equal mtime |
|
|
(encode-time second minute hour day month year 0)) |
|
|
(vc-file-setprop file 'vc-checkout-time mtime) |
|
|
(if set-state (vc-file-setprop file 'vc-state 'up-to-date))) |
|
|
(t |
|
|
(vc-file-setprop file 'vc-checkout-time 0) |
|
|
(if set-state (vc-file-setprop file 'vc-state 'edited)))))) |
|
|
;; entry with arbitrary text as timestamp |
|
|
;; (this means we should consider it modified) |
|
|
((looking-at |
|
|
(concat "/[^/]+" |
|
|
;; revision |
|
|
"/\\([^/]*\\)" |
|
|
;; timestamp (arbitrary text) |
|
|
"/[^/]*" |
|
|
;; optional conflict field |
|
|
"\\(+[^/]*\\)?/")) |
|
941 |
(vc-file-setprop file 'vc-workfile-version (match-string 1)) |
(vc-file-setprop file 'vc-workfile-version (match-string 1)) |
942 |
(vc-file-setprop file 'vc-checkout-time 0) |
(vc-file-setprop file 'vc-cvs-sticky-tag |
943 |
(if set-state (vc-file-setprop file 'vc-state 'edited))))) |
(vc-cvs-parse-sticky-tag (match-string 4) |
944 |
|
(match-string 5))) |
945 |
|
;; Compare checkout time and modification time. |
946 |
|
;; This is intentionally different from the algorithm that CVS uses |
947 |
|
;; (which is based on textual comparison), because there can be problems |
948 |
|
;; generating a time string that looks exactly like the one from CVS. |
949 |
|
(let ((mtime (nth 5 (file-attributes file)))) |
950 |
|
(require 'parse-time) |
951 |
|
(let ((parsed-time |
952 |
|
(parse-time-string (concat (match-string 2) " +0000")))) |
953 |
|
(cond ((and (not (string-match "\\+" (match-string 2))) |
954 |
|
(car parsed-time) |
955 |
|
(equal mtime (apply 'encode-time parsed-time))) |
956 |
|
(vc-file-setprop file 'vc-checkout-time mtime) |
957 |
|
(if set-state (vc-file-setprop file 'vc-state 'up-to-date))) |
958 |
|
(t |
959 |
|
(vc-file-setprop file 'vc-checkout-time 0) |
960 |
|
(if set-state (vc-file-setprop file 'vc-state 'edited))))))))) |
961 |
|
|
962 |
(provide 'vc-cvs) |
(provide 'vc-cvs) |
963 |
|
|
964 |
|
;;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432 |
965 |
;;; vc-cvs.el ends here |
;;; vc-cvs.el ends here |