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