(font_check_object): Delete it.
[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
6653c6b7
DN
428(define-derived-mode vc-svn-log-view-mode log-view-mode "SVN-Log-View"
429 (require 'add-log)
430 (set (make-local-variable 'log-view-per-file-logs) nil))
431
8cdd17b4
ER
432(defun vc-svn-print-log (files &optional buffer)
433 "Get change log(s) associated with FILES."
1fd3454a 434 (save-current-buffer
b349012b 435 (vc-setup-buffer buffer)
1fd3454a
SM
436 (let ((inhibit-read-only t))
437 (goto-char (point-min))
13b56025
ER
438 (if files
439 (dolist (file files)
440 (insert "Working file: " file "\n")
441 (vc-svn-command
442 buffer
443 'async
444 ;; (if (and (= (length files) 1) (vc-stay-local-p file)) 'async 0)
445 (list file)
446 "log"
447 ;; By default Subversion only shows the log up to the
448 ;; working revision, whereas we also want the log of the
449 ;; subsequent commits. At least that's what the
450 ;; vc-cvs.el code does.
451 "-rHEAD:0"))
452 ;; Dump log for the entire directory.
453 (vc-svn-command buffer 0 nil "log" "-rHEAD:0")))))
8cdd17b4 454
8cdd17b4 455(defun vc-svn-diff (files &optional oldvers newvers buffer)
5b5afd50 456 "Get a difference report using SVN between two revisions of fileset FILES."
c62a495a
GM
457 (and oldvers
458 (catch 'no
459 (dolist (f files)
ac3f4c6f 460 (or (equal oldvers (vc-working-revision f))
c62a495a
GM
461 (throw 'no nil)))
462 t)
463 ;; Use nil rather than the current revision because svn handles
464 ;; it better (i.e. locally). Note that if _any_ of the files
465 ;; has a different revision, we fetch the lot, which is
466 ;; obviously sub-optimal.
467 (setq oldvers nil))
8cdd17b4 468 (let* ((switches
f9d1f3be
SM
469 (if vc-svn-diff-switches
470 (vc-switches 'SVN 'diff)
471 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
2d4e93b9 472 (async (and (not vc-disable-async-diff)
8cdd17b4 473 (vc-stay-local-p files)
fe1919ab 474 (or oldvers newvers)))) ; Svn diffs those locally.
b349012b 475 (apply 'vc-svn-command buffer
2766aaaf 476 (if async 'async 0)
8cdd17b4 477 files "diff"
2766aaaf 478 (append
f9d1f3be 479 switches
2766aaaf
SM
480 (when oldvers
481 (list "-r" (if newvers (concat oldvers ":" newvers)
482 oldvers)))))
fd140743
SM
483 (if async 1 ; async diff => pessimistic assumption
484 ;; For some reason `svn diff' does not return a useful
485 ;; status w.r.t whether the diff was empty or not.
8cdd17b4 486 (buffer-size (get-buffer buffer)))))
1fd3454a 487
1fd3454a 488;;;
370fded4 489;;; Tag system
1fd3454a
SM
490;;;
491
370fded4 492(defun vc-svn-create-tag (dir name branchp)
5b5afd50 493 "Assign to DIR's current revision a given NAME.
1fd3454a 494If BRANCHP is non-nil, the name is created as a branch (and the current
5cc7cb96
SM
495workspace is immediately moved to that new branch).
496NAME is assumed to be a URL."
497 (vc-svn-command nil 0 dir "copy" name)
370fded4 498 (when branchp (vc-svn-retrieve-tag dir name nil)))
1fd3454a 499
370fded4
ER
500(defun vc-svn-retrieve-tag (dir name update)
501 "Retrieve a tag at and below DIR.
502NAME is the name of the tag; if it is empty, do a `svn update'.
5cc7cb96
SM
503If UPDATE is non-nil, then update (resynch) any affected buffers.
504NAME is assumed to be a URL."
505 (vc-svn-command nil 0 dir "switch" name)
506 ;; FIXME: parse the output and obey `update'.
507 )
1fd3454a
SM
508
509;;;
510;;; Miscellaneous
511;;;
512
513;; Subversion makes backups for us, so don't bother.
7ffc77d3 514;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
1fd3454a
SM
515;; "Return non-nil if version backups should be made for FILE.")
516
517(defun vc-svn-check-headers ()
518 "Check if the current file has any headers in it."
519 (save-excursion
520 (goto-char (point-min))
521 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
522\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
523
524
525;;;
526;;; Internal functions
527;;;
528
e4cc3f57 529(defcustom vc-svn-program "svn"
4ced8551 530 "Name of the SVN executable."
e4cc3f57
SM
531 :type 'string
532 :group 'vc)
533
b038f9fb
TTN
534(defun vc-svn-root (dir)
535 (vc-find-root dir vc-svn-admin-directory t))
536
8cdd17b4 537(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
1fd3454a
SM
538 "A wrapper around `vc-do-command' for use in vc-svn.el.
539The difference to vc-do-command is that this function always invokes `svn',
540and that it passes `vc-svn-global-switches' to it before FLAGS."
2888a97e 541 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
1fd3454a
SM
542 (if (stringp vc-svn-global-switches)
543 (cons vc-svn-global-switches flags)
544 (append vc-svn-global-switches
545 flags))))
546
7ffc77d3
SM
547(defun vc-svn-repository-hostname (dirname)
548 (with-temp-buffer
549 (let ((coding-system-for-read
550 (or file-name-coding-system
551 default-file-name-coding-system)))
ace2fad9
CY
552 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
553 "/entries")
554 dirname)))
7ffc77d3
SM
555 (goto-char (point-min))
556 (when (re-search-forward
c45b3be3 557 ;; Old `svn' used name="svn:this_dir", newer use just name="".
17a5a301
SM
558 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
559 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
0b0dad41
SM
560 "url=\"\\(?1:[^\"]+\\)\""
561 ;; Yet newer ones don't use XML any more.
562 "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
17a5a301
SM
563 ;; This is not a hostname but a URL. This may actually be considered
564 ;; as a feature since it allows vc-svn-stay-local to specify different
565 ;; behavior for different modules on the same server.
566 (match-string 1))))
1fd3454a 567
1c67a814
SM
568(defun vc-svn-resolve-when-done ()
569 "Call \"svn resolved\" if the conflict markers have been removed."
570 (save-excursion
571 (goto-char (point-min))
54648b5c
DN
572 (unless (re-search-forward "^<<<<<<< " nil t)
573 (vc-svn-command nil 0 buffer-file-name "resolved")
574 ;; Remove the hook so that it is not called multiple times.
575 (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
1c67a814
SM
576
577;; Inspired by vc-arch-find-file-hook.
578(defun vc-svn-find-file-hook ()
579 (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
580 ;; If the file is marked as "conflicted", then we should try and call
581 ;; "svn resolved" when applicable.
582 (if (save-excursion
583 (goto-char (point-min))
584 (re-search-forward "^<<<<<<< " nil t))
585 ;; There are conflict markers.
586 (progn
28e4e2b4 587 (smerge-start-session)
1c67a814
SM
588 (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
589 ;; There are no conflict markers. This is problematic: maybe it means
590 ;; the conflict has been resolved and we should immediately call "svn
591 ;; resolved", or it means that the file's type does not allow Svn to
592 ;; use conflict markers in which case we don't really know what to do.
593 ;; So let's just punt for now.
594 nil)
595 (message "There are unresolved conflicts in this file")))
596
bc8c1bb4 597(defun vc-svn-parse-status (&optional filename)
1fd3454a 598 "Parse output of \"svn status\" command in the current buffer.
bc8c1bb4
SM
599Set file properties accordingly. Unless FILENAME is non-nil, parse only
600information about FILENAME and return its status."
1fd3454a
SM
601 (let (file status)
602 (goto-char (point-min))
603 (while (re-search-forward
484c1b1f 604 ;; Ignore the files with status X.
abc61762 605 "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
c45b3be3
SM
606 ;; If the username contains spaces, the output format is ambiguous,
607 ;; so don't trust the output's filename unless we have to.
608 (setq file (or filename
609 (expand-file-name
610 (buffer-substring (point) (line-end-position)))))
1fd3454a 611 (setq status (char-after (line-beginning-position)))
484c1b1f 612 (if (eq status ??)
4f07b9f2 613 (vc-file-setprop file 'vc-state 'unregistered)
bc8c1bb4
SM
614 ;; `vc-BACKEND-registered' must not set vc-backend,
615 ;; which is instead set in vc-registered.
4f07b9f2 616 (unless filename (vc-file-setprop file 'vc-backend 'SVN))
fd140743
SM
617 ;; Use the last-modified revision, so that searching in vc-print-log
618 ;; output works.
4f07b9f2 619 (vc-file-setprop file 'vc-working-revision (match-string 3))
1c67a814 620 ;; Remember Svn's own status.
4f07b9f2
ER
621 (vc-file-setprop file 'vc-svn-status status)
622 (vc-file-setprop
1fd3454a
SM
623 file 'vc-state
624 (cond
625 ((eq status ?\ )
626 (if (eq (char-after (match-beginning 1)) ?*)
3702367b 627 'needs-update
4f07b9f2 628 (vc-file-setprop file 'vc-checkout-time
1fd3454a
SM
629 (nth 5 (file-attributes file)))
630 'up-to-date))
631 ((eq status ?A)
fd140743 632 ;; If the file was actually copied, (match-string 2) is "-".
4f07b9f2
ER
633 (vc-file-setprop file 'vc-working-revision "0")
634 (vc-file-setprop file 'vc-checkout-time 0)
484c1b1f 635 'added)
7fbb4797
DN
636 ((eq status ?C)
637 (vc-file-setprop file 'vc-state 'conflict))
638 ((eq status '?M)
1fd3454a
SM
639 (if (eq (char-after (match-beginning 1)) ?*)
640 'needs-merge
641 'edited))
722f037f 642 ((eq status ?I)
4f07b9f2 643 (vc-file-setprop file 'vc-state 'ignored))
484c1b1f 644 ((eq status ?R)
4f07b9f2 645 (vc-file-setprop file 'vc-state 'removed))
bc8c1bb4
SM
646 (t 'edited)))))
647 (if filename (vc-file-getprop filename 'vc-state))))
1fd3454a 648
1fd3454a
SM
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