]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-svn.el
(pop-up-frame-function): Remove choice nil since it
[gnu-emacs] / lisp / vc-svn.el
index 053c7fd1965d3e01df9390d63a45e04481ce46a5..6eeb8985bfd125c094ad34a82baa9d5b19a511fe 100644 (file)
@@ -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 <monnier@gnu.org>
 
 ;; 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 <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;; 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"
   :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
 ;;;
@@ -111,9 +119,6 @@ If you want to force an empty list of arguments, use t."
 ;;;###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 (concat vc-svn-admin-directory
@@ -147,18 +152,9 @@ 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)
+;; 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 . conflict)
                      (?D . removed)
@@ -168,12 +164,19 @@ If you 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.
+             "^\\(.\\)....\\(.\\) \\(.*\\)$"))
        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)))
-       (when state
+           (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 (and state (not (string= "." filename)))
          (setq result (cons (list filename state) result)))))
     (funcall callback result)))
 
@@ -181,10 +184,40 @@ If you want to force an empty list of arguments, use t."
   "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."
-  (vc-svn-command (current-buffer) 'async nil "status")
+  ;; FIXME should this rather be all the files in dir?
+  ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up
+  ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR
+  ;; which is VERY SLOW for big trees and it makes emacs
+  ;; completely unresponsive during that time.
+  (let* ((local (and nil (vc-stay-local-p dir)))
+        (remote (or t (not local) (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'."
   ;; There is no need to consult RCS headers under SVN, because we
@@ -193,11 +226,6 @@ 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 (files)
-  "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.
 
@@ -225,16 +253,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)
@@ -288,7 +315,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))
 
@@ -384,12 +411,12 @@ 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.
+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
-      (vc-do-command (current-buffer) 0 "svn" nil "info")
+      (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"))
@@ -406,17 +433,17 @@ or svn+ssh://."
        ;; Repository Root is a local file.
        (progn
          (unless (vc-do-command
-                  nil 0 "svnadmin" nil
-                  "setlog" "--bypass-hooks" directory 
+                  "*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 nil 0 "scp" nil "-q" tempfile remotefile)
+      (unless (vc-do-command "*vc*" 0 "scp" nil "-q" tempfile remotefile)
        (error "Copy of comment to %s failed" remotefile))
       (unless (vc-do-command
-              nil 0 "ssh" nil "-q" host
+              "*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")))))
@@ -425,6 +452,12 @@ or svn+ssh://."
 ;;; 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 +481,11 @@ or svn+ssh://."
        ;; 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
+       (not newvers)
+       files
        (catch 'no
         (dolist (f files)
           (or (equal oldvers (vc-working-revision f))
@@ -469,7 +499,8 @@ or svn+ssh://."
   (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 +518,20 @@ or svn+ssh://."
        (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,19 +558,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-root (dir)
-  (vc-find-root dir vc-svn-admin-directory t))
-
 (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
@@ -603,7 +626,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
@@ -612,9 +635,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))
@@ -645,11 +665,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."
@@ -673,6 +689,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))