Extract and display the CVS repository.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 99c790dc3972b65acc7f2c8b0adfb66927af168c..5495a635edc73a6e17e1bd66fb242bc4ce5b2c89 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -3,6 +3,8 @@
        * vc.el: Remove my analysis of SCCS/RCS concurrency issues from
        the end of the file, it was good work at one time but has been
        stale since 1995 and may now be actively misleading.
+       * vc-cvs.el (vc-cvs-status-extra-headers): Extract and display the
+       CVS repository.
 
 2008-05-16  Juanma Barranquero  <lekktu@gmail.com>
 

diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 90a6b7b2e1f56c2397b01a47c66a1330d3d99c10..1e9788487bc88e2741bd538febf01bd3955e435b 100644 (file)
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -922,17 +922,26 @@ state."
    `(vc-cvs-after-dir-status (quote ,update-function))))
 
 (defun vc-cvs-status-extra-headers (dir)
-  (concat
-   ;; FIXME: see how PCL-CVS gets the data to print all these
-   (propertize "Module     : " 'face 'font-lock-type-face)
-   (propertize "ADD CODE TO PRINT THE MODULE\n"
-              'face 'font-lock-warning-face)
-   (propertize "Repository : " 'face 'font-lock-type-face)
-   (propertize "ADD CODE TO PRINT THE REPOSITORY\n"
-              'face 'font-lock-warning-face)
-   (propertize "Branch     : " 'face 'font-lock-type-face)
-   (propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
-              'face 'font-lock-warning-face)))
+  (let ((repo
+        (condition-case nil 
+            (save-excursion 
+              (set-buffer (find-file-noselect "CVS/Root" t))
+              (and (looking-at ":ext:") (delete-char 5))
+              (buffer-string))
+          nil)))
+    (concat
+     ;; FIXME: see how PCL-CVS gets the data to print all these
+     (propertize "Module     : " 'face 'font-lock-type-face)
+     (propertize "ADD CODE TO PRINT THE MODULE\n"
+                'face 'font-lock-warning-face)
+     (cond (repo
+           (concat
+             (propertize "Repository : " 'face 'font-lock-type-face)
+             (propertize repo 'face 'font-lock-warning-face)))
+          (t ""))
+     (propertize "Branch     : " 'face 'font-lock-type-face)
+     (propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
+                'face 'font-lock-warning-face))))
 
 (defun vc-cvs-get-entries (dir)
   "Insert the CVS/Entries file from below DIR into the current buffer.