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