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