Remove wash-log from the VC backend API.
[bpt/emacs.git] / lisp / vc-svn.el
1 ;;; vc-svn.el --- non-resident support for Subversion version-control
2
3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
4
5 ;; Author: FSF (see vc.el for full credits)
6 ;; Maintainer: Stefan Monnier <monnier@gnu.org>
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version
26 ;; has been extensively modified since to handle filesets.
27
28 ;;; Code:
29
30 (eval-when-compile
31 (require 'vc))
32
33 ;;;
34 ;;; Customization options
35 ;;;
36
37 (defcustom vc-svn-global-switches nil
38 "*Global switches to pass to any SVN command."
39 :type '(choice (const :tag "None" nil)
40 (string :tag "Argument String")
41 (repeat :tag "Argument List"
42 :value ("")
43 string))
44 :version "22.1"
45 :group 'vc)
46
47 (defcustom vc-svn-register-switches nil
48 "*Extra switches for registering a file into SVN.
49 A string or list of strings passed to the checkin program by
50 \\[vc-register]."
51 :type '(choice (const :tag "None" nil)
52 (string :tag "Argument String")
53 (repeat :tag "Argument List"
54 :value ("")
55 string))
56 :version "22.1"
57 :group 'vc)
58
59 (defcustom vc-svn-diff-switches
60 t ;`svn' doesn't support common args like -c or -b.
61 "String or list of strings specifying extra switches for svn diff under VC.
62 If nil, use the value of `vc-diff-switches'.
63 If you want to force an empty list of arguments, use t."
64 :type '(choice (const :tag "Unspecified" nil)
65 (const :tag "None" t)
66 (string :tag "Argument String")
67 (repeat :tag "Argument List"
68 :value ("")
69 string))
70 :version "22.1"
71 :group 'vc)
72
73 (defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$"))
74 "*Header keywords to be inserted by `vc-insert-headers'."
75 :version "22.1"
76 :type '(repeat string)
77 :group 'vc)
78
79 ;; We want to autoload it for use by the autoloaded version of
80 ;; vc-svn-registered, but we want the value to be compiled at startup, not
81 ;; at dump time.
82 ;; ;;;###autoload
83 (defconst vc-svn-admin-directory
84 (cond ((and (memq system-type '(cygwin windows-nt ms-dos))
85 (getenv "SVN_ASP_DOT_NET_HACK"))
86 "_svn")
87 (t ".svn"))
88 "The name of the \".svn\" subdirectory or its equivalent.")
89
90 ;;; Properties of the backend
91
92 (defun vc-svn-revision-granularity () 'repository)
93 (defun vc-svn-checkout-model (files) 'implicit)
94
95 ;;;
96 ;;; State-querying functions
97 ;;;
98
99 ;;; vc-svn-admin-directory is generally not defined when the
100 ;;; autoloaded function is called.
101
102 ;;;###autoload (defun vc-svn-registered (f)
103 ;;;###autoload (let ((admin-dir (cond ((and (eq system-type 'windows-nt)
104 ;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK"))
105 ;;;###autoload "_svn")
106 ;;;###autoload (t ".svn"))))
107 ;;;###autoload (when (file-readable-p (expand-file-name
108 ;;;###autoload (concat admin-dir "/entries")
109 ;;;###autoload (file-name-directory f)))
110 ;;;###autoload (load "vc-svn")
111 ;;;###autoload (vc-svn-registered f))))
112
113 ;;;###autoload
114 (add-to-list 'completion-ignored-extensions ".svn/")
115
116 (defun vc-svn-registered (file)
117 "Check if FILE is SVN registered."
118 (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory
119 "/entries")
120 (file-name-directory file)))
121 (with-temp-buffer
122 (cd (file-name-directory file))
123 (let ((status
124 (condition-case nil
125 ;; Ignore all errors.
126 (vc-svn-command t t file "status" "-v")
127 ;; Some problem happened. E.g. We can't find an `svn'
128 ;; executable. We used to only catch `file-error' but when
129 ;; the process is run on a remote host via Tramp, the error
130 ;; is only reported via the exit status which is turned into
131 ;; an `error' by vc-do-command.
132 (error nil))))
133 (when (eq 0 status)
134 (let ((parsed (vc-svn-parse-status file)))
135 (and parsed (not (memq parsed '(ignored unregistered))))))))))
136
137 (defun vc-svn-state (file &optional localp)
138 "SVN-specific version of `vc-state'."
139 (setq localp (or localp (vc-stay-local-p file)))
140 (with-temp-buffer
141 (cd (file-name-directory file))
142 (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
143 (vc-svn-parse-status file)))
144
145 (defun vc-svn-state-heuristic (file)
146 "SVN-specific state heuristic."
147 (vc-svn-state file 'local))
148
149 (defun vc-svn-after-dir-status (callback)
150 (let ((state-map '((?A . added)
151 (?C . conflict)
152 (?D . removed)
153 (?I . ignored)
154 (?M . edited)
155 (?R . removed)
156 (?? . unregistered)
157 ;; This is what vc-svn-parse-status does.
158 (?~ . edited)))
159 result)
160 (goto-char (point-min))
161 (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t)
162 (let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
163 (filename (match-string 2)))
164 (when state
165 (setq result (cons (list filename state) result)))))
166 (funcall callback result)))
167
168 (defun vc-svn-dir-status (dir callback)
169 "Run 'svn status' for DIR and update BUFFER via CALLBACK.
170 CALLBACK is called as (CALLBACK RESULT BUFFER), where
171 RESULT is a list of conses (FILE . STATE) for directory DIR."
172 (vc-svn-command (current-buffer) 'async nil "status")
173 (vc-exec-after
174 `(vc-svn-after-dir-status (quote ,callback))))
175
176 (defun vc-svn-working-revision (file)
177 "SVN-specific version of `vc-working-revision'."
178 ;; There is no need to consult RCS headers under SVN, because we
179 ;; get the workfile version for free when we recognize that a file
180 ;; is registered in SVN.
181 (vc-svn-registered file)
182 (vc-file-getprop file 'vc-working-revision))
183
184 ;; vc-svn-mode-line-string doesn't exist because the default implementation
185 ;; works just fine.
186
187 (defun vc-svn-previous-revision (file rev)
188 (let ((newrev (1- (string-to-number rev))))
189 (when (< 0 newrev)
190 (number-to-string newrev))))
191
192 (defun vc-svn-next-revision (file rev)
193 (let ((newrev (1+ (string-to-number rev))))
194 ;; The "working revision" is an uneasy conceptual fit under Subversion;
195 ;; we use it as the upper bound until a better idea comes along. If the
196 ;; workfile version W coincides with the tree's latest revision R, then
197 ;; this check prevents a "no such revision: R+1" error. Otherwise, it
198 ;; inhibits showing of W+1 through R, which could be considered anywhere
199 ;; from gracious to impolite.
200 (unless (< (string-to-number (vc-file-getprop file 'vc-working-revision))
201 newrev)
202 (number-to-string newrev))))
203
204
205 ;;;
206 ;;; State-changing functions
207 ;;;
208
209 (defun vc-svn-create-repo ()
210 "Create a new SVN repository."
211 (vc-do-command nil 0 "svnadmin" '("create" "SVN"))
212 (vc-do-command nil 0 "svn" '(".")
213 "checkout" (concat "file://" default-directory "SVN")))
214
215 (defun vc-svn-register (files &optional rev comment)
216 "Register FILES into the SVN version-control system.
217 The COMMENT argument is ignored This does an add but not a commit.
218
219 `vc-register-switches' and `vc-svn-register-switches' are passed to
220 the SVN command (in that order)."
221 (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
222
223 (defun vc-svn-responsible-p (file)
224 "Return non-nil if SVN thinks it is responsible for FILE."
225 (file-directory-p (expand-file-name vc-svn-admin-directory
226 (if (file-directory-p file)
227 file
228 (file-name-directory file)))))
229
230 (defalias 'vc-svn-could-register 'vc-svn-responsible-p
231 "Return non-nil if FILE could be registered in SVN.
232 This is only possible if SVN is responsible for FILE's directory.")
233
234 (defun vc-svn-checkin (files rev comment)
235 "SVN-specific version of `vc-backend-checkin'."
236 (if rev (error "Committing to a specific revision is unsupported in SVN"))
237 (let ((status (apply
238 'vc-svn-command nil 1 files "ci"
239 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
240 (set-buffer "*vc*")
241 (goto-char (point-min))
242 (unless (equal status 0)
243 ;; Check checkin problem.
244 (cond
245 ((search-forward "Transaction is out of date" nil t)
246 (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
247 files)
248 (error (substitute-command-keys
249 (concat "Up-to-date check failed: "
250 "type \\[vc-next-action] to merge in changes"))))
251 (t
252 (pop-to-buffer (current-buffer))
253 (goto-char (point-min))
254 (shrink-window-if-larger-than-buffer)
255 (error "Check-in failed"))))
256 ;; Update file properties
257 ;; (vc-file-setprop
258 ;; file 'vc-working-revision
259 ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
260 ))
261
262 (defun vc-svn-find-revision (file rev buffer)
263 "SVN-specific retrieval of a specified version into a buffer."
264 (apply 'vc-svn-command
265 buffer 0 file
266 "cat"
267 (and rev (not (string= rev ""))
268 (concat "-r" rev))
269 (vc-switches 'SVN 'checkout)))
270
271 (defun vc-svn-checkout (file &optional editable rev)
272 (message "Checking out %s..." file)
273 (with-current-buffer (or (get-file-buffer file) (current-buffer))
274 (vc-svn-update file editable rev (vc-switches 'SVN 'checkout)))
275 (vc-mode-line file)
276 (message "Checking out %s...done" file))
277
278 (defun vc-svn-update (file editable rev switches)
279 (if (and (file-exists-p file) (not rev))
280 ;; If no revision was specified, there's nothing to do.
281 nil
282 ;; Check out a particular version (or recreate the file).
283 (vc-file-setprop file 'vc-working-revision nil)
284 (apply 'vc-svn-command nil 0 file
285 "update"
286 (cond
287 ((null rev) "-rBASE")
288 ((or (eq rev t) (equal rev "")) nil)
289 (t (concat "-r" rev)))
290 switches)))
291
292 (defun vc-svn-delete-file (file)
293 (vc-svn-command nil 0 file "remove"))
294
295 (defun vc-svn-rename-file (old new)
296 (vc-svn-command nil 0 new "move" (file-relative-name old)))
297
298 (defun vc-svn-revert (file &optional contents-done)
299 "Revert FILE to the version it was based on."
300 (unless contents-done
301 (vc-svn-command nil 0 file "revert")))
302
303 (defun vc-svn-merge (file first-version &optional second-version)
304 "Merge changes into current working copy of FILE.
305 The changes are between FIRST-VERSION and SECOND-VERSION."
306 (vc-svn-command nil 0 file
307 "merge"
308 "-r" (if second-version
309 (concat first-version ":" second-version)
310 first-version))
311 (vc-file-setprop file 'vc-state 'edited)
312 (with-current-buffer (get-buffer "*vc*")
313 (goto-char (point-min))
314 (if (looking-at "C ")
315 1 ; signal conflict
316 0))) ; signal success
317
318 (defun vc-svn-merge-news (file)
319 "Merge in any new changes made to FILE."
320 (message "Merging changes into %s..." file)
321 ;; (vc-file-setprop file 'vc-working-revision nil)
322 (vc-file-setprop file 'vc-checkout-time 0)
323 (vc-svn-command nil 0 file "update")
324 ;; Analyze the merge result reported by SVN, and set
325 ;; file properties accordingly.
326 (with-current-buffer (get-buffer "*vc*")
327 (goto-char (point-min))
328 ;; get new working revision
329 (if (re-search-forward
330 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
331 (vc-file-setprop file 'vc-working-revision (match-string 2))
332 (vc-file-setprop file 'vc-working-revision nil))
333 ;; get file status
334 (goto-char (point-min))
335 (prog1
336 (if (looking-at "At revision")
337 0 ;; there were no news; indicate success
338 (if (re-search-forward
339 ;; Newer SVN clients have 3 columns of chars (one for the
340 ;; file's contents, then second for its properties, and the
341 ;; third for lock-grabbing info), before the 2 spaces.
342 ;; We also used to match the filename in column 0 without any
343 ;; meta-info before it, but I believe this can never happen.
344 (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)"
345 (regexp-quote (file-name-nondirectory file)))
346 nil t)
347 (cond
348 ;; Merge successful, we are in sync with repository now
349 ((string= (match-string 2) "U")
350 (vc-file-setprop file 'vc-state 'up-to-date)
351 (vc-file-setprop file 'vc-checkout-time
352 (nth 5 (file-attributes file)))
353 0);; indicate success to the caller
354 ;; Merge successful, but our own changes are still in the file
355 ((string= (match-string 2) "G")
356 (vc-file-setprop file 'vc-state 'edited)
357 0);; indicate success to the caller
358 ;; Conflicts detected!
359 (t
360 (vc-file-setprop file 'vc-state 'edited)
361 1);; signal the error to the caller
362 )
363 (pop-to-buffer "*vc*")
364 (error "Couldn't analyze svn update result")))
365 (message "Merging changes into %s...done" file))))
366
367 (defun vc-svn-modify-change-comment (files rev comment)
368 "Modify the change comments for a specified REV.
369 You must have ssh access to the repository host, and the directory Emacs
370 uses locally for temp files must also be writeable by you on that host.
371 This is only supported if the repository access method is either file://
372 or svn+ssh://."
373 (let (tempfile host remotefile directory fileurl-p)
374 (with-temp-buffer
375 (vc-do-command (current-buffer) 0 "svn" nil "info")
376 (goto-char (point-min))
377 (unless (re-search-forward "Repository Root: \\(file://\\(/.*\\)\\)\\|\\(svn\\+ssh://\\([^/]+\\)\\(/.*\\)\\)" nil t)
378 (error "Repository information is unavailable"))
379 (if (match-string 1)
380 (progn
381 (setq fileurl-p t)
382 (setq directory (match-string 2)))
383 (setq host (match-string 4))
384 (setq directory (match-string 5))
385 (setq remotefile (concat host ":" tempfile))))
386 (with-temp-file (setq tempfile (make-temp-file user-mail-address))
387 (insert comment))
388 (if fileurl-p
389 ;; Repository Root is a local file.
390 (progn
391 (unless (vc-do-command
392 nil 0 "svnadmin" nil
393 "setlog" "--bypass-hooks" directory
394 "-r" rev (format "%s" tempfile))
395 (error "Log edit failed"))
396 (delete-file tempfile))
397
398 ;; Remote repository, using svn+ssh.
399 (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile)
400 (error "Copy of comment to %s failed" remotefile))
401 (unless (vc-do-command
402 nil 0 "ssh" nil "-q" host
403 (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
404 directory rev tempfile tempfile))
405 (error "Log edit failed")))))
406
407 ;;;
408 ;;; History functions
409 ;;;
410
411 (defun vc-svn-print-log (files &optional buffer)
412 "Get change log(s) associated with FILES."
413 (save-current-buffer
414 (vc-setup-buffer buffer)
415 (let ((inhibit-read-only t))
416 (goto-char (point-min))
417 (if files
418 (dolist (file files)
419 (insert "Working file: " file "\n")
420 (vc-svn-command
421 buffer
422 'async
423 ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0)
424 (list file)
425 "log"
426 ;; By default Subversion only shows the log up to the
427 ;; working revision, whereas we also want the log of the
428 ;; subsequent commits. At least that's what the
429 ;; vc-cvs.el code does.
430 "-rHEAD:0"))
431 ;; Dump log for the entire directory.
432 (vc-svn-command buffer 0 nil "log" "-rHEAD:0")))))
433
434 (defun vc-svn-diff (files &optional oldvers newvers buffer)
435 "Get a difference report using SVN between two revisions of fileset FILES."
436 (and oldvers
437 (catch 'no
438 (dolist (f files)
439 (or (equal oldvers (vc-working-revision f))
440 (throw 'no nil)))
441 t)
442 ;; Use nil rather than the current revision because svn handles
443 ;; it better (i.e. locally). Note that if _any_ of the files
444 ;; has a different revision, we fetch the lot, which is
445 ;; obviously sub-optimal.
446 (setq oldvers nil))
447 (let* ((switches
448 (if vc-svn-diff-switches
449 (vc-switches 'SVN 'diff)
450 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
451 (async (and (not vc-disable-async-diff)
452 (vc-stay-local-p files)
453 (or oldvers newvers)))) ; Svn diffs those locally.
454 (apply 'vc-svn-command buffer
455 (if async 'async 0)
456 files "diff"
457 (append
458 switches
459 (when oldvers
460 (list "-r" (if newvers (concat oldvers ":" newvers)
461 oldvers)))))
462 (if async 1 ; async diff => pessimistic assumption
463 ;; For some reason `svn diff' does not return a useful
464 ;; status w.r.t whether the diff was empty or not.
465 (buffer-size (get-buffer buffer)))))
466
467 ;;;
468 ;;; Snapshot system
469 ;;;
470
471 (defun vc-svn-create-snapshot (dir name branchp)
472 "Assign to DIR's current revision a given NAME.
473 If BRANCHP is non-nil, the name is created as a branch (and the current
474 workspace is immediately moved to that new branch).
475 NAME is assumed to be a URL."
476 (vc-svn-command nil 0 dir "copy" name)
477 (when branchp (vc-svn-retrieve-snapshot dir name nil)))
478
479 (defun vc-svn-retrieve-snapshot (dir name update)
480 "Retrieve a snapshot at and below DIR.
481 NAME is the name of the snapshot; if it is empty, do a `svn update'.
482 If UPDATE is non-nil, then update (resynch) any affected buffers.
483 NAME is assumed to be a URL."
484 (vc-svn-command nil 0 dir "switch" name)
485 ;; FIXME: parse the output and obey `update'.
486 )
487
488 ;;;
489 ;;; Miscellaneous
490 ;;;
491
492 ;; Subversion makes backups for us, so don't bother.
493 ;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
494 ;; "Return non-nil if version backups should be made for FILE.")
495
496 (defun vc-svn-check-headers ()
497 "Check if the current file has any headers in it."
498 (save-excursion
499 (goto-char (point-min))
500 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
501 \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
502
503
504 ;;;
505 ;;; Internal functions
506 ;;;
507
508 (defcustom vc-svn-program "svn"
509 "Name of the SVN executable."
510 :type 'string
511 :group 'vc)
512
513 (defun vc-svn-root (dir)
514 (vc-find-root dir vc-svn-admin-directory t))
515
516 (defun vc-svn-command (buffer okstatus file-or-list &rest flags)
517 "A wrapper around `vc-do-command' for use in vc-svn.el.
518 The difference to vc-do-command is that this function always invokes `svn',
519 and that it passes `vc-svn-global-switches' to it before FLAGS."
520 (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
521 (if (stringp vc-svn-global-switches)
522 (cons vc-svn-global-switches flags)
523 (append vc-svn-global-switches
524 flags))))
525
526 (defun vc-svn-repository-hostname (dirname)
527 (with-temp-buffer
528 (let ((coding-system-for-read
529 (or file-name-coding-system
530 default-file-name-coding-system)))
531 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
532 "/entries")
533 dirname)))
534 (goto-char (point-min))
535 (when (re-search-forward
536 ;; Old `svn' used name="svn:this_dir", newer use just name="".
537 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
538 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
539 "url=\"\\(?1:[^\"]+\\)\""
540 ;; Yet newer ones don't use XML any more.
541 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
542 ;; This is not a hostname but a URL. This may actually be considered
543 ;; as a feature since it allows vc-svn-stay-local to specify different
544 ;; behavior for different modules on the same server.
545 (match-string 1))))
546
547 (defun vc-svn-resolve-when-done ()
548 "Call \"svn resolved\" if the conflict markers have been removed."
549 (save-excursion
550 (goto-char (point-min))
551 (unless (re-search-forward "^<<<<<<< " nil t)
552 (vc-svn-command nil 0 buffer-file-name "resolved")
553 ;; Remove the hook so that it is not called multiple times.
554 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
555
556 ;; Inspired by vc-arch-find-file-hook.
557 (defun vc-svn-find-file-hook ()
558 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
559 ;; If the file is marked as "conflicted", then we should try and call
560 ;; "svn resolved" when applicable.
561 (if (save-excursion
562 (goto-char (point-min))
563 (re-search-forward "^<<<<<<< " nil t))
564 ;; There are conflict markers.
565 (progn
566 (smerge-start-session)
567 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
568 ;; There are no conflict markers. This is problematic: maybe it means
569 ;; the conflict has been resolved and we should immediately call "svn
570 ;; resolved", or it means that the file's type does not allow Svn to
571 ;; use conflict markers in which case we don't really know what to do.
572 ;; So let's just punt for now.
573 nil)
574 (message "There are unresolved conflicts in this file")))
575
576 (defun vc-svn-parse-status (&optional filename)
577 "Parse output of \"svn status\" command in the current buffer.
578 Set file properties accordingly. Unless FILENAME is non-nil, parse only
579 information about FILENAME and return its status."
580 (let (file status)
581 (goto-char (point-min))
582 (while (re-search-forward
583 ;; Ignore the files with status X.
584 "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
585 ;; If the username contains spaces, the output format is ambiguous,
586 ;; so don't trust the output's filename unless we have to.
587 (setq file (or filename
588 (expand-file-name
589 (buffer-substring (point) (line-end-position)))))
590 (setq status (char-after (line-beginning-position)))
591 (if (eq status ??)
592 (vc-file-setprop file 'vc-state 'unregistered)
593 ;; `vc-BACKEND-registered' must not set vc-backend,
594 ;; which is instead set in vc-registered.
595 (unless filename (vc-file-setprop file 'vc-backend 'SVN))
596 ;; Use the last-modified revision, so that searching in vc-print-log
597 ;; output works.
598 (vc-file-setprop file 'vc-working-revision (match-string 3))
599 ;; Remember Svn's own status.
600 (vc-file-setprop file 'vc-svn-status status)
601 (vc-file-setprop
602 file 'vc-state
603 (cond
604 ((eq status ?\ )
605 (if (eq (char-after (match-beginning 1)) ?*)
606 'needs-update
607 (vc-file-setprop file 'vc-checkout-time
608 (nth 5 (file-attributes file)))
609 'up-to-date))
610 ((eq status ?A)
611 ;; If the file was actually copied, (match-string 2) is "-".
612 (vc-file-setprop file 'vc-working-revision "0")
613 (vc-file-setprop file 'vc-checkout-time 0)
614 'added)
615 ((eq status ?C)
616 (vc-file-setprop file 'vc-state 'conflict))
617 ((eq status '?M)
618 (if (eq (char-after (match-beginning 1)) ?*)
619 'needs-merge
620 'edited))
621 ((eq status ?I)
622 (vc-file-setprop file 'vc-state 'ignored))
623 ((eq status ?R)
624 (vc-file-setprop file 'vc-state 'removed))
625 (t 'edited)))))
626 (if filename (vc-file-getprop filename 'vc-state))))
627
628 (defun vc-svn-dir-state-heuristic (dir)
629 "Find the SVN state of all files in DIR, using only local information."
630 (vc-svn-dir-state dir 'local))
631
632 (defun vc-svn-valid-symbolic-tag-name-p (tag)
633 "Return non-nil if TAG is a valid symbolic tag name."
634 ;; According to the SVN manual, a valid symbolic tag must start with
635 ;; an uppercase or lowercase letter and can contain uppercase and
636 ;; lowercase letters, digits, `-', and `_'.
637 (and (string-match "^[a-zA-Z]" tag)
638 (not (string-match "[^a-z0-9A-Z-_]" tag))))
639
640 (defun vc-svn-valid-revision-number-p (tag)
641 "Return non-nil if TAG is a valid revision number."
642 (and (string-match "^[0-9]" tag)
643 (not (string-match "[^0-9]" tag))))
644
645 ;; Support for `svn annotate'
646
647 (defun vc-svn-annotate-command (file buf &optional rev)
648 (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev))))
649
650 (defun vc-svn-annotate-time-of-rev (rev)
651 ;; Arbitrarily assume 10 commmits per day.
652 (/ (string-to-number rev) 10.0))
653
654 (defun vc-svn-annotate-current-time ()
655 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))
656
657 (defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
658
659 (defun vc-svn-annotate-time ()
660 (when (looking-at vc-svn-annotate-re)
661 (goto-char (match-end 0))
662 (vc-svn-annotate-time-of-rev (match-string 1))))
663
664 (defun vc-svn-annotate-extract-revision-at-line ()
665 (save-excursion
666 (beginning-of-line)
667 (if (looking-at vc-svn-annotate-re) (match-string 1))))
668
669 (provide 'vc-svn)
670
671 ;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
672 ;;; vc-svn.el ends here