Anonymous avatar Anonymous committed 040dad2

renamed files and removed autoloads

Comments (0)

Files changed (5)

+2001-06-19  Ben Wing  <ben@xemacs.org>
+
+	* vc-cc-hooks.el: Renamed from vc-hooks.el.
+	* vc-cc.el: Renamed from vc.el.
+	Removed all autoloads from these files and renamed them, so that
+	there will be no more conflict with vc.  Changed provides and
+	requires in these files accordingly.  Added a messages about
+	how you need to explicitly load vc-cc if you want it.
+
 2000-06-20  Raymond Toy  <toy@rtp.ericsson.se>
 
 	* vc-hooks.el (vc-consult-headers): Add new defvar.
+;;; vc-cc-hooks.el --- support for vc-cc.el, formerly resident
+
+;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+
+;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
+;; Maintainer: ttn@netcom.com
+;; Version: 5.3 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994.
+;;
+;; XEmacs fixes, CVS fixes, and general improvements
+;; by Jonathan Stigelman <Stig@hackvan.com>
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: FSF 19.28.
+
+;;; Commentary:
+
+;; This is like vc-hooks.el, but for vc-cc.  See the commentary of
+;; vc-hooks.el and vc-cc.el.
+
+;;; Code:
+
+(eval-and-compile
+  (require 'advice))
+
+;; Using defconst only because we may have already loaded another version of
+;; this library!
+(defconst vc-master-templates
+  '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
+    ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
+    vc-cc-registered
+    vc-find-cvs-master)
+  "*Where to look for version-control master files.
+The first pair corresponding to a given back end is used as a template
+when creating new masters.")
+
+(defconst ClearCase "@@")
+
+(defvar vc-path
+  (if (file-exists-p "/usr/sccs")
+      '("/usr/sccs") nil)
+  "*List of extra directories to search for version control commands.")
+
+(defvar vc-make-backup-files nil
+  "*If non-nil, backups of registered files are made as with other files.
+If nil (the default), files covered by version control don't get backups.")
+
+(defvar vc-follow-symlinks 'ask
+  "*Indicates what to do if you visit a symbolic link to a file
+that is under version control.  Editing such a file through the
+link bypasses the version control system, which is dangerous and
+probably not what you want.
+  If this variable is t, VC follows the link and visits the real file,
+telling you about it in the echo area.  If it is `ask', VC asks for
+confirmation whether it should follow the link.  If nil, the link is
+visited and a warning displayed.")
+
+(defvar vc-display-status t
+  "*If non-nil, display revision number and lock status in modeline.
+Otherwise, not displayed.")
+
+(defvar vc-cc-display-branch t
+  "*If non-nil, full branch name of ClearCase working file displayed in modeline.
+Otherwise, just the version number or label is displayed.")
+
+(defvar vc-auto-dired-mode t
+  "*If non-nil, automatically enter `vc-dired-mode' in dired-mode buffers where
+version control is set-up.")
+
+(defvar vc-cc-pwv nil ;; (getenv "CLEARCASE_ROOT")
+  "The ClearCase present working view for the current buffer.")
+(make-variable-buffer-local 'vc-cc-pwv)
+
+(defvar vc-consult-headers t
+  "*If non-nil, identify work files by searching for version headers.")
+
+(defconst vc-elucidated (string-match "Lucid" emacs-version))
+
+;; Tell Emacs about this new kind of minor mode
+(if (not (assoc 'vc-mode minor-mode-alist))
+    (setq minor-mode-alist (cons '(vc-mode vc-mode)
+                                 minor-mode-alist)))
+;; We don't really need to have the toggling feature provided by this command,
+;; so in deference to FSF Emacs, I won't use it.
+;;(add-minor-mode 'vc-mode 'vc-mode)
+
+(defvar vc-mode nil)                    ; used for modeline flag
+(make-variable-buffer-local 'vc-mode)
+(set-default 'vc-mode nil)
+(put 'vc-mode 'permanent-local t)
+
+(defvar vc-dired-mode nil)
+(make-variable-buffer-local 'vc-dired-mode)
+
+;; We need a notion of per-file properties because the version
+;; control state of a file is expensive to derive --- we don't
+;; want to recompute it even on every find.
+
+(defmacro vc-error-occurred (&rest body)
+  (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
+
+(defvar vc-file-prop-obarray (make-vector 17 0)
+  "Obarray for per-file properties.")
+
+(defun vc-file-setprop (file property value)
+  ;; set per-file property
+  (put (intern file vc-file-prop-obarray) property value))
+
+(defun vc-file-getprop (file property)
+  ;; get per-file property
+  (get (intern file vc-file-prop-obarray) property))
+
+(defun vc-file-clearprops (file)
+  ;; clear all properties of a given file
+  (setplist (intern file vc-file-prop-obarray) nil))
+
+;;; actual version-control code starts here
+
+(defun vc-registered (file)
+  (let (handler)
+    (if (boundp 'file-name-handler-alist)
+        (setq handler (find-file-name-handler file 'vc-registered)))
+    (if handler
+        (funcall handler 'vc-registered file)
+      ;; Search for a master corresponding to the given file
+      (let ((dirname (or (file-name-directory file) ""))
+            (basename (file-name-nondirectory file)))
+        (catch 'found
+          (mapcar
+           (function
+            (lambda (s)
+              (if (atom s)
+                  (funcall s dirname basename)
+                (let ((trial (format (car s) dirname basename)))
+                  (if (and (file-exists-p trial)
+			   ;; This ensures that directories are not considered
+			   ;; to be registered files (this happens with the
+			   ;; third RCS pattern in vc-master-templates).
+			   (not (equal basename ""))
+                           ;; Make sure the file we found with name
+                           ;; TRIAL is not the source file itself.
+                           ;; That can happen with RCS-style names
+                           ;; if the file name is truncated
+                           ;; (e.g. to 14 chars).  See if either
+                           ;; directory or attributes differ.
+                           (or (not (string= dirname
+                                             (file-name-directory trial)))
+                               (not (equal
+                                     (file-attributes file)
+                                     (file-attributes trial)))))
+                      (throw 'found (cons trial (cdr s))))))))
+           vc-master-templates)
+          nil)))))
+
+(defun vc-cc-registered (dirname basename)
+  ;; Check if DIRNAME/BASENAME is a ClearCase element
+  ;; If it is, do a (throw 'found (cons MASTER '@@)).
+  ;; Use general purpose function for real check
+  ;; This should only be used in vc-master-template.
+  (let ((fullname (concat dirname basename)))
+    ;; If this is a symlink to a ClearCase file, it will think that it is
+    ;; under control, but won't be able to get all information with
+    ;; vc-fetch-properties.  We should leave it up to the user to chase the
+    ;; link, or simply not edit the file through the link.
+    (if (and (not (file-symlink-p fullname))
+             (clearcase-element-p fullname))
+        (throw 'found (cons fullname '@@))))
+  )
+
+(defun vc-find-cvs-master (dirname basename)
+  ;; Check if DIRNAME/BASENAME is handled by CVS.
+  ;; If it is, do a (throw 'found (cons MASTER 'CVS)).
+  ;; Note: If the file is ``cvs add''ed but not yet ``cvs commit''ed
+  ;; the MASTER will not actually exist yet.  The other parts of VC
+  ;; checks for this condition.  This function returns something random if
+  ;; DIRNAME/BASENAME is not handled by CVS.
+  ;; This should only be used in vc-master-template.
+  (and (string= "" dirname) (setq dirname default-directory))
+  (if (and (file-directory-p (concat dirname "CVS/"))
+           (file-readable-p (concat dirname "CVS/Entries")))
+      (let ((fname (concat dirname basename))
+            sbuf rev)
+        (unwind-protect
+            (save-excursion
+              (set-buffer (generate-new-buffer " vc-scratch"))
+              (setq sbuf (current-buffer))
+              (insert-file-contents (concat dirname "CVS/Entries"))
+              (cond
+               ((re-search-forward
+                 (concat "^/" (regexp-quote basename) "/\\([0-9.]*\\)/.*/\\(T\\([^/\n]+\\)\\)?$")
+                 nil t)
+                ;; We found it.  Store version number, and branch tag
+                (setq rev (buffer-substring (match-beginning 1)
+                                            (match-end 1)))
+                (vc-file-setprop fname 'vc-your-latest-version rev)
+                ;; XEmacs - we put something useful in the modeline
+                (vc-file-setprop fname 'sticky-tag
+                                 (cond ((string= "0" rev) "newfile")
+                                       ((match-beginning 3)
+                                        (buffer-substring (match-beginning 3)
+                                                          (match-end 3)))
+                                       (t "main")))
+                (erase-buffer)
+                (insert-file-contents (concat dirname "CVS/Repository"))
+                (let ((master
+                       (concat (file-name-as-directory
+                                (buffer-substring (point-min)
+                                                  (1- (point-max))))
+                               basename
+                               ",v")))
+                  (throw 'found (cons master 'CVS))))))
+          (kill-buffer sbuf)))))
+
+(defun vc-name (file)
+  "Return the master name of a file, nil if it is not registered."
+  (or (vc-file-getprop file 'vc-name)
+      (let ((name-and-type (vc-registered file)))
+        (if name-and-type
+            (progn
+              (vc-file-setprop file 'vc-backend (cdr name-and-type))
+              (vc-file-setprop file 'vc-name (car name-and-type)))))))
+
+(defun vc-backend-deduce (file)
+  "Return the version-control type of a file, nil if it is not registered."
+  (and file
+       (or (vc-file-getprop file 'vc-backend)
+           (let ((name-and-type (vc-registered file)))
+             (if name-and-type
+                 (progn
+                   (vc-file-setprop file 'vc-name (car name-and-type))
+                   (vc-file-setprop file 'vc-backend (cdr name-and-type))))))))
+
+(defun vc-toggle-read-only (&optional verbose)
+  "Change read-only status of current buffer, perhaps via version control.
+If the buffer is visiting a file registered with a form of version control
+that locks files by making them read-only (i.e.: not CVS), then check the
+file in or out.  Otherwise, just change the read-only flag of the buffer.
+
+If you provide a prefix argument, we pass it on to `vc-next-action'."
+  (interactive "P")
+  (let ((vc-type (vc-backend-deduce (buffer-file-name))))
+    (cond ((and vc-type
+                buffer-read-only
+                (file-writable-p buffer-file-name)
+                (/= 0 (user-uid)))
+           ;; XEmacs - The buffer isn't read-only because it's locked, so
+           ;; keep vc out of this...
+           (toggle-read-only))
+          ((and vc-type (not (eq 'CVS  vc-type)))
+           (vc-next-action verbose))
+          (t
+           (toggle-read-only)))
+    ))
+
+;; Map the vc-toggle-read-only key whereever toggle-read-only was
+(let ((where (where-is-internal 'toggle-read-only global-map)))
+  (if where
+      (mapcar (lambda (key)
+                (define-key global-map
+                  key 'vc-toggle-read-only))
+              where))
+  )
+;;(define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
+
+;; For other cases, try advising...
+(defadvice toggle-read-only (around vc activate)
+  "If file is under version control, perform `vc-next-action'."
+  (if vc-mode
+      (let ((vc-type (vc-backend-deduce (buffer-file-name))))
+        (cond ((and vc-type
+                    buffer-read-only
+                    (file-writable-p buffer-file-name)
+                    (/= 0 (user-uid)))
+               ;; XEmacs - The buffer isn't read-only because it's locked, so
+               ;; keep vc out of this...
+               ad-do-it)
+              ((and vc-type (not (eq 'CVS  vc-type)))
+               (vc-next-action (ad-get-arg 0)))
+              (t ad-do-it))
+        )
+    ad-do-it
+    ))
+
+(defun vc-file-owner (file)
+  ;; XEmacs - vc-locking-user is just WAY too slow.
+  (let* ((fa (file-attributes file)))
+    (cond ((eq ?w (aref (nth 8 fa) 2))  ; -rw-r--r--
+           ;; #### - if it's writable, we trust unix...dumb move?
+           (user-login-name (nth 2 fa)))
+          (t
+           ;; big slowness here...
+           (require 'vc)
+           (vc-locking-user file)
+           ))))
+
+(defun vc-mode-line (file &optional label)
+  "Set `vc-mode' to display type of version control for FILE.
+The value is set in the current buffer, which should be the buffer
+visiting FILE.  Second optional arg LABEL is put in place of version
+control system name."
+  (interactive (list buffer-file-name nil))
+  (if file
+      (let ((vc-type (vc-backend-deduce file)))
+        (setq vc-mode
+              (if vc-type
+                  (concat " " (or label (symbol-name vc-type))
+                          (if vc-display-status
+                              (vc-status file vc-type)))))
+        ;; Even root shouldn't modify a registered file without
+        ;; locking it first.
+        (and vc-type
+             (not (string= (user-login-name) (vc-file-owner file)))
+             (setq buffer-read-only t))
+        (and (null vc-type)
+             (file-symlink-p file)
+             (let ((link-type (vc-backend-deduce (file-symlink-p file))))
+               (if link-type
+                   (message
+                    "Warning: symbolic link to %s-controlled source file"
+                    link-type))))
+        (redraw-modeline)
+        ;;(set-buffer-modified-p (buffer-modified-p))  ;;use this if Emacs 18
+        vc-type)))
+
+(defun vc-status (file vc-type)
+  ;; Return string for placement in modeline by `vc-mode-line'.
+  ;; If FILE is not registered, return nil.
+  ;; If FILE is registered but not locked, return " REV" if there is a head
+  ;; revision and " @@" otherwise.
+  ;; If FILE is locked then return all locks in a string of the
+  ;; form " LOCKER1:REV1 LOCKER2:REV2 ...", where "LOCKERi:" is empty if you
+  ;; are the locker, and otherwise is the name of the locker followed by ":".
+
+  ;; Algorithm:
+
+  ;; Check for master file corresponding to FILE being visited.
+  ;;
+  ;; RCS: Insert the first few characters of the master file into a
+  ;; work buffer.  Search work buffer for "locks...;" phrase; if not
+  ;; found, then keep inserting more characters until the phrase is
+  ;; found.  Extract the locks, and remove control characters
+  ;; separating them, like newlines; the string " user1:revision1
+  ;; user2:revision2 ..." is returned.
+  ;;
+  ;; SCCS: Check if the p-file exists.  If it does, read it and
+  ;; extract the locks, giving them the right format.  Else use prs to
+  ;; find the revision number.
+  ;;
+  ;; CVS: vc-find-cvs-master has already stored the current revision
+  ;; number and sticky-tag for the file.  XEmacs displays the sticky-tag.
+
+  ;; Limitations:
+
+  ;; The output doesn't show which version you are actually looking at.
+  ;; The modeline can get quite cluttered when there are multiple locks.
+  ;; The head revision is probably not what you want if you've used `rcs -b'.
+
+  (let ((master (vc-name file))
+        found
+        status)
+
+    ;; If master file exists, then parse its contents, otherwise we
+    ;; return the nil value of this if form.
+    (if (and master vc-type)
+        (save-excursion
+
+          ;; Create work buffer.
+          (set-buffer (get-buffer-create " *vc-status*"))
+          (setq buffer-read-only nil
+                default-directory (file-name-directory master))
+          (erase-buffer)
+
+          ;; Set the `status' var to the return value.
+          (cond
+
+           ;; RCS code.
+           ((eq vc-type 'RCS)
+            ;; Check if we have enough of the header.
+            ;; If not, then keep including more.
+            (while
+                (not (or found
+                         (let ((s (buffer-size)))
+                           (goto-char (1+ s))
+                           (zerop (car (cdr (insert-file-contents
+                                             master nil s (+ s 8192))))))))
+              (beginning-of-line)
+              (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
+
+            (if found
+                ;; Clean control characters and self-locks from text.
+                (let* ((lock-pattern
+                        (concat "[ \b\t\n\v\f\r]+\\("
+                                (regexp-quote (user-login-name))
+                                ":\\)?"))
+                       (locks
+                        (save-restriction
+                          (narrow-to-region (match-beginning 1) (match-end 1))
+                          (goto-char (point-min))
+                          (while (re-search-forward lock-pattern nil t)
+                            (replace-match (if (eobp) "" ":") t t))
+                          (buffer-string))))
+                  (setq status
+                        (if (not (string-equal locks ""))
+                            locks
+                          (goto-char (point-min))
+                          (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
+                              (concat "-"
+                                      (buffer-substring (match-beginning 1)
+                                                        (match-end 1)))
+                            " @@"))))))
+
+           ;; SCCS code.
+           ((eq vc-type 'SCCS)
+            ;; Build the name of the p-file and put it in the work buffer.
+            (insert master)
+            (search-backward "/s.")
+            (delete-char 2)
+            (insert "/p")
+            (if (not (file-exists-p (buffer-string)))
+                ;; No lock.
+                (let ((exec-path (if (boundp 'vc-path) (append exec-path vc-path)
+                                   exec-path)))
+                  (erase-buffer)
+                  (insert "-")
+                  (if (zerop (call-process "prs" nil t nil "-d:I:" master))
+                      (setq status (buffer-substring 1 (1- (point-max))))))
+              ;; Locks exist.
+              (insert-file-contents (buffer-string) nil nil nil t)
+              (while (looking-at "[^ ]+ \\([^ ]+\\) \\([^ ]+\\).*\n")
+                (replace-match " \\2:\\1"))
+              (setq status (buffer-string))
+              (aset status 0 ?:)))
+           ;; CVS code.
+           ((eq vc-type 'CVS)
+            ;; sticky-tag is initialized by vc-backend-deduce
+            (setq status (concat ":" (vc-file-getprop file 'sticky-tag) "-"
+                                 (vc-file-getprop file 'vc-your-latest-version)
+                                 ))
+            )
+           ;; ClearCase code.
+           ((eq vc-type '@@)
+            (require 'vc)
+            ;; Display the explicitly specified version or the latest version
+            (let ((version (or (vc-cc-version-name file)
+                               (vc-latest-version file)
+                               ;; Make sure version is a string in case the
+                               ;; file is not really a versioned object
+                               "")))
+              ;; Check if the user wants to see the branch
+              (if vc-cc-display-branch
+                  (setq status version)
+                (setq status (concat ":" (file-name-nondirectory version))))
+              ))
+           )
+
+          ;; Clean work buffer.
+          (erase-buffer)
+          (set-buffer-modified-p nil)
+          status))))
+
+;;;;; install a call to the above as a find-file hook
+
+(defun vc-follow-link ()
+  ;; If the current buffer visits a symbolic link, this function makes it
+  ;; visit the real file instead.  If the real file is already visited in
+  ;; another buffer, make that buffer current, and kill the buffer
+  ;; that visits the link.
+  (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
+         (true-buffer (find-buffer-visiting truename))
+	 (this-buffer (current-buffer)))
+    (if (eq true-buffer this-buffer)
+	(progn
+	  (kill-buffer this-buffer)
+	  ;; In principle, we could do something like set-visited-file-name.
+	  ;; However, it can't be exactly the same as set-visited-file-name.
+	  ;; I'm not going to work out the details right now. -- rms.
+	  (set-buffer (find-file-noselect truename)))
+      (set-buffer true-buffer)
+      (kill-buffer this-buffer))))
+
+(defun vc-set-auto-mode ()
+  "Check again for the mode of the current buffer when using ClearCase version extended paths."
+
+  (if (eq (vc-file-getprop buffer-file-name 'vc-backend) '@@)
+      (let* ((version (vc-cc-version-name buffer-file-name))
+             (buffer-file-name (vc-cc-element-name buffer-file-name)))
+        ;; Need to recheck the major mode only if a version was appended
+        (if version (set-auto-mode))
+        ;; Set a buffer-local variable for the working view
+        (setq vc-cc-pwv (vc-cc-pwv buffer-file-name))
+        ))
+  )
+
+(defun vc-find-file-hook ()
+  ;; Recompute whether file is version controlled,
+  ;; if user has killed the buffer and revisited.
+  (cond
+   (buffer-file-name
+    (vc-file-clearprops buffer-file-name)
+    (cond
+     ((vc-backend-deduce buffer-file-name)
+      (vc-mode-line buffer-file-name)
+      (cond ((not vc-make-backup-files)
+	     ;; Use this variable, not make-backup-files,
+	     ;; because this is for things that depend on the file name.
+	     (make-local-variable 'backup-inhibited)
+	     (setq backup-inhibited t)))
+      (vc-set-auto-mode))
+     ((let* ((link (file-symlink-p buffer-file-name))
+	     (link-type (and link (vc-backend-deduce (file-chase-links link)))))
+	(if link-type
+            (cond ((null vc-follow-symlinks)
+                   (message
+                    "Warning: symbolic link to %s-controlled source file" link-type))
+                  ((or (not (eq vc-follow-symlinks 'ask))
+		       ;; If we already visited this file by following
+		       ;; the link, don't ask again if we try to visit
+		       ;; it again.  GUD does that, and repeated questions
+		       ;; are painful.
+                       (let ((find-file-compare-truenames nil))
+                         ;; If compare-truenames is t, this will always be t
+                         (get-file-buffer
+                          (abbreviate-file-name (file-chase-links buffer-file-name)))))
+
+		   (vc-follow-link)
+		   (message "Followed link to %s" buffer-file-name)
+		   (vc-find-file-hook))
+                  (t
+                   (if (yes-or-no-p
+                        (format
+                         "Symbolic link to %s-controlled source file; follow link? "
+                         link-type))
+                       (progn (vc-follow-link)
+                              (message "Followed link to %s" buffer-file-name)
+                              (vc-find-file-hook))
+                     (message
+                      "Warning: editing through the link bypasses version control")
+                     ))))
+        (vc-set-auto-mode)))
+      ))))
+
+;;; install a call to the above as a find-file hook
+(add-hook 'find-file-hooks 'vc-find-file-hook)
+
+;; Handle ClearCase version files correctly.
+;;
+;; This little bit of magic causes the buffer name to be set to
+;; <filename>@@/<branch path>/<version>, if you find a specific version of
+;; a file.  Without this the name of the buffer will just be the version
+;; number.
+
+(defun vc-check-cc-name ()
+  (let ((match (string-match "@@" default-directory)))
+    (if match
+        (progn
+          (while (and (> match 0)
+                      (not (equal (elt default-directory match)
+                                  (string-to-char "/"))))
+            (setq match (1- match)))
+
+
+          (let ((new-buffer-name
+                 (concat (substring default-directory (1+ match))
+                         (buffer-name)))
+                (new-dir
+                 (substring default-directory 0 (1+ match))))
+            (or (string= new-buffer-name (buffer-name))
+                ;; Uniquify the name, if necessary.
+                ;;
+                (let ((n 2)
+                      (uniquifier-string ""))
+                  (while (get-buffer (concat new-buffer-name uniquifier-string))
+                    (setq uniquifier-string (format "<%d>" n))
+                    (setq n (1+ n)))
+                  (rename-buffer
+                   (concat new-buffer-name uniquifier-string))))
+            (setq default-directory new-dir)))
+        nil)))
+
+(add-hook 'find-file-hooks 'vc-check-cc-name)
+
+(defun vc-find-dir-hook ()
+  ;; Recompute whether file is version controlled,
+  ;; if user has killed the buffer and revisited.
+  (vc-file-clearprops default-directory)
+  (if default-directory
+      (vc-file-setprop default-directory 'vc-backend nil))
+
+  ;; Let dired decide whether the file should be read-only
+  (let (buffer-read-only)
+    (vc-mode-line default-directory))
+
+  ;; If in vc-dired-mode, reformat the buffer
+  (if vc-dired-mode
+      (vc-reformat-dired-buffer)
+    ;; Otherwise, check if we should automatically enter vc-dired-mode
+    (let ((default-directory (dired-current-directory)))
+      (if (and vc-auto-dired-mode
+               (or vc-mode
+                   (file-directory-p "SCCS")
+                   (file-directory-p "RCS")
+                   (file-directory-p "CVS")))
+        (vc-dired-mode 1))))
+  )
+
+(add-hook 'dired-after-readin-hook 'vc-find-dir-hook)
+
+;;; more hooks, this time for file-not-found
+(defun vc-file-not-found-hook ()
+  "When file is not found, try to check it out from RCS or SCCS.
+Returns t if checkout was successful, nil otherwise."
+  (if (vc-backend-deduce buffer-file-name)
+      (save-excursion
+        (require 'vc)
+        (not (vc-error-occurred (vc-checkout buffer-file-name))))))
+
+(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
+
+;;; Now arrange for bindings and autoloading of the main package.
+;;; Bindings for this have to go in the global map, as we'll often
+;;; want to call them from random buffers.
+
+(add-to-list 'file-name-handler-alist '("^/view/[^/]+/" . vc-cc-file-handler))
+(add-to-list 'file-name-handler-alist '("^/view[/]*$" . vc-cc-view-handler))
+
+; XEmacs - this is preloaded.  let's not be obtuse!
+(defconst vc-prefix-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-name map 'vc-prefix-map)
+    (define-key map "a" 'vc-update-change-log)
+    (define-key map "c" 'vc-cancel-version)
+    (define-key map "d" 'vc-directory)
+    (define-key map "h" 'vc-insert-headers)
+    (define-key map "i" 'vc-register)
+    (define-key map "l" 'vc-print-log)
+    (define-key map "n" 'vc-assign-name)
+    (define-key map "r" 'vc-retrieve-snapshot)
+    (define-key map "s" 'vc-create-snapshot)
+    (define-key map "u" 'vc-revert-buffer)
+    (define-key map "v" 'vc-next-action)
+    (define-key map "=" 'vc-diff)
+    (define-key map "?" 'vc-file-status) ; XEmacs - this doesn't fit elsewhere
+    (define-key map "~" 'vc-version-other-window)
+    ;; ClearCase only stuff
+    (define-key map "e" 'vc-edit-config)
+    (define-key map "b" 'vc-cc-browse-versions)
+    (define-key map "m" 'vc-mkbrtype)
+    (define-key map "t" 'vc-graph-history)
+    (define-key map "w" 'vc-cc-what-rule)
+    (global-set-key "\C-xv" map)
+    map
+    ))
+
+;;; Emacs 19 menus.
+(if (and (not vc-elucidated) (boundp 'menu-bar-final-items))
+    (progn
+      (defvar menu-bar-vc-menu
+        (make-sparse-keymap "VC"))
+      (or (memq
+           'vc menu-bar-final-items)
+          (setq menu-bar-final-items
+                (cons
+                 'vc menu-bar-final-items)))
+      (define-key menu-bar-vc-menu [vc-report-bug]
+        '("Report Bug in Clearcase VC" . cc-vc-submit-bug-report))
+      (define-key menu-bar-vc-menu [vc-directory-registered]
+        '("List Registered Files" . vc-directory-registered))
+      (define-key menu-bar-vc-menu [vc-directory]
+        '("List Locked Files Any User" . vc-directory))
+      (define-key menu-bar-vc-menu [vc-directory-locked]
+        '("List Locked Files" . vc-directory-locked))
+      (put 'vc-print-log 'menu-enable 'vc-mode)
+      (define-key menu-bar-vc-menu [vc-print-log]
+        '("Show Edit History" . vc-print-log))
+      (put 'vc-version-other-window 'menu-enable 'vc-mode)
+      (define-key menu-bar-vc-menu [vc-version-other-window]
+        '("Visit Previous Revision..." . vc-version-other-window))
+      (put 'vc-diff-since-revision 'menu-enable 'vc-mode)
+      (define-key menu-bar-vc-menu [vc-diff-since-revision]
+        '("Show Changes Since Revision..." . vc-diff-since-revision))
+      (put 'vc-diff 'menu-enable 'vc-mode)
+      (define-key menu-bar-vc-menu [vc-diff]
+        '("Show Changes" . vc-diff))
+      (put 'vc-rename-this-file 'menu-enable 'vc-mode)
+      (define-key menu-bar-vc-menu [vc-rename-this-file]
+        '("Rename File" . vc-rename-this-file))
+      (put 'vc-revert-buffer 'menu-enable 'vc-mode)
+      (define-key menu-bar-vc-menu [vc-revert-buffer]
+        '("Revert File" . vc-revert-buffer))
+      (define-key menu-bar-vc-menu [vc-update-directory]
+        '("Update Current Directory" . vc-update-directory))
+      (define-key menu-bar-vc-menu [next-action]
+        '("Next Action" . vc-next-action))
+      (define-key global-map [menu-bar vc]
+        (cons "VC" menu-bar-vc-menu))))
+
+;;; Lucid Emacs menus..
+(defconst vc-default-menu
+  '(:filter vc-menu-filter
+    ["NEXT-OPERATION"                   vc-next-action                  t nil]
+    ["Update Current Directory"         vc-update-directory             t]
+    "----"
+    ["Revert to Last Revision"          vc-revert-buffer                t nil]
+    ["Cancel Last Checkin"              vc-cancel-version               t nil]
+    ["Rename File"                      vc-rename-this-file             t nil]
+    "----"
+    ["Diff Against Last Version"        vc-diff                         t]
+    ["Diff Between Revisions..."        vc-diff-since-revision          t]
+    ["Visit Other Version..."           vc-version-other-window         t]
+    ["Show Edit History"                vc-print-log                    t]
+    ["Assign Label..."                  vc-assign-name                  t]
+    "----"
+    ["List Locked Files"                (progn
+                                          (setq current-prefix-arg '(16))
+                                          (call-interactively 'vc-directory)) t]
+    ["List Locked Files Any User"       vc-directory                    t]
+    ["List Registered Files"            (progn
+                                          (setq current-prefix-arg '(4))
+                                          (call-interactively 'vc-directory)) t])
+  "Menubar entry for using the revision control system.")
+
+(defconst vc-cvs-menu
+  '(:filter vc-menu-filter
+    ["Update Current Directory"         vc-cvs-update-directory         t]
+    ["Revert File"                      vc-revert-file                  t nil]
+    "----"
+    ["Show Changes"                     vc-show-changes                 t]
+    ["Show Changes Since Revision..."   vc-show-revision-changes        t]
+    ["Visit Previous Revision..."       vc-version-other-window         t]
+    ["Show File Status"                 vc-cvs-file-status              t]
+    ["Show Edit History"                vc-show-history                 t])
+  "Menubar entry for using the revision control system with CVS.")
+
+(defconst vc-cc-menu
+  '(["Edit Config Spec..." vc-edit-config t]
+    ["Browse Versions"     vc-cc-browse-versions t]
+    ["Make Branch Type..." vc-mkbrtype t]
+    ["View Graph History"  vc-graph-history t]
+    ["Show Rule"           vc-cc-what-rule t])
+  "Menubar entries to add to the VC menu when using ClearCase.")
+
+;; This function may be called as a menubar hook, or as a menu filter
+;; The filter is much more efficient, and doesn't slow down menubar selection
+;; for every single menu action, as does the hook method.
+(defun vc-menu-filter (&optional menu)
+  (if (null menu)
+      (progn
+        (setq menu (find-menu-item current-menubar '("Tools" "Version Control")))
+        ;; Get just the menu portion
+        (if menu (setq menu (cdr (car menu))))
+        ))
+  (if (null menu)
+      nil
+    (let* ((rest menu)
+           (case-fold-search t)
+           (filepath (cond ((and vc-dired-mode
+                                 (dired-get-filename nil 'no-error)))
+                           (buffer-file-name)
+                           (t (buffer-name))))
+           (file (and filepath (file-name-nondirectory filepath)))
+           (vc-file (and filepath (vc-name filepath)))
+           owner
+           command
+           item)
+      (while rest
+        (setq item (car rest))
+
+        (if (not (vectorp item))
+            nil
+          (setq command (aref item 1))
+          (cond
+           ;; Display the correct action for vc-next-action command
+           ((eq 'vc-next-action command)
+            (aset item 0
+                  (cond ((not vc-file)
+                         "Register File")
+                        ((not (setq owner
+                                    ;; Just check properties, it's too
+                                    ;; slow (and dangerous) to fetch
+                                    ;; properties
+                                    (vc-file-getprop filepath 'vc-locking-user)))
+                         ;;(vc-locking-user filepath)))
+                         "Check out File")
+                        ((not (string-equal owner (user-login-name)))
+                         "Steal File Lock")
+                        (t "Check in File")))
+            (aset item 2 (or buffer-file-name
+                             (and vc-dired-mode "Marked")))
+            )
+
+           ;; Check for commands to disable
+           ((memq command
+                  '(vc-revert-buffer
+                    vc-cancel-version
+                    vc-rename-this-file
+                    vc-diff
+                    vc-diff-since-revision
+                    vc-version-other-window
+                    vc-visit-previous-revision
+                    vc-print-log
+                    vc-assign-name))
+            (aset item 2 vc-file))
+
+           (t nil))
+
+          ;; Add the file to the menu suffix if not disabled
+          (if (and (> (length item) 3) (aref item 2))
+              (aset item 3 
+                    (if vc-dired-mode "Marked" file)))
+          )
+
+        (setq rest (cdr rest)))
+
+      ;; Return menu plus the ClearCase menu if needed
+      (if (and vc-file (clearcase-element-p filepath))
+          ;; Must use append here - nconc will create looped list
+          (append menu '("----") vc-cc-menu)
+          menu)
+      )))
+
+;; vc-menu-filter was once called vc-sensitize-menu, so just in case another
+;; version of vc was loaded:
+(defalias 'vc-sensitize-menu 'vc-menu-filter)
+
+(if (and (fboundp 'add-submenu) (not (featurep 'infodock)) vc-elucidated)
+    (progn
+      (add-submenu '("Tools") (append (list "Version Control") vc-default-menu))
+;; Only add the hook if the :filter method is unavailable.  I don't know which
+;; version of XEmacs introduced it, but it's been available at least since 19.13
+;;      (add-hook 'activate-menubar-hook 'vc-sensitize-menu)))
+      ))
+
+;; #### called by files.el.  Define it like this until we're merged.
+(defun vc-after-save ())
+
+;;---------------------------------------------------------------------------
+;; Utility functions for ClearCase
+;;---------------------------------------------------------------------------
+
+(defun clearcase-element-p (path)
+  "Determine if PATH refers to a Clearcase element."
+
+  (let (extended-path versioned-path)
+
+    (if (string-match "@@" path)
+        (setq extended-path (substring path 0 (match-end 0))
+              versioned-path t)
+      (setq extended-path (concat path "@@")))
+
+    (and (file-exists-p path)
+         (file-directory-p extended-path)
+
+         ;; Non-checked-out elements have the same inode-number
+         ;; as the extended name ("foo@@").
+         ;; Not so for checked out, and therefore writeable elements.
+         ;;
+         (or (file-writable-p path)
+             versioned-path
+             (eq (file-inode path)
+                 (file-inode extended-path)))
+         )))
+
+(if (not (fboundp 'file-inode))
+    (defun file-inode (file)
+      (nth 10 (file-attributes file))))
+
+(defun vc-cc-element-name (path)
+  (if (string-match "@@" path)
+      (substring path 0 (match-beginning 0))
+    path))
+
+(defun vc-cc-version-name (path)
+  (if (string-match "@@" path)
+      (substring path (match-end 0))
+    nil))
+
+(defsubst vc-cc-relpath (str)
+  (and str
+       (stringp str)
+       (string-match "^/view/\\([^/]+\\)" str)
+       (substring str
+                  (match-end 1))))
+
+(defun vc-cc-build-version (file version &optional view-tag)
+  "Build a ClearCase version-extended pathname for ELEMENT's version VERSION.
+If ELEMENT is actually a version-extended pathname, substitute VERSION for
+the version included in ELEMENT.  If VERSION is nil, remove the version-extended
+pathname.
+
+If optional VIEW-TAG is specified, make a view-relative pathname, possibly
+replacing the existing view prefix."
+  (let* ((element (vc-cc-element-name file))
+         (glue-fmt (if (and (> (length version) 0)
+                            (= (aref version 0) ?/))
+                       "%s@@%s"
+                     "%s@@/%s"))
+         (relpath (vc-cc-relpath element)))
+    (if view-tag
+        (setq element (concat "/view/" view-tag (or relpath element))))
+    (if version
+        (format glue-fmt element version)
+      element)
+    ))
+
+;; These stolen from vc.  pcl-cvs wants to call these in
+;; cvs-mark-buffer-changed.  (Basically only changed vc-backend to
+;; vc-backend-deduce.)
+
+(defun vc-consult-rcs-headers (file)
+  ;; Search for RCS headers in FILE, and set properties
+  ;; accordingly.  This function can be disabled by setting
+  ;; vc-consult-headers to nil.  
+  ;; Returns: nil            if no headers were found 
+  ;;                         (or if the feature is disabled,
+  ;;                         or if there is currently no buffer 
+  ;;                         visiting FILE)
+  ;;          'rev           if a workfile revision was found
+  ;;          'rev-and-lock  if revision and lock info was found 
+  (cond
+   ((or (not vc-consult-headers) 
+	(not (get-file-buffer file))) nil)
+   ((let (status version locking-user)
+     (save-excursion
+      (set-buffer (get-file-buffer file))
+      (goto-char (point-min))
+      (cond  
+       ;; search for $Id or $Header
+       ;; -------------------------
+       ((or (and (search-forward "$Id: " nil t)
+		 (looking-at "[^ ]+ \\([0-9.]+\\) "))
+	    (and (progn (goto-char (point-min))
+			(search-forward "$Header: " nil t))
+		 (looking-at "[^ ]+ \\([0-9.]+\\) ")))
+	(goto-char (match-end 0))
+	;; if found, store the revision number ...
+	(setq version (buffer-substring-no-properties (match-beginning 1)
+						      (match-end 1)))
+	;; ... and check for the locking state
+	(cond 
+	 ((looking-at
+	   (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] "             ; date
+	    "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
+	           "[^ ]+ [^ ]+ "))                       ; author & state
+	  (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
+	  (cond 
+	   ;; unlocked revision
+	   ((looking-at "\\$")
+	    (setq locking-user 'none)
+	    (setq status 'rev-and-lock))
+	   ;; revision is locked by some user
+	   ((looking-at "\\([^ ]+\\) \\$")
+	    (setq locking-user
+		  (buffer-substring-no-properties (match-beginning 1)
+						  (match-end 1)))
+	    (setq status 'rev-and-lock))
+	   ;; everything else: false
+	   (nil)))
+	 ;; unexpected information in
+	 ;; keyword string --> quit
+	 (nil)))
+       ;; search for $Revision
+       ;; --------------------
+       ((re-search-forward (concat "\\$" 
+				   "Revision: \\([0-9.]+\\) \\$")
+			   nil t)
+	;; if found, store the revision number ...
+	(setq version (buffer-substring-no-properties (match-beginning 1)
+						      (match-end 1)))
+	;; and see if there's any lock information
+	(goto-char (point-min))
+	(if (re-search-forward (concat "\\$" "Locker:") nil t)
+	    (cond ((looking-at " \\([^ ]+\\) \\$")
+		   (setq locking-user (buffer-substring-no-properties
+				       (match-beginning 1)
+				       (match-end 1)))
+		   (setq status 'rev-and-lock))
+		  ((looking-at " *\\$") 
+		   (setq locking-user 'none)
+		   (setq status 'rev-and-lock))
+		  (t 
+		   (setq locking-user 'none)
+		   (setq status 'rev-and-lock)))
+	  (setq status 'rev)))
+       ;; else: nothing found
+       ;; -------------------
+       (t nil)))
+     (if status (vc-file-setprop file 'vc-workfile-version version))
+     (and (eq status 'rev-and-lock)
+	  (eq (vc-backend-deduce file) 'RCS)
+	  (vc-file-setprop file 'vc-locking-user locking-user)
+	  ;; If the file has headers, we don't want to query the master file,
+	  ;; because that would eliminate all the performance gain the headers
+	  ;; brought us.  We therefore use a heuristic for the checkout model 
+	  ;; now:  If we trust the file permissions, and the file is not 
+          ;; locked, then if the file is read-only the checkout model is 
+	  ;; `manual', otherwise `implicit'.
+	  (not (vc-mistrust-permissions file))
+	  (not (vc-locking-user file))
+	  (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
+	      (vc-file-setprop file 'vc-checkout-model 'manual)
+	    (vc-file-setprop file 'vc-checkout-model 'implicit)))
+     status))))
+
+(defun vc-workfile-version (file)
+  ;; Return version level of the current workfile FILE
+  ;; This is attempted by first looking at the RCS keywords.
+  ;; If there are no keywords in the working file, 
+  ;; vc-master-workfile-version is taken.
+  ;; Note that this property is cached, that is, it is only 
+  ;; looked up if it is nil.
+  ;; For SCCS, this property is equivalent to vc-latest-version.
+  (cond ((vc-file-getprop file 'vc-workfile-version))
+        ((eq (vc-backend-deduce file) 'SCCS) (vc-latest-version file))
+        ((eq (vc-backend-deduce file) 'RCS)
+         (if (vc-consult-rcs-headers file)
+             (vc-file-getprop file 'vc-workfile-version)
+           (let ((rev (cond ((vc-master-workfile-version file))
+                            ((vc-latest-version file)))))
+             (vc-file-setprop file 'vc-workfile-version rev)
+             rev)))
+        ((eq (vc-backend-deduce file) 'CVS)
+         (if (vc-consult-rcs-headers file)   ;; CVS
+             (vc-file-getprop file 'vc-workfile-version)
+           (catch 'found
+             (vc-find-cvs-master (file-name-directory file)
+                                 (file-name-nondirectory file)))
+           (vc-file-getprop file 'vc-workfile-version)))))
+
+(provide 'vc-cc-hooks)
+
+;;; vc-cc-hooks.el ends here
+;;; vc-cc.el --- ClearCase version of vc.el
+
+;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+
+;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
+;; Maintainer: ttn@netcom.com
+;; Version: 5.6
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: It's not clear at this point.
+;;; mly synched this with FSF at version 5.4.  Stig did a whole lot
+;;; of stuff to it since then, and so has the FSF.
+
+;;; ################## NOTE:
+
+;;; ################## This is NOT the standard vc.el, and it
+;;; conflicts with vc.el.  If you want to use this, you need to
+;;; explicitly load it using `M-x load-library vc-cc', *BEFORE* doing
+;;; anything that loads vc.el. (It might work if loaded after vc.el,
+;;; but we make no guarantees.) You can ensure this by putting a line
+;;; like this in your init file:
+
+;;; (load-library "vc-cc")
+
+;;; If you want to be really cool, merge the ClearCase changes in this
+;;; file into vc.el.
+
+
+;;; Commentary:
+
+;; This mode is fully documented in the Emacs user's manual.
+;;
+;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
+;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
+;; and Richard Stallman contributed valuable criticism, support, and testing.
+;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
+;; in Jan-Feb 1994.
+;;
+;; XEmacs fixes, CVS fixes, and general improvements
+;; by Jonathan Stigelman <Stig@hackvan.com>
+;;
+;; Merged ClearCase features from ClearCase extensions version: 2.2.3 and
+;; added highlighting and menubar access to vc-dired-mode by Chris Felaco
+;; <felaco@iatcmail.ed.ray.com>.
+;;
+;; Supported version-control systems presently include SCCS, RCS, and CVS.
+;; The RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
+;; or newer.  Currently (January 1994) that is only a beta test release.
+;; Even initial checkins will fail if your RCS version is so old that ci
+;; doesn't understand -t-; this has been known to happen to people running
+;; NExTSTEP 3.0.
+;;
+;; The RCS code assumes strict locking.  You can support the RCS -x option
+;; by adding pairs to the vc-master-templates list.
+;;
+;; Proper function of the SCCS diff commands requires the shellscript vcdiff
+;; to be installed somewhere on Emacs's path for executables.
+;;
+;; If your site uses the ChangeLog convention supported by Emacs, the
+;; function vc-comment-to-change-log should prove a useful checkin hook.
+;;
+;; 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 as documented, you need 19.
+;; You also need Emacs 19's ring.el.
+;;
+;; The vc code maintains some internal state in order to reduce expensive
+;; version-control operations to a minimum.  Some names are only computed
+;; once.  If you perform version control operations with RCS/SCCS/CVS while
+;; vc's back is turned, or move/rename master files while vc is running,
+;; vc may get seriously confused.  Don't do these things!
+;;
+;; Developer's notes on some concurrency issues are included at the end of
+;; the file.
+
+;;; Code:
+
+(require 'vc-cc-hooks)
+(require 'ring)
+(eval-when-compile (require 'dired))    ; for dired-map-over-marks macro
+
+(put 'vc-backend-dispatch 'lisp-indent-hook 0)
+(require 'comint)
+(require 'tq) ;; For ClearCase support
+
+(defconst cc-vc-version "2.2.3")
+(defconst cc-vc-maintainer-address "bug-cc-vc@bloom-beacon.mit.edu")
+
+(defun cc-vc-submit-bug-report ()
+   "Submit via mail a bug report on ClearCase VC"
+   (interactive)
+   (require 'reporter)
+   (and (y-or-n-p "Do you really want to submit a report on CC-VC? ")
+        (reporter-submit-bug-report
+          cc-vc-maintainer-address
+          (concat "vc.el " cc-vc-version)
+          '(vc-diff-on-checkin vc-keep-workfiles vc-default-back-end
+                               vc-master-templates))))
+
+(defvar vc-alternate-lsvtree nil
+  "*Use an alternate external program instead of xlsvtree")
+
+(defvar vc-diff-on-checkin nil
+  "*Display diff on checkin to help you compose the checkin comment.")
+
+(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
+
+(defvar vc-default-back-end nil
+  "*Back-end actually used by this interface; may be SCCS or RCS.
+The value is only computed when needed to avoid an expensive search.")
+(defvar vc-suppress-confirm nil
+  "*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
+(defvar vc-keep-workfiles t
+  "*If non-nil, don't delete working files after registering changes.
+If the back-end is CVS, workfiles are always kept, regardless of the
+value of this flag.")
+(defvar vc-initial-comment nil
+  "*Prompt for initial comment when a file is registered.")
+(defvar vc-command-messages nil
+  "*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].")
+(defvar vc-default-comment "[no seeded comment]"
+  "*Default comment for when no checkout comment is available, or
+for those version control systems which don't support checkout comments.")
+(defvar vc-checkin-on-register nil
+  "*If t, file will be checked-in when first registered.
+This only applies to version control systems that by default leave files
+checked-out when first registered.")
+(defvar vc-suppress-checkout-comments nil
+  "*Suppress prompts for checkout comments for those version control
+systems which use them.")
+(defvar vc-checkout-switches nil
+  "*Extra switches passed to the checkout program by \\[vc-checkout].")
+(defvar vc-directory-exclusion-list '("SCCS" "RCS" "lost+found")
+  "*Directory names ignored by functions that recursively walk file trees.")
+
+(defvar vc-dired-highlight t
+  "*If non-nil, highlight registered and reserved files in vc-dired buffers.")
+
+(defvar vc-checkout-dir-on-register 'ask
+  "*If t, automatically checkout the directory (if needed) when registering files.
+If nil, don't checkout the directory and cancel the registration.
+If `ask', prompt before checking out the directory.
+
+This only applies to version control systems with versioned directories (namely
+ClearCase.")
+
+(defconst vc-maximum-comment-ring-size 32
+  "Maximum number of saved comments in the comment ring.")
+
+;;; XEmacs - This is dumped into loaddefs.el already.
+;(defvar diff-switches "-c"
+;  "*A string or list of strings specifying switches to be passed to diff.")
+
+;;;dont ###autoload, it conflicts with vc.el
+(defvar vc-checkin-hook nil
+  "*List of functions called after a checkin is done.  See `run-hooks'.")
+
+;;;dont ###autoload, it conflicts with vc.el
+(defvar vc-before-checkin-hook nil
+  "*List of functions called before a checkin is done.  See `run-hooks'.")
+
+(defvar vc-make-buffer-writable-hook nil
+  "*List of functions called when a buffer is made writable.  See `run-hooks.'
+This hook is only used when the version control system is CVS.  It
+might be useful for sites who uses locking with CVS, or who uses link
+farms to gold trees.")
+
+;; Header-insertion hair
+
+(defvar vc-header-alist
+  '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
+  "*Header keywords to be inserted when `vc-insert-headers' is executed.")
+(defvar vc-static-header-alist
+  '(("\\.c$" .
+     "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
+  "*Associate static header string templates with file types.  A \%s in the
+template is replaced with the first string associated with the file's
+version-control type in `vc-header-alist'.")
+
+(defvar vc-comment-alist
+  '((nroff-mode ".\\\"" ""))
+  "*Special comment delimiters to be used in generating vc headers only.
+Add an entry in this list if you need to override the normal comment-start
+and comment-end variables.  This will only be necessary if the mode language
+is sensitive to blank lines.")
+
+;; Default is to be extra careful for super-user.
+(defvar vc-checkout-carefully (= (user-uid) 0) ; #### - this prevents preloading!
+  "*Non-nil means be extra-careful in checkout.
+Verify that the file really is not locked
+and that its contents match what the master file says.")
+
+;; Variables the user doesn't need to know about.
+(defvar vc-log-entry-mode nil)
+(defvar vc-log-operation nil)
+(defvar vc-log-after-operation-hook nil)
+(defvar vc-log-writable nil)
+(defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
+;; In a log entry buffer, this is a local variable
+;; that points to the buffer for which it was made
+;; (either a file, or a VC dired 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-comment-ring nil)
+(defvar vc-comment-ring-index nil)
+(defvar vc-last-comment-match nil)
+(defvar vc-window-config nil)
+
+(defvar vc-cleartool-path
+  "/usr/atria/bin/cleartool"
+  "Path to ClearCase cleartool")
+
+;; File property caching
+
+(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-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))))
+
+(defvar vc-binary-assoc nil)
+
+(defun vc-find-binary (name)
+  "Look for a command anywhere on the subprocess-command search path."
+  (or (cdr (assoc name vc-binary-assoc))
+      ;; XEmacs - use locate-file
+      (let ((full (locate-file name exec-path nil 1)))
+        (if full
+            (setq vc-binary-assoc (cons (cons name full) vc-binary-assoc)))
+        full)))
+
+(defun vc-do-command (okstatus command file last &rest flags)
+  "Execute a version-control command, notifying user and checking for errors.
+The command is successful if its exit status does not exceed OKSTATUS.
+Output from COMMAND goes to buffer *vc*.  The last argument of the command is
+the master name of FILE if LAST is 'MASTER, or the workfile of FILE if LAST is
+'WORKFILE; this is appended to an optional list of FLAGS."
+  (setq file (expand-file-name file))
+  (let ((camefrom (current-buffer))
+        (pwd (file-name-directory (expand-file-name file)))
+        (squeezed nil)
+        (vc-file (and file (vc-name file)))
+        status)
+;;; #### - don't know why this code was here...to beautify the echo message?
+;;;        the version of code below doesn't break default-directory, but it
+;;;        still might mess up CVS and RCS because they like to operate on
+;;;        files in the current directory. --Stig
+;;;
+;;;     (if (string-match (concat "^" (regexp-quote pwd)) file)
+;;;         (setq file (substring file (match-end 0)))
+;;;       (setq pwd (file-name-directory file)))
+    (if vc-command-messages
+        (message "Running %s on %s..." command file))
+    (set-buffer (get-buffer-create "*vc*"))
+    (setq default-directory pwd
+          file (file-name-nondirectory file))
+
+    (set (make-local-variable 'vc-parent-buffer) camefrom)
+    (set (make-local-variable 'vc-parent-buffer-name)
+         (concat " from " (buffer-name camefrom)))
+
+    (erase-buffer)
+
+    (mapcar
+     (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
+     flags)
+    (if (and vc-file (eq last 'MASTER))
+        (setq squeezed (append squeezed (list vc-file))))
+    (if (eq last 'WORKFILE)
+        (setq squeezed (append squeezed (list file))))
+    (let ((exec-path (if vc-path (append vc-path exec-path) exec-path))
+          ;; Add vc-path to PATH for the execution of this command.
+          (process-environment (copy-sequence process-environment)))
+      (setenv "PATH" (mapconcat 'identity exec-path ":"))
+      (setq status (apply 'call-process command nil t nil squeezed)))
+    (goto-char (point-max))
+    (set-buffer-modified-p nil)         ; XEmacs - fsf uses `not-modified'
+    (forward-line -1)
+    (if (or (not (integerp status)) (< okstatus status))
+        (progn
+          (pop-to-buffer "*vc*")
+          (goto-char (point-min))
+          (shrink-window-if-larger-than-buffer)
+          (error "Running %s...FAILED (%s)" command
+                 (if (integerp status)
+                     (format "status %d" status)
+                   status))
+          )
+      (if vc-command-messages
+          (message "Running %s...OK" command))
+      )
+    (set-buffer camefrom)
+    status)
+  )
+
+;;; Save a bit of the text around POSN in the current buffer, to help
+;;; us find the corresponding position again later.  This works even
+;;; if all markers are destroyed or corrupted.
+(defun vc-position-context (posn)
+  (list posn
+        (buffer-size)
+        (buffer-substring posn
+                          (min (point-max) (+ posn 100)))))
+
+;;; Return the position of CONTEXT in the current buffer, or nil if we
+;;; couldn't find it.
+(defun vc-find-position-by-context (context)
+  (let ((context-string (nth 2 context)))
+    (if (equal "" context-string)
+        (point-max)
+      (save-excursion
+        (let ((diff (- (nth 1 context) (buffer-size))))
+          (if (< diff 0) (setq diff (- diff)))
+          (goto-char (nth 0 context))
+          (if (or (search-forward context-string nil t)
+                  ;; Can't use search-backward since the match may continue
+                  ;; after point.
+                  (progn (goto-char (- (point) diff (length context-string)))
+                         ;; goto-char doesn't signal an error at
+                         ;; beginning of buffer like backward-char would
+                         (search-forward context-string nil t)))
+              ;; to beginning of OSTRING
+              (- (point) (length context-string))))))))
+
+(defun vc-revert-buffer1 (&optional arg no-confirm)
+  ;; Most of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
+  ;; Revert buffer, try to keep point and mark where user expects them in spite
+  ;; of changes because of expanded version-control key words.
+  ;; This is quite important since otherwise typeahead won't work as expected.
+  (interactive "P")
+  (widen)
+  (let ((point-context (vc-position-context (point)))
+        ;; Use mark-marker to avoid confusion in transient-mark-mode.
+        ;; XEmacs - mark-marker t
+        (mark-context  (if (eq (marker-buffer (mark-marker t)) (current-buffer))
+                           (vc-position-context (mark-marker t))))
+        ;; We may want to reparse the compilation buffer after revert
+        (reparse (and (boundp 'compilation-error-list) ;compile loaded
+                      ;; Construct a list; each elt is nil or a buffer
+                      ;; iff that buffer is a compilation output buffer
+                      ;; that contains markers into the current buffer.
+                      (save-excursion
+                        (mapcar (function
+                                 (lambda (buffer)
+                                   (set-buffer buffer)
+                                   (let ((errors (or
+                                                  (symbol-value 'compilation-old-error-list)
+                                                  (symbol-value 'compilation-error-list)))
+                                         (buffer-error-marked-p nil))
+                                     (while (and (consp errors)
+                                                 (not buffer-error-marked-p))
+                                       (and (markerp (cdr (car errors)))
+                                            (eq buffer
+                                                (marker-buffer
+                                                 (cdr (car errors))))
+                                            (setq buffer-error-marked-p t))
+                                       (setq errors (cdr errors)))
+                                     (if buffer-error-marked-p buffer))))
+                                (buffer-list))))))
+
+    ;; The FSF version intentionally runs font-lock here.  That
+    ;; usually just leads to a correctly font-locked buffer being
+    ;; redone.  #### We should detect the cases where the font-locking
+    ;; may be incorrect (such as on reverts).  We know that it is fine
+    ;; during regular checkin and checkouts.
+
+    ;; the actual revisit
+    (revert-buffer arg no-confirm)
+
+    ;; Reparse affected compilation buffers.
+    (while reparse
+      (if (car reparse)
+          (save-excursion
+            (set-buffer (car reparse))
+            (let ((compilation-last-buffer (current-buffer)) ;select buffer
+                  ;; Record the position in the compilation buffer of
+                  ;; the last error next-error went to.
+                  (error-pos (marker-position
+                              (car (car-safe compilation-error-list)))))
+              ;; Reparse the error messages as far as they were parsed before.
+              (if (fboundp 'compile-reinitialize-errors)
+                  (if vc-elucidated
+                      (compile-reinitialize-errors '(4))
+                    (compile-reinitialize-errors '(4) compilation-parsing-end)))
+              ;; Move the pointer up to find the error we were at before
+              ;; reparsing.  Now next-error should properly go to the next one.
+              (while (and compilation-error-list
+                          (/= error-pos (car (car compilation-error-list))))
+                (setq compilation-error-list (cdr compilation-error-list))))))
+      (setq reparse (cdr reparse)))
+
+    ;; Restore point and mark
+    (let ((new-point (vc-find-position-by-context point-context)))
+      (if new-point (goto-char new-point)))
+    (if mark-context
+        (let ((new-mark (vc-find-position-by-context mark-context)))
+          (if new-mark (set-mark new-mark))))))
+
+
+(defun vc-buffer-sync (&optional not-urgent)
+  ;; Make sure the current buffer and its working file are in sync
+  ;; NOT-URGENT means it is ok to continue if the user says not to save.
+  (if (buffer-modified-p)
+      (if (or vc-suppress-confirm
+              (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
+          (save-buffer)
+        (if not-urgent
+            nil
+          (error "Aborted")))))
+
+;;;dont ###autoload, it conflicts with vc.el
+(defun vc-file-status ()
+  "Display the current status of the file being visited.
+Currently, this is only defined for CVS and ClearCase.
+The information provided in the modeline is generally sufficient for
+RCS and SCCS."
+  ;; by Stig@hackvan.com
+  (interactive)
+
+  (let* ((file (if vc-dired-mode (dired-get-filename)
+                   (vc-buffer-sync t) buffer-file-name))
+         (type (vc-backend-deduce file)))
+    (cond ((null type)
+           (if file
+               (message "`%s' is not registered with a version control system."
+                        file)
+             (ding)
+             (message "Buffer `%s' has no associated file."
+                      (buffer-name (current-buffer)))))
+          ((eq 'CVS type)
+           (vc-do-command 0 "cvs" file 'WORKFILE "status" "-v")
+           (set-buffer "*vc*")
+           (set-buffer-modified-p nil)
+           ;; reparse the status information, since we have it handy...
+           (vc-parse-buffer '("Status: \\(.*\\)") file '(vc-cvs-status))
+           (goto-char (point-min))
+           (shrink-window-if-larger-than-buffer
+            (display-buffer (current-buffer))))
+          ((eq '@@ type)
+           (vc-do-command 0 "cleartool" file 'WORKFILE "describe")
+           (set-buffer "*vc*")
+           (set-buffer-modified-p nil)
+           (goto-char (point-min))
+           (shrink-window-if-larger-than-buffer
+            (display-buffer (current-buffer))))
+          (t
+           (ding)
+           (message "Operation not yet defined for RCS or SCCS.")))
+    ))
+
+(defun vc-workfile-unchanged-p (file &optional want-differences-if-changed)
+  ;; Has the given workfile changed since last checkout?
+  (cond ((and (eq 'CVS (vc-backend-deduce file))
+              (not want-differences-if-changed))
+
+         (let ((status (vc-file-getprop file 'vc-cvs-status)))
+           ;; #### - should this have some kind of timeout?  how often does
+           ;; this get called?  possibly the cached information should be
+           ;; flushed out of hand.  The only concern is the VC menu, which
+           ;; may indirectly call this function.
+           (or status                   ; #### - caching is error-prone
+               (setq status (car (vc-log-info "cvs" file 'WORKFILE '("status")
+                                              '("Status: \\(.*\\)")
+                                              '(vc-cvs-status)))))
+           (string= status "Up-to-date")))
+        (t
+         (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
+               (lastmod (nth 5 (file-attributes file)))
+               unchanged)
+           (or (equal checkout-time lastmod)
+               (and (or (not checkout-time) want-differences-if-changed)
+                    (setq unchanged
+                          (zerop (vc-backend-diff file nil nil
+                                                  (not want-differences-if-changed))))
+                    ;; 0 stands for an unknown time; it can't match any mod time.
+                    (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
+                    unchanged))))))
+
+(defun vc-owner-equal (o1 o2)
+  (let ((len1 (length o1))
+        (len2 (length o2)))
+    (string-equal (substring o1 0 (min len1 8))
+                  (substring o2 0 (min len2 8)))))
+
+(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-deduce file))
+        owner version)
+    (cond
+
+     ;; if there is no master file corresponding, create one
+     ((not vc-file)
+      (vc-register verbose comment))
+
+     ;; if there is no lock on the file, assert one and get it
+     ((and (not (eq vc-type 'CVS))      ;There are no locks in CVS.
+           (not (setq owner (vc-locking-user file))))
+      (if (and vc-checkout-carefully
+               (not (vc-workfile-unchanged-p file t)))
+          (if (save-window-excursion
+                (pop-to-buffer "*vc*")
+                (goto-char (point-min))
+                (insert (format "Changes to %s since last lock:\n\n" file))
+                (not (beep))
+                (yes-or-no-p
+                 "File has unlocked changes, claim lock retaining changes? "))
+              (progn (vc-backend-steal file)
+                     (vc-mode-line file))
+            (if (not (yes-or-no-p "Revert to checked-in version, instead? "))
+                (error "Checkout aborted.")
+              (vc-revert-buffer1 t t)
+              (vc-checkout-writable-buffer file))
+            )
+        (vc-checkout-writable-buffer file)))
+
+     ;; a checked-out version exists, but the user may not own the lock
+     ((and (not (eq vc-type 'CVS))      ;There are no locks in CVS.
+           (not (string-equal owner (user-login-name))))
+      (if comment
+          (error "Sorry, you can't steal the lock on %s this way" file))
+      (vc-steal-lock
+       file
+       (and verbose (read-string "Version to steal: "))
+       owner))
+
+     ;; changes to the master file needs to be merged back into the
+     ;; working file
+     ((and (eq vc-type 'CVS)
+           ;; "0" means "added, but not yet committed"
+           (not (string= (vc-file-getprop file 'vc-your-latest-version) "0"))
+           (progn
+             (vc-fetch-properties file)
+             (not (string= (vc-file-getprop file 'vc-your-latest-version)
+                           (vc-file-getprop file 'vc-latest-version)))))
+      (vc-buffer-sync)
+      (if (yes-or-no-p (format "%s is not up-to-date.  Merge in changes now? "
+                               (buffer-name)))
+          (progn
+            (if (and (buffer-modified-p)
+                     (not (yes-or-no-p
+                           (format
+                            "Buffer %s modified; merge file on disc anyhow? "
+                            (buffer-name)))))
+                (error "Merge aborted"))
+            (if (not (zerop (vc-backend-merge-news file)))
+                ;; Overlaps detected - what now?  Should use some
+                ;; fancy RCS conflict resolving package, or maybe
+                ;; emerge, but for now, simply warn the user with a
+                ;; message.
+                (message "Conflicts detected!"))
+            (vc-resynch-window file t (not (buffer-modified-p))))
+
+        (error "%s needs update" (buffer-name))))
+
+     ((and buffer-read-only (eq vc-type 'CVS))
+      (toggle-read-only)
+      ;; Sites who make link farms to a read-only gold tree (or
+      ;; something similar) can use the hook below to break the
+      ;; sym-link.
+      (run-hooks 'vc-make-buffer-writable-hook))
+
+     ;; OK, user owns the lock on the file (or we are running CVS)
+     (t
+      (find-file file)
+
+      ;; give luser a chance to save before checking in.
+      (vc-buffer-sync)
+
+      ;; Revert if file is unchanged and buffer is too.
+      ;; If buffer is modified, that means the user just said no
+      ;; to saving it; in that case, don't revert,
+      ;; because the user might intend to save
+      ;; after finishing the log entry.
+      (if (and (vc-workfile-unchanged-p file)
+               (not (buffer-modified-p)))
+          (progn
+            (if (eq vc-type 'CVS)
+                (message "No changes to %s" file)
+
+              (vc-backend-revert file)
+              ;; DO NOT revert the file without asking the user!
+              (vc-resynch-window file t nil)))
+
+        ;; user may want to set nonstandard parameters
+        (if verbose
+            (setq version (read-string "New version level: ")))
+
+        ;; OK, let's do the checkin
+        (vc-checkin file version comment)
+        )))
+    ))
+
+(defun vc-next-action-on-dir (dirname verbose &optional comment)
+  ;;; If comment is specified, it will be used as an admin or checkin comment.
+  (let ((vc-file (vc-name dirname))
+        (vc-type (vc-backend-deduce dirname))
+        owner version)
+    (cond
+
+     ;; if there is no master file corresponding, create one
+     ((not vc-file)
+      (vc-register verbose comment))
+
+     ;; if there is no lock on the file, assert one and get it
+     ((not (setq owner (vc-locking-user dirname)))
+      (vc-checkout-writable-buffer dirname))
+
+     ;; a checked-out version exists, but the user may not own the lock
+     ((not (string-equal owner (user-login-name)))
+
+      (if comment
+          (error "Sorry, you can't steal the lock on %s this way" dirname))
+      (vc-steal-lock
+       dirname
+       (and verbose (read-string "Version to steal: "))
+       owner))
+
+     ;; OK, user owns the lock on the file
+     (t
+      ;; TODO: figure out how to check if directory is unchanged
+
+      ;; user may want to set nonstandard parameters
+      (if verbose
+          (setq version (read-string "New version level: ")))
+
+      ;; OK, let's do the checkin
+      (vc-checkin dirname version comment)
+      ))
+    ))
+
+(defun vc-next-action-dired (file &optional writable rev workfile comment)
+  ;; We've accepted a log comment, now do a vc-next-action using it on all
+  ;; marked files.
+  (set-buffer vc-parent-buffer)
+  (dired-map-over-marks
+     (save-window-excursion
+     ;;; !!! dired-get-filename doesn't  DTRT if the filename entry is
+     ;;; an absolute pathname..
+     (let ((file (dired-get-filename)))
+       (message "Processing %s..." file)
+       (save-window-excursion
+         (vc-next-action-on-file file nil comment)
+         (message "Processing %s...done" file))))
+   nil t)
+  )
+
+(defun vc-next-dir-action (verbose)
+  (let* ((file default-directory)
+         (owner (vc-locking-user file)))
+    (cond
+     ((not owner)
+      (vc-checkout-writable-buffer file))
+     ((vc-owner-equal owner (user-login-name))
+      (vc-checkin file nil nil))
+     (t
+      (error "Now what do we do?")))))
+
+;; Here's the major entry point.
+
+;;;dont ###autoload, it conflicts with vc.el
+(defun vc-next-action (verbose)
+  "Do the next logical checkin or checkout operation on the current file.
+
+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.
+   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
+first checks to see if the file has changed since checkout.  If not,
+it performs a revert.
+   If the file has been changed, this pops up a buffer for entry
+of a log message; when the message has been entered, it checks in the
+resulting changes along with the log message as change commentary.  If
+the variable `vc-keep-workfiles' is non-nil (which is its default), a
+read-only copy of the changed file is left in place afterwards.
+   If the file is registered and locked by someone else, you are given
+the option to steal the lock.
+
+For CVS files:
+   If the file is not already registered, this registers it for version
+control.  This does a \"cvs add\", but no \"cvs commit\".
+   If the file is added but not committed, it is committed.
+   If the file has not been changed, neither in your working area or
+in the repository, a message is printed and nothing is done.
+   If your working file is changed, but the repository file is
+unchanged, this pops up a buffer for entry of a log message; when the
+message has been entered, it checks in the resulting changes along
+with the logmessage as change commentary.  A writable file is retained.
+   If the repository file is changed, you are asked if you want to
+merge in the changes into your working copy.
+
+The following is true regardless of which version control system you
+are using:
+
+   If you call this from within a VC dired buffer with no files marked,
+it will operate on the file in the current line.
+   If you call this from within a VC dired buffer, and one or more
+files are marked, it will accept a log message and then operate on
+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.
+
+   For checkin, a prefix argument lets you specify the version number to use."
+  (interactive "P")
+  (catch 'nogo
+    (if (or vc-dired-mode
+            (and (eq major-mode 'dired-mode)
+                 (string= "\C-xvv" (if vc-elucidated
+                                       (events-to-keys (this-command-keys))
+                                     (this-command-keys)))))
+        (let ((files (dired-get-marked-files)))
+          (if (= (length files) 1)
+              (if (file-directory-p (car files))
+                  (let* ((dirname (car files))
+                         (registered (vc-registered dirname)))
+                    (if (and registered (eq '@@ (cdr registered)))
+                        (progn (vc-next-action-on-dir dirname nil)
+                               (throw 'nogo nil)))
+                    (vc-registration-error nil))
+                (find-file-other-window (car files)))
+            (vc-start-entry nil nil nil
+                            "Enter a change comment for the marked files."
+                            'vc-next-action-dired
+                            nil
+                            nil         ;after-hook could be used here??
+                            )
+            (throw 'nogo nil))))
+    (while vc-parent-buffer
+      (pop-to-buffer vc-parent-buffer))
+    (if buffer-file-name
+        (vc-next-action-on-file buffer-file-name verbose)
+      ;; TODO: Add code to operate on ClearCase directories here.
+      (vc-registration-error nil))))
+
+;;; These functions help the vc-next-action entry point
+
+(defun vc-checkout-writable-buffer (&optional file)
+  "Retrieve a writable copy of the latest version of the current buffer's file."
+  (if (and (vc-file-getprop file 'vc-need-pre-checkout-message)
+           (not vc-suppress-checkout-comments))
+      (progn
+        (vc-start-entry file nil nil "Enter a checkout comment." 'vc-backend-checkout t 'vc-checkout))
+    (vc-checkout (or file (buffer-file-name)) t)))
+
+;;;dont ###autoload, it conflicts with vc.el
+(defun vc-register (&optional override comment)
+  "Register the current file into your version-control system."
+  (interactive "P")
+  (let ((master (vc-name buffer-file-name)))
+    (and master (file-exists-p master)
+         (error "This file is already registered"))
+    (and master
+         (not (y-or-n-p "Previous master file has vanished.  Make a new one? "))
+         (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
+   (and override
+        (read-string
+         (format "Initial version level for %s: " buffer-file-name)))
+   comment)
+  )
+
+(defun vc-resynch-window (file &optional keep noquery)
+  ;; If the given file is in the current buffer,
+  ;; either revert on it so we see expanded keyworks,
+  ;; or unvisit it (depending on vc-keep-workfiles)
+  ;; NOQUERY if non-nil inhibits confirmation for reverting.
+  ;; NOQUERY should be t *only* if it is known the only difference
+  ;; between the buffer and the file is due to RCS rather than user editing!
+  (and (string= buffer-file-name file)
+       (if keep
+           (progn
+             (vc-revert-buffer1 t noquery)
+             (vc-mode-line buffer-file-name))
+         (progn
+           (delete-window)
+           (kill-buffer (current-buffer))))))
+
+(defsubst vc-log-buffer-name (file-name)
+  (format "*Log-%s*" (or file-name "Marked")))
+
+(defun vc-start-entry (file rev comment msg action &optional writable after-hook before-hook)
+  ;; Accept a comment for an operation on FILE revision REV.  If COMMENT
+  ;; is nil, pop up a VC-log buffer, emit MSG, and set the
+  ;; action on close to ACTION; otherwise, do action immediately.
+  ;; Remember the file's buffer in vc-parent-buffer (current one if no file).
+  ;; AFTER-HOOK specifies the local value for vc-log-operation-hook.
+  ;; BEFORE-HOOK specifies a hook to run before even asking for the
+  ;; checkin comments.
+  (let* ((parent (if file (find-file-noselect file) (current-buffer)))
+         (log-buffer-name (vc-log-buffer-name (if file (file-name-nondirectory file))))
+         (log-buffer (get-buffer-create log-buffer-name)))
+    (when before-hook
+      (save-excursion
+        (set-buffer parent)
+        (run-hooks before-hook)))
+    (if comment
+        (set-buffer log-buffer)
+      (let ((old-window-config (current-window-configuration)))
+        (pop-to-buffer log-buffer)
+        (set (make-local-variable 'vc-window-config) old-window-config)))
+    (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 (or file " (no file)"))
+    ;; If file is not checked out, the log buffer will be read-only
+    (setq buffer-read-only nil)
+    (vc-log-mode)
+    (make-local-variable 'vc-log-after-operation-hook)
+    (if after-hook
+        (setq vc-log-after-operation-hook after-hook))
+    (setq vc-log-operation action)
+    (setq vc-log-file file)
+    (setq vc-log-version rev)
+    (setq vc-log-writable writable)
+    (if comment
+        (progn
+          (erase-buffer)
+          (if (eq comment t)
+              (vc-finish-logentry t)
+            (insert comment)
+            (vc-finish-logentry nil)))
+      (or writable
+          (vc-backend-fetch-default-comment file rev))
+      (message "%s  Type C-c C-c when done." msg))))
+
+(defun vc-admin (file rev &optional comment)
+  "Check a file into your version-control system.
+FILE is the unmodified name of the file.  REV should be the base version
+level to check it in under.  COMMENT, if specified, is the checkin comment."
+
+  ;; For ClearCase, we need to checkout the directory
+  (let ((filedir (file-name-directory file)) user)
+    (if (eq (vc-backend-deduce filedir) '@@)
+        (progn
+          (setq user (vc-locking-user filedir))
+          (if user
+              (if (not (equal user (user-login-name)))
+                  (error "Directory is locked by %s." user))
+            (if (cond
+                 ((eq vc-checkout-dir-on-register 'ask)
+                  (y-or-n-p (format "Checkout directory %s " filedir)))
+                 (vc-checkout-dir-on-register)
+                 (t nil))
+                (vc-backend-checkout filedir t rev nil comment)
+              (error "Can't register file unless directory is reserved.")
+              )))))
+
+  (vc-start-entry file rev
+                  (or comment (not vc-initial-comment))
+                  "Enter initial comment." 'vc-backend-admin
+                  nil nil 'vc-before-checkin-hook))
+
+;;;dont ###autoload, it conflicts with vc.el
+(defun vc-checkout (file &optional writable)
+  "Retrieve a copy of the latest version of the given file."
+  ;; XEmacs - ftp is suppressed by the check for a filename handler in
+  ;;          vc-registered, so this is needless surplussage
+  ;; If ftp is on this system and the name matches the ange-ftp format
+  ;; for a remote file, the user is trying something that won't work.
+  ;;   (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp"))
+  ;;       (error "Sorry, you can't check out files over FTP"))
+  (vc-backend-checkout file writable)
+  (if (string-equal file buffer-file-name)
+      (vc-resynch-window file t t))
+  )
+
+(defun vc-steal-lock (file rev &optional owner)
+  "Steal the lock on the current workfile."
+  (let (file-description)
+    (if (not owner)
+        (setq owner (vc-locking-user file)))
+    (if rev
+        (setq file-description (format "%s:%s" file rev))
+      (setq file-description file))
+    (if (not (y-or-n-p (format "Take the lock on %s from %s? "
+                               file-description owner)))
+        (error "Steal cancelled"))
+    (pop-to-buffer (get-buffer-create "*VC-mail*"))
+    (setq default-directory (expand-file-name "~/"))
+    (auto-save-mode auto-save-default)
+    (mail-mode)
+    (erase-buffer)
+    (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil
+                (list (list 'vc-finish-steal file rev)))
+    (goto-char (point-max))
+    (insert
+     (format "I stole the lock on %s, " file-description)
+     (current-time-string)
+     ".\n")
+    (message "Please explain why you stole the lock.  Type C-c C-c when done.")))
+
+;; This is called when the notification has been sent.
+(defun vc-finish-steal (file version)
+  (vc-backend-steal file version)
+  (if (get-file-buffer file)
+      (save-excursion
+        (set-buffer (get-file-buffer file))
+        (vc-resynch-window file t t))))
+
+(defun vc-checkin (file &optional rev comment)
+  "Check in the file specified by FILE.
+The optional argument REV may be a string specifying the new version level
+\(if nil increment the current level).  The file is either retained with write
+permissions zeroed, or deleted (according to the value of `vc-keep-workfiles').
+If the back-end is CVS, a writable workfile is always kept.
+COMMENT is a comment string; if omitted, a buffer is
+popped up to accept a comment."
+  (vc-start-entry file rev comment
+                  "Enter a change comment." 'vc-backend-checkin
+                  nil 'vc-checkin-hook 'vc-before-checkin-hook)
+  (if (and (not comment) (not (file-directory-p file)) vc-diff-on-checkin)
+      (save-excursion
+        (let ((tmp-buffer (current-buffer)))
+          (message "Running diff...")
+          (vc-diff nil)
+          (message "Running diff...done")
+          (set-buffer "*vc*")
+          (if (get-buffer "*vc-diff*")
+              (kill-buffer "*vc-diff*"))
+          (rename-buffer "*vc-diff*")
+          (pop-to-buffer tmp-buffer)))))
+
+;;; 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 whoami file-name)
+  "Enter last VC comment into change log file for current buffer's file.
+Optional arg (interactive prefix) non-nil means prompt for user name and site.
+Second arg is file name of change log.  \
+If nil, uses `change-log-default-name'."
+  (interactive (if current-prefix-arg
+                   (list current-prefix-arg
+                         (prompt-for-change-log-name))))
+  ;; Make sure the defvar for add-log-current-defun-function has been executed
+  ;; before binding it.
+  (require 'add-log)
+  (let (;; Extract the comment first so we get any error before doing anything.
+        (comment (ring-ref vc-comment-ring 0))
+        ;; Don't let add-change-log-entry insert a defun name.
+        (add-log-current-defun-function 'ignore)
+        end)
+    ;; Call add-log to do half the work.
+    (add-change-log-entry whoami file-name t t)
+    ;; Insert the VC comment, leaving point before it.
+    (setq end (save-excursion (insert comment) (point-marker)))
+    (if (looking-at "\\s *\\s(")
+        ;; It starts with an open-paren, as in "(foo): Frobbed."
+        ;; So remove the ": " add-log inserted.
+        (delete-char -2))
+    ;; Canonicalize the white space between the file name and comment.
+    (just-one-space)
+    ;; Indent rest of the text the same way add-log indented the first line.
+    (let ((indentation (current-indentation)))
+      (save-excursion
+        (while (< (point) end)
+          (forward-line 1)
+          (indent-to indentation))
+        (setq end (point))))
+    ;; Fill the inserted text, preserving open-parens at bol.
+    (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s("))
+          (paragraph-start (concat paragraph-start "\\|^\\s *\\s(")))
+      (beginning-of-line)
+      (fill-region (point) end))
+    ;; Canonicalize the white space at the end of the entry so it is
+    ;; separated from the next entry by a single blank line.
+    (skip-syntax-forward " " end)
+    (delete-char (- (skip-syntax-backward " ")))
+    (or (eobp) (looking-at "\n\n")
+        (insert "\n"))))
+
+
+(defun vc-cc-save-logentry (comment buffer)
+  (save-excursion
+    (set-buffer buffer)
+    (let* ((file (buffer-file-name))
+           (target (concat (vc-latest-version file))))
+      (cond ((string-match "/CHECKEDOUT$" target)
+             (vc-do-cleartool-command "chevent"
+                                      (vc-cc-build-version file target)
+                                      (vc-cleanup-comment comment) "-replace"))
+            (t
+             (error "Can't change comment of checked-in version with this interface"))))))
+
+(defun vc-save-logentry ()
+  "Checkpoint currently entered comment"
+  (interactive)
+  (let ((comment-string (buffer-string))
+        (parent-buffer vc-parent-buffer))
+    (if (not (buffer-modified-p))
+        (message "(No changes need to be saved)")
+      (progn
+        (save-excursion
+          (set-buffer parent-buffer)
+          (vc-backend-dispatch buffer-file-name
+            (error "Logentry saves not supported under SCCS")
+            (error "Logentry saves not supported under RCS")
+            (error "Logentry saves not supported under CVS")
+            (vc-cc-save-logentry comment-string parent-buffer)))
+        (set-buffer-modified-p nil)))))
+
+(defun vc-num-num-error ()
+  (interactive)
+  (message "Perhaps you wanted to type C-c C-c instead?"))
+
+(defun vc-finish-logentry (&optional nocomment)
+  "Complete the operation implied by the current log entry."
+  (interactive)
+  ;; Check and record the comment, if any.
+  (let ((log-buffer (current-buffer)))
+    (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))
+          ))
+    ;; Sync parent buffer in case the user modified it while editing the comment.
+    ;; But not if it is a vc-dired buffer.
+    (save-excursion
+      (set-buffer vc-parent-buffer)
+      (or vc-dired-mode
+          (vc-buffer-sync)))
+    ;; OK, do it to it
+    (if vc-log-operation
+        (save-excursion
+          (funcall vc-log-operation
+                   vc-log-file
+                   vc-log-writable
+                   vc-log-version
+                   nil
+                   (buffer-string)))
+      (error "No log operation is pending"))
+    ;; Return to "parent" buffer of this checkin and remove checkin window
+    ;; save the vc-log-after-operation-hook of log buffer
+    (let ((after-hook vc-log-after-operation-hook)
+          (old-window-config vc-window-config))
+      (pop-to-buffer vc-parent-buffer)
+      (delete-windows-on log-buffer)
+      (kill-buffer log-buffer)
+      (if old-window-config (set-window-configuration old-window-config))
+      ;; Now make sure we see the expanded headers
+      (if buffer-file-name
+          (vc-resynch-window buffer-file-name vc-keep-workfiles t))
+      (if (and (not (eq vc-log-operation 'vc-next-action-dired))
+               (eq major-mode 'dired-mode))
+          (revert-buffer t t))
+      (run-hooks after-hook))))
+
+;; Code for access to the comment ring
+
+(defun vc-previous-comment (arg)
+  "Cycle backwards through comment history."
+  (interactive "*p")
+  (let ((len (ring-length vc-comment-ring)))
+    (cond ((or (not len) (<= len 0))    ; XEmacs change from Barry Warsaw
+           (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
+                 (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))
+        (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
+
+;;;dont ###autoload, it conflicts with vc.el
+(defun vc-diff (historic &optional not-urgent)
+  "Display diffs between file versions.
+Normally this compares the current file and buffer with the most recent
+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 "P")
+  (if vc-dired-mode
+      (set-buffer (find-file-noselect (dired-get-filename))))
+  (while vc-parent-buffer
+    (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)
+      (or (and file (vc-name file))
+          (vc-registration-error file))
+      (vc-buffer-sync not-urgent)
+      (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
+      (if unchanged
+          (message "No changes to %s since latest version." file)
+        (vc-backend-diff file)
+        ;; 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*")
+        (setq default-directory (file-name-directory file))
+        (if (= 0 (buffer-size))
+            (progn
+              (setq unchanged t)
+              (message "No changes to %s since latest version." file))
+          (goto-char (point-min))
+          (shrink-window-if-larger-than-buffer)))
+      (not unchanged))))
+
+;;;dont ###autoload, it conflicts with vc.el
+(defun vc-version-diff (file rel1 rel2)
+  "For FILE, report diffs between two stored versions REL1 and REL2 of it.
+If FILE is a directory, generate diffs between versions for all registered
+files in or below it."
+  (interactive
+   (progn
+     (let ((file (read-file-name "File or directory to diff: "
+                                 default-directory nil t nil)))
+       (if (file-directory-p file)
+           (let ((r1 (read-string "Older version: "))
+                 (r2 (read-string "Newer version: ")))
+             (list file r1 r2))
+         (let ((r1 (vc-read-version
+                    (format "Older version of %s: "
+                            (file-name-nondirectory file))
+                    file))
+               (r2 (vc-read-version
+                    (format "Newer version of %s: "
+                            (file-name-nondirectory file))
+                    file)))
+           (list file r1 r2))))))
+  (if (string-equal rel1 "") (setq rel1 nil))
+  (if (string-equal rel2 "") (setq rel2 nil))
+  (if (file-directory-p file)
+      (let ((camefrom (current-buffer)))
+        (set-buffer (get-buffer-create "*vc-status*"))
+        (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")
+                " and "
+                (or rel2 "current workfile(s)")
+                ":\n\n")
+        (set-buffer (get-buffer-create "*vc*"))
+        (cd file)
+        (vc-file-tree-walk
+         (function (lambda (f)
+                     (message "Looking at %s" f)
+                     (and
+                      (not (file-directory-p f))
+                      (vc-registered f)
+                      (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))
+        (set-buffer-modified-p nil)
+        )
+    (if (zerop (vc-backend-diff file rel1 rel2))
+        (message "No changes to %s between %s and %s." file rel1 rel2)
+      (pop-to-buffer "*vc*"))))
+
+(defun vc-read-version (prompt file)
+  (vc-backend-dispatch file
+      (read-string prompt (vc-latest-version file))
+      (read-string prompt (vc-latest-version file))
+      (read-string prompt (vc-latest-version file))
+      ;; For ClearCase, use the version-extended path
+      (let* (;; Don't show the whole gory path
+             (insert-default-directory nil)
+             ;; Fetch the latest version for defaults - it's not critical that
+             ;; it be up-to-date, so try the property-list first.
+             (latest (or (vc-file-getprop file 'vc-latest-version)
+                         (vc-latest-version file)))
+             (default (vc-cc-build-version file latest))
+             ;; Make the current directory the branch of the latest version
+             ;; This is the only way that read-file-name will work properly, if
+             ;; I pass in this directory, it doesn't complete properly when
+             ;; subdirectories are used.
+             (default-directory (expand-file-name
+                                (vc-cc-build-version file
+                                                     (file-name-directory latest))))
+             )
+        ;; Extract just version name, but still complete
+        (vc-cc-version-name
+         (expand-file-name
+          (read-file-name (format "%s (default %s): " prompt latest)
+                          nil
+                          default
+                          t
+                          nil