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