Add extra-headers method for SVN.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5495a635edc73a6e17e1bd66fb242bc4ce5b2c89..151e3c2a532a070a53688122b04d274ae994bc57 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -5,6 +5,8 @@
        stale since 1995 and may now be actively misleading.
        * vc-cvs.el (vc-cvs-status-extra-headers): Extract and display the
        CVS repository.
+       * vc-svn.el (vc-svn-status-extra-headers): Extract and display the
+       SVN repository.
 
 2008-05-16  Juanma Barranquero  <lekktu@gmail.com>
 

diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index 0b0828ac23d9482711333e124423f6f990083758..8a7c2b291f76863944bb9333b9627fe7afd8100c 100644 (file)
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -173,6 +173,23 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
   (vc-exec-after
    `(vc-svn-after-dir-status (quote ,callback))))
 
+(defun vc-svn-status-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