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