X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/233ba4d924933cb56129bd7511e6137b7c0b8e3e..7a2657fa3bedbd977f4e11fe030cb4a210c04ab4:/lisp/vc/vc-svn.el diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index aefef50cf7..b79af07a75 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -1,6 +1,6 @@ ;;; vc-svn.el --- non-resident support for Subversion version-control -;; Copyright (C) 2003-2011 Free Software Foundation, Inc. +;; Copyright (C) 2003-2013 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -39,11 +39,16 @@ ;;; Customization options ;;; +(defgroup vc-svn nil + "VC Subversion (svn) backend." + :version "24.1" + :group 'vc) + ;; FIXME there is also svnadmin. (defcustom vc-svn-program "svn" "Name of the SVN executable." :type 'string - :group 'vc) + :group 'vc-svn) (defcustom vc-svn-global-switches nil "Global switches to pass to any SVN command." @@ -53,7 +58,7 @@ :value ("") string)) :version "22.1" - :group 'vc) + :group 'vc-svn) (defcustom vc-svn-register-switches nil "Switches for registering a file into SVN. @@ -65,7 +70,7 @@ If t, use no switches." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) :version "22.1" - :group 'vc) + :group 'vc-svn) (defcustom vc-svn-diff-switches t ;`svn' doesn't support common args like -c or -b. @@ -81,13 +86,13 @@ If you want to force an empty list of arguments, use t." :value ("") string)) :version "22.1" - :group 'vc) + :group 'vc-svn) (defcustom vc-svn-header '("\$Id\$") "Header keywords to be inserted by `vc-insert-headers'." :version "24.1" ; no longer consult the obsolete vc-header-alist :type '(repeat string) - :group 'vc) + :group 'vc-svn) ;; 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 @@ -117,17 +122,13 @@ If you want to force an empty list of arguments, use t." ;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK")) ;;;###autoload "_svn") ;;;###autoload (t ".svn")))) -;;;###autoload (when (file-readable-p (expand-file-name -;;;###autoload (concat admin-dir "/entries") -;;;###autoload (file-name-directory f))) +;;;###autoload (when (vc-find-root f admin-dir) ;;;###autoload (load "vc-svn") ;;;###autoload (vc-svn-registered f)))) (defun vc-svn-registered (file) "Check if FILE is SVN registered." - (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory - "/entries") - (file-name-directory file))) + (when (vc-svn-root file) (with-temp-buffer (cd (file-name-directory file)) (let* (process-file-side-effects @@ -154,9 +155,24 @@ If you want to force an empty list of arguments, use t." (vc-svn-command t 0 file "status" (if localp "-v" "-u")) (vc-svn-parse-status file)))) +;; NB this does not handle svn properties, which can be changed +;; without changing the file timestamp. +;; Note that unlike vc-cvs-state-heuristic, this is not called from +;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via +;; vc-after-save (bug#7850). Therefore the fact that it ignores +;; properties is irrelevant. If you want to make vc-svn-state call +;; this, it should be extended to handle svn properties. (defun vc-svn-state-heuristic (file) "SVN-specific state heuristic." - (vc-svn-state file 'local)) + ;; If the file has not changed since checkout, consider it `up-to-date'. + ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic. + (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) + (lastmod (nth 5 (file-attributes file)))) + (cond + ((equal checkout-time lastmod) 'up-to-date) + ((string= (vc-working-revision file) "0") 'added) + ((null checkout-time) 'unregistered) + (t 'edited)))) ;; FIXME it would be better not to have the "remote" argument, ;; but to distinguish the two output formats based on content. @@ -178,7 +194,9 @@ If you want to force an empty list of arguments, use t." (while (re-search-forward re nil t) (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) (propstat (cdr (assq (aref (match-string 2) 0) state-map))) - (filename (match-string 4))) + (filename (if (memq system-type '(windows-nt ms-dos)) + (replace-regexp-in-string "\\\\" "/" (match-string 4)) + (match-string 4)))) (and (memq propstat '(conflict edited)) (not (eq state 'conflict)) ; conflict always wins (setq state propstat)) @@ -265,8 +283,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (defun vc-svn-create-repo () "Create a new SVN repository." (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN")) - (vc-do-command "*vc*" 0 vc-svn-program '(".") - "checkout" (concat "file://" default-directory "SVN"))) + (vc-svn-command "*vc*" 0 "." "checkout" + (concat "file://" default-directory "SVN"))) (defun vc-svn-register (files &optional rev comment) "Register FILES into the SVN version-control system. @@ -275,14 +293,12 @@ Passes either `vc-svn-register-switches' or `vc-register-switches' to the SVN command." (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register))) -(defun vc-svn-responsible-p (file) - "Return non-nil if SVN thinks it is responsible for FILE." - (file-directory-p (expand-file-name vc-svn-admin-directory - (if (file-directory-p file) - file - (file-name-directory file))))) +(defun vc-svn-root (file) + (vc-find-root file vc-svn-admin-directory)) + +(defalias 'vc-svn-responsible-p 'vc-svn-root) -(defalias 'vc-svn-could-register 'vc-svn-responsible-p +(defalias 'vc-svn-could-register 'vc-svn-root "Return non-nil if FILE could be registered in SVN. This is only possible if SVN is responsible for FILE's directory.") @@ -338,7 +354,6 @@ This is only possible if SVN is responsible for FILE's directory.") ;; Check out a particular version (or recreate the file). (vc-file-setprop file 'vc-working-revision nil) (apply 'vc-svn-command nil 0 file - "--non-interactive" ; bug#4280 "update" (cond ((null rev) "-rBASE") @@ -377,7 +392,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (message "Merging changes into %s..." file) ;; (vc-file-setprop file 'vc-working-revision nil) (vc-file-setprop file 'vc-checkout-time 0) - (vc-svn-command nil 0 file "--non-interactive" "update") ; see bug#7152 + (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*") @@ -399,7 +414,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." ;; 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 ]\\)? \\)" - (regexp-quote (file-name-nondirectory file))) + (regexp-quote (file-relative-name file))) nil t) (cond ;; Merge successful, we are in sync with repository now @@ -429,7 +444,7 @@ This is only supported if the repository access method is either file:// or svn+ssh://." (let (tempfile host remotefile directory fileurl-p) (with-temp-buffer - (vc-do-command (current-buffer) 0 vc-svn-program nil "info") + (vc-svn-command (current-buffer) 0 nil "info") (goto-char (point-min)) (unless (re-search-forward "Repository Root: \\(file://\\(/.*\\)\\)\\|\\(svn\\+ssh://\\([^/]+\\)\\(/.*\\)\\)" nil t) (error "Repository information is unavailable")) @@ -585,29 +600,26 @@ NAME is assumed to be a URL." (defun vc-svn-command (buffer okstatus file-or-list &rest flags) "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." - (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list - (if (stringp vc-svn-global-switches) +and that it passes \"--non-interactive\" and `vc-svn-global-switches' to +it before FLAGS." + ;; Might be nice if svn defaulted to non-interactive if stdin not tty. + ;; http://svn.haxx.se/dev/archive-2008-05/0762.shtml + ;; http://svn.haxx.se/dev/archive-2009-04/0094.shtml + ;; Maybe newer ones do? + (or (member "--non-interactive" + (setq flags (if (stringp vc-svn-global-switches) (cons vc-svn-global-switches flags) - (append vc-svn-global-switches - flags)))) + (append vc-svn-global-switches flags)))) + (setq flags (cons "--non-interactive" flags))) + (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list + flags)) (defun vc-svn-repository-hostname (dirname) (with-temp-buffer - (let ((coding-system-for-read - (or file-name-coding-system - default-file-name-coding-system))) - (vc-insert-file (expand-file-name (concat vc-svn-admin-directory - "/entries") - dirname))) + (let (process-file-side-effects) + (vc-svn-command t t dirname "info" "--xml")) (goto-char (point-min)) - (when (re-search-forward - ;; Old `svn' used name="svn:this_dir", newer use just name="". - (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*" - "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" - "url=\"\\(?1:[^\"]+\\)\"" - ;; Yet newer ones don't use XML any more. - "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t) + (when (re-search-forward "\\(.*\\)" nil t) ;; 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. @@ -714,7 +726,7 @@ information about FILENAME and return its status." (vc-svn-command buf 'async file "annotate" (if rev (concat "-r" rev)))) (defun vc-svn-annotate-time-of-rev (rev) - ;; Arbitrarily assume 10 commmits per day. + ;; Arbitrarily assume 10 commits per day. (/ (string-to-number rev) 10.0)) (defvar vc-annotate-parent-rev)