1 ;;; vc-svn.el --- non-resident support for Subversion version-control
3 ;; Copyright (C) 1995,98,99,2000,2001,2002 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 2, 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., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; This is preliminary support for Subversion (http://subversion.tigris.org/).
28 ;; It started as `sed s/cvs/svn/ vc.cvs.el' (from version 1.56)
29 ;; and hasn't been completely fixed since.
31 ;; Sync'd with Subversion's vc-svn.el as of revision 5801.
35 ;; - VC-dired is either not working or (really) dog slow.
36 ;; - vc-print-log does not always jump to the proper log entry because
37 ;; it tries to jump to version 1234 even if there's only an entry
38 ;; for 1232 (because the file hasn't changed since).
46 ;;; Customization options
49 (defcustom vc-svn-global-switches nil
50 "*Global switches to pass to any SVN command."
51 :type
'(choice (const :tag
"None" nil
)
52 (string :tag
"Argument String")
53 (repeat :tag
"Argument List"
59 (defcustom vc-svn-register-switches nil
60 "*Extra switches for registering a file into SVN.
61 A string or list of strings passed to the checkin program by
63 :type
'(choice (const :tag
"None" nil
)
64 (string :tag
"Argument String")
65 (repeat :tag
"Argument List"
71 (defcustom vc-svn-diff-switches nil
72 "*A string or list of strings specifying extra switches for svn diff under VC."
73 :type
'(choice (const :tag
"None" nil
)
74 (string :tag
"Argument String")
75 (repeat :tag
"Argument List"
81 (defcustom vc-svn-header
(or (cdr (assoc 'SVN vc-header-alist
)) '("\$Id\$"))
82 "*Header keywords to be inserted by `vc-insert-headers'."
84 :type
'(repeat string
)
87 (defcustom vc-svn-use-edit nil
88 "*Non-nil means to use `svn edit' to \"check out\" a file.
89 This is only meaningful if you don't use the implicit checkout model
90 \(i.e. if you have $SVNREAD set)."
95 (defcustom vc-svn-stay-local t
96 "*Non-nil means use local operations when possible for remote repositories.
97 This avoids slow queries over the network and instead uses heuristics
98 and past information to determine the current status of a file.
100 The value can also be a regular expression or list of regular
101 expressions to match against the host name of a repository; then VC
102 only stays local for hosts that match it. Alternatively, the value
103 can be a list of regular expressions where the first element is the
104 symbol `except'; then VC always stays local except for hosts matched
105 by these regular expressions."
106 :type
'(choice (const :tag
"Always stay local" t
)
107 (const :tag
"Don't stay local" nil
)
108 (list :format
"\nExamine hostname and %v" :tag
"Examine hostname ..."
109 (set :format
"%v" :inline t
(const :format
"%t" :tag
"don't" except
))
110 (regexp :format
" stay local,\n%t: %v" :tag
"if it matches")
111 (repeat :format
"%v%i\n" :inline t
(regexp :tag
"or"))))
116 ;;; State-querying functions
119 ;;;###autoload (defun vc-svn-registered (f)
120 ;;;###autoload (when (file-readable-p (expand-file-name
121 ;;;###autoload ".svn/entries" (file-name-directory f)))
122 ;;;###autoload (load "vc-svn")
123 ;;;###autoload (vc-svn-registered f)))
125 (defun vc-svn-registered (file)
126 "Check if FILE is SVN registered."
127 (when (file-readable-p (expand-file-name ".svn/entries"
128 (file-name-directory file
)))
130 (cd (file-name-directory file
))
132 (vc-svn-command t
0 file
"status" "-v")
133 ;; We can't find an `svn' executable. We could also deregister SVN.
135 (vc-svn-parse-status t
)
136 (eq 'SVN
(vc-file-getprop file
'vc-backend
)))))
138 (defun vc-svn-state (file &optional localp
)
139 "SVN-specific version of `vc-state'."
140 (setq localp
(or localp
(vc-svn-stay-local-p file
)))
142 (cd (file-name-directory file
))
143 (vc-svn-command t
0 file
"status" (if localp
"-v" "-u"))
144 (vc-svn-parse-status localp
)
145 (vc-file-getprop file
'vc-state
)))
147 (defun vc-svn-state-heuristic (file)
148 "SVN-specific state heuristic."
149 (vc-svn-state file
'local
))
151 (defun vc-svn-dir-state (dir &optional localp
)
152 "Find the SVN state of all files in DIR."
153 (setq localp
(or localp
(vc-svn-stay-local-p dir
)))
154 (let ((default-directory dir
))
155 ;; Don't specify DIR in this command, the default-directory is
156 ;; enough. Otherwise it might fail with remote repositories.
158 (vc-svn-command t
0 nil
"status" (if localp
"-v" "-u"))
159 (vc-svn-parse-status localp
))))
161 (defun vc-svn-workfile-version (file)
162 "SVN-specific version of `vc-workfile-version'."
163 ;; There is no need to consult RCS headers under SVN, because we
164 ;; get the workfile version for free when we recognize that a file
165 ;; is registered in SVN.
166 (vc-svn-registered file
)
167 (vc-file-getprop file
'vc-workfile-version
))
169 (defun vc-svn-checkout-model (file)
170 "SVN-specific version of `vc-checkout-model'."
171 ;; It looks like Subversion has no equivalent of CVSREAD.
174 (defun vc-svn-mode-line-string (file)
175 "Return string for placement into the modeline for FILE.
176 Compared to the default implementation, this function does two things:
177 Handle the special case of a SVN file that is added but not yet
178 committed and support display of sticky tags."
179 (let* ((state (vc-state file
))
180 (rev (vc-workfile-version file
))
181 (sticky-tag (vc-file-getprop file
'vc-svn-sticky-tag
))
182 (sticky-tag-printable (and sticky-tag
183 (not (string= sticky-tag
""))
184 (concat "[" sticky-tag
"]"))))
185 (cond ((string= rev
"0")
186 ;; A file that is added but not yet committed.
188 ((or (eq state
'up-to-date
)
189 (eq state
'needs-patch
))
190 (concat "SVN-" rev sticky-tag-printable
))
192 (concat "SVN:" state
":" rev sticky-tag-printable
))
194 ;; Not just for the 'edited state, but also a fallback
195 ;; for all other states. Think about different symbols
196 ;; for 'needs-patch and 'needs-merge.
197 (concat "SVN:" rev sticky-tag-printable
)))))
199 (defun vc-svn-dired-state-info (file)
200 "SVN-specific version of `vc-dired-state-info'."
201 (let* ((svn-state (vc-state file
))
202 (state (cond ((eq svn-state
'edited
) "modified")
203 ((eq svn-state
'needs-patch
) "patch")
204 ((eq svn-state
'needs-merge
) "merge")
205 ;; FIXME: those two states cannot occur right now
206 ((eq svn-state
'unlocked-changes
) "conflict")
207 ((eq svn-state
'locally-added
) "added")
209 (if state
(concat "(" state
")"))))
213 ;;; State-changing functions
216 (defun vc-svn-register (file &optional rev comment
)
217 "Register FILE into the SVN version-control system.
218 COMMENT can be used to provide an initial description of FILE.
220 `vc-register-switches' and `vc-svn-register-switches' are passed to
221 the SVN command (in that order)."
222 (let ((switches (append
223 (if (stringp vc-register-switches
)
224 (list vc-register-switches
)
225 vc-register-switches
)
226 (if (stringp vc-svn-register-switches
)
227 (list vc-svn-register-switches
)
228 vc-svn-register-switches
))))
230 (apply 'vc-svn-command nil
0 file
232 ;; (and comment (string-match "[^\t\n ]" comment)
233 ;; (concat "-m" comment))
236 (defun vc-svn-responsible-p (file)
237 "Return non-nil if SVN thinks it is responsible for FILE."
238 (file-directory-p (expand-file-name ".svn"
239 (if (file-directory-p file
)
241 (file-name-directory file
)))))
243 (defalias 'vc-svn-could-register
'vc-svn-responsible-p
244 "Return non-nil if FILE could be registered in SVN.
245 This is only possible if SVN is responsible for FILE's directory.")
247 (defun vc-svn-checkin (file rev comment
)
248 "SVN-specific version of `vc-backend-checkin'."
249 (let ((switches (if (stringp vc-checkin-switches
)
250 (list vc-checkin-switches
)
251 vc-checkin-switches
))
253 (setq status
(apply 'vc-svn-command nil
1 file
254 "ci" (list* "-m" comment switches
)))
256 (goto-char (point-min))
257 (unless (equal status
0)
258 ;; Check checkin problem.
260 ((re-search-forward "Up-to-date check failed" nil t
)
261 (vc-file-setprop file
'vc-state
'needs-merge
)
262 (error (substitute-command-keys
263 (concat "Up-to-date check failed: "
264 "type \\[vc-next-action] to merge in changes"))))
266 (pop-to-buffer (current-buffer))
267 (goto-char (point-min))
268 (shrink-window-if-larger-than-buffer)
269 (error "Check-in failed"))))
270 ;; Update file properties
272 ;; file 'vc-workfile-version
273 ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
276 (defun vc-svn-find-version (file rev buffer
)
277 (apply 'vc-svn-command
280 (and rev
(not (string= rev
""))
282 (if (stringp vc-checkout-switches
)
283 (list vc-checkout-switches
)
284 vc-checkout-switches
)))
286 (defun vc-svn-checkout (file &optional editable rev
)
287 (message "Checking out %s..." file
)
288 (with-current-buffer (or (get-file-buffer file
) (current-buffer))
289 (let ((switches (if (stringp vc-checkout-switches
)
290 (list vc-checkout-switches
)
291 vc-checkout-switches
)))
292 (vc-call update file editable rev switches
)))
294 (message "Checking out %s...done" file
))
296 (defun vc-svn-update (file editable rev switches
)
297 (if (and (file-exists-p file
) (not rev
))
298 ;; If no revision was specified, just make the file writable
299 ;; if necessary (using `svn-edit' if requested).
300 (and editable
(not (eq (vc-svn-checkout-model file
) 'implicit
))
302 (vc-svn-command nil
0 file
"edit")
303 (set-file-modes file
(logior (file-modes file
) 128))
304 (if (equal file buffer-file-name
) (toggle-read-only -
1))))
305 ;; Check out a particular version (or recreate the file).
306 (vc-file-setprop file
'vc-workfile-version nil
)
307 (apply 'vc-svn-command nil
0 file
310 ;; default for verbose checkout: clear the sticky tag so
311 ;; that the actual update will get the head of the trunk
312 (if (or (not rev
) (string= rev
""))
317 (defun vc-svn-revert (file &optional contents-done
)
318 "Revert FILE to the version it was based on."
319 (unless contents-done
320 (vc-svn-command nil
0 file
"revert"))
321 (unless (eq (vc-checkout-model file
) 'implicit
)
323 (vc-svn-command nil
0 file
"unedit")
324 ;; Make the file read-only by switching off all w-bits
325 (set-file-modes file
(logand (file-modes file
) 3950)))))
327 (defun vc-svn-merge (file first-version
&optional second-version
)
328 "Merge changes into current working copy of FILE.
329 The changes are between FIRST-VERSION and SECOND-VERSION."
330 (vc-svn-command nil
0 file
332 "-r" (if second-version
333 (concat first-version
":" second-version
)
335 (vc-file-setprop file
'vc-state
'edited
)
336 (with-current-buffer (get-buffer "*vc*")
337 (goto-char (point-min))
338 (if (looking-at "C ")
340 0))) ; signal success
342 (defun vc-svn-merge-news (file)
343 "Merge in any new changes made to FILE."
344 (message "Merging changes into %s..." file
)
345 ;; (vc-file-setprop file 'vc-workfile-version nil)
346 (vc-file-setprop file
'vc-checkout-time
0)
347 (vc-svn-command nil
0 file
"update")
348 ;; Analyze the merge result reported by SVN, and set
349 ;; file properties accordingly.
350 (with-current-buffer (get-buffer "*vc*")
351 (goto-char (point-min))
352 ;; get new workfile version
353 (if (re-search-forward
354 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t
)
355 (vc-file-setprop file
'vc-workfile-version
(match-string 2))
356 (vc-file-setprop file
'vc-workfile-version nil
))
358 (goto-char (point-min))
360 (if (looking-at "At revision")
361 0 ;; there were no news; indicate success
362 (if (re-search-forward
363 (concat "^\\([CGDU] \\)?"
364 (regexp-quote (file-name-nondirectory file
)))
367 ;; Merge successful, we are in sync with repository now
368 ((string= (match-string 1) "U ")
369 (vc-file-setprop file
'vc-state
'up-to-date
)
370 (vc-file-setprop file
'vc-checkout-time
371 (nth 5 (file-attributes file
)))
372 0);; indicate success to the caller
373 ;; Merge successful, but our own changes are still in the file
374 ((string= (match-string 1) "G ")
375 (vc-file-setprop file
'vc-state
'edited
)
376 0);; indicate success to the caller
377 ;; Conflicts detected!
379 (vc-file-setprop file
'vc-state
'edited
)
380 1);; signal the error to the caller
382 (pop-to-buffer "*vc*")
383 (error "Couldn't analyze svn update result")))
384 (message "Merging changes into %s...done" file
))))
388 ;;; History functions
391 (defun vc-svn-print-log (file)
392 "Get change log associated with FILE."
394 (vc-setup-buffer nil
)
395 (let ((inhibit-read-only t
))
396 (goto-char (point-min))
397 ;; Add a line to tell log-view-mode what file this is.
398 (insert "Working file: " (file-relative-name file
) "\n"))
401 (if (and (vc-svn-stay-local-p file
) (fboundp 'start-process
)) 'async
0)
404 (defun vc-svn-diff (file &optional oldvers newvers
)
405 "Get a difference report using SVN between two versions of FILE."
406 (let (status (diff-switches-list (vc-diff-switches-list 'SVN
)))
407 (if (string= (vc-workfile-version file
) "0")
408 ;; This file is added but not yet committed; there is no master file.
409 (if (or oldvers newvers
)
410 (error "No revisions of %s exist" file
)
411 ;; We regard this as "changed".
412 ;; Diff it against /dev/null.
413 ;; Note: this is NOT a "svn diff".
414 (apply 'vc-do-command
"*vc-diff*"
416 (append diff-switches-list
'("/dev/null"))))
418 (apply 'vc-svn-command
"*vc-diff*"
419 (if (and (vc-svn-stay-local-p file
)
420 (or oldvers newvers
) ; Svn diffs those locally.
421 (fboundp 'start-process
))
428 (if newvers
(concat oldvers
":" newvers
) oldvers
)))
429 (when diff-switches-list
430 (list "-x" (mapconcat 'identity diff-switches-list
" "))))))
431 (if (vc-svn-stay-local-p file
)
432 1 ;; async diff, pessimistic assumption
435 (defun vc-svn-diff-tree (dir &optional rev1 rev2
)
436 "Diff all files at and below DIR."
437 (with-current-buffer "*vc-diff*"
438 (setq default-directory dir
)
439 (if (vc-svn-stay-local-p dir
)
440 ;; local diff: do it filewise, and only for files that are modified
445 `(let ((coding-system-for-read (vc-coding-system-for-diff ',f
)))
446 ;; possible optimization: fetch the state of all files
447 ;; in the tree via vc-svn-dir-state-heuristic
448 (unless (vc-up-to-date-p ',f
)
449 (message "Looking at %s" ',f
)
450 (vc-diff-internal ',f
',rev1
',rev2
))))))
451 ;; svn diff: use a single call for the entire tree
452 (let ((coding-system-for-read (or coding-system-for-read
'undecided
))
453 (diff-switches-list (vc-diff-switches-list 'SVN
)))
454 (apply 'vc-svn-command
"*vc-diff*" 1 nil
"diff"
458 (if rev2
(concat rev1
":" rev2
) rev1
)))
459 (when diff-switches-list
460 (list "-x" (mapconcat 'identity diff-switches-list
" ")))))))))
466 (defun vc-svn-create-snapshot (dir name branchp
)
467 "Assign to DIR's current version a given NAME.
468 If BRANCHP is non-nil, the name is created as a branch (and the current
469 workspace is immediately moved to that new branch)."
470 (vc-svn-command nil
0 dir
"tag" "-c" (if branchp
"-b") name
)
471 (when branchp
(vc-svn-command nil
0 dir
"update" "-r" name
)))
473 (defun vc-svn-retrieve-snapshot (dir name update
)
474 "Retrieve a snapshot at and below DIR.
475 NAME is the name of the snapshot; if it is empty, do a `svn update'.
476 If UPDATE is non-nil, then update (resynch) any affected buffers."
477 (with-current-buffer (get-buffer-create "*vc*")
478 (let ((default-directory dir
)
481 (if (or (not name
) (string= name
""))
482 (vc-svn-command t
0 nil
"update")
483 (vc-svn-command t
0 nil
"update" "-r" name
)
484 (setq sticky-tag name
))
486 (goto-char (point-min))
488 (if (looking-at "\\([CMUP]\\) \\(.*\\)")
489 (let* ((file (expand-file-name (match-string 2) dir
))
490 (state (match-string 1))
491 (buffer (find-buffer-visiting file
)))
494 ((or (string= state
"U")
496 (vc-file-setprop file
'vc-state
'up-to-date
)
497 (vc-file-setprop file
'vc-workfile-version nil
)
498 (vc-file-setprop file
'vc-checkout-time
499 (nth 5 (file-attributes file
))))
500 ((or (string= state
"M")
502 (vc-file-setprop file
'vc-state
'edited
)
503 (vc-file-setprop file
'vc-workfile-version nil
)
504 (vc-file-setprop file
'vc-checkout-time
0)))
505 (vc-file-setprop file
'vc-svn-sticky-tag sticky-tag
)
506 (vc-resynch-buffer file t t
))))
507 (forward-line 1))))))
514 ;; Subversion makes backups for us, so don't bother.
515 ;; (defalias 'vc-svn-make-version-backups-p 'vc-svn-stay-local-p
516 ;; "Return non-nil if version backups should be made for FILE.")
518 (defun vc-svn-check-headers ()
519 "Check if the current file has any headers in it."
521 (goto-char (point-min))
522 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
523 \\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t
)))
527 ;;; Internal functions
530 (defun vc-svn-command (buffer okstatus file
&rest flags
)
531 "A wrapper around `vc-do-command' for use in vc-svn.el.
532 The difference to vc-do-command is that this function always invokes `svn',
533 and that it passes `vc-svn-global-switches' to it before FLAGS."
534 (apply 'vc-do-command buffer okstatus
"svn" file
535 (if (stringp vc-svn-global-switches
)
536 (cons vc-svn-global-switches flags
)
537 (append vc-svn-global-switches
540 (defun vc-svn-stay-local-p (file)
541 "Return non-nil if VC should stay local when handling FILE.
542 See `vc-svn-stay-local'."
543 (when vc-svn-stay-local
544 (let* ((dirname (if (file-directory-p file
)
545 (directory-file-name file
)
546 (file-name-directory file
)))
548 (or (vc-file-getprop dirname
'vc-svn-stay-local-p
)
550 dirname
'vc-svn-stay-local-p
551 (let ((rootname (expand-file-name ".svn/entries" dirname
)))
553 ((not (file-readable-p rootname
)) 'no
)
554 ((stringp vc-svn-stay-local
)
556 (let ((coding-system-for-read
557 (or file-name-coding-system
558 default-file-name-coding-system
)))
559 (vc-insert-file rootname
))
560 (goto-char (point-min))
561 (when (re-search-forward
562 (concat "name=\"svn:this_dir\"[\n\t ]*"
563 "url=\"\\([^\"]+\\)\"") nil t
)
564 (let ((hostname (match-string 1)))
567 (let* ((stay-local t
)
570 ;; vc-svn-stay-local: rx
571 ((stringp vc-svn-stay-local
)
573 ;; vc-svn-stay-local: '( [except] rx ... )
574 ((consp vc-svn-stay-local
)
577 (if (not (eq (car vc-svn-stay-local
)
580 (setq stay-local nil
)
581 (cdr vc-svn-stay-local
))
585 (if (not (string-match rx hostname
))
586 (setq stay-local
(not stay-local
)))
590 (if (eq prop
'yes
) t nil
))))
592 (defun vc-svn-parse-status (localp)
593 "Parse output of \"svn status\" command in the current buffer.
594 Set file properties accordingly. Unless FULL is t, parse only
595 essential information."
597 (goto-char (point-min))
598 (while (re-search-forward
599 "^[ ADMCI?!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t
)
600 (setq file
(expand-file-name
601 (buffer-substring (point) (line-end-position))))
602 (setq status
(char-after (line-beginning-position)))
603 (unless (eq status ??
)
604 (vc-file-setprop file
'vc-backend
'SVN
)
605 (vc-file-setprop file
'vc-workfile-version
(match-string 2))
610 (if (eq (char-after (match-beginning 1)) ?
*)
612 (vc-file-setprop file
'vc-checkout-time
613 (nth 5 (file-attributes file
)))
616 (vc-file-setprop file
'vc-checkout-time
0)
618 ((memq status
'(?M ?C
))
619 (if (eq (char-after (match-beginning 1)) ?
*)
624 (defun vc-svn-dir-state-heuristic (dir)
625 "Find the SVN state of all files in DIR, using only local information."
626 (vc-svn-dir-state dir
'local
))
628 (defun vc-svn-valid-symbolic-tag-name-p (tag)
629 "Return non-nil if TAG is a valid symbolic tag name."
630 ;; According to the SVN manual, a valid symbolic tag must start with
631 ;; an uppercase or lowercase letter and can contain uppercase and
632 ;; lowercase letters, digits, `-', and `_'.
633 (and (string-match "^[a-zA-Z]" tag
)
634 (not (string-match "[^a-z0-9A-Z-_]" tag
))))
636 (defun vc-svn-valid-version-number-p (tag)
637 "Return non-nil if TAG is a valid version number."
638 (and (string-match "^[0-9]" tag
)
639 (not (string-match "[^0-9]" tag
))))
643 ;;; vc-svn.el ends here