X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4a47c2757309e338321da1e7a2f6d399a306ce7d..7a2657fa3bedbd977f4e11fe030cb4a210c04ab4:/lisp/vc/vc-svn.el diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 3e4c299f09..b79af07a75 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -1,7 +1,6 @@ ;;; vc-svn.el --- non-resident support for Subversion version-control -;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2003-2013 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -40,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." @@ -54,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. @@ -66,15 +70,15 @@ 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. "String or list of strings specifying extra switches for svn diff under VC. 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." +together with \"-x --diff-cmd=\"`diff-command' (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." :type '(choice (const :tag "Unspecified" nil) (const :tag "None" t) (string :tag "Argument String") @@ -82,13 +86,13 @@ 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 @@ -118,17 +122,13 @@ 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 @@ -155,9 +155,24 @@ 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. @@ -171,15 +186,21 @@ want to force an empty list of arguments, use t." (?? . unregistered) ;; This is what vc-svn-parse-status does. (?~ . edited))) - (re (if remote "^\\(.\\)......? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" - ;; Subexp 2 is a dummy in this case, so the numbers match. - "^\\(.\\)....\\(.\\) \\(.*\\)$")) + (re (if remote "^\\(.\\)\\(.\\).....? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$" + ;; Subexp 3 is a dummy in this case, so the numbers match. + "^\\(.\\)\\(.\\)...\\(.\\) \\(.*\\)$")) result) (goto-char (point-min)) (while (re-search-forward re nil t) (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) - (filename (match-string 3))) - (and remote (string-equal (match-string 2) "*") + (propstat (cdr (assq (aref (match-string 2) 0) state-map))) + (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)) + (and remote (string-equal (match-string 3) "*") ;; FIXME are there other possible combinations? (cond ((eq state 'edited) (setq state 'needs-merge)) ((not state) (setq state 'needs-update)))) @@ -262,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. @@ -272,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.") @@ -335,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") @@ -374,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*") @@ -396,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 @@ -426,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")) @@ -519,7 +537,7 @@ or svn+ssh://." (let* ((switches (if vc-svn-diff-switches (vc-switches 'SVN 'diff) - (list "--diff-cmd=diff" "-x" + (list (concat "--diff-cmd=" diff-command) "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) (async (and (not vc-disable-async-diff) (vc-stay-local-p files 'SVN) @@ -582,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. @@ -643,7 +658,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." "Parse output of \"svn status\" command in the current buffer. Set file properties accordingly. Unless FILENAME is non-nil, parse only information about FILENAME and return its status." - (let (file status) + (let (file status propstat) (goto-char (point-min)) (while (re-search-forward ;; Ignore the files with status X. @@ -653,7 +668,9 @@ information about FILENAME and return its status." (setq file (or filename (expand-file-name (buffer-substring (point) (line-end-position))))) - (setq status (char-after (line-beginning-position))) + (setq status (char-after (line-beginning-position)) + ;; Status of the item's properties ([ MC]). + propstat (char-after (1+ (line-beginning-position)))) (if (eq status ??) (vc-file-setprop file 'vc-state 'unregistered) ;; Use the last-modified revision, so that searching in vc-print-log @@ -664,7 +681,7 @@ information about FILENAME and return its status." (vc-file-setprop file 'vc-state (cond - ((eq status ?\ ) + ((and (eq status ?\ ) (eq propstat ?\ )) (if (eq (char-after (match-beginning 1)) ?*) 'needs-update (vc-file-setprop file 'vc-checkout-time @@ -675,9 +692,11 @@ information about FILENAME and return its status." (vc-file-setprop file 'vc-working-revision "0") (vc-file-setprop file 'vc-checkout-time 0) 'added) - ((eq status ?C) + ;; Conflict in contents or properties. + ((or (eq status ?C) (eq propstat ?C)) (vc-file-setprop file 'vc-state 'conflict)) - ((eq status '?M) + ;; Modified contents or properties. + ((or (eq status ?M) (eq propstat ?M)) (if (eq (char-after (match-beginning 1)) ?*) 'needs-merge 'edited)) @@ -707,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) @@ -744,5 +763,4 @@ information about FILENAME and return its status." (provide 'vc-svn) -;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d ;;; vc-svn.el ends here