]> code.delx.au - gnu-emacs/blobdiff - lisp/vc-svn.el
* indent.el (indent-for-tab-command): Use use-region-p.
[gnu-emacs] / lisp / vc-svn.el
index 5aa1cf7f143659d797b8dafe72350563868d9f5c..a53b478d226e93fba2909378e7647cb3d03b9bc1 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
+;;   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:
 
@@ -91,8 +90,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,18 +147,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,11 +159,18 @@ 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)))
+           (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 (list filename state) result)))))
     (funcall callback result)))
@@ -181,10 +179,36 @@ 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?
+  (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'."
   ;; There is no need to consult RCS headers under SVN, because we
@@ -193,11 +217,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 (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.
 
@@ -225,8 +244,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 nil 0 "svnadmin" '("create" "SVN"))
-  (vc-do-command nil 0 "svn" '(".")
+  (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
+  (vc-do-command "*vc*" 0 "svn" '(".")
                 "checkout" (concat "file://" default-directory "SVN")))
 
 (defun vc-svn-register (files &optional rev comment)
@@ -288,7 +307,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))
 
@@ -300,8 +319,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)
@@ -408,17 +425,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")))))
@@ -427,6 +444,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
@@ -450,14 +473,10 @@ 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
+       files
        (catch 'no
         (dolist (f files)
           (or (equal oldvers (vc-working-revision f))
@@ -489,20 +508,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)
@@ -534,14 +553,11 @@ NAME is assumed to be a URL."
   :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
@@ -605,7 +621,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
@@ -614,9 +630,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))
@@ -627,7 +640,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))
@@ -647,11 +660,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."
@@ -675,6 +684,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))