1;;; vc-svn.el --- non-resident support for Subversion version-control 2 3;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 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 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 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 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Commentary: 26 27;; This is preliminary support for Subversion (http://subversion.tigris.org/). 28;; It started as `sed s/cvs/svn/ vc.cvs.el' (from version 1.56) 29;; and hasn't been completely fixed since. 30 31;; Sync'd with Subversion's vc-svn.el as of revision 5801. 32 33;;; Bugs: 34 35;; - VC-dired is (really) slow. 36 37;;; Code: 38 39(eval-when-compile 40 (require 'vc)) 41 42;;; 43;;; Customization options 44;;; 45 46(defcustom vc-svn-global-switches nil 47 "*Global switches to pass to any SVN command." 48 :type '(choice (const :tag "None" nil) 49 (string :tag "Argument String") 50 (repeat :tag "Argument List" 51 :value ("") 52 string)) 53 :version "22.1" 54 :group 'vc) 55 56(defcustom vc-svn-register-switches nil 57 "*Extra switches for registering a file into SVN. 58A string or list of strings passed to the checkin program by 59\\[vc-register]." 60 :type '(choice (const :tag "None" nil) 61 (string :tag "Argument String") 62 (repeat :tag "Argument List" 63 :value ("") 64 string)) 65 :version "22.1" 66 :group 'vc) 67 68(defcustom vc-svn-diff-switches 69 t ;`svn' doesn't support common args like -c or -b. 70 "String or list of strings specifying extra switches for svn diff under VC. 71If nil, use the value of `vc-diff-switches'. 72If you want to force an empty list of arguments, use t." 73 :type '(choice (const :tag "Unspecified" nil) 74 (const :tag "None" t) 75 (string :tag "Argument String") 76 (repeat :tag "Argument List" 77 :value ("") 78 string)) 79 :version "22.1" 80 :group 'vc) 81 82(defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$")) 83 "*Header keywords to be inserted by `vc-insert-headers'." 84 :version "22.1" 85 :type '(repeat string) 86 :group 'vc) 87 88;; We want to autoload it for use by the autoloaded version of 89;; vc-svn-registered, but we want the value to be compiled at startup, not 90;; at dump time. 91;; ;;;###autoload 92(defconst vc-svn-admin-directory 93 (cond ((and (memq system-type '(cygwin windows-nt ms-dos)) 94 (getenv "SVN_ASP_DOT_NET_HACK")) 95 "_svn") 96 (t ".svn")) 97 "The name of the \".svn\" subdirectory or its equivalent.") 98 99;;; 100;;; State-querying functions 101;;; 102 103;;; vc-svn-admin-directory is generally not defined when the 104;;; autoloaded function is called. 105 106;;;###autoload (defun vc-svn-registered (f) 107;;;###autoload (let ((admin-dir (cond ((and (eq system-type 'windows-nt) 108;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK")) 109;;;###autoload "_svn") 110;;;###autoload (t ".svn")))) 111;;;###autoload (when (file-readable-p (expand-file-name 112;;;###autoload (concat admin-dir "/entries") 113;;;###autoload (file-name-directory f))) 114;;;###autoload (load "vc-svn") 115;;;###autoload (vc-svn-registered f)))) 116 117;;;###autoload 118(add-to-list 'completion-ignored-extensions ".svn/") 119 120(defun vc-svn-registered (file) 121 "Check if FILE is SVN registered." 122 (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory 123 "/entries") 124 (file-name-directory file))) 125 (with-temp-buffer 126 (cd (file-name-directory file)) 127 (let ((status 128 (condition-case nil 129 ;; Ignore all errors. 130 (vc-svn-command t t file "status" "-v") 131 ;; Some problem happened. E.g. We can't find an `svn' 132 ;; executable. We used to only catch `file-error' but when 133 ;; the process is run on a remote host via Tramp, the error 134 ;; is only reported via the exit status which is turned into 135 ;; an `error' by vc-do-command. 136 (error nil)))) 137 (when (eq 0 status) 138 (vc-svn-parse-status file)))))) 139 140(defun vc-svn-state (file &optional localp) 141 "SVN-specific version of `vc-state'." 142 (setq localp (or localp (vc-stay-local-p file))) 143 (with-temp-buffer 144 (cd (file-name-directory file)) 145 (vc-svn-command t 0 file "status" (if localp "-v" "-u")) 146 (vc-svn-parse-status file))) 147 148(defun vc-svn-state-heuristic (file) 149 "SVN-specific state heuristic." 150 (vc-svn-state file 'local)) 151 152(defun vc-svn-dir-state (dir &optional localp) 153 "Find the SVN state of all files in DIR." 154 (setq localp (or localp (vc-stay-local-p dir))) 155 (let ((default-directory dir)) 156 ;; Don't specify DIR in this command, the default-directory is 157 ;; enough. Otherwise it might fail with remote repositories. 158 (with-temp-buffer 159 (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) 160 (vc-svn-parse-status)))) 161 162(defun vc-svn-workfile-version (file) 163 "SVN-specific version of `vc-workfile-version'." 164 ;; There is no need to consult RCS headers under SVN, because we 165 ;; get the workfile version for free when we recognize that a file 166 ;; is registered in SVN. 167 (vc-svn-registered file) 168 (vc-file-getprop file 'vc-workfile-version)) 169 170(defun vc-svn-checkout-model (file) 171 "SVN-specific version of `vc-checkout-model'." 172 ;; It looks like Subversion has no equivalent of CVSREAD. 173 'implicit) 174 175;; vc-svn-mode-line-string doesn't exist because the default implementation 176;; works just fine. 177 178(defun vc-svn-dired-state-info (file) 179 "SVN-specific version of `vc-dired-state-info'." 180 (let ((svn-state (vc-state file))) 181 (cond ((eq svn-state 'edited) 182 (if (equal (vc-workfile-version file) "0") 183 "(added)" "(modified)")) 184 ((eq svn-state 'needs-patch) "(patch)") 185 ((eq svn-state 'needs-merge) "(merge)")))) 186 187(defun vc-svn-previous-version (file rev) 188 (let ((newrev (1- (string-to-number rev)))) 189 (when (< 0 newrev) 190 (number-to-string newrev)))) 191 192(defun vc-svn-next-version (file rev) 193 (let ((newrev (1+ (string-to-number rev)))) 194 ;; The "workfile version" is an uneasy conceptual fit under Subversion; 195 ;; we use it as the upper bound until a better idea comes along. If the 196 ;; workfile version W coincides with the tree's latest revision R, then 197 ;; this check prevents a "no such revision: R+1" error. Otherwise, it 198 ;; inhibits showing of W+1 through R, which could be considered anywhere 199 ;; from gracious to impolite. 200 (unless (< (string-to-number (vc-file-getprop file 'vc-workfile-version)) 201 newrev) 202 (number-to-string newrev)))) 203 204 205;;; 206;;; State-changing functions 207;;; 208 209(defun vc-svn-register (file &optional rev comment) 210 "Register FILE into the SVN version-control system. 211COMMENT can be used to provide an initial description of FILE. 212 213`vc-register-switches' and `vc-svn-register-switches' are passed to 214the SVN command (in that order)." 215 (apply 'vc-svn-command nil 0 file "add" (vc-switches 'SVN 'register))) 216 217(defun vc-svn-responsible-p (file) 218 "Return non-nil if SVN thinks it is responsible for FILE." 219 (file-directory-p (expand-file-name vc-svn-admin-directory 220 (if (file-directory-p file) 221 file 222 (file-name-directory file))))) 223 224(defalias 'vc-svn-could-register 'vc-svn-responsible-p 225 "Return non-nil if FILE could be registered in SVN. 226This is only possible if SVN is responsible for FILE's directory.") 227 228(defun vc-svn-checkin (file rev comment) 229 "SVN-specific version of `vc-backend-checkin'." 230 (let ((status (apply 231 'vc-svn-command nil 1 file "ci" 232 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin))))) 233 (set-buffer "*vc*") 234 (goto-char (point-min)) 235 (unless (equal status 0) 236 ;; Check checkin problem. 237 (cond 238 ((search-forward "Transaction is out of date" nil t) 239 (vc-file-setprop file 'vc-state 'needs-merge) 240 (error (substitute-command-keys 241 (concat "Up-to-date check failed: " 242 "type \\[vc-next-action] to merge in changes")))) 243 (t 244 (pop-to-buffer (current-buffer)) 245 (goto-char (point-min)) 246 (shrink-window-if-larger-than-buffer) 247 (error "Check-in failed")))) 248 ;; Update file properties 249 ;; (vc-file-setprop 250 ;; file 'vc-workfile-version 251 ;; (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) 252 )) 253 254(defun vc-svn-find-version (file rev buffer) 255 (apply 'vc-svn-command 256 buffer 0 file 257 "cat" 258 (and rev (not (string= rev "")) 259 (concat "-r" rev)) 260 (vc-switches 'SVN 'checkout))) 261 262(defun vc-svn-checkout (file &optional editable rev) 263 (message "Checking out %s..." file) 264 (with-current-buffer (or (get-file-buffer file) (current-buffer)) 265 (vc-call update file editable rev (vc-switches 'SVN 'checkout))) 266 (vc-mode-line file) 267 (message "Checking out %s...done" file)) 268 269(defun vc-svn-update (file editable rev switches) 270 (if (and (file-exists-p file) (not rev)) 271 ;; If no revision was specified, there's nothing to do. 272 nil 273 ;; Check out a particular version (or recreate the file). 274 (vc-file-setprop file 'vc-workfile-version nil) 275 (apply 'vc-svn-command nil 0 file 276 "update" 277 ;; default for verbose checkout: clear the sticky tag so 278 ;; that the actual update will get the head of the trunk 279 (cond 280 ((null rev) "-rBASE") 281 ((or (eq rev t) (equal rev "")) nil) 282 (t (concat "-r" rev))) 283 switches))) 284 285(defun vc-svn-delete-file (file) 286 (vc-svn-command nil 0 file "remove")) 287 288(defun vc-svn-rename-file (old new) 289 (vc-svn-command nil 0 new "move" (file-relative-name old))) 290 291(defun vc-svn-revert (file &optional contents-done) 292 "Revert FILE to the version it was based on." 293 (unless contents-done 294 (vc-svn-command nil 0 file "revert"))) 295 296(defun vc-svn-merge (file first-version &optional second-version) 297 "Merge changes into current working copy of FILE. 298The changes are between FIRST-VERSION and SECOND-VERSION." 299 (vc-svn-command nil 0 file 300 "merge" 301 "-r" (if second-version 302 (concat first-version ":" second-version) 303 first-version)) 304 (vc-file-setprop file 'vc-state 'edited) 305 (with-current-buffer (get-buffer "*vc*") 306 (goto-char (point-min)) 307 (if (looking-at "C ") 308 1 ; signal conflict 309 0))) ; signal success 310 311(defun vc-svn-merge-news (file) 312 "Merge in any new changes made to FILE." 313 (message "Merging changes into %s..." file) 314 ;; (vc-file-setprop file 'vc-workfile-version nil) 315 (vc-file-setprop file 'vc-checkout-time 0) 316 (vc-svn-command nil 0 file "update") 317 ;; Analyze the merge result reported by SVN, and set 318 ;; file properties accordingly. 319 (with-current-buffer (get-buffer "*vc*") 320 (goto-char (point-min)) 321 ;; get new workfile version 322 (if (re-search-forward 323 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t) 324 (vc-file-setprop file 'vc-workfile-version (match-string 2)) 325 (vc-file-setprop file 'vc-workfile-version nil)) 326 ;; get file status 327 (goto-char (point-min)) 328 (prog1 329 (if (looking-at "At revision") 330 0 ;; there were no news; indicate success 331 (if (re-search-forward 332 ;; Newer SVN clients have 3 columns of chars (one for the 333 ;; file's contents, then second for its properties, and the 334 ;; third for lock-grabbing info), before the 2 spaces. 335 ;; We also used to match the filename in column 0 without any 336 ;; meta-info before it, but I believe this can never happen. 337 (concat "^\\(\\([ACGDU]\\)\\(.[B ]\\)? \\)" 338 (regexp-quote (file-name-nondirectory file))) 339 nil t) 340 (cond 341 ;; Merge successful, we are in sync with repository now 342 ((string= (match-string 2) "U") 343 (vc-file-setprop file 'vc-state 'up-to-date) 344 (vc-file-setprop file 'vc-checkout-time 345 (nth 5 (file-attributes file))) 346 0);; indicate success to the caller 347 ;; Merge successful, but our own changes are still in the file 348 ((string= (match-string 2) "G") 349 (vc-file-setprop file 'vc-state 'edited) 350 0);; indicate success to the caller 351 ;; Conflicts detected! 352 (t 353 (vc-file-setprop file 'vc-state 'edited) 354 1);; signal the error to the caller 355 ) 356 (pop-to-buffer "*vc*") 357 (error "Couldn't analyze svn update result"))) 358 (message "Merging changes into %s...done" file)))) 359 360 361;;; 362;;; History functions 363;;; 364 365(defun vc-svn-print-log (file &optional buffer) 366 "Get change log associated with FILE." 367 (save-current-buffer 368 (vc-setup-buffer buffer) 369 (let ((inhibit-read-only t)) 370 (goto-char (point-min)) 371 ;; Add a line to tell log-view-mode what file this is. 372 (insert "Working file: " (file-relative-name file) "\n")) 373 (vc-svn-command 374 buffer 375 (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) 376 file "log" 377 ;; By default Subversion only shows the log upto the working version, 378 ;; whereas we also want the log of the subsequent commits. At least 379 ;; that's what the vc-cvs.el code does. 380 "-rHEAD:0"))) 381 382(defun vc-svn-diff (file &optional oldvers newvers buffer) 383 "Get a difference report using SVN between two versions of FILE." 384 (unless buffer (setq buffer "*vc-diff*")) 385 (if (and oldvers (equal oldvers (vc-workfile-version file))) 386 ;; Use nil rather than the current revision because svn handles it 387 ;; better (i.e. locally). 388 (setq oldvers nil)) 389 (if (string= (vc-workfile-version file) "0") 390 ;; This file is added but not yet committed; there is no master file. 391 (if (or oldvers newvers) 392 (error "No revisions of %s exist" file) 393 ;; We regard this as "changed". 394 ;; Diff it against /dev/null. 395 ;; Note: this is NOT a "svn diff". 396 (apply 'vc-do-command buffer 397 1 "diff" file 398 (append (vc-switches nil 'diff) '("/dev/null"))) 399 ;; Even if it's empty, it's locally modified. 400 1) 401 (let* ((switches 402 (if vc-svn-diff-switches 403 (vc-switches 'SVN 'diff) 404 (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) 405 (async (and (not vc-disable-async-diff) 406 (vc-stay-local-p file) 407 (or oldvers newvers) ; Svn diffs those locally. 408 (fboundp 'start-process)))) 409 (apply 'vc-svn-command buffer 410 (if async 'async 0) 411 file "diff" 412 (append 413 switches 414 (when oldvers 415 (list "-r" (if newvers (concat oldvers ":" newvers) 416 oldvers))))) 417 (if async 1 ; async diff => pessimistic assumption 418 ;; For some reason `svn diff' does not return a useful 419 ;; status w.r.t whether the diff was empty or not. 420 (buffer-size (get-buffer buffer)))))) 421 422(defun vc-svn-diff-tree (dir &optional rev1 rev2) 423 "Diff all files at and below DIR." 424 (vc-svn-diff (file-name-as-directory dir) rev1 rev2)) 425 426;;; 427;;; Snapshot system 428;;; 429 430(defun vc-svn-create-snapshot (dir name branchp) 431 "Assign to DIR's current version a given NAME. 432If BRANCHP is non-nil, the name is created as a branch (and the current 433workspace is immediately moved to that new branch). 434NAME is assumed to be a URL." 435 (vc-svn-command nil 0 dir "copy" name) 436 (when branchp (vc-svn-retrieve-snapshot dir name nil))) 437 438(defun vc-svn-retrieve-snapshot (dir name update) 439 "Retrieve a snapshot at and below DIR. 440NAME is the name of the snapshot; if it is empty, do a `svn update'. 441If UPDATE is non-nil, then update (resynch) any affected buffers. 442NAME is assumed to be a URL." 443 (vc-svn-command nil 0 dir "switch" name) 444 ;; FIXME: parse the output and obey `update'. 445 ) 446 447;;; 448;;; Miscellaneous 449;;; 450 451;; Subversion makes backups for us, so don't bother. 452;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p 453;; "Return non-nil if version backups should be made for FILE.") 454 455(defun vc-svn-check-headers () 456 "Check if the current file has any headers in it." 457 (save-excursion 458 (goto-char (point-min)) 459 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\ 460\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t))) 461 462 463;;; 464;;; Internal functions 465;;; 466 467(defun vc-svn-command (buffer okstatus file &rest flags) 468 "A wrapper around `vc-do-command' for use in vc-svn.el. 469The difference to vc-do-command is that this function always invokes `svn', 470and that it passes `vc-svn-global-switches' to it before FLAGS." 471 (apply 'vc-do-command buffer okstatus "svn" file 472 (if (stringp vc-svn-global-switches) 473 (cons vc-svn-global-switches flags) 474 (append vc-svn-global-switches 475 flags)))) 476 477(defun vc-svn-repository-hostname (dirname) 478 (with-temp-buffer 479 (let ((coding-system-for-read 480 (or file-name-coding-system 481 default-file-name-coding-system))) 482 (vc-insert-file (expand-file-name (concat vc-svn-admin-directory 483 "/entries") 484 dirname))) 485 (goto-char (point-min)) 486 (when (re-search-forward 487 ;; Old `svn' used name="svn:this_dir", newer use just name="". 488 (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*" 489 "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" 490 "url=\"\\([^\"]+\\)\"") nil t) 491 ;; This is not a hostname but a URL. This may actually be considered 492 ;; as a feature since it allows vc-svn-stay-local to specify different 493 ;; behavior for different modules on the same server. 494 (match-string 1)))) 495 496(defun vc-svn-parse-status (&optional filename) 497 "Parse output of \"svn status\" command in the current buffer. 498Set file properties accordingly. Unless FILENAME is non-nil, parse only 499information about FILENAME and return its status." 500 (let (file status) 501 (goto-char (point-min)) 502 (while (re-search-forward 503 ;; Ignore the files with status in [IX?]. 504 "^[ ACDGMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t) 505 ;; If the username contains spaces, the output format is ambiguous, 506 ;; so don't trust the output's filename unless we have to. 507 (setq file (or filename 508 (expand-file-name 509 (buffer-substring (point) (line-end-position))))) 510 (setq status (char-after (line-beginning-position))) 511 (unless (eq status ??) 512 ;; `vc-BACKEND-registered' must not set vc-backend, 513 ;; which is instead set in vc-registered. 514 (unless filename (vc-file-setprop file 'vc-backend 'SVN)) 515 ;; Use the last-modified revision, so that searching in vc-print-log 516 ;; output works. 517 (vc-file-setprop file 'vc-workfile-version (match-string 3)) 518 (vc-file-setprop 519 file 'vc-state 520 (cond 521 ((eq status ?\ ) 522 (if (eq (char-after (match-beginning 1)) ?*) 523 'needs-patch 524 (vc-file-setprop file 'vc-checkout-time 525 (nth 5 (file-attributes file))) 526 'up-to-date)) 527 ((eq status ?A) 528 ;; If the file was actually copied, (match-string 2) is "-". 529 (vc-file-setprop file 'vc-workfile-version "0") 530 (vc-file-setprop file 'vc-checkout-time 0) 531 'edited) 532 ((memq status '(?M ?C)) 533 (if (eq (char-after (match-beginning 1)) ?*) 534 'needs-merge 535 'edited)) 536 (t 'edited))))) 537 (if filename (vc-file-getprop filename 'vc-state)))) 538 539(defun vc-svn-dir-state-heuristic (dir) 540 "Find the SVN state of all files in DIR, using only local information." 541 (vc-svn-dir-state dir 'local)) 542 543(defun vc-svn-valid-symbolic-tag-name-p (tag) 544 "Return non-nil if TAG is a valid symbolic tag name." 545 ;; According to the SVN manual, a valid symbolic tag must start with 546 ;; an uppercase or lowercase letter and can contain uppercase and 547 ;; lowercase letters, digits, `-', and `_'. 548 (and (string-match "^[a-zA-Z]" tag) 549 (not (string-match "[^a-z0-9A-Z-_]" tag)))) 550 551(defun vc-svn-valid-version-number-p (tag) 552 "Return non-nil if TAG is a valid version number." 553 (and (string-match "^[0-9]" tag) 554 (not (string-match "[^0-9]" tag)))) 555 556;; Support for `svn annotate' 557 558(defun vc-svn-annotate-command (file buf &optional rev) 559 (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev)))) 560 561(defun vc-svn-annotate-time-of-rev (rev) 562 ;; Arbitrarily assume 10 commmits per day. 563 (/ (string-to-number rev) 10.0)) 564 565(defun vc-svn-annotate-current-time () 566 (vc-svn-annotate-time-of-rev vc-annotate-parent-rev)) 567 568(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ") 569 570(defun vc-svn-annotate-time () 571 (when (looking-at vc-svn-annotate-re) 572 (goto-char (match-end 0)) 573 (vc-svn-annotate-time-of-rev (match-string 1)))) 574 575(defun vc-svn-annotate-extract-revision-at-line () 576 (save-excursion 577 (beginning-of-line) 578 (if (looking-at vc-svn-annotate-re) (match-string 1)))) 579 580(provide 'vc-svn) 581 582;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d 583;;; vc-svn.el ends here 584