[bpt/emacs.git] / lisp / vc-svn.el

;;; vc-svn.el --- non-resident support for Subversion version-control

;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;;           Free Software Foundation, Inc.

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

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; 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
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This is preliminary support for Subversion (http://subversion.tigris.org/).
;; It started as `sed s/cvs/svn/ vc.cvs.el' (from version 1.56)
;; and hasn't been completely fixed since.

;; Sync'd with Subversion's vc-svn.el as of revision 5801.

;;; Bugs:

;; - VC-dired is (really) slow.

;;; Code:

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

;;;
;;; Customization options
;;;

(defcustom vc-svn-global-switches nil
  "*Global switches to pass to any SVN command."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :version "21.4"
  :group 'vc)

(defcustom vc-svn-register-switches nil
  "*Extra switches for registering a file into SVN.
A string or list of strings passed to the checkin program by
\\[vc-register]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :version "21.4"
  :group 'vc)

(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'.
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")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :version "21.4"
  :group 'vc)

(defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$"))
  "*Header keywords to be inserted by `vc-insert-headers'."
  :version "21.4"
  :type '(repeat string)
  :group 'vc)

(defconst vc-svn-use-edit nil
  ;; Subversion does not provide this feature (yet).
  "*Non-nil means to use `svn edit' to \"check out\" a file.
This is only meaningful if you don't use the implicit checkout model
\(i.e. if you have $SVNREAD set)."
  ;; :type 'boolean
  ;; :version "21.4"
  ;; :group 'vc
  )

;;;
;;; State-querying functions
;;;

;;;###autoload (defun vc-svn-registered (f)
;;;###autoload   (when (file-readable-p (expand-file-name
;;;###autoload 			  ".svn/entries" (file-name-directory f)))
;;;###autoload       (load "vc-svn")
;;;###autoload       (vc-svn-registered f)))

;;;###autoload
(add-to-list 'completion-ignored-extensions ".svn/")

(defun vc-svn-registered (file)
  "Check if FILE is SVN registered."
  (when (file-readable-p (expand-file-name ".svn/entries"
					   (file-name-directory file)))
    (with-temp-buffer
      (cd (file-name-directory file))
      (condition-case nil
	  (vc-svn-command t 0 file "status" "-v")
	;; We can't find an `svn' executable.  We could also deregister SVN.
	(file-error nil))
      (vc-svn-parse-status t)
      (eq 'SVN (vc-file-getprop file 'vc-backend)))))

(defun vc-svn-state (file &optional localp)
  "SVN-specific version of `vc-state'."
  (setq localp (or localp (vc-stay-local-p file)))
  (with-temp-buffer
    (cd (file-name-directory file))
    (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
    (vc-svn-parse-status localp)
    (vc-file-getprop file 'vc-state)))

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

(defun vc-svn-dir-state (dir &optional localp)
  "Find the SVN state of all files in DIR."
  (setq localp (or localp (vc-stay-local-p dir)))
  (let ((default-directory dir))
    ;; Don't specify DIR in this command, the default-directory is
    ;; enough.  Otherwise it might fail with remote repositories.
    (with-temp-buffer
      (vc-svn-command t 0 nil "status" (if localp "-v" "-u"))
      (vc-svn-parse-status localp))))

(defun vc-svn-workfile-version (file)
  "SVN-specific version of `vc-workfile-version'."
  ;; 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)
  (vc-file-getprop file 'vc-workfile-version))

(defun vc-svn-checkout-model (file)
  "SVN-specific version of `vc-checkout-model'."
  ;; It looks like Subversion has no equivalent of CVSREAD.
  'implicit)

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

(defun vc-svn-dired-state-info (file)
  "SVN-specific version of `vc-dired-state-info'."
  (let ((svn-state (vc-state file)))
    (cond ((eq svn-state 'edited)
	   (if (equal (vc-workfile-version file) "0")
	       "(added)" "(modified)"))
	  ((eq svn-state 'needs-patch) "(patch)")
	  ((eq svn-state 'needs-merge) "(merge)"))))


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

(defun vc-svn-register (file &optional rev comment)
  "Register FILE into the SVN version-control system.
COMMENT can be used to provide an initial description of FILE.

`vc-register-switches' and `vc-svn-register-switches' are passed to
the SVN command (in that order)."
  (apply 'vc-svn-command nil 0 file "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 ".svn"
				      (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.")

(defun vc-svn-checkin (file rev comment)
  "SVN-specific version of `vc-backend-checkin'."
  (let ((status (apply
                 'vc-svn-command nil 1 file "ci"
                 (nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
    (set-buffer "*vc*")
    (goto-char (point-min))
    (unless (equal status 0)
      ;; Check checkin problem.
      (cond
       ((search-forward "Transaction is out of date" nil t)
        (vc-file-setprop file 'vc-state 'needs-merge)
        (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
    ;;  file 'vc-workfile-version
    ;;  (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
    ))

(defun vc-svn-find-version (file rev buffer)
  (apply 'vc-svn-command
	 buffer 0 file
	 "cat"
	 (and rev (not (string= rev ""))
	      (concat "-r" rev))
	 (vc-switches 'SVN 'checkout)))

(defun vc-svn-checkout (file &optional editable rev)
  (message "Checking out %s..." file)
  (with-current-buffer (or (get-file-buffer file) (current-buffer))
    (vc-call update file editable rev (vc-switches 'SVN 'checkout)))
  (vc-mode-line file)
  (message "Checking out %s...done" file))

(defun vc-svn-update (file editable rev switches)
  (if (and (file-exists-p file) (not rev))
      ;; If no revision was specified, just make the file writable
      ;; if necessary (using `svn-edit' if requested).
      (and editable (not (eq (vc-svn-checkout-model file) 'implicit))
	   (if vc-svn-use-edit
	       (vc-svn-command nil 0 file "edit")
	     (set-file-modes file (logior (file-modes file) 128))
	     (if (equal file buffer-file-name) (toggle-read-only -1))))
    ;; Check out a particular version (or recreate the file).
    (vc-file-setprop file 'vc-workfile-version nil)
    (apply 'vc-svn-command nil 0 file
	   "update"
	   ;; default for verbose checkout: clear the sticky tag so
	   ;; that the actual update will get the head of the trunk
	   (cond
	    ((null rev) "-rBASE")
	    ((or (eq rev t) (equal rev "")) nil)
	    (t (concat "-r" rev)))
	   switches)))

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

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

(defun vc-svn-revert (file &optional contents-done)
  "Revert FILE to the version it was based on."
  (unless contents-done
    (vc-svn-command nil 0 file "revert"))
  (unless (eq (vc-checkout-model file) 'implicit)
    (if vc-svn-use-edit
        (vc-svn-command nil 0 file "unedit")
      ;; Make the file read-only by switching off all w-bits
      (set-file-modes file (logand (file-modes file) 3950)))))

(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
                 "merge"
		 "-r" (if second-version
			(concat first-version ":" second-version)
		      first-version))
  (vc-file-setprop file 'vc-state 'edited)
  (with-current-buffer (get-buffer "*vc*")
    (goto-char (point-min))
    (if (looking-at "C  ")
        1				; signal conflict
      0)))				; signal success

(defun vc-svn-merge-news (file)
  "Merge in any new changes made to FILE."
  (message "Merging changes into %s..." file)
  ;; (vc-file-setprop file 'vc-workfile-version nil)
  (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))
    ;; get new workfile version
    (if (re-search-forward
	 "^\\(Updated to\\|At\\) revision \\([0-9]+\\)" nil t)
	(vc-file-setprop file 'vc-workfile-version (match-string 2))
      (vc-file-setprop file 'vc-workfile-version nil))
    ;; get file status
    (goto-char (point-min))
    (prog1
        (if (looking-at "At revision")
            0 ;; there were no news; indicate success
          (if (re-search-forward
               (concat "^\\([CGDU]  \\)?"
                       (regexp-quote (file-name-nondirectory file)))
               nil t)
              (cond
               ;; Merge successful, we are in sync with repository now
               ((string= (match-string 1) "U  ")
                (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
               ((string= (match-string 1) "G  ")
                (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))))


;;;
;;; History functions
;;;

(defun vc-svn-print-log (file &optional buffer)
  "Get change log associated with FILE."
  (save-current-buffer
    (vc-setup-buffer buffer)
    (let ((inhibit-read-only t))
      (goto-char (point-min))
      ;; Add a line to tell log-view-mode what file this is.
      (insert "Working file: " (file-relative-name file) "\n"))
    (vc-svn-command
     buffer
     (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
     file "log")))

(defun vc-svn-diff (file &optional oldvers newvers buffer)
  "Get a difference report using SVN between two versions of FILE."
  (unless buffer (setq buffer "*vc-diff*"))
  (if (and oldvers (equal oldvers (vc-workfile-version file)))
      ;; Use nil rather than the current revision because svn handles it
      ;; better (i.e. locally).
      (setq oldvers nil))
  (if (string= (vc-workfile-version file) "0")
      ;; This file is added but not yet committed; there is no master file.
      (if (or oldvers newvers)
	  (error "No revisions of %s exist" file)
	;; We regard this as "changed".
	;; Diff it against /dev/null.
	;; Note: this is NOT a "svn diff".
	(apply 'vc-do-command buffer
	       1 "diff" file
	       (append (vc-switches nil 'diff) '("/dev/null")))
	;; Even if it's empty, it's locally modified.
	1)
    (let* ((switches
	    (if vc-svn-diff-switches
		(vc-switches 'SVN 'diff)
	      (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " "))))
	   (async (and (vc-stay-local-p file)
		       (or oldvers newvers) ; Svn diffs those locally.
		       (fboundp 'start-process))))
      (apply 'vc-svn-command buffer
	     (if async 'async 0)
	     file "diff"
	     (append
	      switches
	      (when oldvers
		(list "-r" (if newvers (concat oldvers ":" newvers)
			     oldvers)))))
      (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.
	(buffer-size (get-buffer buffer))))))

(defun vc-svn-diff-tree (dir &optional rev1 rev2)
  "Diff all files at and below DIR."
  (vc-svn-diff (file-name-as-directory dir) rev1 rev2))

;;;
;;; Snapshot system
;;;

(defun vc-svn-create-snapshot (dir name branchp)
  "Assign to DIR's current version a given NAME.
If BRANCHP is non-nil, the name is created as a branch (and the current
workspace is immediately moved to that new branch).
NAME is assumed to be a URL."
  (vc-svn-command nil 0 dir "copy" name)
  (when branchp (vc-svn-retrieve-snapshot dir name nil)))

(defun vc-svn-retrieve-snapshot (dir name update)
  "Retrieve a snapshot at and below DIR.
NAME is the name of the snapshot; if it is empty, do a `svn update'.
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'.
  )

;;;
;;; Miscellaneous
;;;

;; Subversion makes backups for us, so don't bother.
;; (defalias 'vc-svn-make-version-backups-p 'vc-stay-local-p
;;   "Return non-nil if version backups should be made for FILE.")

(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
;;;

(defun vc-svn-command (buffer okstatus file &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 buffer okstatus "svn" file
         (if (stringp vc-svn-global-switches)
             (cons vc-svn-global-switches flags)
           (append vc-svn-global-switches
                   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 ".svn/entries" dirname)))
    (goto-char (point-min))
    (when (re-search-forward
	   ;; Old `svn' used name="svn:dir", newer use just name="".
	   (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*"
		   "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?"
		   "url=\"\\([^\"]+\\)\"") 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.
      (match-string 1))))

(defun vc-svn-parse-status (localp)
  "Parse output of \"svn status\" command in the current buffer.
Set file properties accordingly.  Unless FULL is t, parse only
essential information."
  (let (file status)
    (goto-char (point-min))
    (while (re-search-forward
	    "^[ ADMCI?!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\) +" nil t)
      (setq file (expand-file-name
		  (buffer-substring (point) (line-end-position))))
      (setq status (char-after (line-beginning-position)))
      (unless (eq status ??)
	(vc-file-setprop file 'vc-backend 'SVN)
	;; Use the last-modified revision, so that searching in vc-print-log
	;; output works.
	(vc-file-setprop file 'vc-workfile-version (match-string 3))
	(vc-file-setprop
	 file 'vc-state
	 (cond
	  ((eq status ?\ )
	   (if (eq (char-after (match-beginning 1)) ?*)
	       'needs-patch
             (vc-file-setprop file 'vc-checkout-time
                              (nth 5 (file-attributes file)))
	     'up-to-date))
	  ((eq status ?A)
	   ;; If the file was actually copied, (match-string 2) is "-".
	   (vc-file-setprop file 'vc-workfile-version "0")
	   (vc-file-setprop file 'vc-checkout-time 0)
	   'edited)
	  ((memq status '(?M ?C))
	   (if (eq (char-after (match-beginning 1)) ?*)
	       'needs-merge
	     'edited))
	  (t 'edited)))))))

(defun vc-svn-dir-state-heuristic (dir)
  "Find the SVN state of all files in DIR, using only local information."
  (vc-svn-dir-state dir 'local))

(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))))

(defun vc-svn-valid-version-number-p (tag)
  "Return non-nil if TAG is a valid version number."
  (and (string-match "^[0-9]" tag)
       (not (string-match "[^0-9]" tag))))

;; Support for `svn annotate'

(defun vc-svn-annotate-command (file buf &optional rev)
  (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev))))

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

(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))))

(provide 'vc-svn)

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