(vc-diff): Get proper error message when you run this with no prefix

arg on an empty buffer.

(vc-directory): Better directory format --- replace the user and group IDs
with locking-user (if any).

(vc-finish-logentry, vc-next-comment, vc-previous-comment):  Replace
*VC-comment-buffer* with a ring vector.

1 files changed, 181 insertions, 109 deletions

diff --git a/lisp/vc.el b/lisp/vc.el
index c143fe93e5a..0f7a3557544 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -58,7 +58,15 @@
 ;;; Code:
 
 (require 'vc-hooks)
+(require 'ring)
 (require 'dired)
+(require 'compile)
+(require 'sendmail)
+
+(if (not (assoc 'vc-parent-buffer minor-mode-alist))
+    (setq minor-mode-alist
+          (cons '(vc-parent-buffer vc-parent-buffer-name)
+                minor-mode-alist)))
 
 ;; General customization
 
@@ -77,10 +85,12 @@ The value is only computed when needed to avoid an expensive search.")
   "*Display run messages from back-end commands.")
 (defvar vc-mistrust-permissions 'file-symlink-p
   "*Don't assume that permissions and ownership track version-control status.")
-
 (defvar vc-checkin-switches nil
   "*Extra switches passed to the checkin program by \\[vc-checkin].")
 
+(defconst vc-maximum-comment-ring-size 32
+  "Maximum number of saved comments in the comment ring.")
+
 ;;;###autoload
 (defvar vc-checkin-hook nil
   "*List of functions called after a vc-checkin is done.  See `run-hooks'.")
@@ -110,20 +120,34 @@ is sensitive to blank lines.")
 (defvar vc-log-after-operation-hook nil)
 (defvar vc-checkout-writeable-buffer-hook 'vc-checkout-writeable-buffer)
 (defvar vc-parent-buffer nil)
+(defvar vc-parent-buffer-name nil)
 
 (defvar vc-log-file)
 (defvar vc-log-version)
 
 (defconst vc-name-assoc-file "VC-names")
 
+(defvar vc-dired-mode nil)
 (make-variable-buffer-local 'vc-dired-mode)
 
+(defvar vc-comment-ring nil)
+(defvar vc-comment-ring-index nil)
+(defvar vc-last-comment-match nil)
+
 ;; File property caching
 
 (defun vc-file-clearprops (file)
   ;; clear all properties of a given file
   (setplist (intern file vc-file-prop-obarray) nil))
 
+(defun vc-clear-context ()
+  "Clear all cached file properties and the comment ring."
+  (interactive)
+  (fillarray vc-file-prop-obarray nil)
+  ;; Note: there is potential for minor lossage here if there is an open
+  ;; log buffer with a nonzero local value of vc-comment-ring-index.
+  (setq vc-comment-ring nil))
+
 ;; Random helper functions
 
 (defun vc-name (file)
@@ -162,8 +186,10 @@ the master name of FILE; this is appended to an optional list of FLAGS."
         (vc-file (and file (vc-name file)))
         status)
     (set-buffer (get-buffer-create "*vc*"))
-    (make-local-variable 'vc-parent-buffer)
-    (setq vc-parent-buffer camefrom)
+    (set (make-local-variable 'vc-parent-buffer) camefrom)
+    (set (make-local-variable 'vc-parent-buffer-name)
+         (concat " from " (buffer-name camefrom)))
+    
     (erase-buffer)
 
     ;; This is so that command arguments typed in the *vc* buffer will
@@ -330,11 +356,11 @@ the master name of FILE; this is appended to an optional list of FLAGS."
       (if vc-initial-comment
           (setq vc-log-after-operation-hook
                 'vc-checkout-writeable-buffer-hook)
-        (vc-checkout-writeable-buffer)))
+        (vc-checkout-writeable-buffer file)))
 
      ;; if there is no lock on the file, assert one and get it
      ((not (setq owner (vc-locking-user file)))
-      (vc-checkout-writeable-buffer))
+      (vc-checkout-writeable-buffer file))
 
      ;; a checked-out version exists, but the user may not own the lock
      ((not (string-equal owner (user-login-name)))
@@ -346,7 +372,7 @@ the master name of FILE; this is appended to an optional list of FLAGS."
        owner))
      
      ;; OK, user owns the lock on the file
-     (t (let (file-window)
+     (t
           (find-file file)
 
           ;; give luser a chance to save before checking in.
@@ -370,7 +396,7 @@ the master name of FILE; this is appended to an optional list of FLAGS."
 
             ;; OK, let's do the checkin
             (vc-checkin file version comment)
-            ))))))
+            )))))
 
 (defun vc-next-action-dired (file rev comment)
   ;; We've accepted a log comment, now do a vc-next-action using it on all
@@ -378,7 +404,11 @@ the master name of FILE; this is appended to an optional list of FLAGS."
   (set-buffer vc-parent-buffer)
   (dired-map-over-marks
    (save-window-excursion
-     (vc-next-action-on-file (dired-get-filename) nil comment)) nil t)
+     (let ((file (dired-get-filename)))
+       (message "Processing %s..." file)
+       (vc-next-action-on-file file nil comment)
+       (message "Processing %s...done" file)))
+   nil t)
   )
 
 ;; Here's the major entry point.
@@ -408,13 +438,15 @@ each one.  The log message will be used as a comment for any register
 or checkin operations, but ignored when doing checkouts.  Attempted
 lock steals will raise an error."
   (interactive "P")
-  (if vc-dired-mode
-      (let ((files (dired-get-marked-files)))
-        (if (null files)
-            (find-file-other-window (dired-get-filename))
-          (vc-start-entry nil nil nil
-                          "Enter a change comment."
-                          'vc-next-action-dired)))
+  (catch 'nogo
+    (if vc-dired-mode
+        (let ((files (dired-get-marked-files)))
+          (if (= (length files) 1)
+              (find-file-other-window (dired-get-filename))
+            (vc-start-entry nil nil nil
+                            "Enter a change comment for the marked files."
+                            'vc-next-action-dired)
+            (throw 'nogo))))
     (while vc-parent-buffer
       (pop-to-buffer vc-parent-buffer))
     (if buffer-file-name
@@ -423,9 +455,9 @@ lock steals will raise an error."
 
 ;;; These functions help the vc-next-action entry point
 
-(defun vc-checkout-writeable-buffer ()
+(defun vc-checkout-writeable-buffer (&optional file)
   "Retrieve a writeable copy of the latest version of the current buffer's file."
-  (vc-checkout (buffer-file-name) t)
+  (vc-checkout (or file (buffer-file-name)) t)
   )
 
 ;;;###autoload
@@ -473,8 +505,9 @@ lock steals will raise an error."
     (if comment
         (set-buffer (get-buffer-create "*VC-log*"))
       (pop-to-buffer (get-buffer-create "*VC-log*")))
-    (make-local-variable 'vc-parent-buffer)
-    (setq vc-parent-buffer parent)
+    (set (make-local-variable 'vc-parent-buffer) parent)
+    (set (make-local-variable 'vc-parent-buffer-name)
+         (concat " from " (buffer-name vc-parent-buffer)))
     (vc-mode-line (if file (file-name-nondirectory file) " (no file)"))
     (vc-log-mode)
     (setq vc-log-operation action)
@@ -483,9 +516,10 @@ lock steals will raise an error."
     (if comment
         (progn
           (erase-buffer)
-          (if (not (eq comment t))
-              (insert comment))
-          (vc-finish-logentry))
+          (if (eq comment t)
+              (vc-finish-logentry t)
+            (insert comment)
+            (vc-finish-logentry nil)))
       (message "%s  Type C-c C-c when done." msg))))
 
 (defun vc-admin (file rev &optional comment)
@@ -514,7 +548,6 @@ level to check it in under.  COMMENT, if specified, is the checkin comment."
       (setq owner (vc-locking-user file)))
   (if (not (y-or-n-p (format "Take the lock on %s:%s from %s?" file rev owner)))
       (error "Steal cancelled."))
-  (require 'sendmail)
   (pop-to-buffer (get-buffer-create "*VC-mail*"))
   (setq default-directory (expand-file-name "~/"))
   (auto-save-mode auto-save-default)
@@ -547,7 +580,7 @@ popped up to accept a comment."
 ;;; Here is a checkin hook that may prove useful to sites using the
 ;;; ChangeLog facility supported by Emacs.
 (defun vc-comment-to-change-log (&optional file)
-  "Update change log from comments entered into VC for the current file.
+  "Update change log from VC change comments entered for the current file.
 Optional FILE specifies the change log file name; see `find-change-log'.
 See `vc-update-change-log'."
   (interactive)
@@ -558,24 +591,22 @@ See `vc-update-change-log'."
           (vc-update-change-log
            (file-relative-name buffer-file-name))))))
 
-(defun vc-finish-logentry ()
+(defun vc-finish-logentry (&optional nocomment)
   "Complete the operation implied by the current log entry."
   (interactive)
-  (goto-char (point-max))
-  (if (not (bolp)) (newline))
-  ;; Append the contents of the log buffer to the comment ring
-  (save-excursion
-    (set-buffer (get-buffer-create "*VC-comment-ring*"))
-    (goto-char (point-max))
-    (set-mark (point))
-    (insert-buffer-substring "*VC-log*")
-    (if (and (not (bobp)) (not (= (char-after (1- (point))) ?\f)))
-        (insert-char ?\f 1))
-    (if (not (bobp))
-        (forward-char -1))
-    (exchange-point-and-mark)
-    ;; Check for errors
-    (vc-backend-logentry-check vc-log-file))
+  ;; Check and record the comment, if any.
+  (if (not nocomment)
+      (progn
+        (goto-char (point-max))
+        (if (not (bolp))
+            (newline))
+        ;; Comment too long?
+        (vc-backend-logentry-check vc-log-file)
+        ;; Record the comment in the comment ring
+        (if (null vc-comment-ring)
+            (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
+        (ring-insert vc-comment-ring (buffer-string))
+        ))
   ;; OK, do it to it
   (if vc-log-operation
       (save-excursion
@@ -589,7 +620,6 @@ See `vc-update-change-log'."
   (vc-error-occurred
    (delete-window (get-buffer-window "*VC-log*")))
   (kill-buffer "*VC-log*")
-  (bury-buffer "*VC-comment-ring*")
   ;; Now make sure we see the expanded headers
   (if buffer-file-name
         (vc-resynch-window buffer-file-name vc-keep-workfiles t))
@@ -597,57 +627,65 @@ See `vc-update-change-log'."
 
 ;; Code for access to the comment ring
 
-(defun vc-next-comment ()
-  "Fill the log buffer with the next message in the msg ring."
-  (interactive)
-  (erase-buffer)
-  (save-excursion
-    (set-buffer "*VC-comment-ring*")
-    (forward-page)
-    (if (= (point) (point-max))
-        (goto-char (point-min)))
-    (mark-page)
-    (append-to-buffer "*VC-log*" (point) (1- (mark)))
-    ))
-
-(defun vc-previous-comment ()
-  "Fill the log buffer with the previous message in the msg ring."
-  (interactive)
-  (erase-buffer)
-  (save-excursion
-    (set-buffer "*VC-comment-ring*")
-    (if (= (point) (point-min))
-        (goto-char (point-max)))
-    (backward-page)
-    (mark-page)
-    (append-to-buffer "*VC-log*" (point) (1- (mark)))
-    ))
-
-(defun vc-comment-search-backward (regexp)
-  "Fill the log buffer with the last message in the msg ring matching REGEXP."
-  (interactive "sSearch backward for: ")
-  (erase-buffer)
-  (save-excursion
-    (set-buffer "*VC-comment-ring*")
-    (if (= (point) (point-min))
-        (goto-char (point-max)))
-    (re-search-backward regexp nil t)
-    (mark-page)
-    (append-to-buffer "*VC-log*" (point) (1- (mark)))
-    ))
-
-(defun vc-comment-search-forward (regexp)
-  "Fill the log buffer with the next message in the msg ring matching REGEXP."
-  (interactive "sSearch forward for: ")
-  (erase-buffer)
-  (save-excursion
-    (set-buffer "*VC-comment-ring*")
-    (if (= (point) (point-max))
-        (goto-char (point-min)))
-    (re-search-forward regexp nil t)
-    (mark-page)
-    (append-to-buffer "*VC-log*" (point) (1- (mark)))
-    ))
+(defun vc-previous-comment (arg)
+  "Cycle backwards through comment history."
+  (interactive "*p")
+  (let ((len (ring-length vc-comment-ring)))
+    (cond ((<= len 0)
+           (message "Empty comment ring")
+           (ding))
+          (t
+           (erase-buffer)
+           ;; Initialize the index on the first use of this command
+           ;; so that the first M-p gets index 0, and the first M-n gets
+           ;; index -1.
+           (if (null vc-comment-ring-index)
+               (setq vc-comment-ring-index
+                     (if (> arg 0) -1
+                         (if (< arg 0) 1 0))))
+           (setq vc-comment-ring-index
+                 (ring-mod (+ vc-comment-ring-index arg) len))
+           (message "%d" (1+ vc-comment-ring-index))
+           (insert (ring-ref vc-comment-ring vc-comment-ring-index))))))
+
+(defun vc-next-comment (arg)
+  "Cycle forwards through comment history."
+  (interactive "*p")
+  (vc-previous-comment (- arg)))
+
+(defun vc-comment-search-reverse (str)
+  "Searches backwards through comment history for substring match."
+  (interactive "sComment substring: ")
+  (if (string= str "")
+      (setq str vc-last-comment-match)
+    (setq vc-last-comment-match str))
+  (if (null vc-comment-ring-index)
+      (setq vc-comment-ring-index -1))
+  (let ((str (regexp-quote str))
+        (len (ring-length vc-comment-ring))
+        (n (1+ vc-comment-ring-index)))
+    (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n))))
+      (setq n (+ n 1)))
+    (cond ((< n len)
+           (vc-previous-comment (- n vc-comment-ring-index)))
+          (t (error "Not found")))))
+
+(defun vc-comment-search-forward (str)
+  "Searches forwards through comment history for substring match."
+  (interactive "sComment substring: ")
+  (if (string= str "")
+      (setq str vc-last-comment-match)
+    (setq vc-last-comment-match str))
+  (if (null vc-comment-ring-index)
+      (setq vc-comment-ring-index 0))
+  (let ((str (regexp-quote str))
+        (len (ring-length vc-comment-ring))
+        (n vc-comment-ring-index))
+    (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n))))
+      (setq n (- n 1)))
+    (cond ((>= n 0)
+           (vc-next-comment (- n vc-comment-ring-index)))
+          (t (error "Not found")))))
 
 ;; Additional entry points for examining version histories
 
@@ -661,14 +699,23 @@ See `vc-update-change-log'."
       (pop-to-buffer vc-parent-buffer))
   (if historic
       (call-interactively 'vc-version-diff)
+    (if (or (null buffer-file-name) (null (vc-name buffer-file-name)))
+        (error "There is no version-control master associated with this buffer."))
     (let ((file buffer-file-name)
           unchanged)
       (vc-buffer-sync)
       (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
       (if unchanged
           (message "No changes to %s since latest version." file)
-        (pop-to-buffer "*vc*")
         (vc-backend-diff file nil)
+        ;; Ideally, we'd like at this point to parse the diff so that
+        ;; the buffer effectively goes into compilation mode and we
+        ;; can visit the old and new change locations via next-error.
+        ;; Unfortunately, this is just too painful to do.  The basic
+        ;; problem is that the `old' file doesn't exist to be
+        ;; visited.  This plays hell with numerous assumptions in
+        ;; the diff.el and compile.el machinery.
+        (pop-to-buffer "*vc*")
         (vc-shrink-to-fit)
         (goto-char (point-min))
         )
@@ -687,8 +734,9 @@ files in or below it."
   (if (file-directory-p file)
       (let ((camefrom (current-buffer)))
         (set-buffer (get-buffer-create "*vc-status*"))
-        (make-local-variable 'vc-parent-buffer)
-        (setq vc-parent-buffer camefrom)
+        (set (make-local-variable 'vc-parent-buffer) camefrom)
+        (set (make-local-variable 'vc-parent-buffer-name)
+             (concat " from " (buffer-name camefrom)))
         (erase-buffer)
         (insert "Diffs between "
                 (or rel1 "last version checked in")
@@ -773,6 +821,24 @@ on a buffer attached to the file named in the current Dired buffer line."
   (setq vc-dired-mode t)
   (setq vc-mode " under VC"))
 
+(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")))
+  ;;
+  ;; This code, like dired, assumes UNIX -l format.
+  (forward-word 1)      ;; skip over any extra field due to -ibs options
+  (if x (setq x (concat "(" x ")")))
+  (if (re-search-forward "\\([0-9]+ \\).................\\( .*\\)" nil 0)
+      (let ((rep (substring (concat x "                 ") 0 9)))
+        (replace-match (concat "\\1" rep "\\2") t)))
+  )
+
 ;;;###autoload
 (defun vc-directory (verbose)
   "Show version-control status of all files under the current directory."
@@ -780,7 +846,8 @@ on a buffer attached to the file named in the current Dired buffer line."
   (let (nonempty
         (dl (length default-directory))
         (filelist nil) (userlist nil)
-        dired-buf)
+        dired-buf
+        dired-buf-mod-count)
     (vc-file-tree-walk
      (function (lambda (f)
                  (if (vc-registered f)
@@ -789,22 +856,26 @@ on a buffer attached to the file named in the current Dired buffer line."
                             (setq filelist (cons (substring f dl) filelist))
                             (setq userlist (cons user userlist))))))))
     (save-excursion
-     (dired (cons default-directory (nreverse filelist)))
-     (setq dired-buf (current-buffer))
-     (setq nonempty (not (zerop (buffer-size)))))
+      ;; This uses a semi-documented featre of dired; giving a switch
+      ;; argument forces the buffer to refresh each time.
+      (dired
+       (cons default-directory (nreverse filelist))
+       dired-listing-switches)
+      (setq dired-buf (current-buffer))
+      (setq nonempty (not (zerop (buffer-size)))))
     (if nonempty
         (progn
           (pop-to-buffer dired-buf)
           (vc-dired-mode)
           (goto-char (point-min))
           (setq buffer-read-only nil)
+          (forward-line 1)      ;; Skip header line
           (mapcar
-           (function (lambda (x)
-                       (forward-char 2) ;; skip dired's mark area
-                       (if x (insert x))
-                       (insert "\t")
-                       (forward-line 1)))
-           (cons "\t" (nreverse userlist)))
+           (lambda (x)
+             (forward-char 2)   ;; skip dired's mark area
+             (vc-dired-reformat-line x)
+             (forward-line 1))  ;; go to next line
+           (nreverse userlist))
           (setq buffer-read-only t)
           (goto-char (point-min))
           )
@@ -1269,7 +1340,7 @@ Return nil if there is no such person."
 
 (defun vc-backend-logentry-check (file)
   (vc-backend-dispatch file
-   (if (>= (- (region-end) (region-beginning)) 512)     ;; SCCS
+   (if (>= (buffer-size) 512)   ;; SCCS
        (progn
          (goto-char 512)
          (error
@@ -1414,8 +1485,8 @@ saved comments.  These can be recalled as follows:
 
 \\[vc-next-comment]     replace region with next message in comment ring
 \\[vc-previous-comment] replace region with previous message in comment ring
-\\[vc-search-comment-reverse]   search backward for regexp in the comment ring
-\\[vc-search-comment-forward]   search backward for regexp in the comment ring
+\\[vc-comment-search-reverse]   search backward for regexp in the comment ring
+\\[vc-comment-search-forward]   search backward for regexp in the comment ring
 
 Entry to the change-log submode calls the value of text-mode-hook, then
 the value of vc-log-mode-hook.
@@ -1457,6 +1528,7 @@ Global user options:
   (setq mode-name "VC-Log")
   (make-local-variable 'vc-log-file)
   (make-local-variable 'vc-log-version)
+  (make-local-variable 'vc-comment-ring-index)
   (set-buffer-modified-p nil)
   (setq buffer-file-name nil)
   (run-hooks 'text-mode-hook 'vc-log-mode-hook)
@@ -1468,7 +1540,7 @@ Global user options:
   (setq vc-log-entry-mode (make-sparse-keymap))
   (define-key vc-log-entry-mode "\M-n" 'vc-next-comment)
   (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment)
-  (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-backward)
+  (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse)
   (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward)
   (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry)
   )