comparison lisp/vc.el @ 2750:6f340eabf13f

Improve doc strings and prompt strings. (vc-cancel-version): Ask whether to revert buffer.

2749:305044e75269

;; 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.

(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, reat 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.")
(defvar vc-initial-comment nil
  "*Prompt for initial comment when a file is registered.")
(defvar vc-command-messages nil

(defvar diff-switches "-c"
  "*A string or list of strings specifying switches to be be passed to diff.")

;;;###autoload
(defvar vc-checkin-hook nil
  "*List of functions called after a vc-checkin is done.  See `run-hooks'.")

;; Header-insertion hair

(defvar vc-header-alist
  '((SCCS "\%W\%") (RCS "\$Id\$"))
  "*Header keywords to be inserted when vc-insert-header is executed.")
(defconst 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
verson-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

;; 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-checkout-writeable-buffer-hook 'vc-checkout-writeable-buffer)
(defvar vc-parent-buffer nil)
(defvar vc-parent-buffer-name nil)

(defvar vc-log-file)
(defvar vc-log-version)

  (setq vc-comment-ring nil))

;; Random helper functions

(defun vc-name (file)
  "Return the master name of a file, nil if it is not registered"
  (or (vc-file-getprop file 'vc-name)
      (vc-file-setprop file 'vc-name
		       (let ((name-and-type (vc-registered file)))
			 (and name-and-type (car name-and-type))))))

     ;; if there is no master file corresponding, create one
     ((not vc-file)
      (vc-register verbose comment)
      (if vc-initial-comment
	  (setq vc-log-after-operation-hook
		'vc-checkout-writeable-buffer-hook)
	(vc-checkout-writeable-buffer file)))

     ;; if there is no lock on the file, assert one and get it
     ((not (setq owner (vc-locking-user file)))
      (vc-checkout-writeable-buffer file))

     ;; 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." file))

;;;###autoload
(defun vc-next-action (verbose)
  "Do the next logical checkin or checkout operation on the current file.
   If the file is not already registered, this registers it for version
control and then retrieves a writeable, locked copy for editing.
   If the file is registered and not locked by anyone, this checks out
a writeable 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.
   If you call this from within a VC dired buffer with no files marked,
it will operate on the file in the current line.

	(vc-next-action-on-file buffer-file-name verbose)
      (vc-registration-error nil))))

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

(defun vc-checkout-writeable-buffer (&optional file)
  "Retrieve a writeable copy of the latest version of the current buffer's file."
  (vc-checkout (or file (buffer-file-name)) t)
  )

;;;###autoload
(defun vc-register (&optional override comment)

level to check it in under.  COMMENT, if specified, is the checkin comment."
      (vc-start-entry file rev
		      (or comment (not vc-initial-comment))
		      "Enter initial comment." 'vc-backend-admin))

(defun vc-checkout (file &optional writeable)
  "Retrieve a copy of the latest version of the given file."
  ;; 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 writeable)
  (if (string-equal file buffer-file-name)
      (vc-resynch-window file t t))
  )

(defun vc-steal-lock (file rev &optional owner)

(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).
COMMENT is a comment string; if omitted, a buffer is
popped up to accept a comment."
  (setq vc-log-after-operation-hook 'vc-checkin-hook)
  (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin))

;;;###autoload
(defun vc-insert-headers ()
  "Insert headers in a file for use with your version-control system.
Headers desired are inserted at the start of the buffer, and are pulled from
the variable vc-header-alist"
  (interactive)
  (if vc-dired-mode
      (find-file-other-window (dired-get-filename)))
  (while vc-parent-buffer
      (pop-to-buffer vc-parent-buffer))

  (setq vc-dired-mode t)
  (setq vc-mode " under VC"))

(defun vc-dired-reformat-line (x)
  ;; Hack a directory-listing line, plugging in locking-user info in
  ;; place of the user and group info. Should have the beneficial
  ;; side-effect of shortening the listing line. Each call starts with
  ;; point immediately following the dired mark area on the line to be
  ;; hacked.
  ;;
  ;; Simplest possible one:
  ;; (insert (concat x "\t")))

		     (let ((user (vc-locking-user f)))
		       (and (or verbose user)
			    (setq filelist (cons (substring f dl) filelist))
			    (setq userlist (cons user userlist))))))))
    (save-excursion
      ;; This uses a semi-documented featre of dired; giving a switch
      ;; argument forces the buffer to refresh each time.
      (dired
       (cons default-directory (nreverse filelist))
       dired-listing-switches)
      (setq dired-buf (current-buffer))

    )
  )

;;;###autoload
(defun vc-cancel-version (norevert)
  "Get rid of the version most recently checked in by anyone."
  (interactive "P")
  (if vc-dired-mode
      (find-file-other-window (dired-get-filename)))
  (while vc-parent-buffer
    (pop-to-buffer vc-parent-buffer))

		    "Remove your version %s from master?"
		  "Version %s was not your change.  Remove it anyway?")))
    (if (null (yes-or-no-p (format prompt target)))
	nil
      (vc-backend-uncheck (buffer-file-name) target)
      (if norevert
	  (vc-mode-line (buffer-file-name))
	(vc-checkout (buffer-file-name) nil)))
    ))

(defun vc-rename-file (old new)
  "Rename a file, taking its master files with it."
  (interactive "fOld name: \nFNew name: ")
  (let ((oldbuf (get-file-buffer old)))
    (if (buffer-modified-p oldbuf)
	(error "Please save files before moving them."))
    (if (get-file-buffer new)
	(error "Already editing new file name."))

			  file)
	   )))
  (message "Registering %s...done" file)
  )

(defun vc-backend-checkout (file &optional writeable rev)
  ;; Retrieve a copy of a saved version into a workfile
  (message "Checking out %s..." file)
  (vc-backend-dispatch file
   (progn
     (vc-do-command 0 "get" file	;; SCCS
		    (if writeable "-e")
		    (and rev (concat "-r" (vc-lookup-triple file rev))))
     )
   (vc-do-command 0 "co" file	;; RCS
		  (if writeable "-l")
		  (and rev (concat "-r" rev)))
   )
  (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
  (message "Checking out %s...done" file)
  )

  )

;;; These things should probably be generally available

(defun vc-shrink-to-fit ()
  "Shrink a window vertically until it's just large enough to contain its text"
  (let ((minsize (1+ (count-lines (point-min) (point-max)))))
    (if (< minsize (window-height))
	(let ((window-min-height 2))
	  (shrink-window (- (window-height) minsize))))))

(defun vc-file-tree-walk (func &rest args)
  "Walk recursively through default directory,
invoking FUNC f ARGS on all non-directory files f underneath it."
  (vc-file-tree-walk-internal default-directory func args)
  (message "Traversing directory %s...done" default-directory))

(defun vc-file-tree-walk-internal (file func args)
  (if (not (file-directory-p file))

;;; D).  This window may never be closed if the user fails to complete the
;;; checkin message.  Includes window R.
;;; 
;;; Window W:
;;;    Between vc-locking-user and the following steal-lock (apparent
;;; state E).  This window may never cloce if the user fails to complete
;;; the steal-lock message.  Includes window X.
;;; 
;;; Window X:
;;;    Between the unlock and the immediately following re-lock during a
;;; steal-lock operation (apparent state E).  This window may never cloce

2750:6f340eabf13f

;; 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.

(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.")
(defvar vc-initial-comment nil
  "*Prompt for initial comment when a file is registered.")
(defvar vc-command-messages nil

(defvar diff-switches "-c"
  "*A string or list of strings specifying switches to be be passed to diff.")

;;;###autoload
(defvar vc-checkin-hook nil
  "*List of functions called after a checkin is done.  See `run-hooks'.")

;; Header-insertion hair

(defvar vc-header-alist
  '((SCCS "\%W\%") (RCS "\$Id\$"))
  "*Header keywords to be inserted when `vc-insert-header' is executed.")
(defconst 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

;; 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-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
(defvar vc-parent-buffer nil)
(defvar vc-parent-buffer-name nil)

(defvar vc-log-file)
(defvar vc-log-version)

  (setq vc-comment-ring nil))

;; Random helper functions

(defun vc-name (file)
  "Return the master name of a file, nil if it is not registered."
  (or (vc-file-getprop file 'vc-name)
      (vc-file-setprop file 'vc-name
		       (let ((name-and-type (vc-registered file)))
			 (and name-and-type (car name-and-type))))))

     ;; if there is no master file corresponding, create one
     ((not vc-file)
      (vc-register verbose comment)
      (if vc-initial-comment
	  (setq vc-log-after-operation-hook
		'vc-checkout-writable-buffer-hook)
	(vc-checkout-writable-buffer file)))

     ;; if there is no lock on the file, assert one and get it
     ((not (setq owner (vc-locking-user file)))
      (vc-checkout-writable-buffer file))

     ;; 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." file))

;;;###autoload
(defun vc-next-action (verbose)
  "Do the next logical checkin or checkout operation on the current file.
   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.
   If you call this from within a VC dired buffer with no files marked,
it will operate on the file in the current line.

	(vc-next-action-on-file buffer-file-name verbose)
      (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."
  (vc-checkout (or file (buffer-file-name)) t)
  )

;;;###autoload
(defun vc-register (&optional override comment)

level to check it in under.  COMMENT, if specified, is the checkin comment."
      (vc-start-entry file rev
		      (or comment (not vc-initial-comment))
		      "Enter initial comment." 'vc-backend-admin))

(defun vc-checkout (file &optional writable)
  "Retrieve a copy of the latest version of the given file."
  ;; 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)

(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').
COMMENT is a comment string; if omitted, a buffer is
popped up to accept a comment."
  (setq vc-log-after-operation-hook 'vc-checkin-hook)
  (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin))

;;;###autoload
(defun vc-insert-headers ()
  "Insert headers in a file for use with your version-control system.
Headers desired are inserted at the start of the buffer, and are pulled from
the variable `vc-header-alist'."
  (interactive)
  (if vc-dired-mode
      (find-file-other-window (dired-get-filename)))
  (while vc-parent-buffer
      (pop-to-buffer vc-parent-buffer))

  (setq vc-dired-mode t)
  (setq vc-mode " under VC"))

(defun vc-dired-reformat-line (x)
  ;; Hack a directory-listing line, plugging in locking-user info in
  ;; place of the user and group info.  Should have the beneficial
  ;; side-effect of shortening the listing line.  Each call starts with
  ;; point immediately following the dired mark area on the line to be
  ;; hacked.
  ;;
  ;; Simplest possible one:
  ;; (insert (concat x "\t")))

		     (let ((user (vc-locking-user f)))
		       (and (or verbose user)
			    (setq filelist (cons (substring f dl) filelist))
			    (setq userlist (cons user userlist))))))))
    (save-excursion
      ;; This uses a semi-documented feature of dired; giving a switch
      ;; argument forces the buffer to refresh each time.
      (dired
       (cons default-directory (nreverse filelist))
       dired-listing-switches)
      (setq dired-buf (current-buffer))

    )
  )

;;;###autoload
(defun vc-cancel-version (norevert)
  "Get rid of most recently checked in version of this file.
A prefix argument means do not revert the buffer afterwards."
  (interactive "P")
  (if vc-dired-mode
      (find-file-other-window (dired-get-filename)))
  (while vc-parent-buffer
    (pop-to-buffer vc-parent-buffer))

		    "Remove your version %s from master?"
		  "Version %s was not your change.  Remove it anyway?")))
    (if (null (yes-or-no-p (format prompt target)))
	nil
      (vc-backend-uncheck (buffer-file-name) target)
      (if (or norevert
	      (not (yes-or-no-p "Revert buffer to most recent remaining version? ")))
	  (vc-mode-line (buffer-file-name))
	(vc-checkout (buffer-file-name) nil)))
    ))

(defun vc-rename-file (old new)
  "Rename file OLD to NEW, and rename its master file likewise."
  (interactive "fVC rename file: \nFRename to: ")
  (let ((oldbuf (get-file-buffer old)))
    (if (buffer-modified-p oldbuf)
	(error "Please save files before moving them."))
    (if (get-file-buffer new)
	(error "Already editing new file name."))

			  file)
	   )))
  (message "Registering %s...done" file)
  )

(defun vc-backend-checkout (file &optional writable rev)
  ;; Retrieve a copy of a saved version into a workfile
  (message "Checking out %s..." file)
  (vc-backend-dispatch file
   (progn
     (vc-do-command 0 "get" file	;; SCCS
		    (if writable "-e")
		    (and rev (concat "-r" (vc-lookup-triple file rev))))
     )
   (vc-do-command 0 "co" file	;; RCS
		  (if writable "-l")
		  (and rev (concat "-r" rev)))
   )
  (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
  (message "Checking out %s...done" file)
  )

  )

;;; These things should probably be generally available

(defun vc-shrink-to-fit ()
  "Shrink window vertically until it's just large enough to contain its text."
  (let ((minsize (1+ (count-lines (point-min) (point-max)))))
    (if (< minsize (window-height))
	(let ((window-min-height 2))
	  (shrink-window (- (window-height) minsize))))))

(defun vc-file-tree-walk (func &rest args)
  "Walk recursively through default directory.
Invoke FUNC f ARGS on each non-directory file f underneath it."
  (vc-file-tree-walk-internal default-directory func args)
  (message "Traversing directory %s...done" default-directory))

(defun vc-file-tree-walk-internal (file func args)
  (if (not (file-directory-p file))

;;; D).  This window may never be closed if the user fails to complete the
;;; checkin message.  Includes window R.
;;; 
;;; Window W:
;;;    Between vc-locking-user and the following steal-lock (apparent
;;; state E).  This window may never close if the user fails to complete
;;; the steal-lock message.  Includes window X.
;;; 
;;; Window X:
;;;    Between the unlock and the immediately following re-lock during a
;;; steal-lock operation (apparent state E).  This window may never cloce