X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/68e7476278a3dc4bd13dab63cc23bc0e671e5525..1cc3c18fd41142d2d7f9c2252c526ed45792a2ab:/lisp/vc-svn.el diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index 868680375c..5c444ffee7 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -1,16 +1,17 @@ ;;; vc-svn.el --- non-resident support for Subversion version-control -;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +19,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -36,8 +35,14 @@ ;;; Customization options ;;; +;; FIXME there is also svnadmin. +(defcustom vc-svn-program "svn" + "Name of the SVN executable." + :type 'string + :group 'vc) + (defcustom vc-svn-global-switches nil - "*Global switches to pass to any SVN command." + "Global switches to pass to any SVN command." :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" @@ -47,22 +52,24 @@ :group 'vc) (defcustom vc-svn-register-switches nil - "*Extra switches for registering a file into SVN. + "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) +\\[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) (string :tag "Argument String") - (repeat :tag "Argument List" - :value ("") - string)) + (repeat :tag "Argument List" :value ("") string)) :version "22.1" :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." +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." :type '(choice (const :tag "Unspecified" nil) (const :tag "None" t) (string :tag "Argument String") @@ -73,7 +80,7 @@ If you want to force an empty list of arguments, use t." :group 'vc) (defcustom vc-svn-header (or (cdr (assoc 'SVN vc-header-alist)) '("\$Id\$")) - "*Header keywords to be inserted by `vc-insert-headers'." + "Header keywords to be inserted by `vc-insert-headers'." :version "22.1" :type '(repeat string) :group 'vc) @@ -91,8 +98,9 @@ If you want to force an empty list of arguments, use t." ;;; Properties of the backend -(defun vc-svn-revision-granularity () - 'repository) +(defun vc-svn-revision-granularity () 'repository) +(defun vc-svn-checkout-model (files) 'implicit) + ;;; ;;; State-querying functions ;;; @@ -147,45 +155,67 @@ If you want to force an empty list of arguments, use t." "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 and its subdirectories." - (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 - (buffer-disable-undo) ;; Because these buffers can get huge - (vc-svn-command t 0 nil "status" (if localp "-v" "-u")) - (vc-svn-parse-status)))) - -(defun vc-svn-after-dir-status (callback buffer) +;; 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) (let ((state-map '((?A . added) - (?C . edited) - (?D . removed) - (?I . ignored) - (?M . edited) - (?R . removed) - (?? . unregistered) - ;; This is what vc-svn-parse-status does. - (?~ . edited))) + (?C . conflict) + (?D . removed) + (?I . ignored) + (?M . edited) + (?R . removed) + (?? . 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. + "^\\(.\\)....\\(.\\) \\(.*\\)$")) result) (goto-char (point-min)) - (while (re-search-forward "^\\(.\\)..... \\(.*\\)$" nil t) + (while (re-search-forward re nil t) (let ((state (cdr (assq (aref (match-string 1) 0) state-map))) - (filename (match-string 2))) + (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)))) (when state - (setq result (cons (cons filename state) result))))) - (funcall callback result buffer))) + (setq result (cons (list filename state) result))))) + (funcall callback result))) -(defun vc-svn-dir-status (dir callback buffer) +(defun vc-svn-dir-status (dir callback) "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." - (with-current-buffer (get-buffer-create - (generate-new-buffer-name " *vc svn status*")) - (vc-svn-command (current-buffer) 'async nil "status") - (vc-exec-after - `(vc-svn-after-dir-status (quote ,callback) ,buffer)))) + ;; FIXME should this rather be all the files in dir? + (let* ((local (vc-stay-local-p dir)) + (remote (and local (not (eq local 'only-file))))) + (vc-svn-command (current-buffer) 'async nil "status" + (if remote "-u")) + (vc-exec-after + `(vc-svn-after-dir-status (quote ,callback) ,remote)))) + +(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)))) + +(defun vc-svn-dir-extra-headers (dir) + "Generate extra status headers for a Subversion working copy." + (vc-svn-command "*vc*" 0 nil "info") + (let ((repo + (save-excursion + (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 ""))))) (defun vc-svn-working-revision (file) "SVN-specific version of `vc-working-revision'." @@ -195,25 +225,9 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (vc-svn-registered file) (vc-file-getprop file 'vc-working-revision)) -(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-working-revision file) "0") - "(added)" "(modified)")) - (t - ;; fall back to the default VC representation - (vc-default-dired-state-info 'SVN file))))) - - (defun vc-svn-previous-revision (file rev) (let ((newrev (1- (string-to-number rev)))) (when (< 0 newrev) @@ -238,16 +252,15 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (defun vc-svn-create-repo () "Create a new SVN repository." - (vc-do-command nil 0 "svnadmin" '("create" "SVN")) - (vc-do-command nil 0 "svn" '(".") + (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN")) + (vc-do-command "*vc*" 0 vc-svn-program '(".") "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. - -`vc-register-switches' and `vc-svn-register-switches' are passed to -the SVN command (in that order)." +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) @@ -263,7 +276,7 @@ This is only possible if SVN is responsible for FILE's directory.") (defun vc-svn-checkin (files rev comment) "SVN-specific version of `vc-backend-checkin'." - (if rev (error "Committing to a specific revision is unsupported in SVN.")) + (if rev (error "Committing to a specific revision is unsupported in SVN")) (let ((status (apply 'vc-svn-command nil 1 files "ci" (nconc (list "-m" comment) (vc-switches 'SVN 'checkin))))) @@ -301,7 +314,7 @@ This is only possible if SVN is responsible for FILE's directory.") (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-svn-update file editable rev (vc-switches 'SVN 'checkout))) (vc-mode-line file) (message "Checking out %s...done" file)) @@ -313,8 +326,6 @@ This is only possible if SVN is responsible for FILE's directory.") (vc-file-setprop file 'vc-working-revision 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) @@ -399,32 +410,53 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (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 -uses locally for temp files must also be writeable by you on that host." - (vc-do-command nil 0 "svn" nil "info") - (set-buffer "*vc*") - (goto-char (point-min)) - (unless (re-search-forward "Repository Root: svn\\+ssh://\\([^/]+\\)\\(/.*\\)" nil t) - (error "Repository information is unavailable.")) - (let* ((tempfile (make-temp-file user-mail-address)) - (host (match-string 1)) - (directory (match-string 2)) - (remotefile (concat host ":" tempfile))) +uses locally for temp files must also be writable by you on that host. +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 - (insert comment) - (write-region (point-min) (point-max) tempfile)) - (unless (vc-do-command nil 0 "scp" nil "-q" tempfile remotefile) - (error "Copy of comment to %s failed" remotefile)) - (unless (vc-do-command nil 0 "ssh" nil - "-q" host - (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s" - directory rev tempfile tempfile)) - (error "Log edit failed")) - )) + (vc-do-command (current-buffer) 0 vc-svn-program nil "info") + (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 + "*vc*" 0 "svnadmin" nil + "setlog" "--bypass-hooks" directory + "-r" rev (format "%s" tempfile)) + (error "Log edit failed")) + (delete-file tempfile)) + + ;; Remote repository, using svn+ssh. + (unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile) + (error "Copy of comment to %s failed" remotefile)) + (unless (vc-do-command + "*vc*" 0 "ssh" nil "-q" host + (format "svnadmin setlog --bypass-hooks %s -r %s %s; rm %s" + directory rev tempfile tempfile)) + (error "Log edit failed"))))) ;;; ;;; History functions ;;; +(defvar log-view-per-file-logs) + +(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)) + (defun vc-svn-print-log (files &optional buffer) "Get change log(s) associated with FILES." (save-current-buffer @@ -448,14 +480,10 @@ uses locally for temp files must also be writeable by you on that host." ;; Dump log for the entire directory. (vc-svn-command buffer 0 nil "log" "-rHEAD:0"))))) -(defun vc-svn-wash-log () - "Remove all non-comment information from log output." - ;; FIXME: not implemented for SVN - nil) - (defun vc-svn-diff (files &optional oldvers newvers buffer) "Get a difference report using SVN between two revisions of fileset FILES." (and oldvers + files (catch 'no (dolist (f files) (or (equal oldvers (vc-working-revision f)) @@ -469,7 +497,8 @@ uses locally for temp files must also be writeable by you on that host." (let* ((switches (if vc-svn-diff-switches (vc-switches 'SVN 'diff) - (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) + (list "--diff-cmd=diff" "-x" + (mapconcat 'identity (vc-switches nil 'diff) " ")))) (async (and (not vc-disable-async-diff) (vc-stay-local-p files) (or oldvers newvers)))) ; Svn diffs those locally. @@ -487,20 +516,20 @@ uses locally for temp files must also be writeable by you on that host." (buffer-size (get-buffer buffer))))) ;;; -;;; Snapshot system +;;; Tag system ;;; -(defun vc-svn-create-snapshot (dir name branchp) +(defun vc-svn-create-tag (dir name branchp) "Assign to DIR's current revision 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))) + (when branchp (vc-svn-retrieve-tag 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'. +(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'. 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) @@ -527,16 +556,11 @@ NAME is assumed to be a URL." ;;; Internal functions ;;; -(defcustom vc-svn-program "svn" - "Name of the svn executable." - :type 'string - :group 'vc) - (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 buffer okstatus vc-svn-program file-or-list + (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list (if (stringp vc-svn-global-switches) (cons vc-svn-global-switches flags) (append vc-svn-global-switches @@ -600,7 +624,7 @@ information about FILENAME and return its status." (goto-char (point-min)) (while (re-search-forward ;; Ignore the files with status X. - "^\\(\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) + "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) ;; 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 @@ -609,9 +633,6 @@ information about FILENAME and return its status." (setq status (char-after (line-beginning-position))) (if (eq status ??) (vc-file-setprop file 'vc-state 'unregistered) - ;; `vc-BACKEND-registered' must not set vc-backend, - ;; which is instead set in vc-registered. - (unless filename (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-working-revision (match-string 3)) @@ -622,7 +643,7 @@ information about FILENAME and return its status." (cond ((eq status ?\ ) (if (eq (char-after (match-beginning 1)) ?*) - 'needs-patch + 'needs-update (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) 'up-to-date)) @@ -631,7 +652,9 @@ information about FILENAME and return its status." (vc-file-setprop file 'vc-working-revision "0") (vc-file-setprop file 'vc-checkout-time 0) 'added) - ((memq status '(?M ?C)) + ((eq status ?C) + (vc-file-setprop file 'vc-state 'conflict)) + ((eq status '?M) (if (eq (char-after (match-beginning 1)) ?*) 'needs-merge 'edited)) @@ -640,11 +663,7 @@ information about FILENAME and return its status." ((eq status ?R) (vc-file-setprop file 'vc-state 'removed)) (t 'edited))))) - (if filename (vc-file-getprop filename 'vc-state)))) - -(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)) + (when filename (vc-file-getprop filename 'vc-state)))) (defun vc-svn-valid-symbolic-tag-name-p (tag) "Return non-nil if TAG is a valid symbolic tag name." @@ -668,6 +687,8 @@ information about FILENAME and return its status." ;; Arbitrarily assume 10 commmits per day. (/ (string-to-number rev) 10.0)) +(defvar vc-annotate-parent-rev) + (defun vc-svn-annotate-current-time () (vc-svn-annotate-time-of-rev vc-annotate-parent-rev))