Commit | Line | Data |
---|---|---|
c1b25099 GM |
1 | ;;; vc-cvs.el --- non-resident support for CVS version-control |
2 | ||
0d30b337 | 3 | ;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, |
d58107b0 | 4 | ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
c1b25099 GM |
5 | |
6 | ;; Author: FSF (see vc.el for full credits) | |
7 | ;; Maintainer: Andre Spiegel <spiegel@gnu.org> | |
8 | ||
bc99a968 | 9 | ;; $Id$ |
c1b25099 GM |
10 | |
11 | ;; This file is part of GNU Emacs. | |
12 | ||
eb3fa2cf | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c1b25099 | 14 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
c1b25099 GM |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c1b25099 GM |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;;; Code: | |
29 | ||
2346acf6 | 30 | (eval-when-compile (require 'cl) (require 'vc)) |
89e65817 | 31 | |
98ad325c SM |
32 | ;; Clear up the cache to force vc-call to check again and discover |
33 | ;; new functions when we reload this file. | |
34 | (put 'CVS 'vc-functions nil) | |
35 | ||
70e2f6c7 ER |
36 | ;;; Properties of the backend. |
37 | ||
38 | (defun vc-cvs-revision-granularity () 'file) | |
39 | ||
40 | (defun vc-cvs-checkout-model (files) | |
41 | "CVS-specific version of `vc-checkout-model'." | |
42 | (if (getenv "CVSREAD") | |
43 | 'announce | |
44 | (let* ((file (if (consp files) (car files) files)) | |
45 | (attrib (file-attributes file))) | |
46 | (or (vc-file-getprop file 'vc-checkout-model) | |
47 | (vc-file-setprop | |
48 | file 'vc-checkout-model | |
49 | (if (and attrib ;; don't check further if FILE doesn't exist | |
50 | ;; If the file is not writable (despite CVSREAD being | |
51 | ;; undefined), this is probably because the file is being | |
52 | ;; "watched" by other developers. | |
53 | ;; (If vc-mistrust-permissions was t, we actually shouldn't | |
54 | ;; trust this, but there is no other way to learn this from | |
55 | ;; CVS at the moment (version 1.9).) | |
56 | (string-match "r-..-..-." (nth 8 attrib))) | |
57 | 'announce | |
58 | 'implicit)))))) | |
59 | ||
9b0630e5 | 60 | ;;; |
8f98485f AS |
61 | ;;; Customization options |
62 | ;;; | |
63 | ||
bbce0417 AS |
64 | (defcustom vc-cvs-global-switches nil |
65 | "*Global switches to pass to any CVS command." | |
66 | :type '(choice (const :tag "None" nil) | |
67 | (string :tag "Argument String") | |
68 | (repeat :tag "Argument List" | |
69 | :value ("") | |
70 | string)) | |
bf247b6e | 71 | :version "22.1" |
bbce0417 AS |
72 | :group 'vc) |
73 | ||
c1b25099 GM |
74 | (defcustom vc-cvs-register-switches nil |
75 | "*Extra switches for registering a file into CVS. | |
76 | A string or list of strings passed to the checkin program by | |
77 | \\[vc-register]." | |
78 | :type '(choice (const :tag "None" nil) | |
79 | (string :tag "Argument String") | |
80 | (repeat :tag "Argument List" | |
81 | :value ("") | |
82 | string)) | |
0d685c4f | 83 | :version "21.1" |
c1b25099 GM |
84 | :group 'vc) |
85 | ||
633147f5 AS |
86 | (defcustom vc-cvs-diff-switches nil |
87 | "*A string or list of strings specifying extra switches for cvs diff under VC." | |
88 | :type '(choice (const :tag "None" nil) | |
89 | (string :tag "Argument String") | |
90 | (repeat :tag "Argument List" | |
91 | :value ("") | |
92 | string)) | |
93 | :version "21.1" | |
94 | :group 'vc) | |
95 | ||
c1b25099 GM |
96 | (defcustom vc-cvs-header (or (cdr (assoc 'CVS vc-header-alist)) '("\$Id\$")) |
97 | "*Header keywords to be inserted by `vc-insert-headers'." | |
0d685c4f | 98 | :version "21.1" |
ee3275df | 99 | :type '(repeat string) |
c1b25099 GM |
100 | :group 'vc) |
101 | ||
102 | (defcustom vc-cvs-use-edit t | |
103 | "*Non-nil means to use `cvs edit' to \"check out\" a file. | |
104 | This is only meaningful if you don't use the implicit checkout model | |
105 | \(i.e. if you have $CVSREAD set)." | |
106 | :type 'boolean | |
0d685c4f | 107 | :version "21.1" |
c1b25099 GM |
108 | :group 'vc) |
109 | ||
f354c160 | 110 | (defcustom vc-cvs-stay-local t |
0d685c4f | 111 | "*Non-nil means use local operations when possible for remote repositories. |
c6a84d17 SM |
112 | This avoids slow queries over the network and instead uses heuristics |
113 | and past information to determine the current status of a file. | |
f354c160 | 114 | |
d3ed06c6 AS |
115 | The value can also be a regular expression or list of regular |
116 | expressions to match against the host name of a repository; then VC | |
f354c160 | 117 | only stays local for hosts that match it. Alternatively, the value |
bc99a968 TTN |
118 | can be a list of regular expressions where the first element is the |
119 | symbol `except'; then VC always stays local except for hosts matched | |
f354c160 | 120 | by these regular expressions." |
c1b25099 | 121 | :type '(choice (const :tag "Always stay local" t) |
d3ed06c6 | 122 | (const :tag "Don't stay local" nil) |
bc99a968 | 123 | (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." |
d3ed06c6 AS |
124 | (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) |
125 | (regexp :format " stay local,\n%t: %v" :tag "if it matches") | |
126 | (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) | |
0d685c4f | 127 | :version "21.1" |
c1b25099 GM |
128 | :group 'vc) |
129 | ||
51af12fc AS |
130 | (defcustom vc-cvs-sticky-date-format-string "%c" |
131 | "*Format string for mode-line display of sticky date. | |
132 | Format is according to `format-time-string'. Only used if | |
133 | `vc-cvs-sticky-tag-display' is t." | |
134 | :type '(string) | |
bf247b6e | 135 | :version "22.1" |
51af12fc AS |
136 | :group 'vc) |
137 | ||
138 | (defcustom vc-cvs-sticky-tag-display t | |
139 | "*Specify the mode-line display of sticky tags. | |
140 | Value t means default display, nil means no display at all. If the | |
141 | value is a function or macro, it is called with the sticky tag and | |
142 | its' type as parameters, in that order. TYPE can have three different | |
143 | values: `symbolic-name' (TAG is a string), `revision-number' (TAG is a | |
144 | string) and `date' (TAG is a date as returned by `encode-time'). The | |
145 | return value of the function or macro will be displayed as a string. | |
146 | ||
147 | Here's an example that will display the formatted date for sticky | |
148 | dates and the word \"Sticky\" for sticky tag names and revisions. | |
149 | ||
150 | (lambda (tag type) | |
968b980c | 151 | (cond ((eq type 'date) (format-time-string |
51af12fc AS |
152 | vc-cvs-sticky-date-format-string tag)) |
153 | ((eq type 'revision-number) \"Sticky\") | |
154 | ((eq type 'symbolic-name) \"Sticky\"))) | |
155 | ||
156 | Here's an example that will abbreviate to the first character only, | |
aa4af071 | 157 | any text before the first occurrence of `-' for sticky symbolic tags. |
51af12fc AS |
158 | If the sticky tag is a revision number, the word \"Sticky\" is |
159 | displayed. Date and time is displayed for sticky dates. | |
160 | ||
161 | (lambda (tag type) | |
162 | (cond ((eq type 'date) (format-time-string \"%Y%m%d %H:%M\" tag)) | |
163 | ((eq type 'revision-number) \"Sticky\") | |
968b980c | 164 | ((eq type 'symbolic-name) |
51af12fc AS |
165 | (condition-case nil |
166 | (progn | |
167 | (string-match \"\\\\([^-]*\\\\)\\\\(.*\\\\)\" tag) | |
968b980c | 168 | (concat (substring (match-string 1 tag) 0 1) \":\" |
51af12fc AS |
169 | (substring (match-string 2 tag) 1 nil))) |
170 | (error tag))))) ; Fall-back to given tag name. | |
171 | ||
172 | See also variable `vc-cvs-sticky-date-format-string'." | |
173 | :type '(choice boolean function) | |
bf247b6e | 174 | :version "22.1" |
51af12fc | 175 | :group 'vc) |
9b0630e5 | 176 | |
8f98485f AS |
177 | ;;; |
178 | ;;; Internal variables | |
179 | ;;; | |
180 | ||
9b0630e5 | 181 | |
8f98485f | 182 | ;;; |
9b0630e5 | 183 | ;;; State-querying functions |
8f98485f AS |
184 | ;;; |
185 | ||
c1b25099 GM |
186 | ;;;###autoload (defun vc-cvs-registered (f) |
187 | ;;;###autoload (when (file-readable-p (expand-file-name | |
188 | ;;;###autoload "CVS/Entries" (file-name-directory f))) | |
cfb0dbdc | 189 | ;;;###autoload (load "vc-cvs") |
c1b25099 GM |
190 | ;;;###autoload (vc-cvs-registered f))) |
191 | ||
192 | (defun vc-cvs-registered (file) | |
193 | "Check if FILE is CVS registered." | |
194 | (let ((dirname (or (file-name-directory file) "")) | |
195 | (basename (file-name-nondirectory file)) | |
196 | ;; make sure that the file name is searched case-sensitively | |
197 | (case-fold-search nil)) | |
198 | (if (file-readable-p (expand-file-name "CVS/Entries" dirname)) | |
199 | (with-temp-buffer | |
666721a6 | 200 | (vc-cvs-get-entries dirname) |
c1b25099 | 201 | (goto-char (point-min)) |
0d685c4f DL |
202 | (cond |
203 | ((re-search-forward | |
07d5b8c1 | 204 | (concat "^/" (regexp-quote basename) "/[^/]") nil t) |
c1b25099 GM |
205 | (beginning-of-line) |
206 | (vc-cvs-parse-entry file) | |
207 | t) | |
208 | (t nil))) | |
209 | nil))) | |
210 | ||
c1b25099 GM |
211 | (defun vc-cvs-state (file) |
212 | "CVS-specific version of `vc-state'." | |
e54faddb | 213 | (if (vc-stay-local-p file) |
c1b25099 GM |
214 | (let ((state (vc-file-getprop file 'vc-state))) |
215 | ;; If we should stay local, use the heuristic but only if | |
216 | ;; we don't have a more precise state already available. | |
5124dd38 | 217 | (if (memq state '(up-to-date edited nil)) |
c1b25099 GM |
218 | (vc-cvs-state-heuristic file) |
219 | state)) | |
220 | (with-temp-buffer | |
221 | (cd (file-name-directory file)) | |
bbce0417 | 222 | (vc-cvs-command t 0 file "status") |
c1b25099 GM |
223 | (vc-cvs-parse-status t)))) |
224 | ||
225 | (defun vc-cvs-state-heuristic (file) | |
226 | "CVS-specific state heuristic." | |
227 | ;; If the file has not changed since checkout, consider it `up-to-date'. | |
228 | ;; Otherwise consider it `edited'. | |
229 | (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) | |
230 | (lastmod (nth 5 (file-attributes file)))) | |
45b24b4d SM |
231 | (cond |
232 | ((equal checkout-time lastmod) 'up-to-date) | |
233 | ((string= (vc-working-revision file) "0") 'added) | |
234 | (t 'edited)))) | |
c1b25099 | 235 | |
ac3f4c6f ER |
236 | (defun vc-cvs-working-revision (file) |
237 | "CVS-specific version of `vc-working-revision'." | |
8f98485f AS |
238 | ;; There is no need to consult RCS headers under CVS, because we |
239 | ;; get the workfile version for free when we recognize that a file | |
240 | ;; is registered in CVS. | |
241 | (vc-cvs-registered file) | |
ac3f4c6f | 242 | (vc-file-getprop file 'vc-working-revision)) |
8f98485f | 243 | |
099bd78a SM |
244 | (defun vc-cvs-mode-line-string (file) |
245 | "Return string for placement into the modeline for FILE. | |
51af12fc AS |
246 | Compared to the default implementation, this function does two things: |
247 | Handle the special case of a CVS file that is added but not yet | |
248 | committed and support display of sticky tags." | |
3a12f9f8 DN |
249 | (let* ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag)) |
250 | help-echo | |
45b24b4d SM |
251 | (string |
252 | (let ((def-ml (vc-default-mode-line-string 'CVS file))) | |
253 | (setq help-echo | |
254 | (get-text-property 0 'help-echo def-ml)) | |
255 | def-ml))) | |
3a12f9f8 DN |
256 | (propertize |
257 | (if (zerop (length sticky-tag)) | |
258 | string | |
259 | (setq help-echo (format "%s on the '%s' branch" | |
260 | help-echo sticky-tag)) | |
261 | (concat string "[" sticky-tag "]")) | |
262 | 'help-echo help-echo))) | |
099bd78a | 263 | |
9b0630e5 | 264 | |
8f98485f AS |
265 | ;;; |
266 | ;;; State-changing functions | |
267 | ;;; | |
c1b25099 | 268 | |
8cdd17b4 ER |
269 | (defun vc-cvs-register (files &optional rev comment) |
270 | "Register FILES into the CVS version-control system. | |
271 | COMMENT can be used to provide an initial description of FILES. | |
c1b25099 | 272 | |
8f98485f AS |
273 | `vc-register-switches' and `vc-cvs-register-switches' are passed to |
274 | the CVS command (in that order)." | |
967bf297 GM |
275 | ;; Register the directories if needed. |
276 | (let (dirs) | |
277 | (dolist (file files) | |
278 | (and (not (vc-cvs-responsible-p file)) | |
279 | (vc-cvs-could-register file) | |
280 | (push (directory-file-name (file-name-directory file)) dirs))) | |
281 | (if dirs (vc-cvs-register dirs))) | |
282 | (apply 'vc-cvs-command nil 0 files | |
283 | "add" | |
284 | (and comment (string-match "[^\t\n ]" comment) | |
285 | (concat "-m" comment)) | |
286 | (vc-switches 'CVS 'register))) | |
c1b25099 | 287 | |
8f98485f AS |
288 | (defun vc-cvs-responsible-p (file) |
289 | "Return non-nil if CVS thinks it is responsible for FILE." | |
290 | (file-directory-p (expand-file-name "CVS" | |
291 | (if (file-directory-p file) | |
292 | file | |
293 | (file-name-directory file))))) | |
c1b25099 | 294 | |
e54faddb | 295 | (defun vc-cvs-could-register (file) |
8f98485f | 296 | "Return non-nil if FILE could be registered in CVS. |
e54faddb SM |
297 | This is only possible if CVS is managing FILE's directory or one of |
298 | its parents." | |
299 | (let ((dir file)) | |
300 | (while (and (stringp dir) | |
301 | (not (equal dir (setq dir (file-name-directory dir)))) | |
302 | dir) | |
303 | (setq dir (if (file-directory-p | |
304 | (expand-file-name "CVS/Entries" dir)) | |
305 | t (directory-file-name dir)))) | |
306 | (eq dir t))) | |
c1b25099 | 307 | |
8cdd17b4 | 308 | (defun vc-cvs-checkin (files rev comment) |
c1b25099 | 309 | "CVS-specific version of `vc-backend-checkin'." |
ac3f4c6f | 310 | (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) |
f153cb52 SM |
311 | (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) |
312 | (error "%s is not a valid symbolic tag name" rev) | |
313 | ;; If the input revison is a valid symbolic tag name, we create it | |
314 | ;; as a branch, commit and switch to it. | |
8cdd17b4 ER |
315 | (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) |
316 | (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) | |
ea139d51 ER |
317 | (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) |
318 | files))) | |
319 | (let ((status (apply 'vc-cvs-command nil 1 files | |
f153cb52 SM |
320 | "ci" (if rev (concat "-r" rev)) |
321 | (concat "-m" comment) | |
322 | (vc-switches 'CVS 'checkin)))) | |
c1b25099 GM |
323 | (set-buffer "*vc*") |
324 | (goto-char (point-min)) | |
bee48f25 AS |
325 | (when (not (zerop status)) |
326 | ;; Check checkin problem. | |
327 | (cond | |
328 | ((re-search-forward "Up-to-date check failed" nil t) | |
7d8c4332 ER |
329 | (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) |
330 | files) | |
8c16bd8c | 331 | (error "%s" (substitute-command-keys |
bee48f25 AS |
332 | (concat "Up-to-date check failed: " |
333 | "type \\[vc-next-action] to merge in changes")))) | |
334 | (t | |
335 | (pop-to-buffer (current-buffer)) | |
336 | (goto-char (point-min)) | |
337 | (shrink-window-if-larger-than-buffer) | |
338 | (error "Check-in failed")))) | |
ac3f4c6f | 339 | ;; Single-file commit? Then update the revision by parsing the buffer. |
8cdd17b4 ER |
340 | ;; Otherwise we can't necessarily tell what goes with what; clear |
341 | ;; its properties so they have to be refetched. | |
342 | (if (= (length files) 1) | |
343 | (vc-file-setprop | |
ac3f4c6f | 344 | (car files) 'vc-working-revision |
8cdd17b4 | 345 | (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) |
e0607aaa | 346 | (mapc 'vc-file-clearprops files)) |
8cdd17b4 | 347 | ;; Anyway, forget the checkout model of the file, because we might have |
c1b25099 GM |
348 | ;; guessed wrong when we found the file. After commit, we can |
349 | ;; tell it from the permissions of the file (see | |
350 | ;; vc-cvs-checkout-model). | |
8cdd17b4 ER |
351 | (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil)) |
352 | files) | |
51af12fc AS |
353 | |
354 | ;; if this was an explicit check-in (does not include creation of | |
355 | ;; a branch), remove the sticky tag. | |
356 | (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) | |
8cdd17b4 | 357 | (vc-cvs-command nil 0 files "update" "-A")))) |
c1b25099 | 358 | |
ac3f4c6f | 359 | (defun vc-cvs-find-revision (file rev buffer) |
ea05db01 SM |
360 | (apply 'vc-cvs-command |
361 | buffer 0 file | |
362 | "-Q" ; suppress diagnostic output | |
363 | "update" | |
364 | (and rev (not (string= rev "")) | |
365 | (concat "-r" rev)) | |
366 | "-p" | |
f153cb52 | 367 | (vc-switches 'CVS 'checkout))) |
ea05db01 | 368 | |
f4b43eb3 SM |
369 | (defun vc-cvs-checkout (file &optional editable rev) |
370 | "Checkout a revision of FILE into the working area. | |
34abd98e | 371 | EDITABLE non-nil means that the file should be writable. |
f4b43eb3 SM |
372 | REV is the revision to check out." |
373 | (message "Checking out %s..." file) | |
374 | ;; Change buffers to get local value of vc-checkout-switches. | |
375 | (with-current-buffer (or (get-file-buffer file) (current-buffer)) | |
376 | (if (and (file-exists-p file) (not rev)) | |
377 | ;; If no revision was specified, just make the file writable | |
378 | ;; if necessary (using `cvs-edit' if requested). | |
70e2f6c7 | 379 | (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit)) |
f4b43eb3 SM |
380 | (if vc-cvs-use-edit |
381 | (vc-cvs-command nil 0 file "edit") | |
382 | (set-file-modes file (logior (file-modes file) 128)) | |
383 | (if (equal file buffer-file-name) (toggle-read-only -1)))) | |
ac3f4c6f ER |
384 | ;; Check out a particular revision (or recreate the file). |
385 | (vc-file-setprop file 'vc-working-revision nil) | |
f4b43eb3 SM |
386 | (apply 'vc-cvs-command nil 0 file |
387 | (and editable "-w") | |
388 | "update" | |
389 | (when rev | |
390 | (unless (eq rev t) | |
391 | ;; default for verbose checkout: clear the | |
392 | ;; sticky tag so that the actual update will | |
393 | ;; get the head of the trunk | |
394 | (if (string= rev "") | |
395 | "-A" | |
396 | (concat "-r" rev)))) | |
397 | (vc-switches 'CVS 'checkout))) | |
398 | (vc-mode-line file)) | |
399 | (message "Checking out %s...done" file)) | |
c1b25099 | 400 | |
a0688443 | 401 | (defun vc-cvs-delete-file (file) |
105cac2d | 402 | (vc-cvs-command nil 0 file "remove" "-f")) |
a0688443 | 403 | |
99739bbf | 404 | (defun vc-cvs-revert (file &optional contents-done) |
ac3f4c6f | 405 | "Revert FILE to the working revision on which it was based." |
f4b43eb3 | 406 | (vc-default-revert 'CVS file contents-done) |
70e2f6c7 | 407 | (unless (eq (vc-cvs-checkout-model (list file)) 'implicit) |
99739bbf | 408 | (if vc-cvs-use-edit |
bbce0417 | 409 | (vc-cvs-command nil 0 file "unedit") |
99739bbf AS |
410 | ;; Make the file read-only by switching off all w-bits |
411 | (set-file-modes file (logand (file-modes file) 3950))))) | |
8f98485f | 412 | |
ac3f4c6f | 413 | (defun vc-cvs-merge (file first-revision &optional second-revision) |
8f98485f | 414 | "Merge changes into current working copy of FILE. |
ac3f4c6f | 415 | The changes are between FIRST-REVISION and SECOND-REVISION." |
bbce0417 | 416 | (vc-cvs-command nil 0 file |
8f98485f | 417 | "update" "-kk" |
ac3f4c6f ER |
418 | (concat "-j" first-revision) |
419 | (concat "-j" second-revision)) | |
8f98485f | 420 | (vc-file-setprop file 'vc-state 'edited) |
d3ee404f | 421 | (with-current-buffer (get-buffer "*vc*") |
8f98485f AS |
422 | (goto-char (point-min)) |
423 | (if (re-search-forward "conflicts during merge" nil t) | |
7fbb4797 DN |
424 | (progn |
425 | (vc-file-setprop file 'vc-state 'conflict) | |
426 | ;; signal error | |
427 | 1) | |
428 | (vc-file-setprop file 'vc-state 'edited) | |
429 | ;; signal success | |
430 | 0))) | |
8f98485f AS |
431 | |
432 | (defun vc-cvs-merge-news (file) | |
433 | "Merge in any new changes made to FILE." | |
434 | (message "Merging changes into %s..." file) | |
ac3f4c6f | 435 | ;; (vc-file-setprop file 'vc-working-revision nil) |
d3ee404f | 436 | (vc-file-setprop file 'vc-checkout-time 0) |
c6a234ac | 437 | (vc-cvs-command nil nil file "update") |
d3ee404f SM |
438 | ;; Analyze the merge result reported by CVS, and set |
439 | ;; file properties accordingly. | |
440 | (with-current-buffer (get-buffer "*vc*") | |
8f98485f | 441 | (goto-char (point-min)) |
ac3f4c6f | 442 | ;; get new working revision |
d3ee404f SM |
443 | (if (re-search-forward |
444 | "^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t) | |
ac3f4c6f ER |
445 | (vc-file-setprop file 'vc-working-revision (match-string 1)) |
446 | (vc-file-setprop file 'vc-working-revision nil)) | |
8f98485f AS |
447 | ;; get file status |
448 | (prog1 | |
449 | (if (eq (buffer-size) 0) | |
450 | 0 ;; there were no news; indicate success | |
451 | (if (re-search-forward | |
452 | (concat "^\\([CMUP] \\)?" | |
453 | (regexp-quote (file-name-nondirectory file)) | |
454 | "\\( already contains the differences between \\)?") | |
455 | nil t) | |
456 | (cond | |
457 | ;; Merge successful, we are in sync with repository now | |
458 | ((or (match-string 2) | |
459 | (string= (match-string 1) "U ") | |
460 | (string= (match-string 1) "P ")) | |
461 | (vc-file-setprop file 'vc-state 'up-to-date) | |
462 | (vc-file-setprop file 'vc-checkout-time | |
463 | (nth 5 (file-attributes file))) | |
464 | 0);; indicate success to the caller | |
465 | ;; Merge successful, but our own changes are still in the file | |
466 | ((string= (match-string 1) "M ") | |
467 | (vc-file-setprop file 'vc-state 'edited) | |
468 | 0);; indicate success to the caller | |
469 | ;; Conflicts detected! | |
470 | (t | |
7fbb4797 | 471 | (vc-file-setprop file 'vc-state 'conflict) |
8f98485f AS |
472 | 1);; signal the error to the caller |
473 | ) | |
474 | (pop-to-buffer "*vc*") | |
475 | (error "Couldn't analyze cvs update result"))) | |
476 | (message "Merging changes into %s...done" file)))) | |
477 | ||
9b64a7f0 ER |
478 | (defun vc-cvs-modify-change-comment (files rev comment) |
479 | "Modify the change comments for FILES on a specified REV. | |
480 | Will fail unless you have administrative privileges on the repo." | |
031f1766 | 481 | (vc-cvs-command nil 0 files "admin" (concat "-m" rev ":" comment))) |
9b0630e5 | 482 | |
8f98485f AS |
483 | ;;; |
484 | ;;; History functions | |
485 | ;;; | |
486 | ||
8cdd17b4 | 487 | (defun vc-cvs-print-log (files &optional buffer) |
be01714b ER |
488 | "Get change logs associated with FILES." |
489 | ;; It's just the catenation of the individual logs. | |
bbce0417 | 490 | (vc-cvs-command |
a9817cc4 | 491 | buffer |
fe1919ab | 492 | (if (vc-stay-local-p files) 'async 0) |
8cdd17b4 ER |
493 | files "log")) |
494 | ||
6aa5d910 ER |
495 | (defun vc-cvs-comment-history (file) |
496 | "Get comment history of a file." | |
497 | (vc-call-backend 'RCS 'comment-history file)) | |
8f98485f | 498 | |
8cdd17b4 | 499 | (defun vc-cvs-diff (files &optional oldvers newvers buffer) |
ac3f4c6f | 500 | "Get a difference report using CVS between two revisions of FILE." |
2e7a8a21 DN |
501 | (let* ((async (and (not vc-disable-async-diff) |
502 | (vc-stay-local-p files))) | |
503 | (invoke-cvs-diff-list nil) | |
504 | status) | |
505 | ;; Look through the file list and see if any files have backups | |
506 | ;; that can be used to do a plain "diff" instead of "cvs diff". | |
507 | (dolist (file files) | |
508 | (let ((ov oldvers) | |
509 | (nv newvers)) | |
510 | (when (or (not ov) (string-equal ov "")) | |
511 | (setq ov (vc-working-revision file))) | |
512 | (when (string-equal nv "") | |
513 | (setq nv nil)) | |
514 | (let ((file-oldvers (vc-version-backup-file file ov)) | |
515 | (file-newvers (if (not nv) | |
516 | file | |
517 | (vc-version-backup-file file nv))) | |
518 | (coding-system-for-read (vc-coding-system-for-diff file))) | |
519 | (if (and file-oldvers file-newvers) | |
520 | (progn | |
521 | (apply 'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil | |
522 | (append (if (listp diff-switches) | |
523 | diff-switches | |
524 | (list diff-switches)) | |
525 | (if (listp vc-diff-switches) | |
526 | vc-diff-switches | |
527 | (list vc-diff-switches)) | |
528 | (list (file-relative-name file-oldvers) | |
529 | (file-relative-name file-newvers)))) | |
530 | (setq status 0)) | |
531 | (push file invoke-cvs-diff-list))))) | |
532 | (when invoke-cvs-diff-list | |
533 | (setq status (apply 'vc-cvs-command (or buffer "*vc-diff*") | |
f153cb52 | 534 | (if async 'async 1) |
2e7a8a21 | 535 | invoke-cvs-diff-list "diff" |
f153cb52 SM |
536 | (and oldvers (concat "-r" oldvers)) |
537 | (and newvers (concat "-r" newvers)) | |
538 | (vc-switches 'CVS 'diff)))) | |
2e7a8a21 DN |
539 | (if async 1 status))) ; async diff, pessimistic assumption |
540 | ||
98ad325c SM |
541 | (defconst vc-cvs-annotate-first-line-re "^[0-9]") |
542 | ||
543 | (defun vc-cvs-annotate-process-filter (process string) | |
544 | (setq string (concat (process-get process 'output) string)) | |
545 | (if (not (string-match vc-cvs-annotate-first-line-re string)) | |
546 | ;; Still waiting for the first real line. | |
547 | (process-put process 'output string) | |
548 | (let ((vc-filter (process-get process 'vc-filter))) | |
549 | (set-process-filter process vc-filter) | |
550 | (funcall vc-filter process (substring string (match-beginning 0)))))) | |
551 | ||
ac3f4c6f | 552 | (defun vc-cvs-annotate-command (file buffer &optional revision) |
8f98485f | 553 | "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. |
ac3f4c6f | 554 | Optional arg REVISION is a revision to annotate from." |
98ad325c | 555 | (vc-cvs-command buffer |
fe1919ab | 556 | (if (vc-stay-local-p file) |
98ad325c SM |
557 | 'async 0) |
558 | file "annotate" | |
ac3f4c6f | 559 | (if revision (concat "-r" revision))) |
98ad325c SM |
560 | ;; Strip the leading few lines. |
561 | (let ((proc (get-buffer-process buffer))) | |
562 | (if proc | |
563 | ;; If running asynchronously, use a process filter. | |
564 | (progn | |
565 | (process-put proc 'vc-filter (process-filter proc)) | |
566 | (set-process-filter proc 'vc-cvs-annotate-process-filter)) | |
567 | (with-current-buffer buffer | |
568 | (goto-char (point-min)) | |
569 | (re-search-forward vc-cvs-annotate-first-line-re) | |
570 | (delete-region (point-min) (1- (point))))))) | |
c1b25099 | 571 | |
8ba2df32 AS |
572 | (defun vc-cvs-annotate-current-time () |
573 | "Return the current time, based at midnight of the current day, and | |
574 | encoded as fractional days." | |
575 | (vc-annotate-convert-time | |
576 | (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) | |
577 | ||
578 | (defun vc-cvs-annotate-time () | |
579 | "Return the time of the next annotation (as fraction of days) | |
f0529b5b | 580 | systime, or nil if there is none." |
b44a1825 TTN |
581 | (let* ((bol (point)) |
582 | (cache (get-text-property bol 'vc-cvs-annotate-time)) | |
72d1ce61 SM |
583 | (inhibit-read-only t) |
584 | (inhibit-modification-hooks t)) | |
b44a1825 TTN |
585 | (cond |
586 | (cache) | |
587 | ((looking-at | |
588 | "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ") | |
589 | (let ((day (string-to-number (match-string 1))) | |
590 | (month (cdr (assq (intern (match-string 2)) | |
591 | '((Jan . 1) (Feb . 2) (Mar . 3) | |
592 | (Apr . 4) (May . 5) (Jun . 6) | |
593 | (Jul . 7) (Aug . 8) (Sep . 9) | |
594 | (Oct . 10) (Nov . 11) (Dec . 12))))) | |
595 | (year (let ((tmp (string-to-number (match-string 3)))) | |
596 | ;; Years 0..68 are 2000..2068. | |
597 | ;; Years 69..99 are 1969..1999. | |
598 | (+ (cond ((> 69 tmp) 2000) | |
599 | ((> 100 tmp) 1900) | |
600 | (t 0)) | |
601 | tmp)))) | |
602 | (put-text-property | |
603 | bol (1+ bol) 'vc-cvs-annotate-time | |
604 | (setq cache (cons | |
605 | ;; Position at end makes for nicer overlay result. | |
d58107b0 SM |
606 | ;; Don't put actual buffer pos here, but only relative |
607 | ;; distance, so we don't ever move backward in the | |
608 | ;; goto-char below, even if the text is moved. | |
609 | (- (match-end 0) (match-beginning 0)) | |
b44a1825 TTN |
610 | (vc-annotate-convert-time |
611 | (encode-time 0 0 0 day month year)))))))) | |
612 | (when cache | |
d58107b0 | 613 | (goto-char (+ bol (car cache))) ; Fontify from here to eol. |
b44a1825 | 614 | (cdr cache)))) ; days (float) |
9b0630e5 | 615 | |
f2a2e61b AS |
616 | (defun vc-cvs-annotate-extract-revision-at-line () |
617 | (save-excursion | |
618 | (beginning-of-line) | |
619 | (if (re-search-forward "^\\([0-9]+\\.[0-9]+\\(\\.[0-9]+\\)*\\) +(" | |
620 | (line-end-position) t) | |
621 | (match-string-no-properties 1) | |
622 | nil))) | |
623 | ||
8f98485f | 624 | ;;; |
370fded4 | 625 | ;;; Tag system |
8f98485f AS |
626 | ;;; |
627 | ||
370fded4 | 628 | (defun vc-cvs-create-tag (dir name branchp) |
ac3f4c6f | 629 | "Assign to DIR's current revision a given NAME. |
8f98485f AS |
630 | If BRANCHP is non-nil, the name is created as a branch (and the current |
631 | workspace is immediately moved to that new branch)." | |
bbce0417 AS |
632 | (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name) |
633 | (when branchp (vc-cvs-command nil 0 dir "update" "-r" name))) | |
8f98485f | 634 | |
370fded4 ER |
635 | (defun vc-cvs-retrieve-tag (dir name update) |
636 | "Retrieve a tag at and below DIR. | |
637 | NAME is the name of the tag; if it is empty, do a `cvs update'. | |
8f98485f AS |
638 | If UPDATE is non-nil, then update (resynch) any affected buffers." |
639 | (with-current-buffer (get-buffer-create "*vc*") | |
51af12fc AS |
640 | (let ((default-directory dir) |
641 | (sticky-tag)) | |
8f98485f AS |
642 | (erase-buffer) |
643 | (if (or (not name) (string= name "")) | |
bbce0417 AS |
644 | (vc-cvs-command t 0 nil "update") |
645 | (vc-cvs-command t 0 nil "update" "-r" name) | |
51af12fc | 646 | (setq sticky-tag name)) |
8f98485f AS |
647 | (when update |
648 | (goto-char (point-min)) | |
649 | (while (not (eobp)) | |
650 | (if (looking-at "\\([CMUP]\\) \\(.*\\)") | |
651 | (let* ((file (expand-file-name (match-string 2) dir)) | |
652 | (state (match-string 1)) | |
653 | (buffer (find-buffer-visiting file))) | |
654 | (when buffer | |
655 | (cond | |
656 | ((or (string= state "U") | |
657 | (string= state "P")) | |
658 | (vc-file-setprop file 'vc-state 'up-to-date) | |
ac3f4c6f | 659 | (vc-file-setprop file 'vc-working-revision nil) |
8f98485f AS |
660 | (vc-file-setprop file 'vc-checkout-time |
661 | (nth 5 (file-attributes file)))) | |
662 | ((or (string= state "M") | |
663 | (string= state "C")) | |
664 | (vc-file-setprop file 'vc-state 'edited) | |
ac3f4c6f | 665 | (vc-file-setprop file 'vc-working-revision nil) |
8f98485f | 666 | (vc-file-setprop file 'vc-checkout-time 0))) |
51af12fc | 667 | (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag) |
8f98485f AS |
668 | (vc-resynch-buffer file t t)))) |
669 | (forward-line 1)))))) | |
670 | ||
9b0630e5 | 671 | |
8f98485f AS |
672 | ;;; |
673 | ;;; Miscellaneous | |
674 | ;;; | |
675 | ||
e54faddb | 676 | (defalias 'vc-cvs-make-version-backups-p 'vc-stay-local-p |
d3ee404f | 677 | "Return non-nil if version backups should be made for FILE.") |
8f98485f AS |
678 | |
679 | (defun vc-cvs-check-headers () | |
680 | "Check if the current file has any headers in it." | |
681 | (save-excursion | |
682 | (goto-char (point-min)) | |
683 | (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\ | |
684 | \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t))) | |
685 | ||
9b0630e5 | 686 | |
8f98485f AS |
687 | ;;; |
688 | ;;; Internal functions | |
689 | ;;; | |
690 | ||
b038f9fb TTN |
691 | (defun vc-cvs-root (dir) |
692 | (vc-find-root dir "CVS" t)) | |
693 | ||
8cdd17b4 | 694 | (defun vc-cvs-command (buffer okstatus files &rest flags) |
bbce0417 AS |
695 | "A wrapper around `vc-do-command' for use in vc-cvs.el. |
696 | The difference to vc-do-command is that this function always invokes `cvs', | |
697 | and that it passes `vc-cvs-global-switches' to it before FLAGS." | |
2888a97e | 698 | (apply 'vc-do-command (or buffer "*vc*") okstatus "cvs" files |
968b980c | 699 | (if (stringp vc-cvs-global-switches) |
bbce0417 AS |
700 | (cons vc-cvs-global-switches flags) |
701 | (append vc-cvs-global-switches | |
702 | flags)))) | |
703 | ||
e54faddb SM |
704 | (defalias 'vc-cvs-stay-local-p 'vc-stay-local-p) ;Back-compatibility. |
705 | ||
706 | (defun vc-cvs-repository-hostname (dirname) | |
707 | "Hostname of the CVS server associated to workarea DIRNAME." | |
708 | (let ((rootname (expand-file-name "CVS/Root" dirname))) | |
709 | (when (file-readable-p rootname) | |
710 | (with-temp-buffer | |
711 | (let ((coding-system-for-read | |
712 | (or file-name-coding-system | |
713 | default-file-name-coding-system))) | |
714 | (vc-insert-file rootname)) | |
715 | (goto-char (point-min)) | |
716 | (nth 2 (vc-cvs-parse-root | |
717 | (buffer-substring (point) | |
718 | (line-end-position)))))))) | |
78376474 SM |
719 | |
720 | (defun vc-cvs-parse-root (root) | |
d3ed06c6 AS |
721 | "Split CVS ROOT specification string into a list of fields. |
722 | A CVS root specification of the form | |
723 | [:METHOD:][[USER@]HOSTNAME:]/path/to/repository | |
724 | is converted to a normalized record with the following structure: | |
725 | \(METHOD USER HOSTNAME CVS-ROOT). | |
726 | The default METHOD for a CVS root of the form | |
727 | /path/to/repository | |
728 | is `local'. | |
729 | The default METHOD for a CVS root of the form | |
730 | [USER@]HOSTNAME:/path/to/repository | |
731 | is `ext'. | |
aaed846c | 732 | For an empty string, nil is returned (invalid CVS root)." |
d3ed06c6 AS |
733 | ;; Split CVS root into colon separated fields (0-4). |
734 | ;; The `x:' makes sure, that leading colons are not lost; | |
735 | ;; `HOST:/PATH' is then different from `:METHOD:/PATH'. | |
736 | (let* ((root-list (cdr (split-string (concat "x:" root) ":"))) | |
737 | (len (length root-list)) | |
738 | ;; All syntactic varieties will get a proper METHOD. | |
739 | (root-list | |
740 | (cond | |
741 | ((= len 0) | |
742 | ;; Invalid CVS root | |
743 | nil) | |
744 | ((= len 1) | |
745 | ;; Simple PATH => method `local' | |
746 | (cons "local" | |
747 | (cons nil root-list))) | |
748 | ((= len 2) | |
749 | ;; [USER@]HOST:PATH => method `ext' | |
750 | (and (not (equal (car root-list) "")) | |
751 | (cons "ext" root-list))) | |
752 | ((= len 3) | |
753 | ;; :METHOD:PATH | |
754 | (cons (cadr root-list) | |
755 | (cons nil (cddr root-list)))) | |
756 | (t | |
757 | ;; :METHOD:[USER@]HOST:PATH | |
758 | (cdr root-list))))) | |
759 | (if root-list | |
760 | (let ((method (car root-list)) | |
761 | (uhost (or (cadr root-list) "")) | |
762 | (root (nth 2 root-list)) | |
763 | user host) | |
764 | ;; Split USER@HOST | |
765 | (if (string-match "\\(.*\\)@\\(.*\\)" uhost) | |
766 | (setq user (match-string 1 uhost) | |
767 | host (match-string 2 uhost)) | |
768 | (setq host uhost)) | |
769 | ;; Remove empty HOST | |
770 | (and (equal host "") | |
771 | (setq host)) | |
772 | ;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir' | |
773 | (and host | |
774 | (equal method "local") | |
775 | (setq root (concat host ":" root) host)) | |
776 | ;; Normalize CVS root record | |
777 | (list method user host root))))) | |
8f98485f | 778 | |
4e383781 DN |
779 | ;; XXX: This does not work correctly for subdirectories. "cvs status" |
780 | ;; information is context sensitive, it contains lines like: | |
781 | ;; cvs status: Examining DIRNAME | |
782 | ;; and the file entries after that don't show the full path. | |
caf37b1f ER |
783 | ;; Because of this VC directory listings only show changed files |
784 | ;; at the top level for CVS. | |
8f98485f AS |
785 | (defun vc-cvs-parse-status (&optional full) |
786 | "Parse output of \"cvs status\" command in the current buffer. | |
787 | Set file properties accordingly. Unless FULL is t, parse only | |
722f037f ER |
788 | essential information. Note that this can never set the 'ignored |
789 | state." | |
920fb2b0 | 790 | (let (file status missing) |
8f98485f | 791 | (goto-char (point-min)) |
722f037f ER |
792 | (while (looking-at "? \\(.*\\)") |
793 | (setq file (expand-file-name (match-string 1))) | |
794 | (vc-file-setprop file 'vc-state 'unregistered) | |
795 | (forward-line 1)) | |
920fb2b0 DN |
796 | (when (re-search-forward "^File: " nil t) |
797 | (when (setq missing (looking-at "no file ")) | |
798 | (goto-char (match-end 0))) | |
799 | (cond | |
800 | ((re-search-forward "\\=\\([^ \t]+\\)" nil t) | |
801 | (setq file (expand-file-name (match-string 1))) | |
802 | (vc-file-setprop file 'vc-backend 'CVS) | |
803 | (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)) | |
804 | (setq status "Unknown") | |
805 | (setq status (match-string 1))) | |
7fbb4797 DN |
806 | (when (and full |
807 | (re-search-forward | |
808 | "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\ | |
8f98485f | 809 | \[\t ]+\\([0-9.]+\\)" |
7fbb4797 | 810 | nil t)) |
920fb2b0 DN |
811 | (vc-file-setprop file 'vc-latest-revision (match-string 2))) |
812 | (vc-file-setprop | |
813 | file 'vc-state | |
814 | (cond | |
815 | ((string-match "Up-to-date" status) | |
816 | (vc-file-setprop file 'vc-checkout-time | |
817 | (nth 5 (file-attributes file))) | |
818 | 'up-to-date) | |
819 | ((string-match "Locally Modified" status) 'edited) | |
820 | ((string-match "Needs Merge" status) 'needs-merge) | |
821 | ((string-match "Needs \\(Checkout\\|Patch\\)" status) | |
3702367b | 822 | (if missing 'missing 'needs-update)) |
920fb2b0 DN |
823 | ((string-match "Locally Added" status) 'added) |
824 | ((string-match "Locally Removed" status) 'removed) | |
7fbb4797 | 825 | ((string-match "File had conflicts " status) 'conflict) |
920fb2b0 | 826 | (t 'edited)))))))) |
8f98485f | 827 | |
c1b51374 | 828 | (defun vc-cvs-after-dir-status (update-function) |
798dafb4 | 829 | ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack. |
5a9de6d0 | 830 | ;; This needs a lot of testing. |
798dafb4 DN |
831 | (let ((status nil) |
832 | (status-str nil) | |
833 | (file nil) | |
834 | (result nil) | |
920fb2b0 | 835 | (missing nil) |
798dafb4 DN |
836 | (subdir default-directory)) |
837 | (goto-char (point-min)) | |
838 | (while | |
839 | ;; Look for either a file entry, an unregistered file, or a | |
840 | ;; directory change. | |
841 | (re-search-forward | |
842 | "\\(^=+\n\\([^=c?\n].*\n\\|\n\\)+\\)\\|\\(\\(^?? .*\n\\)+\\)\\|\\(^cvs status: Examining .*\n\\)" | |
843 | nil t) | |
844 | ;; XXX: get rid of narrowing here. | |
845 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
846 | (goto-char (point-min)) | |
847 | ;; The subdir | |
848 | (when (looking-at "cvs status: Examining \\(.+\\)") | |
849 | (setq subdir (expand-file-name (match-string 1)))) | |
850 | ;; Unregistered files | |
851 | (while (looking-at "? \\(.*\\)") | |
852 | (setq file (file-relative-name | |
853 | (expand-file-name (match-string 1) subdir))) | |
1b3f2d4e | 854 | (push (list file 'unregistered) result) |
798dafb4 DN |
855 | (forward-line 1)) |
856 | ;; A file entry. | |
857 | (when (re-search-forward "^File: " nil t) | |
920fb2b0 DN |
858 | (when (setq missing (looking-at "no file ")) |
859 | (goto-char (match-end 0))) | |
798dafb4 | 860 | (cond |
798dafb4 DN |
861 | ((re-search-forward "\\=\\([^ \t]+\\)" nil t) |
862 | (setq file (file-relative-name | |
863 | (expand-file-name (match-string 1) subdir))) | |
864 | (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)) | |
1b3f2d4e | 865 | (push (list file 'unregistered) result) |
798dafb4 DN |
866 | (setq status-str (match-string 1)) |
867 | (setq status | |
868 | (cond | |
869 | ((string-match "Up-to-date" status-str) 'up-to-date) | |
870 | ((string-match "Locally Modified" status-str) 'edited) | |
871 | ((string-match "Needs Merge" status-str) 'needs-merge) | |
872 | ((string-match "Needs \\(Checkout\\|Patch\\)" status-str) | |
3702367b | 873 | (if missing 'missing 'needs-update)) |
798dafb4 | 874 | ((string-match "Locally Added" status-str) 'added) |
874f31a6 | 875 | ((string-match "Locally Removed" status-str) 'removed) |
7fbb4797 | 876 | ((string-match "File had conflicts " status-str) 'conflict) |
798dafb4 DN |
877 | (t 'edited))) |
878 | (unless (eq status 'up-to-date) | |
1b3f2d4e | 879 | (push (list file status) result)))))) |
798dafb4 DN |
880 | (goto-char (point-max)) |
881 | (widen)) | |
769303ae DN |
882 | (funcall update-function result)) |
883 | ;; Alternative implementation: use the "update" command instead of | |
884 | ;; the "status" command. | |
885 | ;; (let ((result nil) | |
886 | ;; (translation '((?? . unregistered) | |
887 | ;; (?A . added) | |
888 | ;; (?C . conflict) | |
889 | ;; (?M . edited) | |
890 | ;; (?P . needs-merge) | |
891 | ;; (?R . removed) | |
3702367b | 892 | ;; (?U . needs-update)))) |
769303ae DN |
893 | ;; (goto-char (point-min)) |
894 | ;; (while (not (eobp)) | |
895 | ;; (if (looking-at "^[ACMPRU?] \\(.*\\)$") | |
896 | ;; (push (list (match-string 1) | |
897 | ;; (cdr (assoc (char-after) translation))) | |
898 | ;; result) | |
899 | ;; (cond | |
900 | ;; ((looking-at "cvs update: warning: \\(.*\\) was lost") | |
901 | ;; ;; Format is: | |
902 | ;; ;; cvs update: warning: FILENAME was lost | |
903 | ;; ;; U FILENAME | |
904 | ;; (push (list (match-string 1) 'missing) result) | |
905 | ;; ;; Skip the "U" line | |
906 | ;; (forward-line 1)) | |
907 | ;; ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored") | |
908 | ;; (push (list (match-string 1) 'unregistered) result)))) | |
909 | ;; (forward-line 1)) | |
910 | ;; (funcall update-function result))) | |
911 | ) | |
798dafb4 | 912 | |
c1b51374 | 913 | (defun vc-cvs-dir-status (dir update-function) |
798dafb4 | 914 | "Create a list of conses (file . state) for DIR." |
115c0061 | 915 | (vc-cvs-command (current-buffer) 'async dir "status") |
769303ae DN |
916 | ;; Alternative implementation: use the "update" command instead of |
917 | ;; the "status" command. | |
918 | ;; (vc-cvs-command (current-buffer) 'async | |
919 | ;; (file-relative-name dir) | |
920 | ;; "-f" "-n" "update" "-d" "-P") | |
115c0061 | 921 | (vc-exec-after |
c1b51374 | 922 | `(vc-cvs-after-dir-status (quote ,update-function)))) |
798dafb4 | 923 | |
47302633 | 924 | (defun vc-cvs-status-extra-headers (dir) |
4c61891a ER |
925 | (let ((repo |
926 | (condition-case nil | |
927 | (save-excursion | |
928 | (set-buffer (find-file-noselect "CVS/Root" t)) | |
929 | (and (looking-at ":ext:") (delete-char 5)) | |
930 | (buffer-string)) | |
931 | nil))) | |
932 | (concat | |
933 | ;; FIXME: see how PCL-CVS gets the data to print all these | |
934 | (propertize "Module : " 'face 'font-lock-type-face) | |
935 | (propertize "ADD CODE TO PRINT THE MODULE\n" | |
936 | 'face 'font-lock-warning-face) | |
937 | (cond (repo | |
938 | (concat | |
939 | (propertize "Repository : " 'face 'font-lock-type-face) | |
940 | (propertize repo 'face 'font-lock-warning-face))) | |
941 | (t "")) | |
942 | (propertize "Branch : " 'face 'font-lock-type-face) | |
943 | (propertize "ADD CODE TO PRINT THE BRANCH NAME\n" | |
944 | 'face 'font-lock-warning-face)))) | |
47302633 | 945 | |
666721a6 AS |
946 | (defun vc-cvs-get-entries (dir) |
947 | "Insert the CVS/Entries file from below DIR into the current buffer. | |
948 | This function ensures that the correct coding system is used for that, | |
949 | which may not be the one that is used for the files' contents. | |
950 | CVS/Entries should only be accessed through this function." | |
951 | (let ((coding-system-for-read (or file-name-coding-system | |
952 | default-file-name-coding-system))) | |
953 | (vc-insert-file (expand-file-name "CVS/Entries" dir)))) | |
bc99a968 | 954 | |
51af12fc AS |
955 | (defun vc-cvs-valid-symbolic-tag-name-p (tag) |
956 | "Return non-nil if TAG is a valid symbolic tag name." | |
957 | ;; According to the CVS manual, a valid symbolic tag must start with | |
958 | ;; an uppercase or lowercase letter and can contain uppercase and | |
959 | ;; lowercase letters, digits, `-', and `_'. | |
960 | (and (string-match "^[a-zA-Z]" tag) | |
961 | (not (string-match "[^a-z0-9A-Z-_]" tag)))) | |
968b980c | 962 | |
ac3f4c6f ER |
963 | (defun vc-cvs-valid-revision-number-p (tag) |
964 | "Return non-nil if TAG is a valid revision number." | |
93bcb353 SS |
965 | (and (string-match "^[0-9]" tag) |
966 | (not (string-match "[^0-9.]" tag)))) | |
51af12fc AS |
967 | |
968 | (defun vc-cvs-parse-sticky-tag (match-type match-tag) | |
968b980c | 969 | "Parse and return the sticky tag as a string. |
51af12fc AS |
970 | `match-data' is protected." |
971 | (let ((data (match-data)) | |
972 | (tag) | |
973 | (type (cond ((string= match-type "D") 'date) | |
974 | ((string= match-type "T") | |
975 | (if (vc-cvs-valid-symbolic-tag-name-p match-tag) | |
976 | 'symbolic-name | |
977 | 'revision-number)) | |
978 | (t nil)))) | |
979 | (unwind-protect | |
980 | (progn | |
968b980c | 981 | (cond |
e6608c12 | 982 | ;; Sticky Date tag. Convert to a proper date value (`encode-time') |
51af12fc | 983 | ((eq type 'date) |
968b980c SS |
984 | (string-match |
985 | "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)" | |
51af12fc AS |
986 | match-tag) |
987 | (let* ((year-tmp (string-to-number (match-string 1 match-tag))) | |
988 | (month (string-to-number (match-string 2 match-tag))) | |
989 | (day (string-to-number (match-string 3 match-tag))) | |
990 | (hour (string-to-number (match-string 4 match-tag))) | |
991 | (min (string-to-number (match-string 5 match-tag))) | |
992 | (sec (string-to-number (match-string 6 match-tag))) | |
993 | ;; Years 0..68 are 2000..2068. | |
994 | ;; Years 69..99 are 1969..1999. | |
995 | (year (+ (cond ((> 69 year-tmp) 2000) | |
996 | ((> 100 year-tmp) 1900) | |
997 | (t 0)) | |
998 | year-tmp))) | |
999 | (setq tag (encode-time sec min hour day month year)))) | |
1000 | ;; Sticky Tag name or revision number | |
1001 | ((eq type 'symbolic-name) (setq tag match-tag)) | |
1002 | ((eq type 'revision-number) (setq tag match-tag)) | |
1003 | ;; Default is no sticky tag at all | |
1004 | (t nil)) | |
1005 | (cond ((eq vc-cvs-sticky-tag-display nil) nil) | |
1006 | ((eq vc-cvs-sticky-tag-display t) | |
968b980c | 1007 | (cond ((eq type 'date) (format-time-string |
51af12fc AS |
1008 | vc-cvs-sticky-date-format-string |
1009 | tag)) | |
1010 | ((eq type 'symbolic-name) tag) | |
1011 | ((eq type 'revision-number) tag) | |
1012 | (t nil))) | |
968b980c | 1013 | ((functionp vc-cvs-sticky-tag-display) |
51af12fc AS |
1014 | (funcall vc-cvs-sticky-tag-display tag type)) |
1015 | (t nil))) | |
1016 | ||
1017 | (set-match-data data)))) | |
1018 | ||
8f98485f AS |
1019 | (defun vc-cvs-parse-entry (file &optional set-state) |
1020 | "Parse a line from CVS/Entries. | |
1021 | Compare modification time to that of the FILE, set file properties | |
1022 | accordingly. However, `vc-state' is set only if optional arg SET-STATE | |
1023 | is non-nil." | |
1024 | (cond | |
1025 | ;; entry for a "locally added" file (not yet committed) | |
1026 | ((looking-at "/[^/]+/0/") | |
8c58d37d | 1027 | (vc-file-setprop file 'vc-backend 'CVS) |
8f98485f | 1028 | (vc-file-setprop file 'vc-checkout-time 0) |
ac3f4c6f | 1029 | (vc-file-setprop file 'vc-working-revision "0") |
45b24b4d | 1030 | (if set-state (vc-file-setprop file 'vc-state 'added))) |
8f98485f AS |
1031 | ;; normal entry |
1032 | ((looking-at | |
1033 | (concat "/[^/]+" | |
1034 | ;; revision | |
1035 | "/\\([^/]*\\)" | |
92788b3b AS |
1036 | ;; timestamp and optional conflict field |
1037 | "/\\([^/]*\\)/" | |
51af12fc AS |
1038 | ;; options |
1039 | "\\([^/]*\\)/" | |
1040 | ;; sticky tag | |
1041 | "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) | |
1042 | "\\(.*\\)")) ;Sticky tag | |
8c58d37d | 1043 | (vc-file-setprop file 'vc-backend 'CVS) |
ac3f4c6f | 1044 | (vc-file-setprop file 'vc-working-revision (match-string 1)) |
839dacca | 1045 | (vc-file-setprop file 'vc-cvs-sticky-tag |
bc99a968 | 1046 | (vc-cvs-parse-sticky-tag (match-string 4) |
e5d9c9a2 | 1047 | (match-string 5))) |
ecfc2ba0 AS |
1048 | ;; Compare checkout time and modification time. |
1049 | ;; This is intentionally different from the algorithm that CVS uses | |
e5d9c9a2 | 1050 | ;; (which is based on textual comparison), because there can be problems |
ecfc2ba0 | 1051 | ;; generating a time string that looks exactly like the one from CVS. |
f52d10f2 DL |
1052 | (let ((mtime (nth 5 (file-attributes file)))) |
1053 | (require 'parse-time) | |
1054 | (let ((parsed-time | |
1055 | (parse-time-string (concat (match-string 2) " +0000")))) | |
1056 | (cond ((and (not (string-match "\\+" (match-string 2))) | |
1057 | (car parsed-time) | |
1058 | (equal mtime (apply 'encode-time parsed-time))) | |
1059 | (vc-file-setprop file 'vc-checkout-time mtime) | |
1060 | (if set-state (vc-file-setprop file 'vc-state 'up-to-date))) | |
1061 | (t | |
1062 | (vc-file-setprop file 'vc-checkout-time 0) | |
1063 | (if set-state (vc-file-setprop file 'vc-state 'edited))))))))) | |
968b980c | 1064 | |
2346acf6 SM |
1065 | ;; Completion of revision names. |
1066 | ;; Just so I don't feel like I'm duplicating code from pcl-cvs, I'll use | |
1067 | ;; `cvs log' so I can list all the revision numbers rather than only | |
1068 | ;; tag names. | |
1069 | ||
1070 | (defun vc-cvs-revision-table (file) | |
1071 | (let ((default-directory (file-name-directory file)) | |
1072 | (res nil)) | |
1073 | (with-temp-buffer | |
1074 | (vc-cvs-command t nil file "log") | |
1075 | (goto-char (point-min)) | |
1076 | (when (re-search-forward "^symbolic names:\n" nil t) | |
1077 | (while (looking-at "^ \\(.*\\): \\(.*\\)") | |
1078 | (push (cons (match-string 1) (match-string 2)) res) | |
1079 | (forward-line 1))) | |
1080 | (while (re-search-forward "^revision \\([0-9.]+\\)" nil t) | |
1081 | (push (match-string 1) res)) | |
1082 | res))) | |
1083 | ||
32c58c47 SM |
1084 | (defun vc-cvs-revision-completion-table (files) |
1085 | (lexical-let ((files files) | |
2346acf6 SM |
1086 | table) |
1087 | (setq table (lazy-completion-table | |
32c58c47 | 1088 | table (lambda () (vc-cvs-revision-table (car files))))) |
2346acf6 SM |
1089 | table)) |
1090 | ||
1091 | ||
c1b25099 GM |
1092 | (provide 'vc-cvs) |
1093 | ||
2346acf6 | 1094 | ;; arch-tag: 60e1402a-aa53-4607-927a-cf74f144b432 |
c1b25099 | 1095 | ;;; vc-cvs.el ends here |