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