1 ;;; vc-svn.el --- non-resident support for Subversion version-control
3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5 ;; Author: FSF (see vc.el for full credits)
6 ;; Maintainer: Stefan Monnier <monnier@gnu.org>
8 ;; This file is part of GNU Emacs.
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, or (at your option)
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version
28 ;; has been extensively modified since to handle filesets.
32 ;; - VC-dired is (really) slow.
40 ;;; Customization options
43 (defcustom vc-svn-global-switches nil
44 "*Global switches to pass to any SVN command."
45 :type
'(choice (const :tag
"None" nil
)
46 (string :tag
"Argument String")
47 (repeat :tag
"Argument List"
53 (defcustom vc-svn-register-switches nil
54 "*Extra switches for registering a file into SVN.
55 A string or list of strings passed to the checkin program by
57 :type
'(choice (const :tag
"None" nil
)
58 (string :tag
"Argument String")
59 (repeat :tag
"Argument List"
65 (defcustom vc-svn-diff-switches
66 t
;`svn' doesn't support common args like -c or -b.
67 "String or list of strings specifying extra switches for svn diff under VC.
68 If nil, use the value of `vc-diff-switches'.
69 If you want to force an empty list of arguments, use t."
70 :type
'(choice (const :tag
"Unspecified" nil
)
72 (string :tag
"Argument String")
73 (repeat :tag
"Argument List"
79 (defcustom vc-svn-header
(or (cdr (assoc 'SVN vc-header-alist
)) '("\$Id\$"))
80 "*Header keywords to be inserted by `vc-insert-headers'."
82 :type
'(repeat string
)
85 ;; We want to autoload it for use by the autoloaded version of
86 ;; vc-svn-registered, but we want the value to be compiled at startup, not
89 (defconst vc-svn-admin-directory
90 (cond ((and (memq system-type
'(cygwin windows-nt ms-dos
))
91 (getenv "SVN_ASP_DOT_NET_HACK"))
94 "The name of the \".svn\" subdirectory or its equivalent.")
96 ;;; Properties of the backend
98 (defun vc-svn-revision-granularity ()
101 ;;; State-querying functions
104 ;;; vc-svn-admin-directory is generally not defined when the
105 ;;; autoloaded function is called.
107 ;;;###autoload (defun vc-svn-registered (f)
108 ;;;###autoload (let ((admin-dir (cond ((and (eq system-type 'windows-nt)
109 ;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK"))
110 ;;;###autoload "_svn")
111 ;;;###autoload (t ".svn"))))
112 ;;;###autoload (when (file-readable-p (expand-file-name
113 ;;;###autoload (concat admin-dir "/entries")
114 ;;;###autoload (file-name-directory f)))
115 ;;;###autoload (load "vc-svn")
116 ;;;###autoload (vc-svn-registered f))))
119 (add-to-list 'completion-ignored-extensions
".svn/")
121 (defun vc-svn-registered (file)
122 "Check if FILE is SVN registered."
123 (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory
125 (file-name-directory file
)))
127 (cd (file-name-directory file
))
130 ;; Ignore all errors.
131 (vc-svn-command t t file
"status" "-v")
132 ;; Some problem happened. E.g. We can't find an `svn'
133 ;; executable. We used to only catch `file-error' but when
134 ;; the process is run on a remote host via Tramp, the error
135 ;; is only reported via the exit status which is turned into
136 ;; an `error' by vc-do-command.
139 (vc-svn-parse-status file
))))))
141 (defun vc-svn-state (file &optional localp
)
142 "SVN-specific version of `vc-state'."
143 (setq localp
(or localp
(vc-stay-local-p file
)))
145 (cd (file-name-directory file
))
146 (vc-svn-command t
0 file
"status" (if localp
"-v" "-u"))
147 (vc-svn-parse-status file
)))
149 (defun vc-svn-state-heuristic (file)
150 "SVN-specific state heuristic."
151 (vc-svn-state file
'local
))
153 (defun vc-svn-dir-state (dir &optional localp
)
154 "Find the SVN state of all files in DIR."
155 (setq localp
(or localp
(vc-stay-local-p dir
)))
156 (let ((default-directory dir
))
157 ;; Don't specify DIR in this command, the default-directory is
158 ;; enough. Otherwise it might fail with remote repositories.
160 (vc-svn-command t
0 nil
"status" (if localp
"-v" "-u"))
161 (vc-svn-parse-status))))
163 (defun vc-svn-working-revision (file)
164 "SVN-specific version of `vc-working-revision'."
165 ;; There is no need to consult RCS headers under SVN, because we
166 ;; get the workfile version for free when we recognize that a file
167 ;; is registered in SVN.
168 (vc-svn-registered file
)
169 (vc-file-getprop file
'vc-working-revision
))
171 (defun vc-svn-checkout-model (file)
172 "SVN-specific version of `vc-checkout-model'."
173 ;; It looks like Subversion has no equivalent of CVSREAD.
176 ;; vc-svn-mode-line-string doesn't exist because the default implementation
179 (defun vc-svn-dired-state-info (file)
180 "SVN-specific version of `vc-dired-state-info'."
181 (let ((svn-state (vc-state file
)))
182 (cond ((eq svn-state
'edited
)
183 (if (equal (vc-working-revision file
) "0")
184 "(added)" "(modified)"))
185 ((eq svn-state
'needs-patch
) "(patch)")
186 ((eq svn-state
'needs-merge
) "(merge)"))))
188 (defun vc-svn-previous-revision (file rev
)
189 (let ((newrev (1- (string-to-number rev
))))
191 (number-to-string newrev
))))
193 (defun vc-svn-next-revision (file rev
)
194 (let ((newrev (1+ (string-to-number rev
))))
195 ;; The "working revision" is an uneasy conceptual fit under Subversion;
196 ;; we use it as the upper bound until a better idea comes along. If the
197 ;; workfile version W coincides with the tree's latest revision R, then
198 ;; this check prevents a "no such revision: R+1" error. Otherwise, it
199 ;; inhibits showing of W+1 through R, which could be considered anywhere
200 ;; from gracious to impolite.
201 (unless (< (string-to-number (vc-file-getprop file
'vc-working-revision
))
203 (number-to-string newrev
))))
207 ;;; State-changing functions
210 (defun vc-svn-create-repo ()
211 "Create a new SVN repository."
212 (vc-do-command nil
0 "svnadmin" '("create" "SVN"))
213 (vc-do-command nil
0 "svn" '(".")
214 "checkout" (concat "file://" default-directory
"SVN")))
216 (defun vc-svn-register (files &optional rev comment
)
217 "Register FILES into the SVN version-control system.
218 The COMMENT argument is ignored This does an add but not a commit.
220 `vc-register-switches' and `vc-svn-register-switches' are passed to
221 the SVN command (in that order)."
222 (apply 'vc-svn-command nil
0 files
"add" (vc-switches 'SVN
'register
)))
224 (defun vc-svn-responsible-p (file)
225 "Return non-nil if SVN thinks it is responsible for FILE."
226 (file-directory-p (expand-file-name vc-svn-admin-directory
227 (if (file-directory-p file
)
229 (file-name-directory file
)))))
231 (defalias 'vc-svn-could-register
'vc-svn-responsible-p
232 "Return non-nil if FILE could be registered in SVN.
233 This is only possible if SVN is responsible for FILE's directory.")
235 (defun vc-svn-checkin (files rev comment
)
236 "SVN-specific version of `vc-backend-checkin'."
237 (if rev
(error "Committing to a specific revision is unsupported in SVN."))
239 'vc-svn-command nil
1 files
"ci"
240 (nconc (list "-m" comment
) (vc-switches 'SVN
'checkin
)))))
242 (goto-char (point-min))
243 (unless (equal status
0)
244 ;; Check checkin problem.
246 ((search-forward "Transaction is out of date" nil t
)
247 (mapc (lambda (file) (vc-file-setprop file
'vc-state
'needs-merge
))
249 (error (substitute-command-keys
250 (concat "Up-to-date check failed: "
251 "type \\[vc-next-action] to merge in changes"))))
253 (pop-to-buffer (current-buffer))
254 (goto-char (point-min))
255 (shrink-window-if-larger-than-buffer)
256 (error "Check-in failed"))))
257 ;; Update file properties
259 ;; file 'vc-working-revision
260 ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
263 (defun vc-svn-find-revision (file rev buffer
)
264 "SVN-specific retrieval of a specified version into a buffer."
265 (apply 'vc-svn-command
268 (and rev
(not (string= rev
""))
270 (vc-switches 'SVN
'checkout
)))
272 (defun vc-svn-checkout (file &optional editable rev
)
273 (message "Checking out %s..." file
)
274 (with-current-buffer (or (get-file-buffer file
) (current-buffer))
275 (vc-call update file editable rev
(vc-switches 'SVN
'checkout
)))
277 (message "Checking out %s...done" file
))
279 (defun vc-svn-update (file editable rev switches
)
280 (if (and (file-exists-p file
) (not rev
))
281 ;; If no revision was specified, there's nothing to do.
283 ;; Check out a particular version (or recreate the file).
284 (vc-file-setprop file
'vc-working-revision nil
)
285 (apply 'vc-svn-command nil
0 file
287 ;; default for verbose checkout: clear the sticky tag so
288 ;; that the actual update will get the head of the trunk
290 ((null rev
) "-rBASE")
291 ((or (eq rev t
) (equal rev
"")) nil
)
292 (t (concat "-r" rev
)))
295 (defun vc-svn-delete-file (file)
296 (vc-svn-command nil
0 file
"remove"))
298 (defun vc-svn-rename-file (old new
)
299 (vc-svn-command nil
0 new
"move" (file-relative-name old
)))
301 (defun vc-svn-revert (file &optional contents-done
)
302 "Revert FILE to the version it was based on."
303 (unless contents-done
304 (vc-svn-command nil
0 file
"revert")))
306 (defun vc-svn-merge (file first-version
&optional second-version
)
307 "Merge changes into current working copy of FILE.
308 The changes are between FIRST-VERSION and SECOND-VERSION."
309 (vc-svn-command nil
0 file
311 "-r" (if second-version
312 (concat first-version
":" second-version
)
314 (vc-file-setprop file
'vc-state
'edited
)
315 (with-current-buffer (get-buffer "*vc*")
316 (goto-char (point-min))
317 (if (looking-at "C ")
319 0))) ; signal success
321 (defun vc-svn-merge-news (file)
322 "Merge in any new changes made to FILE."
323 (message "Merging changes into %s..." file
)
324 ;; (vc-file-setprop file 'vc-working-revision nil)
325 (vc-file-setprop file
'vc-checkout-time
0)
326 (vc-svn-command nil
0 file
"update")
327 ;; Analyze the merge result reported by SVN, and set
328 ;; file properties accordingly.
329 (with-current-buffer (get-buffer "*vc*")
330 (goto-char (point-min))
331 ;; get new working revision
332 (if (re-search-forward
333 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t
)
334 (vc-file-setprop file
'vc-working-revision
(match-string 2))
335 (vc-file-setprop file
'vc-working-revision nil
))
337 (goto-char (point-min))
339 (if (looking-at "At revision")
340 0 ;; there were no news; indicate success
341 (if (re-search-forward
342 ;; Newer SVN clients have 3 columns of chars (one for the
343 ;; file's contents, then second for its properties, and the
344 ;; third for lock-grabbing info), before the 2 spaces.
345 ;; We also used to match the filename in column 0 without any
346 ;; meta-info before it, but I believe this can never happen.
347 (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)"
348 (regexp-quote (file-name-nondirectory file
)))
351 ;; Merge successful, we are in sync with repository now
352 ((string= (match-string 2) "U")
353 (vc-file-setprop file
'vc-state
'up-to-date
)
354 (vc-file-setprop file
'vc-checkout-time
355 (nth 5 (file-attributes file
)))
356 0);; indicate success to the caller
357 ;; Merge successful, but our own changes are still in the file
358 ((string= (match-string 2) "G")
359 (vc-file-setprop file
'vc-state
'edited
)
360 0);; indicate success to the caller
361 ;; Conflicts detected!
363 (vc-file-setprop file
'vc-state
'edited
)
364 1);; signal the error to the caller
366 (pop-to-buffer "*vc*")
367 (error "Couldn't analyze svn update result")))
368 (message "Merging changes into %s...done" file
))))
372 ;;; History functions
375 (defun vc-svn-print-log (files &optional buffer
)
376 "Get change log(s) associated with FILES."
378 (vc-setup-buffer buffer
)
379 (let ((inhibit-read-only t
))
380 (goto-char (point-min))
381 ;; Add a line to tell log-view-mode what file this is.
382 ;; FIXME if there are multiple files, log-view-current-file
383 ;; breaks. It's trivial to adapt log-view-file-re for the
384 ;; changed prefix, but less trivial to make
385 ;; log-view-current-file actually do the right thing in the
386 ;; multiple file case.
387 (insert (format "Working file%s: "
388 (if (= (length files
) 1)
391 (vc-delistify (mapcar 'file-relative-name files
)) "\n"))
394 (if (and (= (length files
) 1) (vc-stay-local-p (car files
)) (fboundp 'start-process
)) 'async
0)
396 ;; By default Subversion only shows the log upto the working revision,
397 ;; whereas we also want the log of the subsequent commits. At least
398 ;; that's what the vc-cvs.el code does.
401 (defun vc-svn-wash-log ()
402 "Remove all non-comment information from log output."
403 ;; FIXME: not implemented for SVN
406 (defun vc-svn-diff (files &optional oldvers newvers buffer
)
407 "Get a difference report using SVN between two revisions of fileset FILES."
411 (or (equal oldvers
(vc-working-revision f
))
414 ;; Use nil rather than the current revision because svn handles
415 ;; it better (i.e. locally). Note that if _any_ of the files
416 ;; has a different revision, we fetch the lot, which is
417 ;; obviously sub-optimal.
420 (if vc-svn-diff-switches
421 (vc-switches 'SVN
'diff
)
422 (list "-x" (mapconcat 'identity
(vc-switches nil
'diff
) " "))))
423 (async (and (not vc-disable-async-diff
)
424 (vc-stay-local-p files
)
425 (or oldvers newvers
) ; Svn diffs those locally.
426 (fboundp 'start-process
))))
427 (apply 'vc-svn-command buffer
433 (list "-r" (if newvers
(concat oldvers
":" newvers
)
435 (if async
1 ; async diff => pessimistic assumption
436 ;; For some reason `svn diff' does not return a useful
437 ;; status w.r.t whether the diff was empty or not.
438 (buffer-size (get-buffer buffer
)))))
444 (defun vc-svn-create-snapshot (dir name branchp
)
445 "Assign to DIR's current revision a given NAME.
446 If BRANCHP is non-nil, the name is created as a branch (and the current
447 workspace is immediately moved to that new branch).
448 NAME is assumed to be a URL."
449 (vc-svn-command nil
0 dir
"copy" name
)
450 (when branchp
(vc-svn-retrieve-snapshot dir name nil
)))
452 (defun vc-svn-retrieve-snapshot (dir name update
)
453 "Retrieve a snapshot at and below DIR.
454 NAME is the name of the snapshot; if it is empty, do a `svn update'.
455 If UPDATE is non-nil, then update (resynch) any affected buffers.
456 NAME is assumed to be a URL."
457 (vc-svn-command nil
0 dir
"switch" name
)
458 ;; FIXME: parse the output and obey `update'.
465 ;; Subversion makes backups for us, so don't bother.
466 ;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
467 ;; "Return non-nil if version backups should be made for FILE.")
469 (defun vc-svn-check-headers ()
470 "Check if the current file has any headers in it."
472 (goto-char (point-min))
473 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
474 \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t
)))
478 ;;; Internal functions
481 (defcustom vc-svn-program
"svn"
482 "Name of the svn executable."
486 (defun vc-svn-command (buffer okstatus file-or-list
&rest flags
)
487 "A wrapper around `vc-do-command' for use in vc-svn.el.
488 The difference to vc-do-command is that this function always invokes `svn',
489 and that it passes `vc-svn-global-switches' to it before FLAGS."
490 (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
491 (if (stringp vc-svn-global-switches
)
492 (cons vc-svn-global-switches flags
)
493 (append vc-svn-global-switches
496 (defun vc-svn-repository-hostname (dirname)
498 (let ((coding-system-for-read
499 (or file-name-coding-system
500 default-file-name-coding-system
)))
501 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
504 (goto-char (point-min))
505 (when (re-search-forward
506 ;; Old `svn' used name="svn:this_dir", newer use just name="".
507 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
508 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
509 "url=\"\\(?1:[^\"]+\\)\""
510 ;; Yet newer ones don't use XML any more.
511 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t
)
512 ;; This is not a hostname but a URL. This may actually be considered
513 ;; as a feature since it allows vc-svn-stay-local to specify different
514 ;; behavior for different modules on the same server.
517 (defun vc-svn-resolve-when-done ()
518 "Call \"svn resolved\" if the conflict markers have been removed."
520 (goto-char (point-min))
521 (if (not (re-search-forward "^<<<<<<< " nil t
))
522 (vc-svn-command nil
0 buffer-file-name
"resolved"))))
524 ;; Inspired by vc-arch-find-file-hook.
525 (defun vc-svn-find-file-hook ()
526 (when (eq ?C
(vc-file-getprop buffer-file-name
'vc-svn-status
))
527 ;; If the file is marked as "conflicted", then we should try and call
528 ;; "svn resolved" when applicable.
530 (goto-char (point-min))
531 (re-search-forward "^<<<<<<< " nil t
))
532 ;; There are conflict markers.
535 (add-hook 'after-save-hook
'vc-svn-resolve-when-done nil t
))
536 ;; There are no conflict markers. This is problematic: maybe it means
537 ;; the conflict has been resolved and we should immediately call "svn
538 ;; resolved", or it means that the file's type does not allow Svn to
539 ;; use conflict markers in which case we don't really know what to do.
540 ;; So let's just punt for now.
542 (message "There are unresolved conflicts in this file")))
544 (defun vc-svn-parse-status (&optional filename
)
545 "Parse output of \"svn status\" command in the current buffer.
546 Set file properties accordingly. Unless FILENAME is non-nil, parse only
547 information about FILENAME and return its status."
549 (goto-char (point-min))
550 (while (re-search-forward
551 ;; Ignore the files with status in [IX?].
552 "^[ ACDGMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t
)
553 ;; If the username contains spaces, the output format is ambiguous,
554 ;; so don't trust the output's filename unless we have to.
555 (setq file
(or filename
557 (buffer-substring (point) (line-end-position)))))
558 (setq status
(char-after (line-beginning-position)))
559 (unless (eq status ??
)
560 ;; `vc-BACKEND-registered' must not set vc-backend,
561 ;; which is instead set in vc-registered.
562 (unless filename
(vc-file-setprop file
'vc-backend
'SVN
))
563 ;; Use the last-modified revision, so that searching in vc-print-log
565 (vc-file-setprop file
'vc-working-revision
(match-string 3))
566 ;; Remember Svn's own status.
567 (vc-file-setprop file
'vc-svn-status status
)
572 (if (eq (char-after (match-beginning 1)) ?
*)
574 (vc-file-setprop file
'vc-checkout-time
575 (nth 5 (file-attributes file
)))
578 ;; If the file was actually copied, (match-string 2) is "-".
579 (vc-file-setprop file
'vc-working-revision
"0")
580 (vc-file-setprop file
'vc-checkout-time
0)
582 ((memq status
'(?M ?C
))
583 (if (eq (char-after (match-beginning 1)) ?
*)
587 (if filename
(vc-file-getprop filename
'vc-state
))))
589 (defun vc-svn-dir-state-heuristic (dir)
590 "Find the SVN state of all files in DIR, using only local information."
591 (vc-svn-dir-state dir
'local
))
593 (defun vc-svn-valid-symbolic-tag-name-p (tag)
594 "Return non-nil if TAG is a valid symbolic tag name."
595 ;; According to the SVN manual, a valid symbolic tag must start with
596 ;; an uppercase or lowercase letter and can contain uppercase and
597 ;; lowercase letters, digits, `-', and `_'.
598 (and (string-match "^[a-zA-Z]" tag
)
599 (not (string-match "[^a-z0-9A-Z-_]" tag
))))
601 (defun vc-svn-valid-revision-number-p (tag)
602 "Return non-nil if TAG is a valid revision number."
603 (and (string-match "^[0-9]" tag
)
604 (not (string-match "[^0-9]" tag
))))
606 ;; Support for `svn annotate'
608 (defun vc-svn-annotate-command (file buf
&optional rev
)
609 (vc-svn-command buf
0 file
"annotate" (if rev
(concat "-r" rev
))))
611 (defun vc-svn-annotate-time-of-rev (rev)
612 ;; Arbitrarily assume 10 commmits per day.
613 (/ (string-to-number rev
) 10.0))
615 (defun vc-svn-annotate-current-time ()
616 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev
))
618 (defconst vc-svn-annotate-re
"[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
620 (defun vc-svn-annotate-time ()
621 (when (looking-at vc-svn-annotate-re
)
622 (goto-char (match-end 0))
623 (vc-svn-annotate-time-of-rev (match-string 1))))
625 (defun vc-svn-annotate-extract-revision-at-line ()
628 (if (looking-at vc-svn-annotate-re
) (match-string 1))))
632 ;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
633 ;;; vc-svn.el ends here