vc-svn.el 27.5 KB
Newer Older
Stefan Monnier's avatar
Stefan Monnier committed
1 2
;;; vc-svn.el --- non-resident support for Subversion version-control

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4
;;   Free Software Foundation, Inc.
Stefan Monnier's avatar
Stefan Monnier committed
5 6 7 8 9 10

;; Author:      FSF (see vc.el for full credits)
;; Maintainer:  Stefan Monnier <monnier@gnu.org>

;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Stefan Monnier's avatar
Stefan Monnier committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Stefan Monnier's avatar
Stefan Monnier committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Stefan Monnier's avatar
Stefan Monnier committed
23 24 25

;;; Commentary:

Eric S. Raymond's avatar
Eric S. Raymond committed
26 27
;; Sync'd with Subversion's vc-svn.el as of revision 5801. but this version
;; has been extensively modified since to handle filesets.
Stefan Monnier's avatar
Stefan Monnier committed
28 29 30 31 32 33

;;; Code:

(eval-when-compile
  (require 'vc))

34 35 36 37
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(put 'SVN 'vc-functions nil)

Stefan Monnier's avatar
Stefan Monnier committed
38 39 40 41
;;;
;;; Customization options
;;;

42 43 44 45 46 47
;; FIXME there is also svnadmin.
(defcustom vc-svn-program "svn"
  "Name of the SVN executable."
  :type 'string
  :group 'vc)

Stefan Monnier's avatar
Stefan Monnier committed
48
(defcustom vc-svn-global-switches nil
49
  "Global switches to pass to any SVN command."
Stefan Monnier's avatar
Stefan Monnier committed
50 51 52 53 54
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
55
  :version "22.1"
Stefan Monnier's avatar
Stefan Monnier committed
56 57 58
  :group 'vc)

(defcustom vc-svn-register-switches nil
59
  "Switches for registering a file into SVN.
Stefan Monnier's avatar
Stefan Monnier committed
60
A string or list of strings passed to the checkin program by
61 62 63 64
\\[vc-register].  If nil, use the value of `vc-register-switches'.
If t, use no switches."
  :type '(choice (const :tag "Unspecified" nil)
		 (const :tag "None" t)
Stefan Monnier's avatar
Stefan Monnier committed
65
		 (string :tag "Argument String")
66
		 (repeat :tag "Argument List" :value ("") string))
67
  :version "22.1"
Stefan Monnier's avatar
Stefan Monnier committed
68 69
  :group 'vc)

70 71 72
(defcustom vc-svn-diff-switches
  t			   ;`svn' doesn't support common args like -c or -b.
  "String or list of strings specifying extra switches for svn diff under VC.
73 74 75 76
If nil, use the value of `vc-diff-switches' (or `diff-switches'),
together with \"-x --diff-cmd=diff\" (since svn diff does not
support the default \"-c\" value of `diff-switches').  If you
want to force an empty list of arguments, use t."
77 78
  :type '(choice (const :tag "Unspecified" nil)
		 (const :tag "None" t)
Stefan Monnier's avatar
Stefan Monnier committed
79 80 81 82
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
83
  :version "22.1"
Stefan Monnier's avatar
Stefan Monnier committed
84 85 86
  :group 'vc)

(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"
Stefan Monnier's avatar
Stefan Monnier committed
89 90 91
  :type '(repeat string)
  :group 'vc)

92 93 94 95 96 97
;; We want to autoload it for use by the autoloaded version of
;; vc-svn-registered, but we want the value to be compiled at startup, not
;; at dump time.
;; ;;;###autoload
(defconst vc-svn-admin-directory
  (cond ((and (memq system-type '(cygwin windows-nt ms-dos))
Chong Yidong's avatar
Chong Yidong committed
98 99 100 101 102
	      (getenv "SVN_ASP_DOT_NET_HACK"))
	 "_svn")
	(t ".svn"))
  "The name of the \".svn\" subdirectory or its equivalent.")

103 104
;;; Properties of the backend

105 106 107
(defun vc-svn-revision-granularity () 'repository)
(defun vc-svn-checkout-model (files) 'implicit)

Stefan Monnier's avatar
Stefan Monnier committed
108 109 110 111
;;;
;;; State-querying functions
;;;

Chong Yidong's avatar
Chong Yidong committed
112 113 114
;;; vc-svn-admin-directory is generally not defined when the
;;; autoloaded function is called.

Stefan Monnier's avatar
Stefan Monnier committed
115
;;;###autoload (defun vc-svn-registered (f)
Chong Yidong's avatar
Chong Yidong committed
116
;;;###autoload   (let ((admin-dir (cond ((and (eq system-type 'windows-nt)
117 118 119
;;;###autoload                                (getenv "SVN_ASP_DOT_NET_HACK"))
;;;###autoload                           "_svn")
;;;###autoload                          (t ".svn"))))
Chong Yidong's avatar
Chong Yidong committed
120
;;;###autoload     (when (file-readable-p (expand-file-name
121 122
;;;###autoload                             (concat admin-dir "/entries")
;;;###autoload                             (file-name-directory f)))
Stefan Monnier's avatar
Stefan Monnier committed
123
;;;###autoload       (load "vc-svn")
Chong Yidong's avatar
Chong Yidong committed
124
;;;###autoload       (vc-svn-registered f))))
Stefan Monnier's avatar
Stefan Monnier committed
125 126 127

(defun vc-svn-registered (file)
  "Check if FILE is SVN registered."
Chong Yidong's avatar
Chong Yidong committed
128 129
  (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory
						   "/entries")
Stefan Monnier's avatar
Stefan Monnier committed
130 131 132
					   (file-name-directory file)))
    (with-temp-buffer
      (cd (file-name-directory file))
133 134
      (let* (process-file-side-effects
	     (status
135 136 137 138 139 140 141 142 143 144
             (condition-case nil
                 ;; Ignore all errors.
                 (vc-svn-command t t file "status" "-v")
               ;; Some problem happened.  E.g. We can't find an `svn'
               ;; executable.  We used to only catch `file-error' but when
               ;; the process is run on a remote host via Tramp, the error
               ;; is only reported via the exit status which is turned into
               ;; an `error' by vc-do-command.
               (error nil))))
        (when (eq 0 status)
145 146
	  (let ((parsed (vc-svn-parse-status file)))
	    (and parsed (not (memq parsed '(ignored unregistered))))))))))
Stefan Monnier's avatar
Stefan Monnier committed
147 148 149

(defun vc-svn-state (file &optional localp)
  "SVN-specific version of `vc-state'."
150 151 152 153 154 155
  (let (process-file-side-effects)
    (setq localp (or localp (vc-stay-local-p file 'SVN)))
    (with-temp-buffer
      (cd (file-name-directory file))
      (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
      (vc-svn-parse-status file))))
Stefan Monnier's avatar
Stefan Monnier committed
156 157 158 159 160

(defun vc-svn-state-heuristic (file)
  "SVN-specific state heuristic."
  (vc-svn-state file 'local))

161 162 163
;; FIXME it would be better not to have the "remote" argument,
;; but to distinguish the two output formats based on content.
(defun vc-svn-after-dir-status (callback &optional remote)
164
  (let ((state-map '((?A . added)
165 166 167
                     (?C . conflict)
                     (?I . ignored)
                     (?M . edited)
168
                     (?D . removed)
169 170 171 172
                     (?R . removed)
                     (?? . unregistered)
                     ;; This is what vc-svn-parse-status does.
                     (?~ . edited)))
173
	(re (if remote "^\\(.\\)...... \\([ *]\\) +\\(?:[-0-9]+\\)?   \\(.*\\)$"
174 175
	      ;; Subexp 2 is a dummy in this case, so the numbers match.
	      "^\\(.\\)....\\(.\\) \\(.*\\)$"))
176 177
       result)
    (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 181 182 183 184
	    (filename (match-string 3)))
	(and remote (string-equal (match-string 2) "*")
	     ;; FIXME are there other possible combinations?
	     (cond ((eq state 'edited) (setq state 'needs-merge))
		   ((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 191 192
  "Run 'svn status' for DIR and update BUFFER via CALLBACK.
CALLBACK is called as (CALLBACK RESULT BUFFER), where
RESULT is a list of conses (FILE . STATE) for directory DIR."
193
  ;; FIXME should this rather be all the files in dir?
194 195 196 197
  ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up
  ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR
  ;; which is VERY SLOW for big trees and it makes emacs
  ;; 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 201
    (vc-svn-command (current-buffer) 'async nil "status"
		    (if remote "-u"))
202
  (vc-exec-after
203
     `(vc-svn-after-dir-status (quote ,callback) ,remote))))
204

205 206 207 208 209
(defun vc-svn-dir-status-files (dir files default-state callback)
  (apply 'vc-svn-command (current-buffer) 'async nil "status" files)
  (vc-exec-after
   `(vc-svn-after-dir-status (quote ,callback))))

210
(defun vc-svn-dir-extra-headers (dir)
211
  "Generate extra status headers for a Subversion working copy."
212 213
  (let (process-file-side-effects)
    (vc-svn-command "*vc*" 0 nil "info"))
214
  (let ((repo
215
	 (save-excursion
216 217 218 219 220 221 222 223 224 225 226 227
	   (and (progn
		  (set-buffer "*vc*")
		  (goto-char (point-min))
		  (re-search-forward "Repository Root: *\\(.*\\)" nil t))
		(match-string 1)))))
    (concat
     (cond (repo
	    (concat
	     (propertize "Repository : " 'face 'font-lock-type-face)
	     (propertize repo 'face 'font-lock-variable-name-face)))
	   (t "")))))

Eric S. Raymond's avatar
Eric S. Raymond committed
228 229
(defun vc-svn-working-revision (file)
  "SVN-specific version of `vc-working-revision'."
Stefan Monnier's avatar
Stefan Monnier committed
230 231 232 233
  ;; There is no need to consult RCS headers under SVN, because we
  ;; get the workfile version for free when we recognize that a file
  ;; is registered in SVN.
  (vc-svn-registered file)
Eric S. Raymond's avatar
Eric S. Raymond committed
234
  (vc-file-getprop file 'vc-working-revision))
Stefan Monnier's avatar
Stefan Monnier committed
235

236 237 238
;; vc-svn-mode-line-string doesn't exist because the default implementation
;; works just fine.

239
(defun vc-svn-previous-revision (file rev)
240 241 242 243
  (let ((newrev (1- (string-to-number rev))))
    (when (< 0 newrev)
      (number-to-string newrev))))

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 248 249 250 251
    ;; we use it as the upper bound until a better idea comes along.  If the
    ;; workfile version W coincides with the tree's latest revision R, then
    ;; this check prevents a "no such revision: R+1" error.  Otherwise, it
    ;; inhibits showing of W+1 through R, which could be considered anywhere
    ;; from gracious to impolite.
Eric S. Raymond's avatar
Eric S. Raymond committed
252
    (unless (< (string-to-number (vc-file-getprop file 'vc-working-revision))
253 254 255
               newrev)
      (number-to-string newrev))))

Stefan Monnier's avatar
Stefan Monnier committed
256 257 258 259 260

;;;
;;; State-changing functions
;;;

261 262
(defun vc-svn-create-repo ()
  "Create a new SVN repository."
263
  (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
264
  (vc-do-command "*vc*" 0 vc-svn-program '(".")
265 266 267 268 269
		 "checkout" (concat "file://" default-directory "SVN")))

(defun vc-svn-register (files &optional rev comment)
  "Register FILES into the SVN version-control system.
The COMMENT argument is ignored  This does an add but not a commit.
270 271
Passes either `vc-svn-register-switches' or `vc-register-switches'
to the SVN command."
272
  (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
Stefan Monnier's avatar
Stefan Monnier committed
273 274 275

(defun vc-svn-responsible-p (file)
  "Return non-nil if SVN thinks it is responsible for FILE."
Chong Yidong's avatar
Chong Yidong committed
276
  (file-directory-p (expand-file-name vc-svn-admin-directory
Stefan Monnier's avatar
Stefan Monnier committed
277 278 279 280 281 282 283 284
				      (if (file-directory-p file)
					  file
					(file-name-directory file)))))

(defalias 'vc-svn-could-register 'vc-svn-responsible-p
  "Return non-nil if FILE could be registered in SVN.
This is only possible if SVN is responsible for FILE's directory.")

285
(defun vc-svn-checkin (files rev comment)
Stefan Monnier's avatar
Stefan Monnier committed
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)))))
Stefan Monnier's avatar
Stefan Monnier committed
291 292 293 294 295
    (set-buffer "*vc*")
    (goto-char (point-min))
    (unless (equal status 0)
      ;; Check checkin problem.
      (cond
296
       ((search-forward "Transaction is out of date" nil t)
297 298
        (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
	      files)
Stefan Monnier's avatar
Stefan Monnier committed
299 300 301 302 303 304 305 306 307 308
        (error (substitute-command-keys
                (concat "Up-to-date check failed: "
                        "type \\[vc-next-action] to merge in changes"))))
       (t
        (pop-to-buffer (current-buffer))
        (goto-char (point-min))
        (shrink-window-if-larger-than-buffer)
        (error "Check-in failed"))))
    ;; Update file properties
    ;; (vc-file-setprop
Eric S. Raymond's avatar
Eric S. Raymond committed
309
    ;;  file 'vc-working-revision
Stefan Monnier's avatar
Stefan Monnier committed
310 311 312
    ;;  (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
    ))

Eric S. Raymond's avatar
Eric S. Raymond committed
313
(defun vc-svn-find-revision (file rev buffer)
314
  "SVN-specific retrieval of a specified version into a buffer."
315 316 317 318 319 320 321
  (let (process-file-side-effects)
    (apply 'vc-svn-command
	   buffer 0 file
	   "cat"
	   (and rev (not (string= rev ""))
		(concat "-r" rev))
	   (vc-switches 'SVN 'checkout))))
Stefan Monnier's avatar
Stefan Monnier committed
322 323 324 325

(defun vc-svn-checkout (file &optional editable rev)
  (message "Checking out %s..." file)
  (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)
Stefan Monnier's avatar
Stefan Monnier committed
328 329 330 331
  (message "Checking out %s...done" file))

(defun vc-svn-update (file editable rev switches)
  (if (and (file-exists-p file) (not rev))
332 333
      ;; If no revision was specified, there's nothing to do.
      nil
Stefan Monnier's avatar
Stefan Monnier committed
334
    ;; Check out a particular version (or recreate the file).
Eric S. Raymond's avatar
Eric S. Raymond committed
335
    (vc-file-setprop file 'vc-working-revision nil)
Stefan Monnier's avatar
Stefan Monnier committed
336
    (apply 'vc-svn-command nil 0 file
337
	   "--non-interactive"		; bug#4280
Stefan Monnier's avatar
Stefan Monnier committed
338
	   "update"
339 340 341 342
	   (cond
	    ((null rev) "-rBASE")
	    ((or (eq rev t) (equal rev "")) nil)
	    (t (concat "-r" rev)))
Stefan Monnier's avatar
Stefan Monnier committed
343 344
	   switches)))

345 346 347
(defun vc-svn-delete-file (file)
  (vc-svn-command nil 0 file "remove"))

348 349 350
(defun vc-svn-rename-file (old new)
  (vc-svn-command nil 0 new "move" (file-relative-name old)))

Stefan Monnier's avatar
Stefan Monnier committed
351 352 353
(defun vc-svn-revert (file &optional contents-done)
  "Revert FILE to the version it was based on."
  (unless contents-done
354
    (vc-svn-command nil 0 file "revert")))
Stefan Monnier's avatar
Stefan Monnier committed
355 356 357 358 359

(defun vc-svn-merge (file first-version &optional second-version)
  "Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
  (vc-svn-command nil 0 file
360
                 "merge"
361
		 "-r" (if second-version
362 363
			(concat first-version ":" second-version)
		      first-version))
Stefan Monnier's avatar
Stefan Monnier committed
364 365 366
  (vc-file-setprop file 'vc-state 'edited)
  (with-current-buffer (get-buffer "*vc*")
    (goto-char (point-min))
367 368
    (if (looking-at "C  ")
        1				; signal conflict
Stefan Monnier's avatar
Stefan Monnier committed
369 370 371 372 373
      0)))				; signal success

(defun vc-svn-merge-news (file)
  "Merge in any new changes made to FILE."
  (message "Merging changes into %s..." file)
Eric S. Raymond's avatar
Eric S. Raymond committed
374
  ;; (vc-file-setprop file 'vc-working-revision nil)
Stefan Monnier's avatar
Stefan Monnier committed
375 376 377 378 379 380
  (vc-file-setprop file 'vc-checkout-time 0)
  (vc-svn-command nil 0 file "update")
  ;; Analyze the merge result reported by SVN, and set
  ;; file properties accordingly.
  (with-current-buffer (get-buffer "*vc*")
    (goto-char (point-min))
381
    ;; get new working revision
Stefan Monnier's avatar
Stefan Monnier committed
382
    (if (re-search-forward
383
	 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
Eric S. Raymond's avatar
Eric S. Raymond committed
384 385
	(vc-file-setprop file 'vc-working-revision (match-string 2))
      (vc-file-setprop file 'vc-working-revision nil))
Stefan Monnier's avatar
Stefan Monnier committed
386
    ;; get file status
387
    (goto-char (point-min))
Stefan Monnier's avatar
Stefan Monnier committed
388
    (prog1
389
        (if (looking-at "At revision")
Stefan Monnier's avatar
Stefan Monnier committed
390 391
            0 ;; there were no news; indicate success
          (if (re-search-forward
392 393 394 395 396 397
               ;; Newer SVN clients have 3 columns of chars (one for the
               ;; file's contents, then second for its properties, and the
               ;; third for lock-grabbing info), before the 2 spaces.
               ;; We also used to match the filename in column 0 without any
               ;; meta-info before it, but I believe this can never happen.
               (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)?  \\)"
398
                       (regexp-quote (file-name-nondirectory file)))
Stefan Monnier's avatar
Stefan Monnier committed
399 400 401
               nil t)
              (cond
               ;; Merge successful, we are in sync with repository now
402
               ((string= (match-string 2) "U")
Stefan Monnier's avatar
Stefan Monnier committed
403 404 405 406 407
                (vc-file-setprop file 'vc-state 'up-to-date)
                (vc-file-setprop file 'vc-checkout-time
                                 (nth 5 (file-attributes file)))
                0);; indicate success to the caller
               ;; Merge successful, but our own changes are still in the file
408
               ((string= (match-string 2) "G")
Stefan Monnier's avatar
Stefan Monnier committed
409 410 411 412 413 414 415 416 417 418 419
                (vc-file-setprop file 'vc-state 'edited)
                0);; indicate success to the caller
               ;; Conflicts detected!
               (t
                (vc-file-setprop file 'vc-state 'edited)
                1);; signal the error to the caller
               )
            (pop-to-buffer "*vc*")
            (error "Couldn't analyze svn update result")))
      (message "Merging changes into %s...done" file))))

420 421 422
(defun vc-svn-modify-change-comment (files rev comment)
  "Modify the change comments for a specified REV.
You must have ssh access to the repository host, and the directory Emacs
Chong Yidong's avatar
Chong Yidong committed
423
uses locally for temp files must also be writable by you on that host.
424 425 426
This is only supported if the repository access method is either file://
or svn+ssh://."
  (let (tempfile host remotefile directory fileurl-p)
427
    (with-temp-buffer
428
      (vc-do-command (current-buffer) 0 vc-svn-program nil "info")
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444
      (goto-char (point-min))
      (unless (re-search-forward "Repository Root: \\(file://\\(/.*\\)\\)\\|\\(svn\\+ssh://\\([^/]+\\)\\(/.*\\)\\)" nil t)
	(error "Repository information is unavailable"))
      (if (match-string 1)
	  (progn
	    (setq fileurl-p t)
	    (setq directory (match-string 2)))
	(setq host (match-string 4))
	(setq directory (match-string 5))
	(setq remotefile (concat host ":" tempfile))))
    (with-temp-file (setq tempfile (make-temp-file user-mail-address))
      (insert comment))
    (if fileurl-p
	;; Repository Root is a local file.
	(progn
	  (unless (vc-do-command
445
		   "*vc*" 0 "svnadmin" nil
446
		   "setlog" "--bypass-hooks" directory
447 448 449 450 451
		   "-r" rev (format "%s" tempfile))
	    (error "Log edit failed"))
	  (delete-file tempfile))

      ;; Remote repository, using svn+ssh.
452
      (unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile)
453 454
	(error "Copy of comment to %s failed" remotefile))
      (unless (vc-do-command
455
	       "*vc*" 0 "ssh" nil "-q" host
456 457 458
	       (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s"
		       directory rev tempfile tempfile))
	(error "Log edit failed")))))
Stefan Monnier's avatar
Stefan Monnier committed
459 460 461 462 463

;;;
;;; History functions
;;;

464 465
(defvar log-view-per-file-logs)

466 467 468 469
(define-derived-mode vc-svn-log-view-mode log-view-mode "SVN-Log-View"
  (require 'add-log)
  (set (make-local-variable 'log-view-per-file-logs) nil))

470
(defun vc-svn-print-log (files buffer &optional shortlog start-revision limit)
471
  "Get change log(s) associated with FILES."
Stefan Monnier's avatar
Stefan Monnier committed
472
  (save-current-buffer
473
    (vc-setup-buffer buffer)
Stefan Monnier's avatar
Stefan Monnier committed
474 475
    (let ((inhibit-read-only t))
      (goto-char (point-min))
Eric S. Raymond's avatar
Eric S. Raymond committed
476 477 478
      (if files
	  (dolist (file files)
		  (insert "Working file: " file "\n")
479 480
		  (apply
		   'vc-svn-command
Eric S. Raymond's avatar
Eric S. Raymond committed
481 482
		   buffer
		   'async
483
		   ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0)
Eric S. Raymond's avatar
Eric S. Raymond committed
484 485
		   (list file)
		   "log"
486 487 488 489 490 491 492 493 494
		   (append
		    (list
		     (if start-revision
			 (format "-r%s" start-revision)
		       ;; By default Subversion only shows the log up to the
		       ;; working revision, whereas we also want the log of the
		       ;; subsequent commits.  At least that's what the
		       ;; vc-cvs.el code does.
		       "-rHEAD:0"))
495
		    (when limit (list "--limit" (format "%s" limit))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
496
	;; Dump log for the entire directory.
497 498 499 500
	(apply 'vc-svn-command buffer 0 nil "log"
	       (append
		(list
		 (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 506 507 508 509 510 511 512 513 514 515 516 517
  (and oldvers
       (not newvers)
       files
       (catch 'no
	 (dolist (f files)
	   (or (equal oldvers (vc-working-revision f))
	       (throw 'no nil)))
	 t)
       ;; Use nil rather than the current revision because svn handles
       ;; it better (i.e. locally).  Note that if _any_ of the files
       ;; has a different revision, we fetch the lot, which is
       ;; obviously sub-optimal.
       (setq oldvers nil))
518
  (let* ((switches
519 520
	    (if vc-svn-diff-switches
		(vc-switches 'SVN 'diff)
521 522
	      (list "--diff-cmd=diff" "-x"
		    (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 532 533
	      (when oldvers
		(list "-r" (if newvers (concat oldvers ":" newvers)
			     oldvers)))))
534 535 536
      (if async 1		      ; async diff => pessimistic assumption
	;; For some reason `svn diff' does not return a useful
	;; status w.r.t whether the diff was empty or not.
537
	(buffer-size (get-buffer buffer)))))
Stefan Monnier's avatar
Stefan Monnier committed
538 539

;;;
540
;;; Tag system
Stefan Monnier's avatar
Stefan Monnier committed
541 542
;;;

543
(defun vc-svn-create-tag (dir name branchp)
544
  "Assign to DIR's current revision a given NAME.
Stefan Monnier's avatar
Stefan Monnier committed
545
If BRANCHP is non-nil, the name is created as a branch (and the current
546 547 548
workspace is immediately moved to that new branch).
NAME is assumed to be a URL."
  (vc-svn-command nil 0 dir "copy" name)
549
  (when branchp (vc-svn-retrieve-tag dir name nil)))
Stefan Monnier's avatar
Stefan Monnier committed
550

551 552 553
(defun vc-svn-retrieve-tag (dir name update)
  "Retrieve a tag at and below DIR.
NAME is the name of the tag; if it is empty, do a `svn update'.
554 555 556 557 558
If UPDATE is non-nil, then update (resynch) any affected buffers.
NAME is assumed to be a URL."
  (vc-svn-command nil 0 dir "switch" name)
  ;; FIXME: parse the output and obey `update'.
  )
Stefan Monnier's avatar
Stefan Monnier committed
559 560 561 562 563 564

;;;
;;; Miscellaneous
;;;

;; Subversion makes backups for us, so don't bother.
565 566 567
;; (defun vc-svn-make-version-backups-p (file)
;;   "Return non-nil if version backups should be made for FILE."
;;  (vc-stay-local-p file 'SVN))
Stefan Monnier's avatar
Stefan Monnier committed
568 569 570 571 572 573 574 575 576 577 578 579 580

(defun vc-svn-check-headers ()
  "Check if the current file has any headers in it."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))


;;;
;;; Internal functions
;;;

581
(defun vc-svn-command (buffer okstatus file-or-list &rest flags)
Stefan Monnier's avatar
Stefan Monnier committed
582 583 584
  "A wrapper around `vc-do-command' for use in vc-svn.el.
The difference to vc-do-command is that this function always invokes `svn',
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
Stefan Monnier's avatar
Stefan Monnier committed
586 587 588 589 590
         (if (stringp vc-svn-global-switches)
             (cons vc-svn-global-switches flags)
           (append vc-svn-global-switches
                   flags))))

591 592 593 594 595
(defun vc-svn-repository-hostname (dirname)
  (with-temp-buffer
    (let ((coding-system-for-read
	   (or file-name-coding-system
	       default-file-name-coding-system)))
Chong Yidong's avatar
Chong Yidong committed
596 597 598
      (vc-insert-file (expand-file-name (concat vc-svn-admin-directory
						"/entries")
					dirname)))
599 600
    (goto-char (point-min))
    (when (re-search-forward
601
	   ;; Old `svn' used name="svn:this_dir", newer use just name="".
602 603
	   (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
		   "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
604 605 606
		   "url=\"\\(?1:[^\"]+\\)\""
                   ;; Yet newer ones don't use XML any more.
                   "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t)
607 608 609 610
      ;; This is not a hostname but a URL.  This may actually be considered
      ;; as a feature since it allows vc-svn-stay-local to specify different
      ;; behavior for different modules on the same server.
      (match-string 1))))
Stefan Monnier's avatar
Stefan Monnier committed
611

612 613 614 615
(defun vc-svn-resolve-when-done ()
  "Call \"svn resolved\" if the conflict markers have been removed."
  (save-excursion
    (goto-char (point-min))
616 617 618 619
    (unless (re-search-forward "^<<<<<<< " nil t)
      (vc-svn-command nil 0 buffer-file-name "resolved")
      ;; Remove the hook so that it is not called multiple times.
      (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
620 621 622 623 624 625 626 627 628 629 630

;; Inspired by vc-arch-find-file-hook.
(defun vc-svn-find-file-hook ()
  (when (eq ?C (vc-file-getprop buffer-file-name 'vc-svn-status))
    ;; If the file is marked as "conflicted", then we should try and call
    ;; "svn resolved" when applicable.
    (if (save-excursion
          (goto-char (point-min))
          (re-search-forward "^<<<<<<< " nil t))
        ;; There are conflict markers.
        (progn
631
          (smerge-start-session)
632 633 634 635 636 637 638 639 640
          (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
      ;; There are no conflict markers.  This is problematic: maybe it means
      ;; the conflict has been resolved and we should immediately call "svn
      ;; resolved", or it means that the file's type does not allow Svn to
      ;; use conflict markers in which case we don't really know what to do.
      ;; So let's just punt for now.
      nil)
    (message "There are unresolved conflicts in this file")))

641
(defun vc-svn-parse-status (&optional filename)
Stefan Monnier's avatar
Stefan Monnier committed
642
  "Parse output of \"svn status\" command in the current buffer.
643 644
Set file properties accordingly.  Unless FILENAME is non-nil, parse only
information about FILENAME and return its status."
Stefan Monnier's avatar
Stefan Monnier committed
645 646 647
  (let (file status)
    (goto-char (point-min))
    (while (re-search-forward
648
            ;; Ignore the files with status X.
649
	    "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
650 651 652 653 654
      ;; If the username contains spaces, the output format is ambiguous,
      ;; so don't trust the output's filename unless we have to.
      (setq file (or filename
                     (expand-file-name
                      (buffer-substring (point) (line-end-position)))))
Stefan Monnier's avatar
Stefan Monnier committed
655
      (setq status (char-after (line-beginning-position)))
656
      (if (eq status ??)
Eric S. Raymond's avatar
Eric S. Raymond committed
657
	  (vc-file-setprop file 'vc-state 'unregistered)
658 659
	;; Use the last-modified revision, so that searching in vc-print-log
	;; output works.
Eric S. Raymond's avatar
Eric S. Raymond committed
660
	(vc-file-setprop file 'vc-working-revision (match-string 3))
661
        ;; Remember Svn's own status.
Eric S. Raymond's avatar
Eric S. Raymond committed
662 663
        (vc-file-setprop file 'vc-svn-status status)
	(vc-file-setprop
Stefan Monnier's avatar
Stefan Monnier committed
664 665 666 667
	 file 'vc-state
	 (cond
	  ((eq status ?\ )
	   (if (eq (char-after (match-beginning 1)) ?*)
668
	       'needs-update
Eric S. Raymond's avatar
Eric S. Raymond committed
669
             (vc-file-setprop file 'vc-checkout-time
Stefan Monnier's avatar
Stefan Monnier committed
670 671 672
                              (nth 5 (file-attributes file)))
	     'up-to-date))
	  ((eq status ?A)
673
	   ;; If the file was actually copied, (match-string 2) is "-".
Eric S. Raymond's avatar
Eric S. Raymond committed
674 675
	   (vc-file-setprop file 'vc-working-revision "0")
	   (vc-file-setprop file 'vc-checkout-time 0)
676
	   'added)
677 678 679
	  ((eq status ?C)
	   (vc-file-setprop file 'vc-state 'conflict))
	  ((eq status '?M)
Stefan Monnier's avatar
Stefan Monnier committed
680 681 682
	   (if (eq (char-after (match-beginning 1)) ?*)
	       'needs-merge
	     'edited))
683
	  ((eq status ?I)
Eric S. Raymond's avatar
Eric S. Raymond committed
684
	   (vc-file-setprop file 'vc-state 'ignored))
685
	  ((memq status '(?D ?R))
Eric S. Raymond's avatar
Eric S. Raymond committed
686
	   (vc-file-setprop file 'vc-state 'removed))
687
	  (t 'edited)))))
688
    (when filename (vc-file-getprop filename 'vc-state))))
Stefan Monnier's avatar
Stefan Monnier committed
689 690 691 692 693 694 695 696 697

(defun vc-svn-valid-symbolic-tag-name-p (tag)
  "Return non-nil if TAG is a valid symbolic tag name."
  ;; According to the SVN manual, a valid symbolic tag must start with
  ;; an uppercase or lowercase letter and can contain uppercase and
  ;; lowercase letters, digits, `-', and `_'.
  (and (string-match "^[a-zA-Z]" tag)
       (not (string-match "[^a-z0-9A-Z-_]" tag))))

698 699
(defun vc-svn-valid-revision-number-p (tag)
  "Return non-nil if TAG is a valid revision number."
Stefan Monnier's avatar
Stefan Monnier committed
700 701 702
  (and (string-match "^[0-9]" tag)
       (not (string-match "[^0-9]" tag))))

703 704 705
;; Support for `svn annotate'

(defun vc-svn-annotate-command (file buf &optional rev)
706
  (vc-svn-command buf 'async file "annotate" (if rev (concat "-r" rev))))
707 708 709 710 711

(defun vc-svn-annotate-time-of-rev (rev)
  ;; Arbitrarily assume 10 commmits per day.
  (/ (string-to-number rev) 10.0))

712 713
(defvar vc-annotate-parent-rev)

714 715 716 717 718 719 720 721 722 723 724 725 726 727 728
(defun vc-svn-annotate-current-time ()
  (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))

(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ")

(defun vc-svn-annotate-time ()
  (when (looking-at vc-svn-annotate-re)
    (goto-char (match-end 0))
    (vc-svn-annotate-time-of-rev (match-string 1))))

(defun vc-svn-annotate-extract-revision-at-line ()
  (save-excursion
    (beginning-of-line)
    (if (looking-at vc-svn-annotate-re) (match-string 1))))

729 730 731 732 733 734 735 736 737 738 739 740 741 742 743
(defun vc-svn-revision-table (files)
  (let ((vc-svn-revisions '()))
    (with-current-buffer "*vc*"
      (vc-svn-command nil 0 files "log" "-q")
      (goto-char (point-min))
      (forward-line)
      (let ((start (point-min))
            (loglines (buffer-substring-no-properties (point-min)
                                                      (point-max))))
        (while (string-match "^r\\([0-9]+\\) " loglines)
          (push (match-string 1 loglines) vc-svn-revisions)
          (setq start (+ start (match-end 0)))
          (setq loglines (buffer-substring-no-properties start (point-max)))))
    vc-svn-revisions)))

Stefan Monnier's avatar
Stefan Monnier committed
744 745
(provide 'vc-svn)

746
;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d
Stefan Monnier's avatar
Stefan Monnier committed
747
;;; vc-svn.el ends here