changeset 2054:341337259785

(vc-update-change-log): Check that ChangeLog is writable before starting the expensive rcs2log process. Use call-process instead of shell-command to invoke rcs2log; this avoids undesired shell escapes and is more robust about errors. Put mark at point-min, so that the new insertion is in the region. (vc-checkin-hook): Fix `runs-hooks' typo. (vc-checkout-writeable-buffer-hook): New var. (vc-next-action): Fix bug: initial checkin was botched when C-x v v was applied to a new file while vc-initial-comment was non-nil. (vc-register): Don't barf when registering a new, empty buffer. (vc-directory): The `No files are currently registered' message was wrongly worded, because sometimes the message talks about locked files, not registered files. (vc-file-tree-walk): Change (apply 'funcall ...) to (apply ...), since the 'funcall is redundant. When traversing a directory tree, message "Traversing directory XXX" so that the user can see what progress is being made. Traversal can take a long time. Omit first argument, since it is always the current directory. All callers changed. (vc-file-tree-walk-internal): New function. (vc-do-command, vc-diff, vc-version-diff, vc-backend-diff): Remove redundant calls to `format'. (vc-diff): Remove unused variable `old'. (vc-version-diff): When recursively generating a difference listing, don't append the latest output unless diff was actually run; otherwise, you'll get the output from the previous file by mistake.

--- a/lisp/vc.el	Sun Mar 07 09:35:31 1993 +0000
+++ b/lisp/vc.el	Sun Mar 07 18:20:54 1993 +0000
@@ -5,7 +5,7 @@
 ;; Author: Eric S. Raymond <[e-mail]>
 ;; Version: 4.0
 
-;;	$Id: vc.el,v 1.20 1993/02/22 14:17:16 jimb Exp rms $	
+;;	$Id: vc.el,v 1.21 1993/03/07 07:44:46 rms Exp eggert $	
 
 ;; This file is part of GNU Emacs.
 
@@ -78,7 +78,7 @@
 
 ;;;###autoload
 (defvar vc-checkin-hook nil
-  "*List of functions called after a vc-checkin is done.  See `runs-hooks'.")
+  "*List of functions called after a vc-checkin is done.  See `run-hooks'.")
 
 ;; Header-insertion hair
 
@@ -102,6 +102,7 @@
 (defvar vc-log-entry-mode nil)
 (defvar vc-log-operation nil)
 (defvar vc-log-after-operation-hook nil)
+(defvar vc-checkout-writeable-buffer-hook 'vc-checkout-writeable-buffer)
 
 (defvar vc-log-file)
 (defvar vc-log-version)
@@ -149,7 +150,7 @@
 the master name of FILE; this is appended to an optional list of FLAGS."
   (setq file (expand-file-name file))
   (if vc-command-messages
-      (message (format "Running %s on %s..." command file)))
+      (message "Running %s on %s..." command file))
   (let ((obuf (current-buffer))
 	(squeezed nil)
 	(vc-file (and file (vc-name file)))
@@ -180,13 +181,13 @@
 	  (pop-to-buffer "*vc*")
 	  (vc-shrink-to-fit)
 	  (goto-char (point-min))
-	  (error (format "Running %s...FAILED (%s)" command
-			 (if (integerp status)
-			     (format "status %d" status)
-			   status)))
+	  (error "Running %s...FAILED (%s)" command
+		 (if (integerp status)
+		     (format "status %d" status)
+		   status))
 	  )
       (if vc-command-messages
-	  (message (format "Running %s...OK" command)))
+	  (message "Running %s...OK" command))
       )
     (set-buffer obuf)
     status)
@@ -300,11 +301,14 @@
 	 ;; if there is no master file corresponding, create one
 	 ((not vc-file)
 	  (vc-register verbose)
-	  (vc-next-action verbose))
+	  (if vc-initial-comment
+	      (setq vc-log-after-operation-hook
+		    'vc-checkout-writeable-buffer-hook)
+	    (vc-checkout-writeable-buffer)))
 
 	 ;; if there is no lock on the file, assert one and get it
 	 ((not (setq owner (vc-locking-user file)))
-	  (vc-checkout file t))
+	  (vc-checkout-writeable-buffer))
 
 	 ;; a checked-out version exists, but the user may not own the lock
 	 ((not (string-equal owner (user-login-name)))
@@ -341,12 +345,23 @@
 
 ;;; These functions help the vc-next-action entry point
 
+(defun vc-checkout-writeable-buffer ()
+  "Retrieve a writeable copy of the latest version of the current buffer's file."
+  (vc-checkout buffer-file-name t)
+  )
+
 ;;;###autoload
 (defun vc-register (&optional override)
   "Register the current file into your version-control system."
   (interactive "P")
   (if (vc-name buffer-file-name)
       (error "This file is already registered."))
+  ;; Watch out for new buffers of size 0: the corresponding file
+  ;; does not exist yet, even though buffer-modified-p is nil.
+  (if (and (not (buffer-modified-p))
+	   (zerop (buffer-size))
+	   (not (file-exists-p buffer-file-name)))
+      (set-buffer-modified-p t))
   (vc-buffer-sync)
   (vc-admin
    buffer-file-name
@@ -526,16 +541,12 @@
   (interactive "P")
   (if historic
       (call-interactively 'vc-version-diff)
-    (let ((old
-	   (and
-	    current-prefix-arg
-	    (read-string "Version to compare against: ")))
-	  (file buffer-file-name)
+    (let ((file buffer-file-name)
 	  unchanged)
       (vc-buffer-sync)
       (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
       (if unchanged
-	  (message (format "No changes to %s since latest version." file))
+	  (message "No changes to %s since latest version." file)
 	(pop-to-buffer "*vc*")
 	(vc-backend-diff file nil)
 	(goto-char (point-min))
@@ -561,12 +572,10 @@
 	(vc-file-tree-walk
 	 (function (lambda (f)
 		     (and
-		      (not (file-directory-p f))
 		      (vc-name f)
-		      (vc-backend-diff f rel1 rel2))
-		     (append-to-buffer "*vc-status*" (point-min) (point-max))
-		     ))
-	 default-directory)
+		      (vc-backend-diff f rel1 rel2)
+		      (append-to-buffer "*vc-status*" (point-min) (point-max)))
+		     )))
 	(pop-to-buffer "*vc-status*")
 	(insert "\nEnd of diffs.\n")
 	(goto-char (point-min))
@@ -576,7 +585,7 @@
       (vc-backend-diff file rel1 rel2)
       (goto-char (point-min))
       (if (equal (point-min) (point-max))
-	  (message (format "No changes to %s between %s and %s." file rel1 rel2))
+	  (message "No changes to %s between %s and %s." file rel1 rel2)
 	(pop-to-buffer "*vc*")
 	(goto-char (point-min))
 	)
@@ -620,8 +629,7 @@
 (defun vc-directory (verbose)
   "Show version-control status of all files under the current directory."
   (interactive "P")
-  (let ((dir (substring default-directory 0 (1- (length default-directory))))
-	nonempty)
+  (let (nonempty)
     (save-excursion
       (set-buffer (get-buffer-create "*vc-status*"))
       (erase-buffer)
@@ -632,15 +640,15 @@
 			 (if (or user verbose)
 			     (insert (format
 				      "%s	%s\n"
-				      (concat user) f)))))))
-       dir)
+				      (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 registered under %s" dir))
+      (message "No files are currently %s under %s"
+	       (if verbose "registered" "locked") default-directory))
     ))
 
 ;; Named-configuration support for SCCS
@@ -677,14 +685,12 @@
 
 (defun vc-quiescent-p ()
   ;; Is the current directory ready to be snapshot?
-  (let ((dir (substring default-directory 0 (1- (length default-directory)))))
-    (catch 'quiet
-      (vc-file-tree-walk
-       (function (lambda (f)
-		   (if (and (vc-registered f) (vc-locking-user f))
-		       (throw 'quiet nil))))
-       dir)
-      t)))
+  (catch 'quiet
+    (vc-file-tree-walk
+     (function (lambda (f)
+		 (if (and (vc-registered f) (vc-locking-user f))
+		     (throw 'quiet nil)))))
+    t))
 
 ;;;###autoload
 (defun vc-create-snapshot (name)
@@ -697,10 +703,8 @@
       (error "Can't make a snapshot, locked files are in the way.")
     (vc-file-tree-walk
      (function (lambda (f) (and
-		   (not (file-directory-p f))
 		   (vc-name f)
-		   (vc-backend-assign-name f name))))
-     default-directory)
+		   (vc-backend-assign-name f name)))))
     ))
 
 ;;;###autoload
@@ -714,10 +718,8 @@
       (error "Can't retrieve a snapshot, locked files are in the way.")
     (vc-file-tree-walk
      (function (lambda (f) (and
-		   (not (file-directory-p f))
 		   (vc-name f)
-		   (vc-error-occurred (vc-backend-checkout f nil name)))))
-     default-directory)
+		   (vc-error-occurred (vc-backend-checkout f nil name))))))
     ))
 
 ;; Miscellaneous other entry points
@@ -825,12 +827,15 @@
 	      (setq buffers (cdr buffers)))
 	    files))))
   (find-file-other-window "ChangeLog")
+  (barf-if-buffer-read-only)
   (vc-buffer-sync)
   (undo-boundary)
   (goto-char (point-min))
+  (push-mark)
   (message "Computing change log entries...")
-  (shell-command (mapconcat 'identity (cons "rcs2log" args) " ") t)
-  (message "Computing change log entries... done"))
+  (message "Computing change log entries... %s"
+           (if (eq 0 (apply 'call-process "rcs2log" nil t nil args))
+	       "done" "failed")))
 
 ;; Functions for querying the master and lock files.
 
@@ -1176,7 +1181,7 @@
   ;; Get a difference report between two versions
   (apply 'vc-do-command 1
 	 (or (vc-backend-dispatch file "vcdiff" "rcsdiff")
-	     (error (format "File %s is not under version control." file)))
+	     (error "File %s is not under version control." file))
 	 file
 	 (and oldvers (concat "-r" oldvers))
 	 (and newvers (concat "-r" newvers))
@@ -1290,22 +1295,27 @@
 	(let ((window-min-height 2))
 	  (shrink-window (- (window-height) minsize))))))
 
-(defun vc-file-tree-walk (func dir &rest args)
-  "Apply a given function to dir and all files underneath it, recursively."
-  (apply 'funcall func dir args)
-  (and (file-directory-p dir)
-       (mapcar
-	(function (lambda (f) (or
-		      (string-equal f ".")
-		      (string-equal f "..")
-		      (file-symlink-p f)	;; Avoid possible loops
-		      (apply 'vc-file-tree-walk
-			     func
-			     (if (= (aref dir (1- (length dir))) ?/)
-				 (concat dir f)
-			       (concat dir "/" f))
-			     args))))
-	(directory-files dir))))
+(defun vc-file-tree-walk (func &rest args)
+  "Walk recursively through default directory,
+invoking FUNC f ARGS on all non-directory files f underneath it."
+  (vc-file-tree-walk-internal default-directory func args)
+  (message "Traversing directory %s...done" default-directory))
+
+(defun vc-file-tree-walk-internal (file func args)
+  (if (not (file-directory-p file))
+      (apply func file args)
+    (message "Traversing directory %s..." file)
+    (let ((dir (file-name-as-directory file)))
+      (mapcar
+       (function
+	(lambda (f) (or
+		     (string-equal f ".")
+		     (string-equal f "..")
+		     (let ((dirf (concat dir f)))
+			(or
+			 (file-symlink-p dirf) ;; Avoid possible loops
+			 (vc-file-tree-walk-internal dirf func args))))))
+       (directory-files dir)))))
 
 (provide 'vc)