Kill eol whitespace; nfc.
[bpt/emacs.git] / lisp / vc-svn.el
CommitLineData
1fd3454a
SM
1;;; vc-svn.el --- non-resident support for Subversion version-control
2
409cc4a3 3;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
1fd3454a
SM
4
5;; Author: FSF (see vc.el for full credits)
6;; Maintainer: Stefan Monnier <monnier@gnu.org>
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
b4aa6026 12;; the Free Software Foundation; either version 3, or (at your option)
1fd3454a
SM
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
1fd3454a
SM
24
25;;; Commentary:
26
f9914e54
ER
27;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version
28;; has been extensively modified since to handle filesets.
1fd3454a 29
1fd3454a
SM
30;;; Code:
31
32(eval-when-compile
33 (require 'vc))
34
35;;;
36;;; Customization options
37;;;
38
39(defcustom vc-svn-global-switches nil
40 "*Global switches to pass to any SVN command."
41 :type '(choice (const :tag "None" nil)
42 (string :tag "Argument String")
43 (repeat :tag "Argument List"
44 :value ("")
45 string))
bf247b6e 46 :version "22.1"
1fd3454a
SM
47 :group 'vc)
48
49(defcustom vc-svn-register-switches nil
50 "*Extra switches for registering a file into SVN.
51A string or list of strings passed to the checkin program by
52\\[vc-register]."
53 :type '(choice (const :tag "None" nil)
54 (string :tag "Argument String")
55 (repeat :tag "Argument List"
56 :value ("")
57 string))
bf247b6e 58 :version "22.1"
1fd3454a
SM
59 :group 'vc)
60
8462aca5
SM
61(defcustom vc-svn-diff-switches
62 t ;`svn' doesn't support common args like -c or -b.
63 "String or list of strings specifying extra switches for svn diff under VC.
64If nil, use the value of `vc-diff-switches'.
65If you want to force an empty list of arguments, use t."
66 :type '(choice (const :tag "Unspecified" nil)
67 (const :tag "None" t)
1fd3454a
SM
68 (string :tag "Argument String")
69 (repeat :tag "Argument List"
70 :value ("")
71 string))
bf247b6e 72 :version "22.1"
1fd3454a
SM
73 :group 'vc)
74
75(defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$"))
76 "*Header keywords to be inserted by `vc-insert-headers'."
bf247b6e 77 :version "22.1"
1fd3454a
SM
78 :type '(repeat string)
79 :group 'vc)
80
fc2fb30c
SM
81;; We want to autoload it for use by the autoloaded version of
82;; vc-svn-registered, but we want the value to be compiled at startup, not
83;; at dump time.
84;; ;;;###autoload
85(defconst vc-svn-admin-directory
86 (cond ((and (memq system-type '(cygwin windows-nt ms-dos))
ace2fad9
CY
87 (getenv "SVN_ASP_DOT_NET_HACK"))
88 "_svn")
89 (t ".svn"))
90 "The name of the \".svn\" subdirectory or its equivalent.")
91
8cdd17b4
ER
92;;; Properties of the backend
93
94(defun vc-svn-revision-granularity ()
95 'repository)
1fd3454a
SM
96;;;
97;;; State-querying functions
98;;;
99
ace2fad9
CY
100;;; vc-svn-admin-directory is generally not defined when the
101;;; autoloaded function is called.
102
1fd3454a 103;;;###autoload (defun vc-svn-registered (f)
ace2fad9 104;;;###autoload (let ((admin-dir (cond ((and (eq system-type 'windows-nt)
fc2fb30c
SM
105;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK"))
106;;;###autoload "_svn")
107;;;###autoload (t ".svn"))))
ace2fad9 108;;;###autoload (when (file-readable-p (expand-file-name
fc2fb30c
SM
109;;;###autoload (concat admin-dir "/entries")
110;;;###autoload (file-name-directory f)))
1fd3454a 111;;;###autoload (load "vc-svn")
ace2fad9 112;;;###autoload (vc-svn-registered f))))
1fd3454a 113
3bdc13e4
SM
114;;;###autoload
115(add-to-list 'completion-ignored-extensions ".svn/")
116
1fd3454a
SM
117(defun vc-svn-registered (file)
118 "Check if FILE is SVN registered."
ace2fad9
CY
119 (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory
120 "/entries")
1fd3454a
SM
121 (file-name-directory file)))
122 (with-temp-buffer
123 (cd (file-name-directory file))
aaef169d 124 (let ((status
df4da7f4
SM
125 (condition-case nil
126 ;; Ignore all errors.
127 (vc-svn-command t t file "status" "-v")
128 ;; Some problem happened. E.g. We can't find an `svn'
129 ;; executable. We used to only catch `file-error' but when
130 ;; the process is run on a remote host via Tramp, the error
131 ;; is only reported via the exit status which is turned into
132 ;; an `error' by vc-do-command.
133 (error nil))))
134 (when (eq 0 status)
b5e791bd
DN
135 (let ((parsed (vc-svn-parse-status file)))
136 (and parsed (not (memq parsed '(ignored unregistered))))))))))
1fd3454a
SM
137
138(defun vc-svn-state (file &optional localp)
139 "SVN-specific version of `vc-state'."
7ffc77d3 140 (setq localp (or localp (vc-stay-local-p file)))
1fd3454a
SM
141 (with-temp-buffer
142 (cd (file-name-directory file))
143 (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
bc8c1bb4 144 (vc-svn-parse-status file)))
1fd3454a
SM
145
146(defun vc-svn-state-heuristic (file)
147 "SVN-specific state heuristic."
148 (vc-svn-state file 'local))
149
150(defun vc-svn-dir-state (dir &optional localp)
cdce374a 151 "Find the SVN state of all files in DIR and its subdirectories."
7ffc77d3 152 (setq localp (or localp (vc-stay-local-p dir)))
1fd3454a
SM
153 (let ((default-directory dir))
154 ;; Don't specify DIR in this command, the default-directory is
155 ;; enough. Otherwise it might fail with remote repositories.
156 (with-temp-buffer
18e1f249 157 (buffer-disable-undo) ;; Because these buffers can get huge
1fd3454a 158 (vc-svn-command t 0 nil "status" (if localp "-v" "-u"))
bc8c1bb4 159 (vc-svn-parse-status))))
1fd3454a 160
c222c25f
DN
161(defun vc-svn-after-dir-status (callback buffer)
162 (let ((state-map '((?A . added)
163 (?C . edited)
164 (?D . removed)
165 (?I . ignored)
166 (?M . edited)
167 (?R . removed)
168 (?? . unregistered)
169 ;; This is what vc-svn-parse-status does.
170 (?~ . edited)))
171 result)
172 (goto-char (point-min))
173 (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t)
174 (let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
175 (filename (match-string 2)))
176 (when state
177 (setq result (cons (cons filename state) result)))))
178 (funcall callback result buffer)))
179
180(defun vc-svn-dir-status (dir callback buffer)
181 "Run 'svn status' for DIR and update BUFFER via CALLBACK.
182CALLBACK is called as (CALLBACK RESULT BUFFER), where
183RESULT is a list of conses (FILE . STATE) for directory DIR."
184 (with-current-buffer (get-buffer-create
185 (generate-new-buffer-name " *vc svn status*"))
186 (vc-svn-command (current-buffer) 'async nil "status")
187 (vc-exec-after
188 `(vc-svn-after-dir-status (quote ,callback) ,buffer))))
f8e89f19 189
ac3f4c6f
ER
190(defun vc-svn-working-revision (file)
191 "SVN-specific version of `vc-working-revision'."
1fd3454a
SM
192 ;; There is no need to consult RCS headers under SVN, because we
193 ;; get the workfile version for free when we recognize that a file
194 ;; is registered in SVN.
195 (vc-svn-registered file)
ac3f4c6f 196 (vc-file-getprop file 'vc-working-revision))
1fd3454a
SM
197
198(defun vc-svn-checkout-model (file)
199 "SVN-specific version of `vc-checkout-model'."
200 ;; It looks like Subversion has no equivalent of CVSREAD.
201 'implicit)
202
5cc7cb96
SM
203;; vc-svn-mode-line-string doesn't exist because the default implementation
204;; works just fine.
205
1fd3454a
SM
206(defun vc-svn-dired-state-info (file)
207 "SVN-specific version of `vc-dired-state-info'."
fd140743
SM
208 (let ((svn-state (vc-state file)))
209 (cond ((eq svn-state 'edited)
ac3f4c6f 210 (if (equal (vc-working-revision file) "0")
fd140743 211 "(added)" "(modified)"))
0f67cc71
ER
212 (t
213 ;; fall back to the default VC representation
214 (vc-default-dired-state-info 'SVN file)))))
215
1fd3454a 216
5b5afd50 217(defun vc-svn-previous-revision (file rev)
cbbd2cd3
TTN
218 (let ((newrev (1- (string-to-number rev))))
219 (when (< 0 newrev)
220 (number-to-string newrev))))
221
5b5afd50 222(defun vc-svn-next-revision (file rev)
cbbd2cd3 223 (let ((newrev (1+ (string-to-number rev))))
5b5afd50 224 ;; The "working revision" is an uneasy conceptual fit under Subversion;
cbbd2cd3
TTN
225 ;; we use it as the upper bound until a better idea comes along. If the
226 ;; workfile version W coincides with the tree's latest revision R, then
227 ;; this check prevents a "no such revision: R+1" error. Otherwise, it
228 ;; inhibits showing of W+1 through R, which could be considered anywhere
229 ;; from gracious to impolite.
ac3f4c6f 230 (unless (< (string-to-number (vc-file-getprop file 'vc-working-revision))
cbbd2cd3
TTN
231 newrev)
232 (number-to-string newrev))))
233
1fd3454a
SM
234
235;;;
236;;; State-changing functions
237;;;
238
8cdd17b4
ER
239(defun vc-svn-create-repo ()
240 "Create a new SVN repository."
241 (vc-do-command nil 0 "svnadmin" '("create" "SVN"))
242 (vc-do-command nil 0 "svn" '(".")
243 "checkout" (concat "file://" default-directory "SVN")))
244
245(defun vc-svn-register (files &optional rev comment)
246 "Register FILES into the SVN version-control system.
247The COMMENT argument is ignored This does an add but not a commit.
1fd3454a
SM
248
249`vc-register-switches' and `vc-svn-register-switches' are passed to
250the SVN command (in that order)."
8cdd17b4 251 (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
1fd3454a
SM
252
253(defun vc-svn-responsible-p (file)
254 "Return non-nil if SVN thinks it is responsible for FILE."
ace2fad9 255 (file-directory-p (expand-file-name vc-svn-admin-directory
1fd3454a
SM
256 (if (file-directory-p file)
257 file
258 (file-name-directory file)))))
259
260(defalias 'vc-svn-could-register 'vc-svn-responsible-p
261 "Return non-nil if FILE could be registered in SVN.
262This is only possible if SVN is responsible for FILE's directory.")
263
8cdd17b4 264(defun vc-svn-checkin (files rev comment)
1fd3454a 265 "SVN-specific version of `vc-backend-checkin'."
8cdd17b4 266 (if rev (error "Committing to a specific revision is unsupported in SVN."))
5129f10c 267 (let ((status (apply
8cdd17b4 268 'vc-svn-command nil 1 files "ci"
5129f10c 269 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
1fd3454a
SM
270 (set-buffer "*vc*")
271 (goto-char (point-min))
272 (unless (equal status 0)
273 ;; Check checkin problem.
274 (cond
fd140743 275 ((search-forward "Transaction is out of date" nil t)
8cdd17b4
ER
276 (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
277 files)
1fd3454a
SM
278 (error (substitute-command-keys
279 (concat "Up-to-date check failed: "
280 "type \\[vc-next-action] to merge in changes"))))
281 (t
282 (pop-to-buffer (current-buffer))
283 (goto-char (point-min))
284 (shrink-window-if-larger-than-buffer)
285 (error "Check-in failed"))))
286 ;; Update file properties
287 ;; (vc-file-setprop
ac3f4c6f 288 ;; file 'vc-working-revision
1fd3454a
SM
289 ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
290 ))
291
ac3f4c6f 292(defun vc-svn-find-revision (file rev buffer)
8cdd17b4 293 "SVN-specific retrieval of a specified version into a buffer."
1fd3454a
SM
294 (apply 'vc-svn-command
295 buffer 0 file
296 "cat"
297 (and rev (not (string= rev ""))
298 (concat "-r" rev))
fd140743 299 (vc-switches 'SVN 'checkout)))
1fd3454a
SM
300
301(defun vc-svn-checkout (file &optional editable rev)
302 (message "Checking out %s..." file)
303 (with-current-buffer (or (get-file-buffer file) (current-buffer))
fd140743 304 (vc-call update file editable rev (vc-switches 'SVN 'checkout)))
1fd3454a
SM
305 (vc-mode-line file)
306 (message "Checking out %s...done" file))
307
308(defun vc-svn-update (file editable rev switches)
309 (if (and (file-exists-p file) (not rev))
fc2fb30c
SM
310 ;; If no revision was specified, there's nothing to do.
311 nil
1fd3454a 312 ;; Check out a particular version (or recreate the file).
ac3f4c6f 313 (vc-file-setprop file 'vc-working-revision nil)
1fd3454a 314 (apply 'vc-svn-command nil 0 file
1fd3454a
SM
315 "update"
316 ;; default for verbose checkout: clear the sticky tag so
317 ;; that the actual update will get the head of the trunk
5cc7cb96
SM
318 (cond
319 ((null rev) "-rBASE")
320 ((or (eq rev t) (equal rev "")) nil)
321 (t (concat "-r" rev)))
1fd3454a
SM
322 switches)))
323
3bdc13e4
SM
324(defun vc-svn-delete-file (file)
325 (vc-svn-command nil 0 file "remove"))
326
2766aaaf
SM
327(defun vc-svn-rename-file (old new)
328 (vc-svn-command nil 0 new "move" (file-relative-name old)))
329
1fd3454a
SM
330(defun vc-svn-revert (file &optional contents-done)
331 "Revert FILE to the version it was based on."
332 (unless contents-done
fc2fb30c 333 (vc-svn-command nil 0 file "revert")))
1fd3454a
SM
334
335(defun vc-svn-merge (file first-version &optional second-version)
336 "Merge changes into current working copy of FILE.
337The changes are between FIRST-VERSION and SECOND-VERSION."
338 (vc-svn-command nil 0 file
c217cb04 339 "merge"
02610d0e 340 "-r" (if second-version
c217cb04
SM
341 (concat first-version ":" second-version)
342 first-version))
1fd3454a
SM
343 (vc-file-setprop file 'vc-state 'edited)
344 (with-current-buffer (get-buffer "*vc*")
345 (goto-char (point-min))
c217cb04
SM
346 (if (looking-at "C ")
347 1 ; signal conflict
1fd3454a
SM
348 0))) ; signal success
349
350(defun vc-svn-merge-news (file)
351 "Merge in any new changes made to FILE."
352 (message "Merging changes into %s..." file)
ac3f4c6f 353 ;; (vc-file-setprop file 'vc-working-revision nil)
1fd3454a
SM
354 (vc-file-setprop file 'vc-checkout-time 0)
355 (vc-svn-command nil 0 file "update")
356 ;; Analyze the merge result reported by SVN, and set
357 ;; file properties accordingly.
358 (with-current-buffer (get-buffer "*vc*")
359 (goto-char (point-min))
5b5afd50 360 ;; get new working revision
1fd3454a 361 (if (re-search-forward
1468d754 362 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
ac3f4c6f
ER
363 (vc-file-setprop file 'vc-working-revision (match-string 2))
364 (vc-file-setprop file 'vc-working-revision nil))
1fd3454a 365 ;; get file status
1468d754 366 (goto-char (point-min))
1fd3454a 367 (prog1
1468d754 368 (if (looking-at "At revision")
1fd3454a
SM
369 0 ;; there were no news; indicate success
370 (if (re-search-forward
459b1fe4
SM
371 ;; Newer SVN clients have 3 columns of chars (one for the
372 ;; file's contents, then second for its properties, and the
373 ;; third for lock-grabbing info), before the 2 spaces.
374 ;; We also used to match the filename in column 0 without any
375 ;; meta-info before it, but I believe this can never happen.
376 (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)"
1468d754 377 (regexp-quote (file-name-nondirectory file)))
1fd3454a
SM
378 nil t)
379 (cond
380 ;; Merge successful, we are in sync with repository now
459b1fe4 381 ((string= (match-string 2) "U")
1fd3454a
SM
382 (vc-file-setprop file 'vc-state 'up-to-date)
383 (vc-file-setprop file 'vc-checkout-time
384 (nth 5 (file-attributes file)))
385 0);; indicate success to the caller
386 ;; Merge successful, but our own changes are still in the file
459b1fe4 387 ((string= (match-string 2) "G")
1fd3454a
SM
388 (vc-file-setprop file 'vc-state 'edited)
389 0);; indicate success to the caller
390 ;; Conflicts detected!
391 (t
392 (vc-file-setprop file 'vc-state 'edited)
393 1);; signal the error to the caller
394 )
395 (pop-to-buffer "*vc*")
396 (error "Couldn't analyze svn update result")))
397 (message "Merging changes into %s...done" file))))
398
42a0a135
ER
399(defun vc-svn-modify-change-comment (files rev comment)
400 "Modify the change comments for a specified REV.
401You must have ssh access to the repository host, and the directory Emacs
402uses locally for temp files must also be writeable by you on that host."
403 (vc-do-command nil 0 "svn" nil "info")
404 (set-buffer "*vc*")
405 (goto-char (point-min))
406 (unless (re-search-forward "Repository Root: svn\\+ssh://\\([^/]+\\)\\(/.*\\)" nil t)
407 (error "Repository information is unavailable."))
408 (let* ((tempfile (make-temp-file user-mail-address))
409 (host (match-string 1))
410 (directory (match-string 2))
411 (remotefile (concat host ":" tempfile)))
412 (with-temp-buffer
413 (insert comment)
414 (write-region (point-min) (point-max) tempfile))
415 (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile)
416 (error "Copy of comment to %s failed" remotefile))
417 (unless (vc-do-command nil 0 "ssh" nil
418 "-q" host
419 (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
420 directory rev tempfile tempfile))
421 (error "Log edit failed"))
422 ))
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
SM
530(defcustom vc-svn-program "svn"
531 "Name of the svn executable."
532 :type 'string
533 :group 'vc)
534
8cdd17b4 535(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
1fd3454a
SM
536 "A wrapper around `vc-do-command' for use in vc-svn.el.
537The difference to vc-do-command is that this function always invokes `svn',
538and that it passes `vc-svn-global-switches' to it before FLAGS."
8cdd17b4 539 (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list
1fd3454a
SM
540 (if (stringp vc-svn-global-switches)
541 (cons vc-svn-global-switches flags)
542 (append vc-svn-global-switches
543 flags))))
544
7ffc77d3
SM
545(defun vc-svn-repository-hostname (dirname)
546 (with-temp-buffer
547 (let ((coding-system-for-read
548 (or file-name-coding-system
549 default-file-name-coding-system)))
ace2fad9
CY
550 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
551 "/entries")
552 dirname)))
7ffc77d3
SM
553 (goto-char (point-min))
554 (when (re-search-forward
c45b3be3 555 ;; Old `svn' used name="svn:this_dir", newer use just name="".
17a5a301
SM
556 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
557 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
0b0dad41
SM
558 "url=\"\\(?1:[^\"]+\\)\""
559 ;; Yet newer ones don't use XML any more.
560 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
17a5a301
SM
561 ;; This is not a hostname but a URL. This may actually be considered
562 ;; as a feature since it allows vc-svn-stay-local to specify different
563 ;; behavior for different modules on the same server.
564 (match-string 1))))
1fd3454a 565
1c67a814
SM
566(defun vc-svn-resolve-when-done ()
567 "Call \"svn resolved\" if the conflict markers have been removed."
568 (save-excursion
569 (goto-char (point-min))
54648b5c
DN
570 (unless (re-search-forward "^<<<<<<< " nil t)
571 (vc-svn-command nil 0 buffer-file-name "resolved")
572 ;; Remove the hook so that it is not called multiple times.
573 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
1c67a814
SM
574
575;; Inspired by vc-arch-find-file-hook.
576(defun vc-svn-find-file-hook ()
577 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
578 ;; If the file is marked as "conflicted", then we should try and call
579 ;; "svn resolved" when applicable.
580 (if (save-excursion
581 (goto-char (point-min))
582 (re-search-forward "^<<<<<<< " nil t))
583 ;; There are conflict markers.
584 (progn
28e4e2b4 585 (smerge-start-session)
1c67a814
SM
586 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
587 ;; There are no conflict markers. This is problematic: maybe it means
588 ;; the conflict has been resolved and we should immediately call "svn
589 ;; resolved", or it means that the file's type does not allow Svn to
590 ;; use conflict markers in which case we don't really know what to do.
591 ;; So let's just punt for now.
592 nil)
593 (message "There are unresolved conflicts in this file")))
594
bc8c1bb4 595(defun vc-svn-parse-status (&optional filename)
1fd3454a 596 "Parse output of \"svn status\" command in the current buffer.
bc8c1bb4
SM
597Set file properties accordingly. Unless FILENAME is non-nil, parse only
598information about FILENAME and return its status."
1fd3454a
SM
599 (let (file status)
600 (goto-char (point-min))
601 (while (re-search-forward
484c1b1f 602 ;; Ignore the files with status X.
abc61762 603 "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
c45b3be3
SM
604 ;; If the username contains spaces, the output format is ambiguous,
605 ;; so don't trust the output's filename unless we have to.
606 (setq file (or filename
607 (expand-file-name
608 (buffer-substring (point) (line-end-position)))))
1fd3454a 609 (setq status (char-after (line-beginning-position)))
484c1b1f 610 (if (eq status ??)
4f07b9f2 611 (vc-file-setprop file 'vc-state 'unregistered)
bc8c1bb4
SM
612 ;; `vc-BACKEND-registered' must not set vc-backend,
613 ;; which is instead set in vc-registered.
4f07b9f2 614 (unless filename (vc-file-setprop file 'vc-backend 'SVN))
fd140743
SM
615 ;; Use the last-modified revision, so that searching in vc-print-log
616 ;; output works.
4f07b9f2 617 (vc-file-setprop file 'vc-working-revision (match-string 3))
1c67a814 618 ;; Remember Svn's own status.
4f07b9f2
ER
619 (vc-file-setprop file 'vc-svn-status status)
620 (vc-file-setprop
1fd3454a
SM
621 file 'vc-state
622 (cond
623 ((eq status ?\ )
624 (if (eq (char-after (match-beginning 1)) ?*)
625 'needs-patch
4f07b9f2 626 (vc-file-setprop file 'vc-checkout-time
1fd3454a
SM
627 (nth 5 (file-attributes file)))
628 'up-to-date))
629 ((eq status ?A)
fd140743 630 ;; If the file was actually copied, (match-string 2) is "-".
4f07b9f2
ER
631 (vc-file-setprop file 'vc-working-revision "0")
632 (vc-file-setprop file 'vc-checkout-time 0)
484c1b1f 633 'added)
1fd3454a
SM
634 ((memq status '(?M ?C))
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
SM
644
645(defun vc-svn-dir-state-heuristic (dir)
646 "Find the SVN state of all files in DIR, using only local information."
647 (vc-svn-dir-state dir 'local))
648
649(defun vc-svn-valid-symbolic-tag-name-p (tag)
650 "Return non-nil if TAG is a valid symbolic tag name."
651 ;; According to the SVN manual, a valid symbolic tag must start with
652 ;; an uppercase or lowercase letter and can contain uppercase and
653 ;; lowercase letters, digits, `-', and `_'.
654 (and (string-match "^[a-zA-Z]" tag)
655 (not (string-match "[^a-z0-9A-Z-_]" tag))))
656
5b5afd50
ER
657(defun vc-svn-valid-revision-number-p (tag)
658 "Return non-nil if TAG is a valid revision number."
1fd3454a
SM
659 (and (string-match "^[0-9]" tag)
660 (not (string-match "[^0-9]" tag))))
661
17a5a301
SM
662;; Support for `svn annotate'
663
664(defun vc-svn-annotate-command (file buf &optional rev)
665 (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev))))
666
667(defun vc-svn-annotate-time-of-rev (rev)
668 ;; Arbitrarily assume 10 commmits per day.
669 (/ (string-to-number rev) 10.0))
670
671(defun vc-svn-annotate-current-time ()
672 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))
673
674(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
675
676(defun vc-svn-annotate-time ()
677 (when (looking-at vc-svn-annotate-re)
678 (goto-char (match-end 0))
679 (vc-svn-annotate-time-of-rev (match-string 1))))
680
681(defun vc-svn-annotate-extract-revision-at-line ()
682 (save-excursion
683 (beginning-of-line)
684 (if (looking-at vc-svn-annotate-re) (match-string 1))))
685
1fd3454a
SM
686(provide 'vc-svn)
687
f9d1f3be 688;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
1fd3454a 689;;; vc-svn.el ends here