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