changeset 2691:be85636d8b6e

(vc-directory-18): New function. If Emacs 18, make vc-directory alias to this.

--- a/lisp/vc.el	Sat May 08 14:55:39 1993 +0000
+++ b/lisp/vc.el	Sat May 08 16:14:11 1993 +0000
@@ -44,7 +44,7 @@
 ;;
 ;; This code depends on call-process passing back the subprocess exit
 ;; status.  Thus, you need Emacs 18.58 or later to run it.  For the
-;; vc-directory command to work properly, you need 19
+;; vc-directory command to work properly as documented, you need 19.
 ;;
 ;; The vc code maintains some internal state in order to reduce expensive
 ;; version-control operations to a minimum.  Some names are only computed
@@ -847,6 +847,8 @@
 	(replace-match (concat "\\1" rep "\\2") t)))
   )
 
+;;; Note in Emacs 18 the following defun gets overridden
+;;; with the symbol 'vc-directory-18.  See below.
 ;;;###autoload
 (defun vc-directory (verbose)
   "Show version-control status of all files under the current directory."
@@ -891,6 +893,35 @@
 	       (if verbose "registered" "locked") default-directory))
     ))
 
+;; Emacs 18 version
+(defun vc-directory-18 (verbose)
+  "Show version-control status of all files under the current directory."
+  (interactive "P")
+  (let (nonempty)
+    (save-excursion
+      (set-buffer (get-buffer-create "*vc-status*"))
+      (erase-buffer)
+      (vc-file-tree-walk
+       (function (lambda (f)
+		   (if (vc-registered f)
+		       (let ((user (vc-locking-user f)))
+			 (if (or user verbose)
+			     (insert (format
+				      "%s	%s\n"
+				      (concat user) f))))))))
+      (setq nonempty (not (zerop (buffer-size)))))
+    (if nonempty
+	(progn
+	  (pop-to-buffer "*vc-status*" t)
+	  (vc-shrink-to-fit)
+	  (goto-char (point-min)))
+      (message "No files are currently %s under %s"
+	       (if verbose "registered" "locked") default-directory))
+    ))
+
+(or (boundp 'minor-mode-map-alist)
+    (fset 'vc-directory 'vc-directory-18))
+
 ;; Named-configuration support for SCCS
 
 (defun vc-add-triple (name file rev)