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