changeset 21357:b0e5a2784761

(vc-next-action-dired): Use dired-do-redisplay. Handle window configuration correctly. (vc-next-action): Save window configuration for vc-next-action-dired. (vc-finish-logentry): Only kill log buffer if it does exist. (vc-dired-mode): Rewritten so that it works entirely through dired-after-readin-hook. Subdirectories are handled just as in ordinary dired. (vc-dired-hook): New function. (vc-state-info, vc-dired-reformat-line): Adapted. (vc-dired-update, vc-dired-update-line): Removed. (vc-directory): Rewritten. (vc-directory-18): Removed. (vc-dired-mark-locked): New function, bound to "*l" in vc-dired-mode. (vc-do-command): Only compute vc-name if it is really needed. (vc-fetch-cvs-status): New function. (vc-dired-hook): Use it.

--- a/lisp/vc.el	Sat Apr 04 05:21:44 1998 +0000
+++ b/lisp/vc.el	Sat Apr 04 05:22:37 1998 +0000
@@ -1,11 +1,11 @@
 ;;; vc.el --- drive a version-control system from within Emacs
 
-;; Copyright (C) 1992, 93, 94, 95, 96, 97 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
 
 ;; Author:     Eric S. Raymond <[e-mail]>
 ;; Maintainer: Andre Spiegel <[e-mail]>
 
-;; $Id: vc.el,v 1.214 1998/03/31 18:08:36 spiegel Exp spiegel $
+;; $Id: vc.el,v 1.215 1998/04/01 12:26:43 spiegel Exp rms $
 
 ;; This file is part of GNU Emacs.
 
@@ -32,7 +32,7 @@
 ;; Paul Eggert <[e-mail]>, Sebastian Kremer <[e-mail]>,
 ;; and Richard Stallman contributed valuable criticism, support, and testing.
 ;; CVS support was added by Per Cederqvist <[e-mail]>
-;; in Jan-Feb 1994.  Further enhancements came from ttn.netcom.com and
+;; in Jan-Feb 1994.  Further enhancements came from [e-mail] and
 ;; Andre Spiegel <[e-mail]>.
 ;;
 ;; Supported version-control systems presently include SCCS, RCS, and CVS.
@@ -540,9 +540,8 @@
       (message "Running %s on %s..." command file))
   (let ((obuf (current-buffer)) (camefrom (current-buffer))
 	(squeezed nil)
-	(vc-file (and file (vc-name file)))
 	(olddir default-directory)
-	status)
+	vc-file status)
     (set-buffer (get-buffer-create buffer))
     (set (make-local-variable 'vc-parent-buffer) camefrom)
     (set (make-local-variable 'vc-parent-buffer-name)
@@ -554,7 +553,7 @@
     (mapcar
      (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
      flags)
-    (if (and vc-file (eq last 'MASTER))
+    (if (and (eq last 'MASTER) file (setq vc-file (vc-name file)))
 	(setq squeezed (append squeezed (list vc-file))))
     (if (and file (eq last 'WORKFILE))
 	(progn
@@ -893,8 +892,7 @@
 (defun vc-next-action-dired (file rev comment)
   ;; Do a vc-next-action-on-file on all the marked files, possibly 
   ;; passing on the log comment we've just entered.
-  (let ((configuration (current-window-configuration))
-	(dired-buffer (current-buffer))
+  (let ((dired-buffer (current-buffer))
 	(dired-dir default-directory))
     (dired-map-over-marks
      (let ((file (dired-get-filename)) p
@@ -906,10 +904,11 @@
        (vc-next-action-on-file file nil comment)
        (set-buffer dired-buffer)
        (setq default-directory dired-dir)
-       (vc-dired-update-line file)
-       (set-window-configuration configuration)
+       (dired-do-redisplay file)
+       (set-window-configuration vc-dired-window-configuration)
        (message "Processing %s...done" file))
-    nil t)))
+    nil t))
+  (dired-move-to-filename))
 
 ;; Here's the major entry point.
 
@@ -956,6 +955,8 @@
   (catch 'nogo
     (if vc-dired-mode
 	(let ((files (dired-get-marked-files)))
+          (set (make-local-variable 'vc-dired-window-configuration)
+               (current-window-configuration))
 	  (if (string= "" 
 		 (mapconcat
 	             (function (lambda (f)
@@ -1231,11 +1232,14 @@
     ;; Remove checkin window (after the checkin so that if that fails
     ;; we don't zap the *VC-log* buffer and the typing therein).
     (let ((logbuf (get-buffer "*VC-log*")))
-      (delete-windows-on logbuf)
-      (kill-buffer logbuf))
+      (cond (logbuf
+             (delete-windows-on logbuf)
+             (kill-buffer logbuf))))
     ;; Now make sure we see the expanded headers
     (if buffer-file-name
 	(vc-resynch-window buffer-file-name vc-keep-workfiles t))
+    (if vc-dired-mode 
+        (dired-move-to-filename))
     (run-hooks after-hook 'vc-finish-logentry-hook)))
 
 ;; Code for access to the comment ring
@@ -1568,42 +1572,69 @@
 ;; All VC commands get mapped into logical equivalents.
 
 (define-derived-mode vc-dired-mode dired-mode "Dired under VC"
-  "The major mode used in VC directory buffers.  It is derived from Dired.
-All Dired commands operate normally.  Users currently locking listed files
-are listed in place of the file's owner and group.
-Keystrokes bound to VC commands will execute as though they had been called
-on a buffer attached to the file named in the current Dired buffer line."
+  "The major mode used in VC directory buffers.  It works like Dired,
+but lists only files under version control, with the current VC state of 
+each file being indicated in the place of the file's link count, owner, 
+group and size.  Subdirectories are also listed, and you may insert them 
+into the buffer as desired, like in Dired.
+  All Dired commands operate normally, with the exception of `v', which
+is redefined as the version control prefix, so that you can type 
+`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
+the file named in the current Dired buffer line.  `vv' invokes
+`vc-next-action' on this file, or on all files currently marked.
+There is a special command, `*l', to mark all files currently locked."
+  (make-local-variable 'dired-after-readin-hook)
+  (add-hook 'dired-after-readin-hook 'vc-dired-hook)
   (setq vc-dired-mode t))
 
 (define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
-(define-key vc-dired-mode-map "g" 'vc-dired-update)
+(define-key vc-dired-mode-map "v" vc-prefix-map)
 (define-key vc-dired-mode-map "=" 'vc-diff)
 
+(defun vc-dired-mark-locked ()
+  "Mark all files currently locked."
+  (interactive)
+  (dired-mark-if (let ((f (dired-get-filename nil t)))
+		   (and f
+			(not (file-directory-p f))
+			(vc-locking-user f)))
+		 "locked file"))
+
+(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
+
+(defun vc-fetch-cvs-status (dir)
+  (let ((default-directory dir))
+    (vc-do-command "*vc-info*" 0 "cvs" nil nil "status" dir)
+    (save-excursion
+      (set-buffer (get-buffer "*vc-info*"))
+      (goto-char (point-min))
+      (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
+        (narrow-to-region (match-beginning 0) (match-end 0))
+        (vc-parse-cvs-status)
+        (goto-char (point-max))
+        (widen)))))
+
 (defun vc-dired-state-info (file)
   ;; Return the string that indicates the version control status
   ;; on a VC dired line.
-  (let ((cvs-state (and (eq (vc-backend file) 'CVS)
-			(vc-cvs-status file))))
-    (if cvs-state
-	(cond ((eq cvs-state 'up-to-date) nil)
-	      ((eq cvs-state 'needs-checkout)      "patch")
-	      ((eq cvs-state 'locally-modified)    "modified")
-	      ((eq cvs-state 'needs-merge)         "merge")
-	      ((eq cvs-state 'unresolved-conflict) "conflict")
-	      ((eq cvs-state 'locally-added)       "added"))
-      (vc-locking-user file))))
+  (let* ((cvs-state (and (eq (vc-backend file) 'CVS)
+                         (vc-cvs-status file)))
+         (state 
+          (if cvs-state
+              (cond ((eq cvs-state 'up-to-date) nil)
+                    ((eq cvs-state 'needs-checkout)      "patch")
+                    ((eq cvs-state 'locally-modified)    "modified")
+                    ((eq cvs-state 'needs-merge)         "merge")
+                    ((eq cvs-state 'unresolved-conflict) "conflict")
+                    ((eq cvs-state 'locally-added)       "added"))
+            (vc-locking-user file))))
+    (if state (concat "(" state ")"))))
 
 (defun vc-dired-reformat-line (x)
-  ;; Hack a directory-listing line, plugging in locking-user info in
-  ;; place of the user and group info.  Should have the beneficial
-  ;; side-effect of shortening the listing line.  Each call starts with
-  ;; point immediately following the dired mark area on the line to be
-  ;; hacked.
-  ;;
-  ;; Simplest possible one:
-  ;; (insert (concat x "\t")))
-  ;;
+  ;; Reformat a directory-listing line, plugging in version control info in
+  ;; place of the user and group info.
   ;; This code, like dired, assumes UNIX -l format.
+  (beginning-of-line)
   (let ((pos (point)) limit perm owner date-and-file)
     (end-of-line)
     (setq limit (point))
@@ -1611,144 +1642,74 @@
     (cond
      ((or
        (re-search-forward  ;; owner and group
-"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
+"^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
 	  limit t)       
        (re-search-forward  ;; only owner displayed
-"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" 
+"^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" 
 	  limit t))
       (setq perm          (match-string 1)
 	    owner         (match-string 2)
 	    date-and-file (match-string 3)))
      ((re-search-forward  ;; OS/2 -l format, no links, owner, group
-"\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
+"^\\(..[drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
          limit t)
       (setq perm          (match-string 1)
 	    date-and-file (match-string 2))))
-    (if x (setq x (concat "(" x ")")))
-    (let ((rep (substring (concat x "                 ") 0 10)))
-      (replace-match (concat perm rep date-and-file)))))
-       
-(defun vc-dired-update-line (file)
-  ;; Update the vc-dired listing line of file -- it is assumed 
-  ;; that point is already on this line.  Don't use dired-do-redisplay
-  ;; for this, because it cannot handle the way vc-dired deals with 
-  ;; subdirectories.
-  (beginning-of-line)
-  (forward-char 2)
-  (let ((start (point)))
-    (forward-line 1)
-    (beginning-of-line)
-    (delete-region start (point))
-    (insert-directory file dired-listing-switches)
-    (forward-line -1)
-    (end-of-line)
-    (delete-char (- (length file)))
-    (insert (substring file (length (expand-file-name default-directory))))
-    (goto-char start))
-  (vc-dired-reformat-line (vc-dired-state-info file)))
+    (setq x (substring (concat x "          ") 0 10))
+    (replace-match (concat perm x date-and-file))))
 
-(defun vc-dired-update (verbose)
-  (interactive "P")
-  (vc-directory default-directory verbose))
+(defun vc-dired-hook ()
+  ;; Called by dired after any portion of a vc-dired buffer has been read in.
+  ;; Reformat the listing according to version control.
+  (message "Getting version information... ")
+  (let (subdir filename (buffer-read-only nil))
+    (goto-char (point-min))
+    (while (not (eq (point) (point-max)))
+      (cond 
+       ;; subdir header line
+       ((setq subdir (dired-get-subdir))
+        (if (file-directory-p (concat subdir "/CVS"))
+            (vc-fetch-cvs-status (file-name-as-directory subdir)))
+        (forward-line 1)
+        ;; erase (but don't remove) the "total" line
+        (let ((start (point)))
+          (end-of-line)
+          (delete-region start (point))
+          (beginning-of-line)
+          (forward-line 1)))
+       ;; an ordinary file line
+       ((setq filename (dired-get-filename nil t))
+        (cond
+         ((file-directory-p filename)
+          (if (member (file-name-nondirectory filename) 
+                      vc-directory-exclusion-list)
+              (dired-kill-line)
+            (vc-dired-reformat-line nil)
+            (forward-line 1)))
+         ((vc-backend filename)
+          (vc-dired-reformat-line (vc-dired-state-info filename))
+          (forward-line 1))
+         (t 
+          (dired-kill-line))))
+       ;; any other line
+       (t (forward-line 1)))))
+  (message "Getting version information... done"))
 
-;;; Note in Emacs 18 the following defun gets overridden
-;;; with the symbol 'vc-directory-18.  See below.
 ;;;###autoload
-(defun vc-directory (dirname verbose)
-  "Show version-control status of the current directory and subdirectories.
-Normally it creates a Dired buffer that lists only the locked files
-in all these directories.  With a prefix argument, it lists all files."
+(defun vc-directory (dirname read-switches)
   (interactive "DDired under VC (directory): \nP")
-  (require 'dired)
-  (setq dirname (expand-file-name dirname))
-  ;; force a trailing slash
-  (if (not (eq (elt dirname (1- (length dirname))) ?/))
-      (setq dirname (concat dirname "/")))
-  (let (nonempty
-	(dl (length dirname))
-	(filelist nil) (statelist nil)
-	(old-dir default-directory)
-	dired-buf
-	dired-buf-mod-count)
-    (vc-file-tree-walk
-     dirname
-     (function 
-      (lambda (f)
-	(if (vc-registered f)
-	    (let ((state (vc-dired-state-info f)))
-	      (and (or verbose state)
-		   (setq filelist (cons (substring f dl) filelist))
-		   (setq statelist (cons state statelist))))))))
-    (save-window-excursion
-      (save-excursion
-	;; This uses a semi-documented feature of dired; giving a switch
-	;; argument forces the buffer to refresh each time.
-	(setq dired-buf
-	      (dired-internal-noselect
-	       (cons dirname (nreverse filelist))
-	       dired-listing-switches 'vc-dired-mode))
-	(setq nonempty (not (eq 0 (length filelist))))))
-    (switch-to-buffer dired-buf)
-    ;; Make a few modifications to the header
-    (setq buffer-read-only nil)
-    (goto-char (point-min))
-    (forward-line 1)	      ;; Skip header line
-    (let ((start (point)))    ;; Erase (but don't remove) the 
-      (end-of-line)           ;; "wildcard" line.
-      (delete-region start (point)))
-    (beginning-of-line)
-    (if nonempty
-	(progn
-	  ;; Plug the version information into the individual lines
-	  (mapcar
-	   (function
-	    (lambda (x)
-	     (forward-char 2)	;; skip dired's mark area
-	     (vc-dired-reformat-line x)
-	     (forward-line 1)))	;; go to next line
-	   (nreverse statelist))
-	  (setq buffer-read-only t)
-	  (goto-char (point-min))
-	  (dired-next-line 2)
-	  )
-      (dired-next-line 1) 
-      (insert "  ")
-      (setq buffer-read-only t)
-      (message "No files are currently %s under %s"
-	       (if verbose "registered" "locked") dirname))
-    ))
-
-;; Emacs 18 version
-(defun vc-directory-18 (verbose)
-  "Show version-control status of all files under the current directory."
-  (interactive "P")
-  (let (nonempty (dir default-directory))
-    (save-excursion
-      (set-buffer (get-buffer-create "*vc-status*"))
-      (erase-buffer)
-      (cd dir)
-      (vc-file-tree-walk
-       default-directory
-       (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)
-	  (goto-char (point-min))
-	  (shrink-window-if-larger-than-buffer)))
-      (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))
+  (let ((switches 
+         (if read-switches (read-string "Dired listing switches: "
+                                        dired-listing-switches))))
+    (require 'dired)
+    (require 'dired-aux)
+    ;; force a trailing slash
+    (if (not (eq (elt dirname (1- (length dirname))) ?/))
+        (setq dirname (concat dirname "/")))
+    (switch-to-buffer 
+     (dired-internal-noselect (expand-file-name dirname)
+                              (or switches dired-listing-switches)
+                              'vc-dired-mode))))
 
 ;; Named-configuration support for SCCS