* net/tramp-cmds.el (tramp-cleanup-all-connections): Reset
[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
2ec0d864
ER
176(defun vc-svn-status-extra-headers (dir)
177 "Generate extra status headers for a Subversion working copy."
178 (vc-svn-command "*vc*" 0 nil "info")
179 (let ((repo
180 (save-excursion
181 (and (progn
182 (set-buffer "*vc*")
183 (goto-char (point-min))
184 (re-search-forward "Repository Root: *\\(.*\\)" nil t))
185 (match-string 1)))))
186 (concat
187 (cond (repo
188 (concat
189 (propertize "Repository : " 'face 'font-lock-type-face)
190 (propertize repo 'face 'font-lock-variable-name-face)))
191 (t "")))))
192
ac3f4c6f
ER
193(defun vc-svn-working-revision (file)
194 "SVN-specific version of `vc-working-revision'."
1fd3454a
SM
195 ;; There is no need to consult RCS headers under SVN, because we
196 ;; get the workfile version for free when we recognize that a file
197 ;; is registered in SVN.
198 (vc-svn-registered file)
ac3f4c6f 199 (vc-file-getprop file 'vc-working-revision))
1fd3454a 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."
2888a97e
ER
228 (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
229 (vc-do-command "*vc*" 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))
a749e19d 291 (vc-svn-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
2888a97e 409 "*vc*" 0 "svnadmin" nil
fd064451
DN
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.
2888a97e 416 (unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile)
fd064451
DN
417 (error "Copy of comment to %s failed" remotefile))
418 (unless (vc-do-command
2888a97e 419 "*vc*" 0 "ssh" nil "-q" host
fd064451
DN
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 450
8cdd17b4 451(defun vc-svn-diff (files &optional oldvers newvers buffer)
5b5afd50 452 "Get a difference report using SVN between two revisions of fileset FILES."
c62a495a
GM
453 (and oldvers
454 (catch 'no
455 (dolist (f files)
ac3f4c6f 456 (or (equal oldvers (vc-working-revision f))
c62a495a
GM
457 (throw 'no nil)))
458 t)
459 ;; Use nil rather than the current revision because svn handles
460 ;; it better (i.e. locally). Note that if _any_ of the files
461 ;; has a different revision, we fetch the lot, which is
462 ;; obviously sub-optimal.
463 (setq oldvers nil))
8cdd17b4 464 (let* ((switches
f9d1f3be
SM
465 (if vc-svn-diff-switches
466 (vc-switches 'SVN 'diff)
467 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
2d4e93b9 468 (async (and (not vc-disable-async-diff)
8cdd17b4 469 (vc-stay-local-p files)
fe1919ab 470 (or oldvers newvers)))) ; Svn diffs those locally.
b349012b 471 (apply 'vc-svn-command buffer
2766aaaf 472 (if async 'async 0)
8cdd17b4 473 files "diff"
2766aaaf 474 (append
f9d1f3be 475 switches
2766aaaf
SM
476 (when oldvers
477 (list "-r" (if newvers (concat oldvers ":" newvers)
478 oldvers)))))
fd140743
SM
479 (if async 1 ; async diff => pessimistic assumption
480 ;; For some reason `svn diff' does not return a useful
481 ;; status w.r.t whether the diff was empty or not.
8cdd17b4 482 (buffer-size (get-buffer buffer)))))
1fd3454a 483
1fd3454a 484;;;
370fded4 485;;; Tag system
1fd3454a
SM
486;;;
487
370fded4 488(defun vc-svn-create-tag (dir name branchp)
5b5afd50 489 "Assign to DIR's current revision a given NAME.
1fd3454a 490If BRANCHP is non-nil, the name is created as a branch (and the current
5cc7cb96
SM
491workspace is immediately moved to that new branch).
492NAME is assumed to be a URL."
493 (vc-svn-command nil 0 dir "copy" name)
370fded4 494 (when branchp (vc-svn-retrieve-tag dir name nil)))
1fd3454a 495
370fded4
ER
496(defun vc-svn-retrieve-tag (dir name update)
497 "Retrieve a tag at and below DIR.
498NAME is the name of the tag; if it is empty, do a `svn update'.
5cc7cb96
SM
499If UPDATE is non-nil, then update (resynch) any affected buffers.
500NAME is assumed to be a URL."
501 (vc-svn-command nil 0 dir "switch" name)
502 ;; FIXME: parse the output and obey `update'.
503 )
1fd3454a
SM
504
505;;;
506;;; Miscellaneous
507;;;
508
509;; Subversion makes backups for us, so don't bother.
7ffc77d3 510;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
1fd3454a
SM
511;; "Return non-nil if version backups should be made for FILE.")
512
513(defun vc-svn-check-headers ()
514 "Check if the current file has any headers in it."
515 (save-excursion
516 (goto-char (point-min))
517 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
518\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
519
520
521;;;
522;;; Internal functions
523;;;
524
e4cc3f57 525(defcustom vc-svn-program "svn"
4ced8551 526 "Name of the SVN executable."
e4cc3f57
SM
527 :type 'string
528 :group 'vc)
529
b038f9fb
TTN
530(defun vc-svn-root (dir)
531 (vc-find-root dir vc-svn-admin-directory t))
532
8cdd17b4 533(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
1fd3454a
SM
534 "A wrapper around `vc-do-command' for use in vc-svn.el.
535The difference to vc-do-command is that this function always invokes `svn',
536and that it passes `vc-svn-global-switches' to it before FLAGS."
2888a97e 537 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
1fd3454a
SM
538 (if (stringp vc-svn-global-switches)
539 (cons vc-svn-global-switches flags)
540 (append vc-svn-global-switches
541 flags))))
542
7ffc77d3
SM
543(defun vc-svn-repository-hostname (dirname)
544 (with-temp-buffer
545 (let ((coding-system-for-read
546 (or file-name-coding-system
547 default-file-name-coding-system)))
ace2fad9
CY
548 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
549 "/entries")
550 dirname)))
7ffc77d3
SM
551 (goto-char (point-min))
552 (when (re-search-forward
c45b3be3 553 ;; Old `svn' used name="svn:this_dir", newer use just name="".
17a5a301
SM
554 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
555 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
0b0dad41
SM
556 "url=\"\\(?1:[^\"]+\\)\""
557 ;; Yet newer ones don't use XML any more.
558 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
17a5a301
SM
559 ;; This is not a hostname but a URL. This may actually be considered
560 ;; as a feature since it allows vc-svn-stay-local to specify different
561 ;; behavior for different modules on the same server.
562 (match-string 1))))
1fd3454a 563
1c67a814
SM
564(defun vc-svn-resolve-when-done ()
565 "Call \"svn resolved\" if the conflict markers have been removed."
566 (save-excursion
567 (goto-char (point-min))
54648b5c
DN
568 (unless (re-search-forward "^<<<<<<< " nil t)
569 (vc-svn-command nil 0 buffer-file-name "resolved")
570 ;; Remove the hook so that it is not called multiple times.
571 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
1c67a814
SM
572
573;; Inspired by vc-arch-find-file-hook.
574(defun vc-svn-find-file-hook ()
575 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
576 ;; If the file is marked as "conflicted", then we should try and call
577 ;; "svn resolved" when applicable.
578 (if (save-excursion
579 (goto-char (point-min))
580 (re-search-forward "^<<<<<<< " nil t))
581 ;; There are conflict markers.
582 (progn
28e4e2b4 583 (smerge-start-session)
1c67a814
SM
584 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
585 ;; There are no conflict markers. This is problematic: maybe it means
586 ;; the conflict has been resolved and we should immediately call "svn
587 ;; resolved", or it means that the file's type does not allow Svn to
588 ;; use conflict markers in which case we don't really know what to do.
589 ;; So let's just punt for now.
590 nil)
591 (message "There are unresolved conflicts in this file")))
592
bc8c1bb4 593(defun vc-svn-parse-status (&optional filename)
1fd3454a 594 "Parse output of \"svn status\" command in the current buffer.
bc8c1bb4
SM
595Set file properties accordingly. Unless FILENAME is non-nil, parse only
596information about FILENAME and return its status."
1fd3454a
SM
597 (let (file status)
598 (goto-char (point-min))
599 (while (re-search-forward
484c1b1f 600 ;; Ignore the files with status X.
abc61762 601 "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
c45b3be3
SM
602 ;; If the username contains spaces, the output format is ambiguous,
603 ;; so don't trust the output's filename unless we have to.
604 (setq file (or filename
605 (expand-file-name
606 (buffer-substring (point) (line-end-position)))))
1fd3454a 607 (setq status (char-after (line-beginning-position)))
484c1b1f 608 (if (eq status ??)
4f07b9f2 609 (vc-file-setprop file 'vc-state 'unregistered)
bc8c1bb4
SM
610 ;; `vc-BACKEND-registered' must not set vc-backend,
611 ;; which is instead set in vc-registered.
4f07b9f2 612 (unless filename (vc-file-setprop file 'vc-backend 'SVN))
fd140743
SM
613 ;; Use the last-modified revision, so that searching in vc-print-log
614 ;; output works.
4f07b9f2 615 (vc-file-setprop file 'vc-working-revision (match-string 3))
1c67a814 616 ;; Remember Svn's own status.
4f07b9f2
ER
617 (vc-file-setprop file 'vc-svn-status status)
618 (vc-file-setprop
1fd3454a
SM
619 file 'vc-state
620 (cond
621 ((eq status ?\ )
622 (if (eq (char-after (match-beginning 1)) ?*)
3702367b 623 'needs-update
4f07b9f2 624 (vc-file-setprop file 'vc-checkout-time
1fd3454a
SM
625 (nth 5 (file-attributes file)))
626 'up-to-date))
627 ((eq status ?A)
fd140743 628 ;; If the file was actually copied, (match-string 2) is "-".
4f07b9f2
ER
629 (vc-file-setprop file 'vc-working-revision "0")
630 (vc-file-setprop file 'vc-checkout-time 0)
484c1b1f 631 'added)
7fbb4797
DN
632 ((eq status ?C)
633 (vc-file-setprop file 'vc-state 'conflict))
634 ((eq status '?M)
1fd3454a
SM
635 (if (eq (char-after (match-beginning 1)) ?*)
636 'needs-merge
637 'edited))
722f037f 638 ((eq status ?I)
4f07b9f2 639 (vc-file-setprop file 'vc-state 'ignored))
484c1b1f 640 ((eq status ?R)
4f07b9f2 641 (vc-file-setprop file 'vc-state 'removed))
bc8c1bb4
SM
642 (t 'edited)))))
643 (if filename (vc-file-getprop filename 'vc-state))))
1fd3454a 644
1fd3454a
SM
645(defun vc-svn-valid-symbolic-tag-name-p (tag)
646 "Return non-nil if TAG is a valid symbolic tag name."
647 ;; According to the SVN manual, a valid symbolic tag must start with
648 ;; an uppercase or lowercase letter and can contain uppercase and
649 ;; lowercase letters, digits, `-', and `_'.
650 (and (string-match "^[a-zA-Z]" tag)
651 (not (string-match "[^a-z0-9A-Z-_]" tag))))
652
5b5afd50
ER
653(defun vc-svn-valid-revision-number-p (tag)
654 "Return non-nil if TAG is a valid revision number."
1fd3454a
SM
655 (and (string-match "^[0-9]" tag)
656 (not (string-match "[^0-9]" tag))))
657
17a5a301
SM
658;; Support for `svn annotate'
659
660(defun vc-svn-annotate-command (file buf &optional rev)
661 (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev))))
662
663(defun vc-svn-annotate-time-of-rev (rev)
664 ;; Arbitrarily assume 10 commmits per day.
665 (/ (string-to-number rev) 10.0))
666
667(defun vc-svn-annotate-current-time ()
668 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))
669
670(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
671
672(defun vc-svn-annotate-time ()
673 (when (looking-at vc-svn-annotate-re)
674 (goto-char (match-end 0))
675 (vc-svn-annotate-time-of-rev (match-string 1))))
676
677(defun vc-svn-annotate-extract-revision-at-line ()
678 (save-excursion
679 (beginning-of-line)
680 (if (looking-at vc-svn-annotate-re) (match-string 1))))
681
1fd3454a
SM
682(provide 'vc-svn)
683
f9d1f3be 684;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
1fd3454a 685;;; vc-svn.el ends here