(bdf-generate-font): New argument CHARSET. Give WIDTH

[gnu-emacs] / lisp / vc.el

diff --git a/lisp/vc.el b/lisp/vc.el
index b14791931a26018bdbeca789350a1dae94dcc2e8..eadd64fe91e9777c0d0f6239bd386d272ca918e5 100644 (file)
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -5,7 +5,7 @@
 ;; Author:     Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
 
 ;; Author:     Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
 

-;; $Id: vc.el,v 1.215 1998/04/01 12:26:43 spiegel Exp rms $
+;; $Id: vc.el,v 1.235 1998/07/09 03:24:06 rms Exp spiegel $

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -116,7 +116,8 @@ If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
   "*A string used as the default version number when a new file is registered.
 This can be overriden by giving a prefix argument to \\[vc-register]."
   :type 'string
   "*A string used as the default version number when a new file is registered.
 This can be overriden by giving a prefix argument to \\[vc-register]."
   :type 'string

-  :group 'vc)
+  :group 'vc
+  :version "20.3")

 
 (defcustom vc-command-messages nil
   "*If non-nil, display run messages from back-end commands."
 
 (defcustom vc-command-messages nil
   "*If non-nil, display run messages from back-end commands."


@@ -153,6 +154,18 @@ These are passed to the checkin program by \\[vc-register]."
                         string))
   :group 'vc)
 
                         string))
   :group 'vc)
 

+(defcustom vc-dired-recurse t
+  "*If non-nil, show directory trees recursively in VC Dired."
+  :type 'boolean
+  :group 'vc
+  :version "20.3")
+
+(defcustom vc-dired-terse-display t
+  "*If non-nil, show only locked files in VC Dired."
+  :type 'boolean
+  :group 'vc
+  :version "20.3")
+

 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
   "*List of directory names to be ignored while recursively walking file trees."
   :type '(repeat string)
 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
   "*List of directory names to be ignored while recursively walking file trees."
   :type '(repeat string)


@@ -318,27 +331,6 @@ If nil, VC itself computes this value when it is first needed."
 (defvar vc-comment-ring-index nil)
 (defvar vc-last-comment-match nil)
 
 (defvar vc-comment-ring-index nil)
 (defvar vc-last-comment-match nil)
 

-;; Back-portability to Emacs 18
-
-(defun file-executable-p-18 (f)
-  (let ((modes (file-modes f)))
-    (and modes (not (zerop (logand 292))))))
-
-(defun file-regular-p-18 (f)
-  (let ((attributes (file-attributes f)))
-    (and attributes (not (car attributes)))))
-
-; Conditionally rebind some things for Emacs 18 compatibility
-(if (not (boundp 'minor-mode-map-alist))
-    (progn
-      (setq compilation-old-error-list nil)
-      (fset 'file-executable-p 'file-executable-p-18)
-      (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
-      ))
-
-(if (not (fboundp 'file-regular-p))
-    (fset 'file-regular-p 'file-regular-p-18))
-

 ;;; Find and compare backend releases
 
 (defun vc-backend-release (backend)
 ;;; Find and compare backend releases
 
 (defun vc-backend-release (backend)


@@ -409,6 +401,10 @@ If nil, VC itself computes this value when it is first needed."
   ;; return t if REV is a revision on the trunk
   (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
 
   ;; return t if REV is a revision on the trunk
   (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
 

+(defun vc-branch-p (rev)
+  ;; return t if REV is a branch revision
+  (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
+

 (defun vc-branch-part (rev)
   ;; return the branch part of a revision number REV
   (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
 (defun vc-branch-part (rev)
   ;; return the branch part of a revision number REV
   (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))


@@ -498,13 +494,22 @@ If nil, VC itself computes this value when it is first needed."
      ;; CVS
      t))
 
      ;; CVS
      t))
 

-(defun vc-registration-error (file)
-  (if file
-      (error "File %s is not under version control" file)
-    (error "Buffer %s is not associated with a file" (buffer-name))))
+(defun vc-ensure-vc-buffer ()
+  ;; Make sure that the current buffer visits a version-controlled file.
+  (if vc-dired-mode
+      (set-buffer (find-file-noselect (dired-get-filename)))
+    (while vc-parent-buffer
+      (pop-to-buffer vc-parent-buffer))
+    (if (not (buffer-file-name))
+       (error "Buffer %s is not associated with a file" (buffer-name))
+      (if (not (vc-backend (buffer-file-name)))
+         (error "File %s is not under version control" (buffer-file-name))))))

 
 (defvar vc-binary-assoc nil)
 
 (defvar vc-binary-assoc nil)

-
+(defvar vc-binary-suffixes
+  (if (memq system-type '(ms-dos windows-nt))
+      '(".exe" ".com" ".bat" ".cmd" ".btm" "")
+    '("")))

 (defun vc-find-binary (name)
   "Look for a command anywhere on the subprocess-command search path."
   (or (cdr (assoc name vc-binary-assoc))
 (defun vc-find-binary (name)
   "Look for a command anywhere on the subprocess-command search path."
   (or (cdr (assoc name vc-binary-assoc))


@@ -513,12 +518,18 @@ If nil, VC itself computes this value when it is first needed."
         (function 
          (lambda (s)
            (if s
         (function 
          (lambda (s)
            (if s

-               (let ((full (concat s "/" name)))
-                 (if (file-executable-p full)
-                     (progn
-                       (setq vc-binary-assoc
-                             (cons (cons name full) vc-binary-assoc))
-                       (throw 'found full)))))))
+               (let ((full (concat s "/" name))
+                     (suffixes vc-binary-suffixes)
+                     candidate)
+                 (while suffixes
+                   (setq candidate (concat full (car suffixes)))
+                   (if (and (file-executable-p candidate)
+                            (not (file-directory-p candidate)))
+                       (progn
+                         (setq vc-binary-assoc
+                               (cons (cons name candidate) vc-binary-assoc))
+                         (throw 'found candidate))
+                     (setq suffixes (cdr suffixes))))))))

         exec-path)
        nil)))
 
         exec-path)
        nil)))
 


@@ -744,18 +755,13 @@ before the filename."
 
 (defun vc-next-action-on-file (file verbose &optional comment)
   ;;; If comment is specified, it will be used as an admin or checkin comment.
 
 (defun vc-next-action-on-file (file verbose &optional comment)
   ;;; If comment is specified, it will be used as an admin or checkin comment.

-  (let ((vc-file (vc-name file))
-       (vc-type (vc-backend file))
+  (let ((vc-type (vc-backend file))

        owner version buffer)
     (cond
 
        owner version buffer)
     (cond
 

-     ;; if there is no master file corresponding, create one
-     ((not vc-file)
-      (vc-register verbose comment)
-      (if vc-initial-comment
-         (setq vc-log-after-operation-hook
-               'vc-checkout-writable-buffer-hook)
-       (vc-checkout-writable-buffer file)))
+     ;; If the file is not under version control, register it
+     ((not vc-type)
+      (vc-register verbose comment))

 
      ;; CVS: changes to the master file need to be 
      ;; merged back into the working file
 
      ;; CVS: changes to the master file need to be 
      ;; merged back into the working file


@@ -895,16 +901,17 @@ before the filename."
   (let ((dired-buffer (current-buffer))
        (dired-dir default-directory))
     (dired-map-over-marks
   (let ((dired-buffer (current-buffer))
        (dired-dir default-directory))
     (dired-map-over-marks

-     (let ((file (dired-get-filename)) p
-          (default-directory default-directory))
+     (let ((file (dired-get-filename)))

        (message "Processing %s..." file)
        ;; Adjust the default directory so that checkouts
        ;; go to the right place.
        (message "Processing %s..." file)
        ;; Adjust the default directory so that checkouts
        ;; go to the right place.

-       (setq default-directory (file-name-directory file))
-       (vc-next-action-on-file file nil comment)
-       (set-buffer dired-buffer)
-       (setq default-directory dired-dir)
-       (dired-do-redisplay file)
+       (let ((default-directory (file-name-directory file)))
+         (vc-next-action-on-file file nil comment)
+         (set-buffer dired-buffer))
+       ;; Make sure that files don't vanish
+       ;; after they are checked in.
+       (let ((vc-dired-terse-mode nil))
+         (dired-do-redisplay file))

        (set-window-configuration vc-dired-window-configuration)
        (message "Processing %s...done" file))
     nil t))
        (set-window-configuration vc-dired-window-configuration)
        (message "Processing %s...done" file))
     nil t))


@@ -926,7 +933,7 @@ lock steals will raise an error.
 
 For RCS and SCCS files:
    If the file is not already registered, this registers it for version
 
 For RCS and SCCS files:
    If the file is not already registered, this registers it for version

-control and then retrieves a writable, locked copy for editing.
+control.

    If the file is registered and not locked by anyone, this checks out
 a writable and locked file ready for editing.
    If the file is checked out and locked by the calling user, this
    If the file is registered and not locked by anyone, this checks out
 a writable and locked file ready for editing.
    If the file is checked out and locked by the calling user, this


@@ -974,8 +981,8 @@ merge in the changes into your working copy."
     (while vc-parent-buffer
       (pop-to-buffer vc-parent-buffer))
     (if buffer-file-name
     (while vc-parent-buffer
       (pop-to-buffer vc-parent-buffer))
     (if buffer-file-name

-       (vc-next-action-on-file buffer-file-name verbose)
-      (vc-registration-error nil))))
+        (vc-next-action-on-file buffer-file-name verbose)
+      (error "Buffer %s is not associated with a file" (buffer-name)))))

 
 ;;; These functions help the vc-next-action entry point
 
 
 ;;; These functions help the vc-next-action entry point
 


@@ -1233,7 +1240,8 @@ May be useful as a `vc-checkin-hook' to update change logs automatically."
     ;; we don't zap the *VC-log* buffer and the typing therein).
     (let ((logbuf (get-buffer "*VC-log*")))
       (cond (logbuf
     ;; we don't zap the *VC-log* buffer and the typing therein).
     (let ((logbuf (get-buffer "*VC-log*")))
       (cond (logbuf

-             (delete-windows-on logbuf)
+             (delete-windows-on logbuf (selected-frame))
+            ;; Kill buffer and delete any other dedicated windows/frames.

              (kill-buffer logbuf))))
     ;; Now make sure we see the expanded headers
     (if buffer-file-name
              (kill-buffer logbuf))))
     ;; Now make sure we see the expanded headers
     (if buffer-file-name


@@ -1314,15 +1322,9 @@ checked in version of that file.  This uses no arguments.
 With a prefix argument, it reads the file name to use
 and two version designators specifying which versions to compare."
   (interactive (list current-prefix-arg t))
 With a prefix argument, it reads the file name to use
 and two version designators specifying which versions to compare."
   (interactive (list current-prefix-arg t))

-  (if vc-dired-mode
-      (set-buffer (find-file-noselect (dired-get-filename))))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
+  (vc-ensure-vc-buffer)

   (if historic
       (call-interactively 'vc-version-diff)
   (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 not-urgent)
     (let ((file buffer-file-name)
          unchanged)
       (vc-buffer-sync not-urgent)


@@ -1423,19 +1425,14 @@ files in or below it."
 If the current buffer is named `F', the version is named `F.~REV~'.
 If `F.~REV~' already exists, it is used instead of being re-created."
   (interactive "sVersion to visit (default is latest version): ")
 If the current buffer is named `F', the version is named `F.~REV~'.
 If `F.~REV~' already exists, it is used instead of being re-created."
   (interactive "sVersion to visit (default is latest version): ")

-  (if vc-dired-mode
-      (set-buffer (find-file-noselect (dired-get-filename))))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (if (and buffer-file-name (vc-name buffer-file-name))
-      (let* ((version (if (string-equal rev "")
-                         (vc-latest-version buffer-file-name)
-                       rev))
-            (filename (concat buffer-file-name ".~" version "~")))
-        (or (file-exists-p filename)
-            (vc-backend-checkout buffer-file-name nil version filename))
-        (find-file-other-window filename))
-    (vc-registration-error buffer-file-name)))
+  (vc-ensure-vc-buffer)
+  (let* ((version (if (string-equal rev "")
+                     (vc-latest-version buffer-file-name)
+                   rev))
+        (filename (concat buffer-file-name ".~" version "~")))
+    (or (file-exists-p filename)
+       (vc-backend-checkout buffer-file-name nil version filename))
+    (find-file-other-window filename)))

 
 ;; Header-insertion code
 
 
 ;; Header-insertion code
 


@@ -1445,10 +1442,7 @@ If `F.~REV~' already exists, it is used instead of being re-created."
 Headers desired are inserted at the start of the buffer, and are pulled from
 the variable `vc-header-alist'."
   (interactive)
 Headers desired are inserted at the start of the buffer, and are pulled from
 the variable `vc-header-alist'."
   (interactive)

-  (if vc-dired-mode
-      (find-file-other-window (dired-get-filename)))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
+  (vc-ensure-vc-buffer)

   (save-excursion
     (save-restriction
       (widen)
   (save-excursion
     (save-restriction
       (widen)


@@ -1488,16 +1482,64 @@ the variable `vc-header-alist'."
        (replace-match "$\\1$")))
     (vc-restore-buffer-context context)))
 
        (replace-match "$\\1$")))
     (vc-restore-buffer-context context)))
 

-(defun vc-resolve-conflicts ()
+;;;###autoload
+(defun vc-merge ()
+  (interactive)
+  (vc-ensure-vc-buffer)
+  (vc-buffer-sync)
+  (let* ((file buffer-file-name)
+        (backend (vc-backend file))
+        first-version second-version locking-user)
+    (if (eq backend 'SCCS)
+       (error "Sorry, merging is not implemented for SCCS")
+      (setq locking-user (vc-locking-user file))
+      (if (eq (vc-checkout-model file) 'manual)
+         (if (not locking-user)
+             (if (not (y-or-n-p 
+                       (format "File must be %s for merging.  %s now? "
+                               (if (eq backend 'RCS) "locked" "writable")
+                               (if (eq backend 'RCS) "Lock" "Check out"))))
+                 (error "Merge aborted")
+               (vc-checkout file t))
+           (if (not (string= locking-user (vc-user-login-name)))
+               (error "File is locked by %s" locking-user))))
+      (setq first-version (read-string "Branch or version to merge from: "))
+      (if (and (>= (elt first-version 0) ?0)
+              (<= (elt first-version 0) ?9))
+         (if (not (vc-branch-p first-version))
+             (setq second-version 
+                   (read-string "Second version: " 
+                                (concat (vc-branch-part first-version) ".")))
+           ;; We want to merge an entire branch.  Set versions
+           ;; accordingly, so that vc-backend-merge understands us.
+           (setq second-version first-version)
+           ;; first-version must be the starting point of the branch
+           (setq first-version (vc-branch-part first-version))))
+      (let ((status (vc-backend-merge file first-version second-version)))
+       (if (and (eq (vc-checkout-model file) 'implicit)
+                (not (vc-locking-user file)))
+           (vc-file-setprop file 'vc-locking-user nil))
+       (vc-resynch-buffer file t t)
+       (if (not (zerop status))
+           (if (y-or-n-p "Conflicts detected.  Resolve them now? ")
+               (vc-resolve-conflicts "WORKFILE" "MERGE SOURCE")
+             (message "File contains conflict markers"))
+         (message "Merge successful"))))))
+
+;;;###autoload
+(defun vc-resolve-conflicts (&optional name-A name-B)

   "Invoke ediff to resolve conflicts in the current buffer.
 The conflicts must be marked with rcsmerge conflict markers."
   (interactive)
   "Invoke ediff to resolve conflicts in the current buffer.
 The conflicts must be marked with rcsmerge conflict markers."
   (interactive)

+  (vc-ensure-vc-buffer)

   (let* ((found nil)
          (file-name (file-name-nondirectory buffer-file-name))
         (your-buffer   (generate-new-buffer 
   (let* ((found nil)
          (file-name (file-name-nondirectory buffer-file-name))
         (your-buffer   (generate-new-buffer 

-                         (concat "*" file-name " WORKFILE*")))
+                         (concat "*" file-name 
+                                " " (or name-A "WORKFILE") "*")))

         (other-buffer  (generate-new-buffer 
         (other-buffer  (generate-new-buffer 

-                         (concat "*" file-name " CHECKED-IN*")))
+                         (concat "*" file-name 
+                                " " (or name-B "CHECKED-IN") "*")))

          (result-buffer (current-buffer)))
     (save-excursion 
       (set-buffer your-buffer)
          (result-buffer (current-buffer)))
     (save-excursion 
       (set-buffer your-buffer)


@@ -1583,13 +1625,50 @@ is redefined as the version control prefix, so that you can type
 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."
 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)
+  (make-local-hook 'dired-after-readin-hook)
+  (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
+  ;; The following is slightly modified from dired.el,
+  ;; because file lines look a bit different in vc-dired-mode.
+  (set (make-local-variable 'dired-move-to-filename-regexp)
+       (let* 
+          ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+           ;; In some locales, month abbreviations are as short as 2 letters,
+           ;; and they can be padded on the right with spaces.
+           (month (concat l l "+ *"))
+           ;; Recognize any non-ASCII character.  
+           ;; The purpose is to match a Kanji character.
+           (k "[^\0-\177]")
+           ;; (k "[^\x00-\x7f\x80-\xff]")
+           (s " ")
+           (yyyy "[0-9][0-9][0-9][0-9]")
+           (mm "[ 0-1][0-9]")
+           (dd "[ 0-3][0-9]")
+           (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+           (western (concat "\\(" month s dd "\\|" dd s month "\\)"
+                            s "\\(" HH:MM "\\|" s yyyy "\\)"))
+           (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
+         (concat s "\\(" western "\\|" japanese "\\)" s)))
+  (and (boundp 'vc-dired-switches)
+       vc-dired-switches
+       (set (make-local-variable 'dired-actual-switches)
+            vc-dired-switches))
+  (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)

   (setq vc-dired-mode t))
 
 (define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
 (define-key vc-dired-mode-map "v" vc-prefix-map)
   (setq vc-dired-mode t))
 
 (define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
 (define-key vc-dired-mode-map "v" vc-prefix-map)

-(define-key vc-dired-mode-map "=" 'vc-diff)
+
+(defun vc-dired-toggle-terse-mode ()
+  "Toggle terse display in VC Dired."
+  (interactive)
+  (if (not vc-dired-mode)
+      nil
+    (setq vc-dired-terse-mode (not vc-dired-terse-mode))
+    (if vc-dired-terse-mode
+        (vc-dired-hook)
+      (revert-buffer))))
+
+(define-key vc-dired-mode-map "vt" 'vc-dired-toggle-terse-mode)

 
 (defun vc-dired-mark-locked ()
   "Mark all files currently locked."
 
 (defun vc-dired-mark-locked ()
   "Mark all files currently locked."


@@ -1604,7 +1683,9 @@ There is a special command, `*l', to mark all files currently locked."
 
 (defun vc-fetch-cvs-status (dir)
   (let ((default-directory dir))
 
 (defun vc-fetch-cvs-status (dir)
   (let ((default-directory dir))

-    (vc-do-command "*vc-info*" 0 "cvs" nil nil "status" dir)
+    ;; Don't specify DIR in this command, the default-directory is
+    ;; enough.  Otherwise it might fail with remote repositories.
+    (vc-do-command "*vc-info*" 0 "cvs" nil nil "status")

     (save-excursion
       (set-buffer (get-buffer "*vc-info*"))
       (goto-char (point-min))
     (save-excursion
       (set-buffer (get-buffer "*vc-info*"))
       (goto-char (point-min))


@@ -1631,45 +1712,45 @@ There is a special command, `*l', to mark all files currently locked."
     (if state (concat "(" state ")"))))
 
 (defun vc-dired-reformat-line (x)
     (if state (concat "(" state ")"))))
 
 (defun vc-dired-reformat-line (x)

-  ;; Reformat a directory-listing line, plugging in version control info in
-  ;; place of the user and group info.
+  ;; Reformat a directory-listing line, replacing various columns with 
+  ;; version control information.

   ;; This code, like dired, assumes UNIX -l format.
   (beginning-of-line)
   ;; This code, like dired, assumes UNIX -l format.
   (beginning-of-line)

-  (let ((pos (point)) limit perm owner date-and-file)
+  (let ((pos (point)) limit perm date-and-file)

     (end-of-line)
     (setq limit (point))
     (goto-char pos)
     (end-of-line)
     (setq limit (point))
     (goto-char pos)

-    (cond
-     ((or
-       (re-search-forward  ;; owner and group
-"^\\(..[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] .*\\)" 
-         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] .*\\)"
-         limit t)
+    (when
+        (or
+         (re-search-forward  ;; owner and group
+          "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)"
+          limit t)       
+         (re-search-forward  ;; only owner displayed
+          "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)" 
+         limit t)
+         (re-search-forward  ;; OS/2 -l format, no links, owner, group
+          "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)"
+          limit t))

       (setq perm          (match-string 1)
       (setq perm          (match-string 1)

-           date-and-file (match-string 2))))
-    (setq x (substring (concat x "          ") 0 10))
-    (replace-match (concat perm x date-and-file))))
+           date-and-file (match-string 2))
+      (setq x (substring (concat x "          ") 0 10))
+      (replace-match (concat perm x date-and-file)))))

 
 (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... ")
 
 (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))
+  (let (subdir filename (buffer-read-only nil) cvs-dir)

     (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"))
     (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)))
+            (progn
+              (vc-fetch-cvs-status (file-name-as-directory subdir))
+              (setq cvs-dir t))
+          (setq cvs-dir nil))

         (forward-line 1)
         ;; erase (but don't remove) the "total" line
         (let ((start (point)))
         (forward-line 1)
         ;; erase (but don't remove) the "total" line
         (let ((start (point)))


@@ -1677,30 +1758,80 @@ There is a special command, `*l', to mark all files currently locked."
           (delete-region start (point))
           (beginning-of-line)
           (forward-line 1)))
           (delete-region start (point))
           (beginning-of-line)
           (forward-line 1)))

-       ;; an ordinary file line
+       ;; directory entry

        ((setq filename (dired-get-filename nil t))
         (cond
        ((setq filename (dired-get-filename nil t))
         (cond

+         ;; subdir

          ((file-directory-p filename)
          ((file-directory-p filename)

-          (if (member (file-name-nondirectory filename) 
-                      vc-directory-exclusion-list)
-              (dired-kill-line)
+          (cond 
+           ((member (file-name-nondirectory filename) 
+                    vc-directory-exclusion-list)
+            (let ((pos (point)))
+              (dired-kill-tree filename)
+              (goto-char pos)
+              (dired-kill-line)))
+           (vc-dired-terse-mode
+            ;; Don't show directories in terse mode.  Don't use
+            ;; dired-kill-line to remove it, because in recursive listings,
+            ;; that would remove the directory contents as well.
+            (delete-region (progn (beginning-of-line) (point))
+                           (progn (forward-line 1) (point))))
+           ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
+            (dired-kill-line))
+           (t

             (vc-dired-reformat-line nil)
             (vc-dired-reformat-line nil)

-            (forward-line 1)))
-         ((vc-backend filename)
+            (forward-line 1))))
+         ;; ordinary file
+         ((if cvs-dir 
+              (and (eq (vc-file-getprop filename 'vc-backend) 'CVS)
+                   (or (not vc-dired-terse-mode)
+                       (not (eq (vc-cvs-status filename) 'up-to-date))))
+            (and (vc-backend filename)
+                 (or (not vc-dired-terse-mode)
+                     (vc-locking-user filename))))

           (vc-dired-reformat-line (vc-dired-state-info filename))
           (forward-line 1))
          (t 
           (dired-kill-line))))
        ;; any other line
           (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"))
+       (t (forward-line 1))))
+    (vc-dired-purge))
+  (message "Getting version information... done")
+  (save-restriction
+    (widen)
+    (cond ((eq (count-lines (point-min) (point-max)) 1)
+           (goto-char (point-min))
+           (message "No files locked under %s" default-directory)))))
+
+(defun vc-dired-purge ()
+  ;; Remove empty subdirs
+  (let (subdir)
+    (goto-char (point-min))
+    (while (setq subdir (dired-get-subdir))
+      (forward-line 2)
+      (if (dired-get-filename nil t)
+          (if (not (dired-next-subdir 1 t))
+              (goto-char (point-max)))
+        (forward-line -2)
+        (if (not (string= (dired-current-directory) default-directory))
+            (dired-do-kill-lines t "")
+          ;; We cannot remove the top level directory.
+          ;; Just make it look a little nicer.
+          (forward-line 1)
+          (kill-line)
+          (if (not (dired-next-subdir 1 t))
+              (goto-char (point-max))))))
+    (goto-char (point-min))))

 
 ;;;###autoload
 (defun vc-directory (dirname read-switches)
   (interactive "DDired under VC (directory): \nP")
 
 ;;;###autoload
 (defun vc-directory (dirname read-switches)
   (interactive "DDired under VC (directory): \nP")

-  (let ((switches 
-         (if read-switches (read-string "Dired listing switches: "
-                                        dired-listing-switches))))
+  (let ((vc-dired-switches (concat dired-listing-switches
+                                   (if vc-dired-recurse "R" ""))))
+    (if read-switches 
+        (setq vc-dired-switches
+              (read-string "Dired listing switches: "
+                           vc-dired-switches)))

     (require 'dired)
     (require 'dired-aux)
     ;; force a trailing slash
     (require 'dired)
     (require 'dired-aux)
     ;; force a trailing slash


@@ -1708,7 +1839,7 @@ There is a special command, `*l', to mark all files currently locked."
         (setq dirname (concat dirname "/")))
     (switch-to-buffer 
      (dired-internal-noselect (expand-file-name dirname)
         (setq dirname (concat dirname "/")))
     (switch-to-buffer 
      (dired-internal-noselect (expand-file-name dirname)

-                              (or switches dired-listing-switches)
+                              (or vc-dired-switches dired-listing-switches)

                               'vc-dired-mode))))
 
 ;; Named-configuration support for SCCS
                               'vc-dired-mode))))
 
 ;; Named-configuration support for SCCS


@@ -1832,58 +1963,50 @@ locked are updated to the latest versions."
 (defun vc-print-log ()
   "List the change log of the current buffer in a window."
   (interactive)
 (defun vc-print-log ()
   "List the change log of the current buffer in a window."
   (interactive)

-  (if vc-dired-mode
-      (set-buffer (find-file-noselect (dired-get-filename))))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (if (and buffer-file-name (vc-name buffer-file-name))
-      (let ((file buffer-file-name))
-       (vc-backend-print-log file)
-       (pop-to-buffer (get-buffer-create "*vc*"))
-       (setq default-directory (file-name-directory file))
-       (goto-char (point-max)) (forward-line -1)
-       (while (looking-at "=*\n")
-         (delete-char (- (match-end 0) (match-beginning 0)))
-         (forward-line -1))
-       (goto-char (point-min))
-       (if (looking-at "[\b\t\n\v\f\r ]+")
-           (delete-char (- (match-end 0) (match-beginning 0))))
-       (shrink-window-if-larger-than-buffer)
-       ;; move point to the log entry for the current version
-       (and (not (eq (vc-backend file) 'SCCS))
-            (re-search-forward
-             ;; also match some context, for safety
-             (concat "----\nrevision " (vc-workfile-version file)
-                     "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
-            ;; set the display window so that 
-            ;; the whole log entry is displayed
-            (let (start end lines)
-              (beginning-of-line) (forward-line -1) (setq start (point))
-              (if (not (re-search-forward "^----*\nrevision" nil t))
-                  (setq end (point-max))
-                (beginning-of-line) (forward-line -1) (setq end (point)))
-              (setq lines (count-lines start end))
-              (cond
-               ;; if the global information and this log entry fit
-               ;; into the window, display from the beginning
-               ((< (count-lines (point-min) end) (window-height))
-                (goto-char (point-min))
-                (recenter 0)
-                (goto-char start))
-               ;; if the whole entry fits into the window,
-               ;; display it centered
-               ((< (1+ lines) (window-height))
-                (goto-char start)
-                (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
-               ;; otherwise (the entry is too large for the window),
-               ;; display from the start
-               (t
-                (goto-char start)
-                (recenter 0)))))
-       )
-    (vc-registration-error buffer-file-name)
-    )
-  )
+  (vc-ensure-vc-buffer)
+  (let ((file buffer-file-name))
+    (vc-backend-print-log file)
+    (pop-to-buffer (get-buffer-create "*vc*"))
+    (setq default-directory (file-name-directory file))
+    (goto-char (point-max)) (forward-line -1)
+    (while (looking-at "=*\n")
+      (delete-char (- (match-end 0) (match-beginning 0)))
+      (forward-line -1))
+    (goto-char (point-min))
+    (if (looking-at "[\b\t\n\v\f\r ]+")
+       (delete-char (- (match-end 0) (match-beginning 0))))
+    (shrink-window-if-larger-than-buffer)
+    ;; move point to the log entry for the current version
+    (and (not (eq (vc-backend file) 'SCCS))
+        (re-search-forward
+         ;; also match some context, for safety
+         (concat "----\nrevision " (vc-workfile-version file)
+                 "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
+        ;; set the display window so that 
+        ;; the whole log entry is displayed
+        (let (start end lines)
+          (beginning-of-line) (forward-line -1) (setq start (point))
+          (if (not (re-search-forward "^----*\nrevision" nil t))
+              (setq end (point-max))
+            (beginning-of-line) (forward-line -1) (setq end (point)))
+          (setq lines (count-lines start end))
+          (cond
+           ;; if the global information and this log entry fit
+           ;; into the window, display from the beginning
+           ((< (count-lines (point-min) end) (window-height))
+            (goto-char (point-min))
+            (recenter 0)
+            (goto-char start))
+           ;; if the whole entry fits into the window,
+           ;; display it centered
+           ((< (1+ lines) (window-height))
+            (goto-char start)
+            (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
+           ;; otherwise (the entry is too large for the window),
+           ;; display from the start
+           (t
+            (goto-char start)
+            (recenter 0)))))))

 
 ;;;###autoload
 (defun vc-revert-buffer ()
 
 ;;;###autoload
 (defun vc-revert-buffer ()


@@ -1893,10 +2016,7 @@ to that version.  Note that for RCS and CVS, this function does not
 automatically pick up newer changes found in the master file; 
 use C-u \\[vc-next-action] RET to do so."
   (interactive)
 automatically pick up newer changes found in the master file; 
 use C-u \\[vc-next-action] RET to do so."
   (interactive)

-  (if vc-dired-mode
-      (find-file-other-window (dired-get-filename)))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
+  (vc-ensure-vc-buffer)

   (let ((file buffer-file-name)
        ;; This operation should always ask for confirmation.
        (vc-suppress-confirm nil)
   (let ((file buffer-file-name)
        ;; This operation should always ask for confirmation.
        (vc-suppress-confirm nil)


@@ -1918,13 +2038,8 @@ use C-u \\[vc-next-action] RET to do so."
   "Get rid of most recently checked in version of this file.
 A prefix argument means do not revert the buffer afterwards."
   (interactive "P")
   "Get rid of most recently checked in version of this file.
 A prefix argument means do not revert the buffer afterwards."
   (interactive "P")

-  (if vc-dired-mode
-      (find-file-other-window (dired-get-filename)))
-  (while vc-parent-buffer
-    (pop-to-buffer vc-parent-buffer))
+  (vc-ensure-vc-buffer)

   (cond 
   (cond 

-   ((not (vc-registered (buffer-file-name)))
-    (vc-registration-error (buffer-file-name)))

    ((eq (vc-backend (buffer-file-name)) 'CVS)
     (error "Unchecking files under CVS is dangerous and not supported in VC"))
    ((vc-locking-user (buffer-file-name))
    ((eq (vc-backend (buffer-file-name)) 'CVS)
     (error "Unchecking files under CVS is dangerous and not supported in VC"))
    ((vc-locking-user (buffer-file-name))


@@ -2092,12 +2207,7 @@ default directory."
        (changelog (find-change-log))
        ;; Presumably not portable to non-Unixy systems, along with rcs2log:
        (tempfile (make-temp-name
        (changelog (find-change-log))
        ;; Presumably not portable to non-Unixy systems, along with rcs2log:
        (tempfile (make-temp-name

-                  (concat (file-name-as-directory
-                           (directory-file-name (or (getenv "TMPDIR")
-                                                    (getenv "TMP")
-                                                    (getenv "TEMP")
-                                                    "/tmp")))
-                          "vc")))
+                  (expand-file-name "vc" temporary-file-directory)))

        (full-name (or add-log-full-name
                       (user-full-name)
                       (user-login-name)
        (full-name (or add-log-full-name
                       (user-full-name)
                       (user-login-name)


@@ -2228,8 +2338,9 @@ mode-specific menu. `vc-annotate-color-map' and
 `vc-annotate-very-old-color' defines the mapping of time to
 colors. `vc-annotate-background' specifies the background color."
   (interactive "p")
 `vc-annotate-very-old-color' defines the mapping of time to
 colors. `vc-annotate-background' specifies the background color."
   (interactive "p")

-  (if (not (eq (vc-buffer-backend) 'CVS)) ; This only works with CVS
-      (vc-registration-error (buffer-file-name)))
+  (vc-ensure-vc-buffer)
+  (if (not (eq (vc-backend (buffer-file-name)) 'CVS))
+      (error "Sorry, vc-annotate is only implemented for CVS"))

   (message "Annotating...")
   (let ((temp-buffer-name (concat "*cvs annotate " (buffer-name) "*"))
        (temp-buffer-show-function 'vc-annotate-display)
   (message "Annotating...")
   (let ((temp-buffer-name (concat "*cvs annotate " (buffer-name) "*"))
        (temp-buffer-show-function 'vc-annotate-display)


@@ -2679,7 +2790,7 @@ THRESHOLD, nil otherwise"
      ;; Checking out explicit versions is not supported under SCCS, yet.
      ;; We always "revert" to the latest version; therefore 
      ;; vc-workfile-version is cleared here so that it gets recomputed.
      ;; Checking out explicit versions is not supported under SCCS, yet.
      ;; We always "revert" to the latest version; therefore 
      ;; vc-workfile-version is cleared here so that it gets recomputed.

-     (vc-file-setprop 'vc-workfile-version nil))
+     (vc-file-setprop file 'vc-workfile-version nil))

    ;; RCS
    (vc-do-command nil 0 "co" file 'MASTER
                  "-f" (concat "-u" (vc-workfile-version file)))
    ;; RCS
    (vc-do-command nil 0 "co" file 'MASTER
                  "-f" (concat "-u" (vc-workfile-version file)))


@@ -2794,9 +2905,7 @@ THRESHOLD, nil otherwise"
               (and newvers (concat "-r" newvers))
               (if (listp diff-switches)
                   diff-switches
               (and newvers (concat "-r" newvers))
               (if (listp diff-switches)
                   diff-switches

-                (list diff-switches)))))
-     (t
-      (vc-registration-error file)))))
+                (list diff-switches))))))))

 
 (defun vc-backend-merge-news (file)
   ;; Merge in any new changes made to FILE.
 
 (defun vc-backend-merge-news (file)
   ;; Merge in any new changes made to FILE.


@@ -2824,23 +2933,27 @@ THRESHOLD, nil otherwise"
              (vc-file-setprop file 'vc-workfile-version (match-string 1)))
          ;; get file status
         (if (re-search-forward 
              (vc-file-setprop file 'vc-workfile-version (match-string 1)))
          ;; get file status
         (if (re-search-forward 

-              (concat "^\\([CMU]\\) " 
-                      (regexp-quote (file-name-nondirectory file)))
+              (concat "^\\(\\([CMU]\\) \\)?" 
+                      (regexp-quote (file-name-nondirectory file))
+                     "\\( already contains the differences between \\)?")

               nil t)
              (cond 
               ;; Merge successful, we are in sync with repository now
               nil t)
              (cond 
               ;; Merge successful, we are in sync with repository now

-              ((string= (match-string 1) "U")
-               (vc-file-setprop file 'vc-locking-user 'none)
+              ((or (string= (match-string 2) "U")
+                  ;; Special case: file contents in sync with
+                  ;; repository anyhow:
+                  (match-string 3))
+              (vc-file-setprop file 'vc-locking-user 'none)

                (vc-file-setprop file 'vc-checkout-time 
                                 (nth 5 (file-attributes file)))
                0) ;; indicate success to the caller
               ;; Merge successful, but our own changes are still in the file
                (vc-file-setprop file 'vc-checkout-time 
                                 (nth 5 (file-attributes file)))
                0) ;; indicate success to the caller
               ;; Merge successful, but our own changes are still in the file

-              ((string= (match-string 1) "M")
+              ((string= (match-string 2) "M")

                (vc-file-setprop file 'vc-locking-user (vc-file-owner file))
                (vc-file-setprop file 'vc-checkout-time 0)
                0) ;; indicate success to the caller
               ;; Conflicts detected!
                (vc-file-setprop file 'vc-locking-user (vc-file-owner file))
                (vc-file-setprop file 'vc-checkout-time 0)
                0) ;; indicate success to the caller
               ;; Conflicts detected!

-              ((string= (match-string 1) "C")
+              ((string= (match-string 2) "C")

                (vc-file-setprop file 'vc-locking-user (vc-file-owner file))
                (vc-file-setprop file 'vc-checkout-time 0)
                1) ;; signal the error to the caller
                (vc-file-setprop file 'vc-locking-user (vc-file-owner file))
                (vc-file-setprop file 'vc-checkout-time 0)
                1) ;; signal the error to the caller


@@ -2849,6 +2962,32 @@ THRESHOLD, nil otherwise"
            (error "Couldn't analyze cvs update result"))))
     (message "Merging changes into %s...done" file)))
 
            (error "Couldn't analyze cvs update result"))))
     (message "Merging changes into %s...done" file)))
 

+(defun vc-backend-merge (file first-version &optional second-version)
+  ;; Merge the changes between FIRST-VERSION and SECOND-VERSION into
+  ;; the current working copy of FILE.  It is assumed that FILE is
+  ;; locked and writable (vc-merge ensures this).
+  (vc-backend-dispatch file
+   ;; SCCS
+   (error "Sorry, merging is not implemented for SCCS")
+   ;; RCS
+   (vc-do-command nil 1 "rcsmerge" file 'MASTER
+                 "-kk" ;; ignore keyword conflicts
+                 (concat "-r" first-version)
+                 (if second-version (concat "-r" second-version)))
+   ;; CVS
+   (progn
+     (vc-do-command nil 0 "cvs" file 'WORKFILE
+                   "update" "-kk"
+                   (concat "-j" first-version)
+                   (concat "-j" second-version))
+     (save-excursion
+       (set-buffer (get-buffer "*vc*"))
+       (goto-char (point-min))
+       (if (re-search-forward "conflicts during merge" nil t)
+          1  ;; signal error
+        0  ;; signal success
+        )))))
+

 (defun vc-check-headers ()
   "Check if the current file has any headers in it."
   (interactive)
 (defun vc-check-headers ()
   "Check if the current file has any headers in it."
   (interactive)