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