(custom-face-value-create): If face name doesn't end with "face", add
[bpt/emacs.git] / lisp / vc-cvs.el
CommitLineData
c1b25099
GM
1;;; vc-cvs.el --- non-resident support for CVS version-control
2
3;; Copyright (C) 1995,98,99,2000 Free Software Foundation, Inc.
4
5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Andre Spiegel <spiegel@gnu.org>
7
e1483c38 8;; $Id: vc-cvs.el,v 1.7 2000/10/27 11:37:17 spiegel Exp $
c1b25099
GM
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
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
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;;; Code:
30
31(defcustom vc-cvs-register-switches nil
32 "*Extra switches for registering a file into CVS.
33A string or list of strings passed to the checkin program by
34\\[vc-register]."
35 :type '(choice (const :tag "None" nil)
36 (string :tag "Argument String")
37 (repeat :tag "Argument List"
38 :value ("")
39 string))
0d685c4f 40 :version "21.1"
c1b25099
GM
41 :group 'vc)
42
43(defcustom vc-cvs-header (or (cdr (assoc 'CVS vc-header-alist)) '("\$Id\$"))
44 "*Header keywords to be inserted by `vc-insert-headers'."
0d685c4f 45 :version "21.1"
c1b25099
GM
46 :type 'string
47 :group 'vc)
48
49(defcustom vc-cvs-use-edit t
50 "*Non-nil means to use `cvs edit' to \"check out\" a file.
51This is only meaningful if you don't use the implicit checkout model
52\(i.e. if you have $CVSREAD set)."
53 :type 'boolean
0d685c4f 54 :version "21.1"
c1b25099
GM
55 :group 'vc)
56
57(defcustom vc-cvs-stay-local t
0d685c4f
DL
58 "*Non-nil means use local operations when possible for remote repositories.
59This avoids slow queries over the network. Turning this option on
60will instruct VC to use only heuristics and past information to
61determine the current status of a file. The value can also be a
62regular expression to match against the host name of a repository;
63then VC only stays local for hosts that match it."
c1b25099
GM
64 :type '(choice (const :tag "Always stay local" t)
65 (string :tag "Host regexp")
66 (const :tag "Don't stay local" nil))
0d685c4f 67 :version "21.1"
c1b25099
GM
68 :group 'vc)
69
70;;;###autoload (defun vc-cvs-registered (f)
71;;;###autoload (when (file-readable-p (expand-file-name
72;;;###autoload "CVS/Entries" (file-name-directory f)))
73;;;###autoload (require 'vc-cvs)
74;;;###autoload (vc-cvs-registered f)))
75
76(defun vc-cvs-registered (file)
77 "Check if FILE is CVS registered."
78 (let ((dirname (or (file-name-directory file) ""))
79 (basename (file-name-nondirectory file))
80 ;; make sure that the file name is searched case-sensitively
81 (case-fold-search nil))
82 (if (file-readable-p (expand-file-name "CVS/Entries" dirname))
83 (with-temp-buffer
84 (vc-insert-file (expand-file-name "CVS/Entries" dirname))
85 (goto-char (point-min))
0d685c4f
DL
86 (cond
87 ((re-search-forward
c1b25099
GM
88 (concat "^/" (regexp-quote basename) "/") nil t)
89 (beginning-of-line)
90 (vc-cvs-parse-entry file)
91 t)
92 (t nil)))
93 nil)))
94
95(defun vc-cvs-stay-local-p (file)
96 "Return non-nil if VC should stay local when handling FILE."
97 (if vc-cvs-stay-local
98 (let* ((dirname (if (file-directory-p file)
99 (directory-file-name file)
100 (file-name-directory file)))
0d685c4f 101 (prop
c1b25099
GM
102 (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
103 (let ((rootname (expand-file-name "CVS/Root" dirname)))
0d685c4f 104 (vc-file-setprop
c1b25099
GM
105 dirname 'vc-cvs-stay-local-p
106 (when (file-readable-p rootname)
107 (with-temp-buffer
108 (vc-insert-file rootname)
109 (goto-char (point-min))
110 (if (looking-at "\\([^:]*\\):")
0d685c4f 111 (if (not (stringp vc-cvs-stay-local))
c1b25099
GM
112 'yes
113 (let ((hostname (match-string 1)))
114 (if (string-match vc-cvs-stay-local hostname)
115 'yes
116 'no)))
117 'no))))))))
118 (if (eq prop 'yes) t nil))))
119
120(defun vc-cvs-workfile-version (file)
121 "CVS-specific version of `vc-workfile-version'."
122 ;; There is no need to consult RCS headers under CVS, because we
123 ;; get the workfile version for free when we recognize that a file
124 ;; is registered in CVS.
125 (vc-cvs-registered file)
126 (vc-file-getprop file 'vc-workfile-version))
127
128(defun vc-cvs-checkout-model (file)
129 "CVS-specific version of `vc-checkout-model'."
130 (if (or (getenv "CVSREAD")
131 ;; If the file is not writable (despite CVSREAD being
132 ;; undefined), this is probably because the file is being
133 ;; "watched" by other developers.
134 ;; (If vc-mistrust-permissions was t, we actually shouldn't
135 ;; trust this, but there is no other way to learn this from CVS
136 ;; at the moment (version 1.9).)
137 (string-match "r-..-..-." (nth 8 (file-attributes file))))
138 'announce
139 'implicit))
140\f
141;; VC Dired functions
142
143(defun vc-cvs-dired-state-info (file)
144 "CVS-specific version of `vc-dired-state-info'."
145 (let* ((cvs-state (vc-state file))
146 (state (cond ((eq cvs-state 'edited) "modified")
147 ((eq cvs-state 'needs-patch) "patch")
148 ((eq cvs-state 'needs-merge) "merge")
149 ;; FIXME: those two states cannot occur right now
150 ((eq cvs-state 'unlocked-changes) "conflict")
151 ((eq cvs-state 'locally-added) "added")
152 )))
153 (if state (concat "(" state ")"))))
154
155(defun vc-cvs-parse-status (&optional full)
156 "Parse output of \"cvs status\" command in the current buffer.
157Set file properties accordingly. Unless FULL is t, parse only
158essential information."
159 (let (file status)
160 (goto-char (point-min))
161 (if (re-search-forward "^File: " nil t)
162 (cond
163 ((looking-at "no file") nil)
164 ((re-search-forward "\\=\\([^ \t]+\\)" nil t)
165 (setq file (expand-file-name (match-string 1)))
166 (vc-file-setprop file 'vc-backend 'CVS)
167 (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t))
168 (setq status "Unknown")
169 (setq status (match-string 1)))
170 (if (and full
171 (re-search-forward
172 "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
173\[\t ]+\\([0-9.]+\\)"
174 nil t))
175 (vc-file-setprop file 'vc-latest-version (match-string 2)))
176 (cond
177 ((string-match "Up-to-date" status)
178 (vc-file-setprop file 'vc-checkout-time
179 (nth 5 (file-attributes file)))
180 'up-to-date)
181 ((string-match "Locally Modified" status) 'edited)
182 ((string-match "Needs Merge" status) 'needs-merge)
183 ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-patch)
184 (t 'edited)))))))
185
186(defun vc-cvs-state (file)
187 "CVS-specific version of `vc-state'."
188 (if (vc-cvs-stay-local-p file)
189 (let ((state (vc-file-getprop file 'vc-state)))
190 ;; If we should stay local, use the heuristic but only if
191 ;; we don't have a more precise state already available.
192 (if (memq state '(up-to-date edited))
193 (vc-cvs-state-heuristic file)
194 state))
195 (with-temp-buffer
196 (cd (file-name-directory file))
197 (vc-do-command t 0 "cvs" file "status")
198 (vc-cvs-parse-status t))))
199
200(defun vc-cvs-state-heuristic (file)
201 "CVS-specific state heuristic."
202 ;; If the file has not changed since checkout, consider it `up-to-date'.
203 ;; Otherwise consider it `edited'.
204 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
205 (lastmod (nth 5 (file-attributes file))))
206 (if (equal checkout-time lastmod)
207 'up-to-date
208 'edited)))
209
099bd78a
SM
210(defun vc-cvs-mode-line-string (file)
211 "Return string for placement into the modeline for FILE.
212Compared to the default implementation, this function handles the
213special case of a CVS file that is added but not yet comitted."
214 (let ((state (vc-state file))
215 (rev (vc-workfile-version file)))
216 (cond ((string= rev "0")
217 ;; A file that is added but not yet comitted.
218 "CVS @@")
219 ((or (eq state 'up-to-date)
220 (eq state 'needs-patch))
221 (concat "CVS-" rev))
222 ((stringp state)
223 (concat "CVS:" state ":" rev))
224 (t
225 ;; Not just for the 'edited state, but also a fallback
226 ;; for all other states. Think about different symbols
227 ;; for 'needs-patch and 'needs-merge.
228 (concat "CVS:" rev)))))
229
c1b25099
GM
230(defun vc-cvs-dir-state (dir)
231 "Find the CVS state of all files in DIR."
232 (if (vc-cvs-stay-local-p dir)
233 (vc-cvs-dir-state-heuristic dir)
234 (let ((default-directory dir))
235 ;; Don't specify DIR in this command, the default-directory is
236 ;; enough. Otherwise it might fail with remote repositories.
237 (with-temp-buffer
238 (vc-do-command t 0 "cvs" nil "status" "-l")
239 (goto-char (point-min))
240 (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
241 (narrow-to-region (match-beginning 0) (match-end 0))
242 (vc-cvs-parse-status)
243 (goto-char (point-max))
244 (widen))))))
245
246(defun vc-cvs-dir-state-heuristic (dir)
247 "Find the CVS state of all files in DIR, using only local information."
248 (with-temp-buffer
249 (vc-insert-file (expand-file-name "CVS/Entries" dir))
250 (goto-char (point-min))
251 (while (not (eobp))
252 (when (looking-at "/\\([^/]*\\)/")
253 (let ((file (expand-file-name (match-string 1) dir)))
254 (unless (vc-file-getprop file 'vc-state)
255 (vc-cvs-parse-entry file t))))
256 (forward-line 1))))
257
258(defun vc-cvs-parse-entry (file &optional set-state)
0d685c4f
DL
259 "Parse a line from CVS/Entries.
260Compare modification time to that of the FILE, set file properties
261accordingly. However, `vc-state' is set only if optional arg SET-STATE
262is non-nil."
c1b25099
GM
263 (cond
264 ;; entry for a "locally added" file (not yet committed)
265 ((looking-at "/[^/]+/0/")
266 (vc-file-setprop file 'vc-checkout-time 0)
267 (vc-file-setprop file 'vc-workfile-version "0")
268 (if set-state (vc-file-setprop file 'vc-state 'edited)))
269 ;; normal entry
0d685c4f 270 ((looking-at
c1b25099
GM
271 (concat "/[^/]+"
272 ;; revision
273 "/\\([^/]*\\)"
274 ;; timestamp
275 "/[A-Z][a-z][a-z]" ;; week day (irrelevant)
276 " \\([A-Z][a-z][a-z]\\)" ;; month name
277 " *\\([0-9]*\\)" ;; day of month
278 " \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\)" ;; hms
279 " \\([0-9]*\\)" ;; year
280 ;; optional conflict field
281 "\\(+[^/]*\\)?/"))
282 (vc-file-setprop file 'vc-workfile-version (match-string 1))
283 ;; compare checkout time and modification time
284 (let ((second (string-to-number (match-string 6)))
285 (minute (string-to-number (match-string 5)))
286 (hour (string-to-number (match-string 4)))
287 (day (string-to-number (match-string 3)))
288 (year (string-to-number (match-string 7)))
289 (month (/ (string-match
290 (match-string 2)
291 "xxxJanFebMarAprMayJunJulAugSepOctNovDec")
292 3))
293 (mtime (nth 5 (file-attributes file))))
294 (cond ((equal mtime
295 (encode-time second minute hour day month year 0))
296 (vc-file-setprop file 'vc-checkout-time mtime)
297 (if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
298 (t
299 (vc-file-setprop file 'vc-checkout-time 0)
300 (if set-state (vc-file-setprop file 'vc-state 'edited))))))
301 ;; entry with arbitrary text as timestamp
302 ;; (this means we should consider it modified)
303 ((looking-at
304 (concat "/[^/]+"
305 ;; revision
306 "/\\([^/]*\\)"
307 ;; timestamp (arbitrary text)
308 "/[^/]*"
309 ;; optional conflict field
310 "\\(+[^/]*\\)?/"))
311 (vc-file-setprop file 'vc-workfile-version (match-string 1))
312 (vc-file-setprop file 'vc-checkout-time 0)
313 (if set-state (vc-file-setprop file 'vc-state 'edited)))))
314\f
315(defun vc-cvs-print-log (file)
316 "Get change log associated with FILE."
317 (vc-do-command t 'async "cvs" file "log"))
318
319(defun vc-cvs-show-log-entry (version)
320 (when (re-search-forward
321 ;; also match some context, for safety
322 (concat "----\nrevision " version
323 "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
324 ;; set the display window so that
325 ;; the whole log entry is displayed
326 (let (start end lines)
327 (beginning-of-line) (forward-line -1) (setq start (point))
328 (if (not (re-search-forward "^----*\nrevision" nil t))
329 (setq end (point-max))
330 (beginning-of-line) (forward-line -1) (setq end (point)))
331 (setq lines (count-lines start end))
332 (cond
333 ;; if the global information and this log entry fit
334 ;; into the window, display from the beginning
335 ((< (count-lines (point-min) end) (window-height))
336 (goto-char (point-min))
337 (recenter 0)
338 (goto-char start))
339 ;; if the whole entry fits into the window,
340 ;; display it centered
341 ((< (1+ lines) (window-height))
342 (goto-char start)
343 (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
344 ;; otherwise (the entry is too large for the window),
345 ;; display from the start
346 (t
347 (goto-char start)
348 (recenter 0))))))
349
350(defun vc-cvs-create-snapshot (dir name branchp)
351 "Assign to DIR's current version a given NAME.
352If BRANCHP is non-nil, the name is created as a branch (and the current
353workspace is immediately moved to that new branch)."
354 (vc-do-command nil 0 "cvs" dir "tag" "-c" (if branchp "-b") name)
355 (when branchp (vc-do-command nil 0 "cvs" dir "update" "-r" name)))
356
357(defun vc-cvs-retrieve-snapshot (dir name update)
358 "Retrieve a snapshot at and below DIR.
359NAME is the name of the snapshot; if it is empty, do a `cvs update'.
360If UPDATE is non-nil, then update (resynch) any affected buffers."
361 (with-current-buffer (get-buffer-create "*vc*")
362 (let ((default-directory dir))
363 (erase-buffer)
364 (if (or (not name) (string= name ""))
365 (vc-do-command t 0 "cvs" nil "update")
366 (vc-do-command t 0 "cvs" nil "update" "-r" name))
367 (when update
368 (goto-char (point-min))
369 (while (not (eobp))
370 (if (looking-at "\\([CMUP]\\) \\(.*\\)")
371 (let* ((file (expand-file-name (match-string 2) dir))
372 (state (match-string 1))
373 (buffer (find-buffer-visiting file)))
374 (when buffer
0d685c4f 375 (cond
c1b25099
GM
376 ((or (string= state "U")
377 (string= state "P"))
378 (vc-file-setprop file 'vc-state 'up-to-date)
379 (vc-file-setprop file 'vc-workfile-version nil)
380 (vc-file-setprop file 'vc-checkout-time
381 (nth 5 (file-attributes file))))
382 ((or (string= state "M")
383 (string= state "C"))
384 (vc-file-setprop file 'vc-state 'edited)
385 (vc-file-setprop file 'vc-workfile-version nil)
386 (vc-file-setprop file 'vc-checkout-time 0)))
387 (vc-resynch-buffer file t t))))
388 (forward-line 1))))))
389
390(defun vc-cvs-merge (file first-version &optional second-version)
391 "Merge changes into current working copy of FILE.
392The changes are between FIRST-VERSION and SECOND-VERSION."
393 (vc-do-command nil 0 "cvs" file
394 "update" "-kk"
395 (concat "-j" first-version)
396 (concat "-j" second-version))
397 (vc-file-setprop file 'vc-state 'edited)
398 (save-excursion
399 (set-buffer (get-buffer "*vc*"))
400 (goto-char (point-min))
401 (if (re-search-forward "conflicts during merge" nil t)
402 1 ; signal error
403 0))) ; signal success
404
405(defun vc-cvs-merge-news (file)
406 "Merge in any new changes made to FILE."
407 (message "Merging changes into %s..." file)
408 (save-excursion
409 ;; (vc-file-setprop file 'vc-workfile-version nil)
410 (vc-file-setprop file 'vc-checkout-time 0)
411 (vc-do-command nil 0 "cvs" file "update")
412 ;; Analyze the merge result reported by CVS, and set
413 ;; file properties accordingly.
414 (set-buffer (get-buffer "*vc*"))
415 (goto-char (point-min))
416 ;; get new workfile version
417 (if (re-search-forward (concat "^Merging differences between "
418 "[01234567890.]* and "
419 "\\([01234567890.]*\\) into")
420 nil t)
421 (vc-file-setprop file 'vc-workfile-version (match-string 1))
422 (vc-file-setprop file 'vc-workfile-version nil))
423 ;; get file status
424 (prog1
e1483c38
AS
425 (if (eq (buffer-size) 0)
426 0 ;; there were no news; indicate success
427 (if (re-search-forward
428 (concat "^\\([CMUP] \\)?"
429 (regexp-quote (file-name-nondirectory file))
430 "\\( already contains the differences between \\)?")
431 nil t)
432 (cond
433 ;; Merge successful, we are in sync with repository now
434 ((or (match-string 2)
435 (string= (match-string 1) "U ")
436 (string= (match-string 1) "P "))
437 (vc-file-setprop file 'vc-state 'up-to-date)
438 (vc-file-setprop file 'vc-checkout-time
439 (nth 5 (file-attributes file)))
440 0);; indicate success to the caller
441 ;; Merge successful, but our own changes are still in the file
442 ((string= (match-string 1) "M ")
443 (vc-file-setprop file 'vc-state 'edited)
444 0);; indicate success to the caller
445 ;; Conflicts detected!
446 (t
447 (vc-file-setprop file 'vc-state 'edited)
448 1);; signal the error to the caller
449 )
450 (pop-to-buffer "*vc*")
451 (error "Couldn't analyze cvs update result")))
c1b25099
GM
452 (message "Merging changes into %s...done" file))))
453
454(defun vc-cvs-check-headers ()
455 "Check if the current file has any headers in it."
456 (save-excursion
457 (goto-char (point-min))
458 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
459\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
460
461(defun vc-cvs-steal (file &optional rev)
462 "Steal the lock on the current workfile for FILE and revision REV.
463Inappropriate for CVS"
464 (error "You cannot steal a CVS lock; there are no CVS locks to steal"))
465
466;; vc-check `not reached' for CVS.
467
468(defun vc-cvs-revert (file)
469 "Revert FILE to the version it was based on."
470 ;; Check out via standard output (caused by the final argument
471 ;; FILE below), so that no sticky tag is set.
472 (vc-cvs-checkout file nil (vc-workfile-version file) file)
473 ;; If "cvs edit" was used to make the file writable,
474 ;; call "cvs unedit" now to undo that.
475 (if (not (eq (vc-cvs-checkout-model file) 'implicit))
476 (vc-do-command nil 0 "cvs" file "unedit")))
477
478(defun vc-cvs-diff (file &optional oldvers newvers)
479 "Get a difference report using CVS between two versions of FILE."
480 (let (options status
481 (diff-switches-list (if (listp diff-switches)
482 diff-switches
483 (list diff-switches))))
484 (if (string= (vc-workfile-version file) "0")
485 ;; This file is added but not yet committed; there is no master file.
486 (if (or oldvers newvers)
487 (error "No revisions of %s exist" file)
488 ;; we regard this as "changed".
489 ;; diff it against /dev/null.
490 (apply 'vc-do-command t
491 'async "diff" file
492 (append diff-switches-list '("/dev/null"))))
493 (apply 'vc-do-command t
494 'async "cvs" file "diff"
495 (and oldvers (concat "-r" oldvers))
496 (and newvers (concat "-r" newvers))
497 diff-switches-list))
498 ;; We can't know yet, so we assume there'll be a difference
499 1))
500
501(defun vc-cvs-latest-on-branch-p (file)
0d685c4f 502 "Return t iff current workfile version of FILE is the latest on its branch."
c1b25099
GM
503 ;; Since this is only used as a sanity check for vc-cancel-version,
504 ;; and that is not supported under CVS at all, we can safely return t here.
505 ;; TODO: Think of getting rid of this altogether.
506 t)
507
508(defun vc-cvs-checkin (file rev comment)
509 "CVS-specific version of `vc-backend-checkin'."
510 (let ((switches (if (stringp vc-checkin-switches)
511 (list vc-checkin-switches)
512 vc-checkin-switches))
513 status)
514 ;; explicit check-in to the trunk requires a double check-in (first
515 ;; unexplicit) (CVS-1.3)
516 (if (and rev (vc-trunk-p rev))
517 (apply 'vc-do-command nil 1 "cvs" file
518 "ci" "-m" "intermediate"
519 switches))
520 (setq status (apply 'vc-do-command nil 1 "cvs" file
521 "ci" (if rev (concat "-r" rev))
522 (concat "-m" comment)
523 switches))
c1b25099
GM
524 (set-buffer "*vc*")
525 (goto-char (point-min))
bee48f25
AS
526 (when (not (zerop status))
527 ;; Check checkin problem.
528 (cond
529 ((re-search-forward "Up-to-date check failed" nil t)
530 (vc-file-setprop file 'vc-state 'needs-merge)
531 (error (substitute-command-keys
532 (concat "Up-to-date check failed: "
533 "type \\[vc-next-action] to merge in changes"))))
534 (t
535 (pop-to-buffer (current-buffer))
536 (goto-char (point-min))
537 (shrink-window-if-larger-than-buffer)
538 (error "Check-in failed"))))
c1b25099
GM
539 ;; Update file properties
540 (vc-file-setprop
541 file 'vc-workfile-version
542 (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
543 ;; Forget the checkout model of the file, because we might have
544 ;; guessed wrong when we found the file. After commit, we can
545 ;; tell it from the permissions of the file (see
546 ;; vc-cvs-checkout-model).
547 (vc-file-setprop file 'vc-checkout-model nil)
c1b25099
GM
548 ;; if this was an explicit check-in, remove the sticky tag
549 (if rev (vc-do-command t 0 "cvs" file "update" "-A"))))
550
551(defun vc-cvs-responsible-p (file)
552 "Return non-nil if CVS thinks it is responsible for FILE."
0d685c4f 553 (file-directory-p (expand-file-name "CVS"
c1b25099
GM
554 (if (file-directory-p file)
555 file
556 (file-name-directory file)))))
557
558(defun vc-cvs-could-register (file)
559 "Return non-nil if FILE could be registered in CVS.
560This is only possible if CVS is responsible for FILE's directory."
561 (vc-cvs-responsible-p file))
562
c86ef81c 563(defun vc-cvs-make-version-backups-p (file)
b3d6528a
AS
564 "Return non-nil if version backups should be made for FILE."
565 (vc-cvs-stay-local-p file))
566
c1b25099
GM
567(defun vc-cvs-register (file &optional rev comment)
568 "Register FILE into the CVS version-control system.
569COMMENT can be used to provide an initial description of FILE.
570
571`vc-register-switches' and `vc-cvs-register-switches' are passed to
572the CVS command (in that order)."
c1b25099
GM
573 (let ((switches (list
574 (if (stringp vc-register-switches)
575 (list vc-register-switches)
576 vc-register-switches)
577 (if (stringp vc-cvs-register-switches)
578 (list vc-cvs-register-switches)
579 vc-cvs-register-switches))))
580
581 (apply 'vc-do-command nil 0 "cvs" file
582 "add"
583 (and comment (string-match "[^\t\n ]" comment)
584 (concat "-m" comment))
585 switches)))
586
587(defun vc-cvs-checkout (file &optional writable rev workfile)
588 "Retrieve a revision of FILE into a WORKFILE.
589WRITABLE non-nil means that the file should be writable.
590REV is the revision to check out into WORKFILE."
591 (let ((filename (or workfile file))
592 (file-buffer (get-file-buffer file))
593 switches)
594 (message "Checking out %s..." filename)
595 (save-excursion
596 ;; Change buffers to get local value of vc-checkout-switches.
597 (if file-buffer (set-buffer file-buffer))
598 (setq switches (if (stringp vc-checkout-switches)
599 (list vc-checkout-switches)
600 vc-checkout-switches))
601 ;; Save this buffer's default-directory
602 ;; and use save-excursion to make sure it is restored
603 ;; in the same buffer it was saved in.
604 (let ((default-directory default-directory))
605 (save-excursion
606 ;; Adjust the default-directory so that the check-out creates
607 ;; the file in the right place.
608 (setq default-directory (file-name-directory filename))
609 (if workfile
610 (let ((failed t))
611 (unwind-protect
612 (progn
613 (let ((coding-system-for-read 'no-conversion)
614 (coding-system-for-write 'no-conversion))
615 (with-temp-file filename
616 (apply 'vc-do-command
617 (current-buffer) 0 "cvs" file
618 "-Q" ; suppress diagnostic output
619 "update"
620 (and rev (not (string= rev ""))
621 (concat "-r" rev))
622 "-p"
623 switches)))
624 (setq failed nil))
625 (and failed (file-exists-p filename) (delete-file filename))))
626 (if (and (file-exists-p file) (not rev))
627 ;; If no revision was specified, just make the file writable
628 ;; if necessary (using `cvs-edit' if requested).
629 (and writable (not (eq (vc-cvs-checkout-model file) 'implicit))
630 (if vc-cvs-use-edit
631 (vc-do-command nil 0 "cvs" file "edit")
632 (set-file-modes file (logior (file-modes file) 128))
633 (if file-buffer (toggle-read-only -1))))
634 ;; Check out a particular version (or recreate the file).
635 (vc-file-setprop file 'vc-workfile-version nil)
636 (apply 'vc-do-command nil 0 "cvs" file
637 (and writable
638 (or (not (file-exists-p file))
0d685c4f 639 (not (eq (vc-cvs-checkout-model file)
c1b25099
GM
640 'implicit)))
641 "-w")
642 "update"
643 ;; default for verbose checkout: clear the sticky tag so
644 ;; that the actual update will get the head of the trunk
0d685c4f
DL
645 (if (or (not rev) (string= rev ""))
646 "-A"
c1b25099 647 (concat "-r" rev))
099bd78a 648 switches))))
c1b25099
GM
649 (vc-mode-line file)
650 (message "Checking out %s...done" filename)))))
651
652(defun vc-cvs-annotate-command (file buffer)
0d685c4f
DL
653 "Execute \"cvs annotate\" on FILE.
654Use `call-process' and insert the contents in BUFFER."
c1b25099
GM
655 (call-process "cvs" nil buffer nil "annotate" file))
656
657(defvar vc-cvs-local-month-numbers
658 '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4)
659 ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8)
660 ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
0d685c4f 661 "Local association list of month numbers.")
c1b25099
GM
662
663(defun vc-cvs-annotate-difference (point)
0d685c4f
DL
664 "Return the difference between the time of the line and the current time.
665Return values are as defined for `current-time'."
c1b25099
GM
666 ;; We need a list of months and their corresponding numbers.
667 (if (looking-at "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")
668 (progn
669 (let* ((day (string-to-number (match-string 1)))
670 (month (cdr (assoc (match-string 2) vc-cvs-local-month-numbers)))
671 (year-tmp (string-to-number (match-string 3)))
672 ;; Years 0..68 are 2000..2068.
673 ;; Years 69..99 are 1969..1999.
674 (year (+ (cond ((> 69 year-tmp) 2000)
675 ((> 100 year-tmp) 1900)
676 (t 0))
677 year-tmp)))
678 (goto-char (match-end 0)) ; Position at end makes for nicer overlay result
679 (- (car (current-time))
680 (car (encode-time 0 0 0 day month year)))))
681 ;; If we did not look directly at an annotation, there might be
682 ;; some further down. This is the case if we are positioned at
683 ;; the very top of the buffer, for instance.
0d685c4f 684 (if (re-search-forward
c1b25099
GM
685 "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): " nil t)
686 (progn
687 (beginning-of-line nil)
688 (vc-cvs-annotate-difference (point))))))
689
690(provide 'vc-cvs)
691
692;;; vc-cvs.el ends here