(vc-delete-file): Check if the file has uncommitted changed.
[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
c1b51374 161(defun vc-svn-after-dir-status (callback)
c222c25f 162 (let ((state-map '((?A . added)
b2ee56c9
SM
163 (?C . conflict)
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)))
c222c25f
DN
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)))))
b2ee56c9 178 (funcall callback result)))
c222c25f 179
c1b51374 180(defun vc-svn-dir-status (dir callback)
c222c25f
DN
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
c1b51374 186 `(vc-svn-after-dir-status (quote ,callback))))
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 195
e0607aaa 196(defun vc-svn-checkout-model (files)
1fd3454a
SM
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 302 "update"
5cc7cb96
SM
303 (cond
304 ((null rev) "-rBASE")
305 ((or (eq rev t) (equal rev "")) nil)
306 (t (concat "-r" rev)))
1fd3454a
SM
307 switches)))
308
3bdc13e4
SM
309(defun vc-svn-delete-file (file)
310 (vc-svn-command nil 0 file "remove"))
311
2766aaaf
SM
312(defun vc-svn-rename-file (old new)
313 (vc-svn-command nil 0 new "move" (file-relative-name old)))
314
1fd3454a
SM
315(defun vc-svn-revert (file &optional contents-done)
316 "Revert FILE to the version it was based on."
317 (unless contents-done
fc2fb30c 318 (vc-svn-command nil 0 file "revert")))
1fd3454a
SM
319
320(defun vc-svn-merge (file first-version &optional second-version)
321 "Merge changes into current working copy of FILE.
322The changes are between FIRST-VERSION and SECOND-VERSION."
323 (vc-svn-command nil 0 file
c217cb04 324 "merge"
02610d0e 325 "-r" (if second-version
c217cb04
SM
326 (concat first-version ":" second-version)
327 first-version))
1fd3454a
SM
328 (vc-file-setprop file 'vc-state 'edited)
329 (with-current-buffer (get-buffer "*vc*")
330 (goto-char (point-min))
c217cb04
SM
331 (if (looking-at "C ")
332 1 ; signal conflict
1fd3454a
SM
333 0))) ; signal success
334
335(defun vc-svn-merge-news (file)
336 "Merge in any new changes made to FILE."
337 (message "Merging changes into %s..." file)
ac3f4c6f 338 ;; (vc-file-setprop file 'vc-working-revision nil)
1fd3454a
SM
339 (vc-file-setprop file 'vc-checkout-time 0)
340 (vc-svn-command nil 0 file "update")
341 ;; Analyze the merge result reported by SVN, and set
342 ;; file properties accordingly.
343 (with-current-buffer (get-buffer "*vc*")
344 (goto-char (point-min))
5b5afd50 345 ;; get new working revision
1fd3454a 346 (if (re-search-forward
1468d754 347 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
ac3f4c6f
ER
348 (vc-file-setprop file 'vc-working-revision (match-string 2))
349 (vc-file-setprop file 'vc-working-revision nil))
1fd3454a 350 ;; get file status
1468d754 351 (goto-char (point-min))
1fd3454a 352 (prog1
1468d754 353 (if (looking-at "At revision")
1fd3454a
SM
354 0 ;; there were no news; indicate success
355 (if (re-search-forward
459b1fe4
SM
356 ;; Newer SVN clients have 3 columns of chars (one for the
357 ;; file's contents, then second for its properties, and the
358 ;; third for lock-grabbing info), before the 2 spaces.
359 ;; We also used to match the filename in column 0 without any
360 ;; meta-info before it, but I believe this can never happen.
361 (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)"
1468d754 362 (regexp-quote (file-name-nondirectory file)))
1fd3454a
SM
363 nil t)
364 (cond
365 ;; Merge successful, we are in sync with repository now
459b1fe4 366 ((string= (match-string 2) "U")
1fd3454a
SM
367 (vc-file-setprop file 'vc-state 'up-to-date)
368 (vc-file-setprop file 'vc-checkout-time
369 (nth 5 (file-attributes file)))
370 0);; indicate success to the caller
371 ;; Merge successful, but our own changes are still in the file
459b1fe4 372 ((string= (match-string 2) "G")
1fd3454a
SM
373 (vc-file-setprop file 'vc-state 'edited)
374 0);; indicate success to the caller
375 ;; Conflicts detected!
376 (t
377 (vc-file-setprop file 'vc-state 'edited)
378 1);; signal the error to the caller
379 )
380 (pop-to-buffer "*vc*")
381 (error "Couldn't analyze svn update result")))
382 (message "Merging changes into %s...done" file))))
383
42a0a135
ER
384(defun vc-svn-modify-change-comment (files rev comment)
385 "Modify the change comments for a specified REV.
386You must have ssh access to the repository host, and the directory Emacs
fd064451
DN
387uses locally for temp files must also be writeable by you on that host.
388This is only supported if the repository access method is either file://
389or svn+ssh://."
390 (let (tempfile host remotefile directory fileurl-p)
42a0a135 391 (with-temp-buffer
fd064451
DN
392 (vc-do-command (current-buffer) 0 "svn" nil "info")
393 (goto-char (point-min))
394 (unless (re-search-forward "Repository Root: \\(file://\\(/.*\\)\\)\\|\\(svn\\+ssh://\\([^/]+\\)\\(/.*\\)\\)" nil t)
395 (error "Repository information is unavailable"))
396 (if (match-string 1)
397 (progn
398 (setq fileurl-p t)
399 (setq directory (match-string 2)))
400 (setq host (match-string 4))
401 (setq directory (match-string 5))
402 (setq remotefile (concat host ":" tempfile))))
403 (with-temp-file (setq tempfile (make-temp-file user-mail-address))
404 (insert comment))
405 (if fileurl-p
406 ;; Repository Root is a local file.
407 (progn
408 (unless (vc-do-command
409 nil 0 "svnadmin" nil
410 "setlog" "--bypass-hooks" directory
411 "-r" rev (format "%s" tempfile))
412 (error "Log edit failed"))
413 (delete-file tempfile))
414
415 ;; Remote repository, using svn+ssh.
416 (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile)
417 (error "Copy of comment to %s failed" remotefile))
418 (unless (vc-do-command
419 nil 0 "ssh" nil "-q" host
420 (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
421 directory rev tempfile tempfile))
422 (error "Log edit failed")))))
1fd3454a
SM
423
424;;;
425;;; History functions
426;;;
427
8cdd17b4
ER
428(defun vc-svn-print-log (files &optional buffer)
429 "Get change log(s) associated with FILES."
1fd3454a 430 (save-current-buffer
b349012b 431 (vc-setup-buffer buffer)
1fd3454a
SM
432 (let ((inhibit-read-only t))
433 (goto-char (point-min))
13b56025
ER
434 (if files
435 (dolist (file files)
436 (insert "Working file: " file "\n")
437 (vc-svn-command
438 buffer
439 'async
440 ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0)
441 (list file)
442 "log"
443 ;; By default Subversion only shows the log up to the
444 ;; working revision, whereas we also want the log of the
445 ;; subsequent commits. At least that's what the
446 ;; vc-cvs.el code does.
447 "-rHEAD:0"))
448 ;; Dump log for the entire directory.
449 (vc-svn-command buffer 0 nil "log" "-rHEAD:0")))))
8cdd17b4
ER
450
451(defun vc-svn-wash-log ()
452 "Remove all non-comment information from log output."
453 ;; FIXME: not implemented for SVN
454 nil)
455
456(defun vc-svn-diff (files &optional oldvers newvers buffer)
5b5afd50 457 "Get a difference report using SVN between two revisions of fileset FILES."
c62a495a
GM
458 (and oldvers
459 (catch 'no
460 (dolist (f files)
ac3f4c6f 461 (or (equal oldvers (vc-working-revision f))
c62a495a
GM
462 (throw 'no nil)))
463 t)
464 ;; Use nil rather than the current revision because svn handles
465 ;; it better (i.e. locally). Note that if _any_ of the files
466 ;; has a different revision, we fetch the lot, which is
467 ;; obviously sub-optimal.
468 (setq oldvers nil))
8cdd17b4 469 (let* ((switches
f9d1f3be
SM
470 (if vc-svn-diff-switches
471 (vc-switches 'SVN 'diff)
472 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
2d4e93b9 473 (async (and (not vc-disable-async-diff)
8cdd17b4 474 (vc-stay-local-p files)
fe1919ab 475 (or oldvers newvers)))) ; Svn diffs those locally.
b349012b 476 (apply 'vc-svn-command buffer
2766aaaf 477 (if async 'async 0)
8cdd17b4 478 files "diff"
2766aaaf 479 (append
f9d1f3be 480 switches
2766aaaf
SM
481 (when oldvers
482 (list "-r" (if newvers (concat oldvers ":" newvers)
483 oldvers)))))
fd140743
SM
484 (if async 1 ; async diff => pessimistic assumption
485 ;; For some reason `svn diff' does not return a useful
486 ;; status w.r.t whether the diff was empty or not.
8cdd17b4 487 (buffer-size (get-buffer buffer)))))
1fd3454a 488
1fd3454a
SM
489;;;
490;;; Snapshot system
491;;;
492
493(defun vc-svn-create-snapshot (dir name branchp)
5b5afd50 494 "Assign to DIR's current revision a given NAME.
1fd3454a 495If BRANCHP is non-nil, the name is created as a branch (and the current
5cc7cb96
SM
496workspace is immediately moved to that new branch).
497NAME is assumed to be a URL."
498 (vc-svn-command nil 0 dir "copy" name)
499 (when branchp (vc-svn-retrieve-snapshot dir name nil)))
1fd3454a
SM
500
501(defun vc-svn-retrieve-snapshot (dir name update)
502 "Retrieve a snapshot at and below DIR.
503NAME is the name of the snapshot; if it is empty, do a `svn update'.
5cc7cb96
SM
504If UPDATE is non-nil, then update (resynch) any affected buffers.
505NAME is assumed to be a URL."
506 (vc-svn-command nil 0 dir "switch" name)
507 ;; FIXME: parse the output and obey `update'.
508 )
1fd3454a
SM
509
510;;;
511;;; Miscellaneous
512;;;
513
514;; Subversion makes backups for us, so don't bother.
7ffc77d3 515;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
1fd3454a
SM
516;; "Return non-nil if version backups should be made for FILE.")
517
518(defun vc-svn-check-headers ()
519 "Check if the current file has any headers in it."
520 (save-excursion
521 (goto-char (point-min))
522 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
523\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
524
525
526;;;
527;;; Internal functions
528;;;
529
e4cc3f57 530(defcustom vc-svn-program "svn"
4ced8551 531 "Name of the SVN executable."
e4cc3f57
SM
532 :type 'string
533 :group 'vc)
534
b038f9fb
TTN
535(defun vc-svn-root (dir)
536 (vc-find-root dir vc-svn-admin-directory t))
537
8cdd17b4 538(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
1fd3454a
SM
539 "A wrapper around `vc-do-command' for use in vc-svn.el.
540The difference to vc-do-command is that this function always invokes `svn',
541and that it passes `vc-svn-global-switches' to it before FLAGS."
8cdd17b4 542 (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
1fd3454a
SM
543 (if (stringp vc-svn-global-switches)
544 (cons vc-svn-global-switches flags)
545 (append vc-svn-global-switches
546 flags))))
547
7ffc77d3
SM
548(defun vc-svn-repository-hostname (dirname)
549 (with-temp-buffer
550 (let ((coding-system-for-read
551 (or file-name-coding-system
552 default-file-name-coding-system)))
ace2fad9
CY
553 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
554 "/entries")
555 dirname)))
7ffc77d3
SM
556 (goto-char (point-min))
557 (when (re-search-forward
c45b3be3 558 ;; Old `svn' used name="svn:this_dir", newer use just name="".
17a5a301
SM
559 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
560 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
0b0dad41
SM
561 "url=\"\\(?1:[^\"]+\\)\""
562 ;; Yet newer ones don't use XML any more.
563 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
17a5a301
SM
564 ;; This is not a hostname but a URL. This may actually be considered
565 ;; as a feature since it allows vc-svn-stay-local to specify different
566 ;; behavior for different modules on the same server.
567 (match-string 1))))
1fd3454a 568
1c67a814
SM
569(defun vc-svn-resolve-when-done ()
570 "Call \"svn resolved\" if the conflict markers have been removed."
571 (save-excursion
572 (goto-char (point-min))
54648b5c
DN
573 (unless (re-search-forward "^<<<<<<< " nil t)
574 (vc-svn-command nil 0 buffer-file-name "resolved")
575 ;; Remove the hook so that it is not called multiple times.
576 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
1c67a814
SM
577
578;; Inspired by vc-arch-find-file-hook.
579(defun vc-svn-find-file-hook ()
580 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
581 ;; If the file is marked as "conflicted", then we should try and call
582 ;; "svn resolved" when applicable.
583 (if (save-excursion
584 (goto-char (point-min))
585 (re-search-forward "^<<<<<<< " nil t))
586 ;; There are conflict markers.
587 (progn
28e4e2b4 588 (smerge-start-session)
1c67a814
SM
589 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
590 ;; There are no conflict markers. This is problematic: maybe it means
591 ;; the conflict has been resolved and we should immediately call "svn
592 ;; resolved", or it means that the file's type does not allow Svn to
593 ;; use conflict markers in which case we don't really know what to do.
594 ;; So let's just punt for now.
595 nil)
596 (message "There are unresolved conflicts in this file")))
597
bc8c1bb4 598(defun vc-svn-parse-status (&optional filename)
1fd3454a 599 "Parse output of \"svn status\" command in the current buffer.
bc8c1bb4
SM
600Set file properties accordingly. Unless FILENAME is non-nil, parse only
601information about FILENAME and return its status."
1fd3454a
SM
602 (let (file status)
603 (goto-char (point-min))
604 (while (re-search-forward
484c1b1f 605 ;; Ignore the files with status X.
abc61762 606 "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
c45b3be3
SM
607 ;; If the username contains spaces, the output format is ambiguous,
608 ;; so don't trust the output's filename unless we have to.
609 (setq file (or filename
610 (expand-file-name
611 (buffer-substring (point) (line-end-position)))))
1fd3454a 612 (setq status (char-after (line-beginning-position)))
484c1b1f 613 (if (eq status ??)
4f07b9f2 614 (vc-file-setprop file 'vc-state 'unregistered)
bc8c1bb4
SM
615 ;; `vc-BACKEND-registered' must not set vc-backend,
616 ;; which is instead set in vc-registered.
4f07b9f2 617 (unless filename (vc-file-setprop file 'vc-backend 'SVN))
fd140743
SM
618 ;; Use the last-modified revision, so that searching in vc-print-log
619 ;; output works.
4f07b9f2 620 (vc-file-setprop file 'vc-working-revision (match-string 3))
1c67a814 621 ;; Remember Svn's own status.
4f07b9f2
ER
622 (vc-file-setprop file 'vc-svn-status status)
623 (vc-file-setprop
1fd3454a
SM
624 file 'vc-state
625 (cond
626 ((eq status ?\ )
627 (if (eq (char-after (match-beginning 1)) ?*)
628 'needs-patch
4f07b9f2 629 (vc-file-setprop file 'vc-checkout-time
1fd3454a
SM
630 (nth 5 (file-attributes file)))
631 'up-to-date))
632 ((eq status ?A)
fd140743 633 ;; If the file was actually copied, (match-string 2) is "-".
4f07b9f2
ER
634 (vc-file-setprop file 'vc-working-revision "0")
635 (vc-file-setprop file 'vc-checkout-time 0)
484c1b1f 636 'added)
7fbb4797
DN
637 ((eq status ?C)
638 (vc-file-setprop file 'vc-state 'conflict))
639 ((eq status '?M)
1fd3454a
SM
640 (if (eq (char-after (match-beginning 1)) ?*)
641 'needs-merge
642 'edited))
722f037f 643 ((eq status ?I)
4f07b9f2 644 (vc-file-setprop file 'vc-state 'ignored))
484c1b1f 645 ((eq status ?R)
4f07b9f2 646 (vc-file-setprop file 'vc-state 'removed))
bc8c1bb4
SM
647 (t 'edited)))))
648 (if filename (vc-file-getprop filename 'vc-state))))
1fd3454a
SM
649
650(defun vc-svn-dir-state-heuristic (dir)
651 "Find the SVN state of all files in DIR, using only local information."
652 (vc-svn-dir-state dir 'local))
653
654(defun vc-svn-valid-symbolic-tag-name-p (tag)
655 "Return non-nil if TAG is a valid symbolic tag name."
656 ;; According to the SVN manual, a valid symbolic tag must start with
657 ;; an uppercase or lowercase letter and can contain uppercase and
658 ;; lowercase letters, digits, `-', and `_'.
659 (and (string-match "^[a-zA-Z]" tag)
660 (not (string-match "[^a-z0-9A-Z-_]" tag))))
661
5b5afd50
ER
662(defun vc-svn-valid-revision-number-p (tag)
663 "Return non-nil if TAG is a valid revision number."
1fd3454a
SM
664 (and (string-match "^[0-9]" tag)
665 (not (string-match "[^0-9]" tag))))
666
17a5a301
SM
667;; Support for `svn annotate'
668
669(defun vc-svn-annotate-command (file buf &optional rev)
670 (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev))))
671
672(defun vc-svn-annotate-time-of-rev (rev)
673 ;; Arbitrarily assume 10 commmits per day.
674 (/ (string-to-number rev) 10.0))
675
676(defun vc-svn-annotate-current-time ()
677 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))
678
679(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
680
681(defun vc-svn-annotate-time ()
682 (when (looking-at vc-svn-annotate-re)
683 (goto-char (match-end 0))
684 (vc-svn-annotate-time-of-rev (match-string 1))))
685
686(defun vc-svn-annotate-extract-revision-at-line ()
687 (save-excursion
688 (beginning-of-line)
689 (if (looking-at vc-svn-annotate-re) (match-string 1))))
690
1fd3454a
SM
691(provide 'vc-svn)
692
f9d1f3be 693;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
1fd3454a 694;;; vc-svn.el ends here