*** empty log message ***
[bpt/emacs.git] / lisp / vc-svn.el
CommitLineData
1fd3454a
SM
1;;; vc-svn.el --- non-resident support for Subversion version-control
2
a80a6b03
GM
3;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
4;; Free Software Foundation, Inc.
1fd3454a
SM
5
6;; Author: FSF (see vc.el for full credits)
7;; Maintainer: Stefan Monnier <monnier@gnu.org>
8
9;; This file is part of GNU Emacs.
10
eb3fa2cf 11;; GNU Emacs is free software: you can redistribute it and/or modify
1fd3454a 12;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
1fd3454a
SM
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
eb3fa2cf 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1fd3454a
SM
23
24;;; Commentary:
25
f9914e54
ER
26;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version
27;; has been extensively modified since to handle filesets.
1fd3454a 28
1fd3454a
SM
29;;; Code:
30
31(eval-when-compile
32 (require 'vc))
33
34;;;
35;;; Customization options
36;;;
37
f9d5dc48
GM
38;; FIXME there is also svnadmin.
39(defcustom vc-svn-program "svn"
40 "Name of the SVN executable."
41 :type 'string
42 :group 'vc)
43
1fd3454a 44(defcustom vc-svn-global-switches nil
f9d5dc48 45 "Global switches to pass to any SVN command."
1fd3454a
SM
46 :type '(choice (const :tag "None" nil)
47 (string :tag "Argument String")
48 (repeat :tag "Argument List"
49 :value ("")
50 string))
bf247b6e 51 :version "22.1"
1fd3454a
SM
52 :group 'vc)
53
54(defcustom vc-svn-register-switches nil
c8d6b4bc 55 "Switches for registering a file into SVN.
1fd3454a 56A string or list of strings passed to the checkin program by
c8d6b4bc
GM
57\\[vc-register]. If nil, use the value of `vc-register-switches'.
58If t, use no switches."
59 :type '(choice (const :tag "Unspecified" nil)
60 (const :tag "None" t)
1fd3454a 61 (string :tag "Argument String")
c8d6b4bc 62 (repeat :tag "Argument List" :value ("") string))
bf247b6e 63 :version "22.1"
1fd3454a
SM
64 :group 'vc)
65
8462aca5
SM
66(defcustom vc-svn-diff-switches
67 t ;`svn' doesn't support common args like -c or -b.
68 "String or list of strings specifying extra switches for svn diff under VC.
9751169a
GM
69If nil, use the value of `vc-diff-switches' (or `diff-switches'),
70together with \"-x --diff-cmd=diff\" (since svn diff does not
71support the default \"-c\" value of `diff-switches'). If you
72want to force an empty list of arguments, use t."
8462aca5
SM
73 :type '(choice (const :tag "Unspecified" nil)
74 (const :tag "None" t)
1fd3454a
SM
75 (string :tag "Argument String")
76 (repeat :tag "Argument List"
77 :value ("")
78 string))
bf247b6e 79 :version "22.1"
1fd3454a
SM
80 :group 'vc)
81
82(defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$"))
f9d5dc48 83 "Header keywords to be inserted by `vc-insert-headers'."
bf247b6e 84 :version "22.1"
1fd3454a
SM
85 :type '(repeat string)
86 :group 'vc)
87
fc2fb30c
SM
88;; We want to autoload it for use by the autoloaded version of
89;; vc-svn-registered, but we want the value to be compiled at startup, not
90;; at dump time.
91;; ;;;###autoload
92(defconst vc-svn-admin-directory
93 (cond ((and (memq system-type '(cygwin windows-nt ms-dos))
ace2fad9
CY
94 (getenv "SVN_ASP_DOT_NET_HACK"))
95 "_svn")
96 (t ".svn"))
97 "The name of the \".svn\" subdirectory or its equivalent.")
98
8cdd17b4
ER
99;;; Properties of the backend
100
70e2f6c7
ER
101(defun vc-svn-revision-granularity () 'repository)
102(defun vc-svn-checkout-model (files) 'implicit)
103
1fd3454a
SM
104;;;
105;;; State-querying functions
106;;;
107
ace2fad9
CY
108;;; vc-svn-admin-directory is generally not defined when the
109;;; autoloaded function is called.
110
1fd3454a 111;;;###autoload (defun vc-svn-registered (f)
ace2fad9 112;;;###autoload (let ((admin-dir (cond ((and (eq system-type 'windows-nt)
fc2fb30c
SM
113;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK"))
114;;;###autoload "_svn")
115;;;###autoload (t ".svn"))))
ace2fad9 116;;;###autoload (when (file-readable-p (expand-file-name
fc2fb30c
SM
117;;;###autoload (concat admin-dir "/entries")
118;;;###autoload (file-name-directory f)))
1fd3454a 119;;;###autoload (load "vc-svn")
ace2fad9 120;;;###autoload (vc-svn-registered f))))
1fd3454a 121
3bdc13e4
SM
122;;;###autoload
123(add-to-list 'completion-ignored-extensions ".svn/")
124
1fd3454a
SM
125(defun vc-svn-registered (file)
126 "Check if FILE is SVN registered."
ace2fad9
CY
127 (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory
128 "/entries")
1fd3454a
SM
129 (file-name-directory file)))
130 (with-temp-buffer
131 (cd (file-name-directory file))
aaef169d 132 (let ((status
df4da7f4
SM
133 (condition-case nil
134 ;; Ignore all errors.
135 (vc-svn-command t t file "status" "-v")
136 ;; Some problem happened. E.g. We can't find an `svn'
137 ;; executable. We used to only catch `file-error' but when
138 ;; the process is run on a remote host via Tramp, the error
139 ;; is only reported via the exit status which is turned into
140 ;; an `error' by vc-do-command.
141 (error nil))))
142 (when (eq 0 status)
b5e791bd
DN
143 (let ((parsed (vc-svn-parse-status file)))
144 (and parsed (not (memq parsed '(ignored unregistered))))))))))
1fd3454a
SM
145
146(defun vc-svn-state (file &optional localp)
147 "SVN-specific version of `vc-state'."
7ffc77d3 148 (setq localp (or localp (vc-stay-local-p file)))
1fd3454a
SM
149 (with-temp-buffer
150 (cd (file-name-directory file))
151 (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
bc8c1bb4 152 (vc-svn-parse-status file)))
1fd3454a
SM
153
154(defun vc-svn-state-heuristic (file)
155 "SVN-specific state heuristic."
156 (vc-svn-state file 'local))
157
a80a6b03
GM
158;; FIXME it would be better not to have the "remote" argument,
159;; but to distinguish the two output formats based on content.
160(defun vc-svn-after-dir-status (callback &optional remote)
c222c25f 161 (let ((state-map '((?A . added)
b2ee56c9
SM
162 (?C . conflict)
163 (?D . removed)
164 (?I . ignored)
165 (?M . edited)
166 (?R . removed)
167 (?? . unregistered)
168 ;; This is what vc-svn-parse-status does.
169 (?~ . edited)))
a80a6b03
GM
170 (re (if remote "^\\(.\\)..... \\([ *]\\) +[-0-9]+ +\\(.*\\)$"
171 ;; Subexp 2 is a dummy in this case, so the numbers match.
172 "^\\(.\\)....\\(.\\) \\(.*\\)$"))
c222c25f
DN
173 result)
174 (goto-char (point-min))
a80a6b03 175 (while (re-search-forward re nil t)
c222c25f 176 (let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
a80a6b03
GM
177 (filename (match-string 3)))
178 (and remote (string-equal (match-string 2) "*")
179 ;; FIXME are there other possible combinations?
180 (cond ((eq state 'edited) (setq state 'needs-merge))
181 ((not state) (setq state 'needs-update))))
c222c25f 182 (when state
1b3f2d4e 183 (setq result (cons (list filename state) result)))))
b2ee56c9 184 (funcall callback result)))
c222c25f 185
c1b51374 186(defun vc-svn-dir-status (dir callback)
c222c25f
DN
187 "Run 'svn status' for DIR and update BUFFER via CALLBACK.
188CALLBACK is called as (CALLBACK RESULT BUFFER), where
189RESULT is a list of conses (FILE . STATE) for directory DIR."
a80a6b03 190 ;; FIXME should this rather be all the files in dir?
5870cb76
DN
191 (let* ((local (vc-stay-local-p dir))
192 (remote (and local (not (eq local 'only-file)))))
a80a6b03
GM
193 (vc-svn-command (current-buffer) 'async nil "status"
194 (if remote "-u"))
115c0061 195 (vc-exec-after
a80a6b03 196 `(vc-svn-after-dir-status (quote ,callback) ,remote))))
f8e89f19 197
847fb889
DN
198(defun vc-svn-dir-status-files (dir files default-state callback)
199 (apply 'vc-svn-command (current-buffer) 'async nil "status" files)
200 (vc-exec-after
201 `(vc-svn-after-dir-status (quote ,callback))))
202
13ad7457 203(defun vc-svn-dir-extra-headers (dir)
2ec0d864
ER
204 "Generate extra status headers for a Subversion working copy."
205 (vc-svn-command "*vc*" 0 nil "info")
206 (let ((repo
def61be2 207 (save-excursion
2ec0d864
ER
208 (and (progn
209 (set-buffer "*vc*")
210 (goto-char (point-min))
211 (re-search-forward "Repository Root: *\\(.*\\)" nil t))
212 (match-string 1)))))
213 (concat
214 (cond (repo
215 (concat
216 (propertize "Repository : " 'face 'font-lock-type-face)
217 (propertize repo 'face 'font-lock-variable-name-face)))
218 (t "")))))
219
ac3f4c6f
ER
220(defun vc-svn-working-revision (file)
221 "SVN-specific version of `vc-working-revision'."
1fd3454a
SM
222 ;; There is no need to consult RCS headers under SVN, because we
223 ;; get the workfile version for free when we recognize that a file
224 ;; is registered in SVN.
225 (vc-svn-registered file)
ac3f4c6f 226 (vc-file-getprop file 'vc-working-revision))
1fd3454a 227
5cc7cb96
SM
228;; vc-svn-mode-line-string doesn't exist because the default implementation
229;; works just fine.
230
5b5afd50 231(defun vc-svn-previous-revision (file rev)
cbbd2cd3
TTN
232 (let ((newrev (1- (string-to-number rev))))
233 (when (< 0 newrev)
234 (number-to-string newrev))))
235
5b5afd50 236(defun vc-svn-next-revision (file rev)
cbbd2cd3 237 (let ((newrev (1+ (string-to-number rev))))
5b5afd50 238 ;; The "working revision" is an uneasy conceptual fit under Subversion;
cbbd2cd3
TTN
239 ;; we use it as the upper bound until a better idea comes along. If the
240 ;; workfile version W coincides with the tree's latest revision R, then
241 ;; this check prevents a "no such revision: R+1" error. Otherwise, it
242 ;; inhibits showing of W+1 through R, which could be considered anywhere
243 ;; from gracious to impolite.
ac3f4c6f 244 (unless (< (string-to-number (vc-file-getprop file 'vc-working-revision))
cbbd2cd3
TTN
245 newrev)
246 (number-to-string newrev))))
247
1fd3454a
SM
248
249;;;
250;;; State-changing functions
251;;;
252
8cdd17b4
ER
253(defun vc-svn-create-repo ()
254 "Create a new SVN repository."
2888a97e 255 (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
f9d5dc48 256 (vc-do-command "*vc*" 0 vc-svn-program '(".")
8cdd17b4
ER
257 "checkout" (concat "file://" default-directory "SVN")))
258
259(defun vc-svn-register (files &optional rev comment)
260 "Register FILES into the SVN version-control system.
261The COMMENT argument is ignored This does an add but not a commit.
c8d6b4bc
GM
262Passes either `vc-svn-register-switches' or `vc-register-switches'
263to the SVN command."
8cdd17b4 264 (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
1fd3454a
SM
265
266(defun vc-svn-responsible-p (file)
267 "Return non-nil if SVN thinks it is responsible for FILE."
ace2fad9 268 (file-directory-p (expand-file-name vc-svn-admin-directory
1fd3454a
SM
269 (if (file-directory-p file)
270 file
271 (file-name-directory file)))))
272
273(defalias 'vc-svn-could-register 'vc-svn-responsible-p
274 "Return non-nil if FILE could be registered in SVN.
275This is only possible if SVN is responsible for FILE's directory.")
276
8cdd17b4 277(defun vc-svn-checkin (files rev comment)
1fd3454a 278 "SVN-specific version of `vc-backend-checkin'."
4ced8551 279 (if rev (error "Committing to a specific revision is unsupported in SVN"))
5129f10c 280 (let ((status (apply
8cdd17b4 281 'vc-svn-command nil 1 files "ci"
5129f10c 282 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
1fd3454a
SM
283 (set-buffer "*vc*")
284 (goto-char (point-min))
285 (unless (equal status 0)
286 ;; Check checkin problem.
287 (cond
fd140743 288 ((search-forward "Transaction is out of date" nil t)
8cdd17b4
ER
289 (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
290 files)
1fd3454a
SM
291 (error (substitute-command-keys
292 (concat "Up-to-date check failed: "
293 "type \\[vc-next-action] to merge in changes"))))
294 (t
295 (pop-to-buffer (current-buffer))
296 (goto-char (point-min))
297 (shrink-window-if-larger-than-buffer)
298 (error "Check-in failed"))))
299 ;; Update file properties
300 ;; (vc-file-setprop
ac3f4c6f 301 ;; file 'vc-working-revision
1fd3454a
SM
302 ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
303 ))
304
ac3f4c6f 305(defun vc-svn-find-revision (file rev buffer)
8cdd17b4 306 "SVN-specific retrieval of a specified version into a buffer."
1fd3454a
SM
307 (apply 'vc-svn-command
308 buffer 0 file
309 "cat"
310 (and rev (not (string= rev ""))
311 (concat "-r" rev))
fd140743 312 (vc-switches 'SVN 'checkout)))
1fd3454a
SM
313
314(defun vc-svn-checkout (file &optional editable rev)
315 (message "Checking out %s..." file)
316 (with-current-buffer (or (get-file-buffer file) (current-buffer))
a749e19d 317 (vc-svn-update file editable rev (vc-switches 'SVN 'checkout)))
1fd3454a
SM
318 (vc-mode-line file)
319 (message "Checking out %s...done" file))
320
321(defun vc-svn-update (file editable rev switches)
322 (if (and (file-exists-p file) (not rev))
fc2fb30c
SM
323 ;; If no revision was specified, there's nothing to do.
324 nil
1fd3454a 325 ;; Check out a particular version (or recreate the file).
ac3f4c6f 326 (vc-file-setprop file 'vc-working-revision nil)
1fd3454a 327 (apply 'vc-svn-command nil 0 file
1fd3454a 328 "update"
5cc7cb96
SM
329 (cond
330 ((null rev) "-rBASE")
331 ((or (eq rev t) (equal rev "")) nil)
332 (t (concat "-r" rev)))
1fd3454a
SM
333 switches)))
334
3bdc13e4
SM
335(defun vc-svn-delete-file (file)
336 (vc-svn-command nil 0 file "remove"))
337
2766aaaf
SM
338(defun vc-svn-rename-file (old new)
339 (vc-svn-command nil 0 new "move" (file-relative-name old)))
340
1fd3454a
SM
341(defun vc-svn-revert (file &optional contents-done)
342 "Revert FILE to the version it was based on."
343 (unless contents-done
fc2fb30c 344 (vc-svn-command nil 0 file "revert")))
1fd3454a
SM
345
346(defun vc-svn-merge (file first-version &optional second-version)
347 "Merge changes into current working copy of FILE.
348The changes are between FIRST-VERSION and SECOND-VERSION."
349 (vc-svn-command nil 0 file
c217cb04 350 "merge"
02610d0e 351 "-r" (if second-version
c217cb04
SM
352 (concat first-version ":" second-version)
353 first-version))
1fd3454a
SM
354 (vc-file-setprop file 'vc-state 'edited)
355 (with-current-buffer (get-buffer "*vc*")
356 (goto-char (point-min))
c217cb04
SM
357 (if (looking-at "C ")
358 1 ; signal conflict
1fd3454a
SM
359 0))) ; signal success
360
361(defun vc-svn-merge-news (file)
362 "Merge in any new changes made to FILE."
363 (message "Merging changes into %s..." file)
ac3f4c6f 364 ;; (vc-file-setprop file 'vc-working-revision nil)
1fd3454a
SM
365 (vc-file-setprop file 'vc-checkout-time 0)
366 (vc-svn-command nil 0 file "update")
367 ;; Analyze the merge result reported by SVN, and set
368 ;; file properties accordingly.
369 (with-current-buffer (get-buffer "*vc*")
370 (goto-char (point-min))
5b5afd50 371 ;; get new working revision
1fd3454a 372 (if (re-search-forward
1468d754 373 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
ac3f4c6f
ER
374 (vc-file-setprop file 'vc-working-revision (match-string 2))
375 (vc-file-setprop file 'vc-working-revision nil))
1fd3454a 376 ;; get file status
1468d754 377 (goto-char (point-min))
1fd3454a 378 (prog1
1468d754 379 (if (looking-at "At revision")
1fd3454a
SM
380 0 ;; there were no news; indicate success
381 (if (re-search-forward
459b1fe4
SM
382 ;; Newer SVN clients have 3 columns of chars (one for the
383 ;; file's contents, then second for its properties, and the
384 ;; third for lock-grabbing info), before the 2 spaces.
385 ;; We also used to match the filename in column 0 without any
386 ;; meta-info before it, but I believe this can never happen.
387 (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)"
1468d754 388 (regexp-quote (file-name-nondirectory file)))
1fd3454a
SM
389 nil t)
390 (cond
391 ;; Merge successful, we are in sync with repository now
459b1fe4 392 ((string= (match-string 2) "U")
1fd3454a
SM
393 (vc-file-setprop file 'vc-state 'up-to-date)
394 (vc-file-setprop file 'vc-checkout-time
395 (nth 5 (file-attributes file)))
396 0);; indicate success to the caller
397 ;; Merge successful, but our own changes are still in the file
459b1fe4 398 ((string= (match-string 2) "G")
1fd3454a
SM
399 (vc-file-setprop file 'vc-state 'edited)
400 0);; indicate success to the caller
401 ;; Conflicts detected!
402 (t
403 (vc-file-setprop file 'vc-state 'edited)
404 1);; signal the error to the caller
405 )
406 (pop-to-buffer "*vc*")
407 (error "Couldn't analyze svn update result")))
408 (message "Merging changes into %s...done" file))))
409
42a0a135
ER
410(defun vc-svn-modify-change-comment (files rev comment)
411 "Modify the change comments for a specified REV.
412You must have ssh access to the repository host, and the directory Emacs
e09deae9 413uses locally for temp files must also be writable by you on that host.
fd064451
DN
414This is only supported if the repository access method is either file://
415or svn+ssh://."
416 (let (tempfile host remotefile directory fileurl-p)
42a0a135 417 (with-temp-buffer
f9d5dc48 418 (vc-do-command (current-buffer) 0 vc-svn-program nil "info")
fd064451
DN
419 (goto-char (point-min))
420 (unless (re-search-forward "Repository Root: \\(file://\\(/.*\\)\\)\\|\\(svn\\+ssh://\\([^/]+\\)\\(/.*\\)\\)" nil t)
421 (error "Repository information is unavailable"))
422 (if (match-string 1)
423 (progn
424 (setq fileurl-p t)
425 (setq directory (match-string 2)))
426 (setq host (match-string 4))
427 (setq directory (match-string 5))
428 (setq remotefile (concat host ":" tempfile))))
429 (with-temp-file (setq tempfile (make-temp-file user-mail-address))
430 (insert comment))
431 (if fileurl-p
432 ;; Repository Root is a local file.
433 (progn
434 (unless (vc-do-command
2888a97e 435 "*vc*" 0 "svnadmin" nil
def61be2 436 "setlog" "--bypass-hooks" directory
fd064451
DN
437 "-r" rev (format "%s" tempfile))
438 (error "Log edit failed"))
439 (delete-file tempfile))
440
441 ;; Remote repository, using svn+ssh.
2888a97e 442 (unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile)
fd064451
DN
443 (error "Copy of comment to %s failed" remotefile))
444 (unless (vc-do-command
2888a97e 445 "*vc*" 0 "ssh" nil "-q" host
fd064451
DN
446 (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
447 directory rev tempfile tempfile))
448 (error "Log edit failed")))))
1fd3454a
SM
449
450;;;
451;;; History functions
452;;;
453
def61be2
JB
454(defvar log-view-per-file-logs)
455
6653c6b7
DN
456(define-derived-mode vc-svn-log-view-mode log-view-mode "SVN-Log-View"
457 (require 'add-log)
458 (set (make-local-variable 'log-view-per-file-logs) nil))
459
8cdd17b4
ER
460(defun vc-svn-print-log (files &optional buffer)
461 "Get change log(s) associated with FILES."
1fd3454a 462 (save-current-buffer
b349012b 463 (vc-setup-buffer buffer)
1fd3454a
SM
464 (let ((inhibit-read-only t))
465 (goto-char (point-min))
13b56025
ER
466 (if files
467 (dolist (file files)
468 (insert "Working file: " file "\n")
469 (vc-svn-command
470 buffer
471 'async
472 ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0)
473 (list file)
474 "log"
475 ;; By default Subversion only shows the log up to the
476 ;; working revision, whereas we also want the log of the
477 ;; subsequent commits. At least that's what the
478 ;; vc-cvs.el code does.
479 "-rHEAD:0"))
480 ;; Dump log for the entire directory.
481 (vc-svn-command buffer 0 nil "log" "-rHEAD:0")))))
8cdd17b4 482
8cdd17b4 483(defun vc-svn-diff (files &optional oldvers newvers buffer)
5b5afd50 484 "Get a difference report using SVN between two revisions of fileset FILES."
c62a495a 485 (and oldvers
09c6e72e 486 files
c62a495a
GM
487 (catch 'no
488 (dolist (f files)
ac3f4c6f 489 (or (equal oldvers (vc-working-revision f))
c62a495a
GM
490 (throw 'no nil)))
491 t)
492 ;; Use nil rather than the current revision because svn handles
493 ;; it better (i.e. locally). Note that if _any_ of the files
494 ;; has a different revision, we fetch the lot, which is
495 ;; obviously sub-optimal.
496 (setq oldvers nil))
8cdd17b4 497 (let* ((switches
f9d1f3be
SM
498 (if vc-svn-diff-switches
499 (vc-switches 'SVN 'diff)
9751169a
GM
500 (list "--diff-cmd=diff" "-x"
501 (mapconcat 'identity (vc-switches nil 'diff) " "))))
2d4e93b9 502 (async (and (not vc-disable-async-diff)
8cdd17b4 503 (vc-stay-local-p files)
fe1919ab 504 (or oldvers newvers)))) ; Svn diffs those locally.
b349012b 505 (apply 'vc-svn-command buffer
2766aaaf 506 (if async 'async 0)
8cdd17b4 507 files "diff"
2766aaaf 508 (append
f9d1f3be 509 switches
2766aaaf
SM
510 (when oldvers
511 (list "-r" (if newvers (concat oldvers ":" newvers)
512 oldvers)))))
fd140743
SM
513 (if async 1 ; async diff => pessimistic assumption
514 ;; For some reason `svn diff' does not return a useful
515 ;; status w.r.t whether the diff was empty or not.
8cdd17b4 516 (buffer-size (get-buffer buffer)))))
1fd3454a 517
1fd3454a 518;;;
370fded4 519;;; Tag system
1fd3454a
SM
520;;;
521
370fded4 522(defun vc-svn-create-tag (dir name branchp)
5b5afd50 523 "Assign to DIR's current revision a given NAME.
1fd3454a 524If BRANCHP is non-nil, the name is created as a branch (and the current
5cc7cb96
SM
525workspace is immediately moved to that new branch).
526NAME is assumed to be a URL."
527 (vc-svn-command nil 0 dir "copy" name)
370fded4 528 (when branchp (vc-svn-retrieve-tag dir name nil)))
1fd3454a 529
370fded4
ER
530(defun vc-svn-retrieve-tag (dir name update)
531 "Retrieve a tag at and below DIR.
532NAME is the name of the tag; if it is empty, do a `svn update'.
5cc7cb96
SM
533If UPDATE is non-nil, then update (resynch) any affected buffers.
534NAME is assumed to be a URL."
535 (vc-svn-command nil 0 dir "switch" name)
536 ;; FIXME: parse the output and obey `update'.
537 )
1fd3454a
SM
538
539;;;
540;;; Miscellaneous
541;;;
542
543;; Subversion makes backups for us, so don't bother.
7ffc77d3 544;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
1fd3454a
SM
545;; "Return non-nil if version backups should be made for FILE.")
546
547(defun vc-svn-check-headers ()
548 "Check if the current file has any headers in it."
549 (save-excursion
550 (goto-char (point-min))
551 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
552\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
553
554
555;;;
556;;; Internal functions
557;;;
558
8cdd17b4 559(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
1fd3454a
SM
560 "A wrapper around `vc-do-command' for use in vc-svn.el.
561The difference to vc-do-command is that this function always invokes `svn',
562and that it passes `vc-svn-global-switches' to it before FLAGS."
2888a97e 563 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
1fd3454a
SM
564 (if (stringp vc-svn-global-switches)
565 (cons vc-svn-global-switches flags)
566 (append vc-svn-global-switches
567 flags))))
568
7ffc77d3
SM
569(defun vc-svn-repository-hostname (dirname)
570 (with-temp-buffer
571 (let ((coding-system-for-read
572 (or file-name-coding-system
573 default-file-name-coding-system)))
ace2fad9
CY
574 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
575 "/entries")
576 dirname)))
7ffc77d3
SM
577 (goto-char (point-min))
578 (when (re-search-forward
c45b3be3 579 ;; Old `svn' used name="svn:this_dir", newer use just name="".
17a5a301
SM
580 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
581 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
0b0dad41
SM
582 "url=\"\\(?1:[^\"]+\\)\""
583 ;; Yet newer ones don't use XML any more.
584 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
17a5a301
SM
585 ;; This is not a hostname but a URL. This may actually be considered
586 ;; as a feature since it allows vc-svn-stay-local to specify different
587 ;; behavior for different modules on the same server.
588 (match-string 1))))
1fd3454a 589
1c67a814
SM
590(defun vc-svn-resolve-when-done ()
591 "Call \"svn resolved\" if the conflict markers have been removed."
592 (save-excursion
593 (goto-char (point-min))
54648b5c
DN
594 (unless (re-search-forward "^<<<<<<< " nil t)
595 (vc-svn-command nil 0 buffer-file-name "resolved")
596 ;; Remove the hook so that it is not called multiple times.
597 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
1c67a814
SM
598
599;; Inspired by vc-arch-find-file-hook.
600(defun vc-svn-find-file-hook ()
601 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
602 ;; If the file is marked as "conflicted", then we should try and call
603 ;; "svn resolved" when applicable.
604 (if (save-excursion
605 (goto-char (point-min))
606 (re-search-forward "^<<<<<<< " nil t))
607 ;; There are conflict markers.
608 (progn
28e4e2b4 609 (smerge-start-session)
1c67a814
SM
610 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
611 ;; There are no conflict markers. This is problematic: maybe it means
612 ;; the conflict has been resolved and we should immediately call "svn
613 ;; resolved", or it means that the file's type does not allow Svn to
614 ;; use conflict markers in which case we don't really know what to do.
615 ;; So let's just punt for now.
616 nil)
617 (message "There are unresolved conflicts in this file")))
618
bc8c1bb4 619(defun vc-svn-parse-status (&optional filename)
1fd3454a 620 "Parse output of \"svn status\" command in the current buffer.
bc8c1bb4
SM
621Set file properties accordingly. Unless FILENAME is non-nil, parse only
622information about FILENAME and return its status."
1fd3454a
SM
623 (let (file status)
624 (goto-char (point-min))
625 (while (re-search-forward
484c1b1f 626 ;; Ignore the files with status X.
245cacf1 627 "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
c45b3be3
SM
628 ;; If the username contains spaces, the output format is ambiguous,
629 ;; so don't trust the output's filename unless we have to.
630 (setq file (or filename
631 (expand-file-name
632 (buffer-substring (point) (line-end-position)))))
1fd3454a 633 (setq status (char-after (line-beginning-position)))
484c1b1f 634 (if (eq status ??)
4f07b9f2 635 (vc-file-setprop file 'vc-state 'unregistered)
fd140743
SM
636 ;; Use the last-modified revision, so that searching in vc-print-log
637 ;; output works.
4f07b9f2 638 (vc-file-setprop file 'vc-working-revision (match-string 3))
1c67a814 639 ;; Remember Svn's own status.
4f07b9f2
ER
640 (vc-file-setprop file 'vc-svn-status status)
641 (vc-file-setprop
1fd3454a
SM
642 file 'vc-state
643 (cond
644 ((eq status ?\ )
645 (if (eq (char-after (match-beginning 1)) ?*)
3702367b 646 'needs-update
4f07b9f2 647 (vc-file-setprop file 'vc-checkout-time
1fd3454a
SM
648 (nth 5 (file-attributes file)))
649 'up-to-date))
650 ((eq status ?A)
fd140743 651 ;; If the file was actually copied, (match-string 2) is "-".
4f07b9f2
ER
652 (vc-file-setprop file 'vc-working-revision "0")
653 (vc-file-setprop file 'vc-checkout-time 0)
484c1b1f 654 'added)
7fbb4797
DN
655 ((eq status ?C)
656 (vc-file-setprop file 'vc-state 'conflict))
657 ((eq status '?M)
1fd3454a
SM
658 (if (eq (char-after (match-beginning 1)) ?*)
659 'needs-merge
660 'edited))
722f037f 661 ((eq status ?I)
4f07b9f2 662 (vc-file-setprop file 'vc-state 'ignored))
484c1b1f 663 ((eq status ?R)
4f07b9f2 664 (vc-file-setprop file 'vc-state 'removed))
bc8c1bb4 665 (t 'edited)))))
245cacf1 666 (when filename (vc-file-getprop filename 'vc-state))))
1fd3454a 667
1fd3454a
SM
668(defun vc-svn-valid-symbolic-tag-name-p (tag)
669 "Return non-nil if TAG is a valid symbolic tag name."
670 ;; According to the SVN manual, a valid symbolic tag must start with
671 ;; an uppercase or lowercase letter and can contain uppercase and
672 ;; lowercase letters, digits, `-', and `_'.
673 (and (string-match "^[a-zA-Z]" tag)
674 (not (string-match "[^a-z0-9A-Z-_]" tag))))
675
5b5afd50
ER
676(defun vc-svn-valid-revision-number-p (tag)
677 "Return non-nil if TAG is a valid revision number."
1fd3454a
SM
678 (and (string-match "^[0-9]" tag)
679 (not (string-match "[^0-9]" tag))))
680
17a5a301
SM
681;; Support for `svn annotate'
682
683(defun vc-svn-annotate-command (file buf &optional rev)
684 (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev))))
685
686(defun vc-svn-annotate-time-of-rev (rev)
687 ;; Arbitrarily assume 10 commmits per day.
688 (/ (string-to-number rev) 10.0))
689
e53ac718
DN
690(defvar vc-annotate-parent-rev)
691
17a5a301
SM
692(defun vc-svn-annotate-current-time ()
693 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))
694
695(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")
696
697(defun vc-svn-annotate-time ()
698 (when (looking-at vc-svn-annotate-re)
699 (goto-char (match-end 0))
700 (vc-svn-annotate-time-of-rev (match-string 1))))
701
702(defun vc-svn-annotate-extract-revision-at-line ()
703 (save-excursion
704 (beginning-of-line)
705 (if (looking-at vc-svn-annotate-re) (match-string 1))))
706
1fd3454a
SM
707(provide 'vc-svn)
708
f9d1f3be 709;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
1fd3454a 710;;; vc-svn.el ends here