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