comparison lisp/vc.el @ 32054:fef29341db1c

(vc-next-action-on-file): Update mode line only if file is visited. (vc-start-entry): New argument initial-contents. Don't visit the file if it isn't already visited. Brought documentation up-to-date. (vc-next-action, vc-register): Updated calls to vc-start-entry. (vc-checkin): New optional arg initial-contents, which is passed to vc-start-entry. (vc-finish-logentry): Make sure to bury log buffer only if there really is one. Call `vc-resynch-buffer' on log-file, not buffer-file-name. (vc-default-comment-history, vc-default-wash-log): New functions. (vc-index-of): Removed. (vc-transfer-file): Make do without the above. (vc-default-receive-file): Call comment-history unconditionally. Pass the resulting string to vc-checkin, instead of inserting it into the comment ring.

32053:0216f8dcf1d4

    
    ;; Do the right thing
    (if (not (vc-registered file))
	(vc-register verbose comment)
      (vc-recompute-state file)
      (vc-mode-line file)
      (setq state (vc-state file))
      (cond
       ;; up-to-date
       ((or (eq state 'up-to-date)
	    (and verbose (eq state 'needs-patch)))

		 (mapconcat
	             (lambda (f)
		       (if (not (vc-up-to-date-p f)) "@" ""))
		     files ""))
		(vc-next-action-dired nil nil "dummy")
	      (vc-start-entry nil nil nil
			      "Enter a change comment for the marked files."
			      'vc-next-action-dired))
	    (throw 'nogo nil)))
    (while vc-parent-buffer
      (pop-to-buffer vc-parent-buffer))

                      (read-string (format "Initial version level for %s: "
					   (buffer-name)))
                    ;; TODO: Use backend-specific init version.
                    vc-default-init-version)
                  (or comment (not vc-initial-comment))
                  "Enter initial comment."
		  (lambda (file rev comment)
		    (message "Registering %s... " file)
		    (let ((backend (vc-responsible-backend file)))
		      (vc-file-clearprops file)

      (if buffer
	  (with-current-buffer buffer
	    (vc-resynch-window file keep noquery)))))
  (vc-dired-resynch-file file))

(defun vc-start-entry (file rev comment msg action &optional after-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."
  (let ((parent (if file (find-file-noselect file) (current-buffer))))
    (if vc-before-checkin-hook
        (if file
            (with-current-buffer parent
              (run-hooks 'vc-before-checkin-hook))
          (run-hooks 'vc-before-checkin-hook)))
    (if comment
	(set-buffer (get-buffer-create "*VC-log*"))
      (pop-to-buffer (get-buffer-create "*VC-log*")))
    (set (make-local-variable 'vc-parent-buffer) parent)
    (set (make-local-variable 'vc-parent-buffer-name)
	 (concat " from " (buffer-name vc-parent-buffer)))

    (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-version rev)
    (if comment
	(progn
	  (erase-buffer)
	  (if (eq comment t)
	      (vc-finish-logentry t)
	    (insert comment)
	    (vc-finish-logentry nil)))
      (message "%s  Type C-c C-c when done" msg))))

(defun vc-checkout (file &optional writable rev)
  "Retrieve a copy of the revision REV of FILE.
If WRITABLE is non-nil, make sure the retrieved file is writable.
REV defaults to the latest revision."

   (vc-call steal-lock file version)
   `((vc-state edited)))
  (vc-resynch-buffer file t t)
  (message "Stealing lock on %s...done" file))

(defun vc-checkin (file &optional rev comment)
  "Check in FILE.
The optional argument REV may be a string specifying the new version
level (if nil increment the current level).  COMMENT is a comment
string; if omitted, a buffer is popped up to accept a comment.

If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
that the version control system supports this mode of operation.

Runs the normal hook `vc-checkin-hook'."
  (vc-start-entry
   file rev comment
   "Enter a change comment."
   (lambda (file rev comment)
     (message "Checking in %s..." file)
     ;; "This log message intentionally left almost blank".
     ;; RCS 5.7 gripes about white-space-only comments too.

    (let ((logbuf (get-buffer "*VC-log*")))
      (cond ((and logbuf vc-delete-logbuf-window)
	     (delete-windows-on logbuf (selected-frame))
	     ;; Kill buffer and delete any other dedicated windows/frames.
	     (kill-buffer logbuf))
	    (t (pop-to-buffer "*VC-log*")
	       (bury-buffer)
	       (pop-to-buffer tmp-vc-parent-buffer))))
    ;; Now make sure we see the expanded headers
    (if buffer-file-name
	(vc-resynch-buffer buffer-file-name vc-keep-workfiles t))
    (if vc-dired-mode
        (dired-move-to-filename))
    (run-hooks after-hook 'vc-finish-logentry-hook)))

;; Code for access to the comment ring

(defun vc-new-comment-index (stride len)

	  (if (vc-find-backend-function ',(vc-backend file) 'show-log-entry)
	      (vc-call-backend ',(vc-backend file)
			       'show-log-entry
			       ',(vc-workfile-version file))))))))

;;;###autoload
(defun vc-revert-buffer ()
  "Revert the current buffer's file back to the version it was based on.
This asks for confirmation if the buffer contents are not identical
to that version.  Note that for RCS and CVS, this function does not

    (error "%s is not registered in %s" file backend))
  (vc-file-clearprops file)
  (vc-file-setprop file 'vc-backend backend)
  (vc-resynch-buffer file t t))

(defun vc-index-of (backend)
  "Return the index of BACKEND in vc-handled-backends."
  (- (length vc-handled-backends) 
     (length (memq backend vc-handled-backends))))

;;;autoload
(defun vc-transfer-file (file new-backend)
  "Transfer FILE to another version control system NEW-BACKEND.  
If NEW-BACKEND has a higher precedence than FILE's current backend
\(i.e. it comes earlier in vc-handled-backends), then register FILE in

	(error "%s is the current backend of %s"
	       new-backend file)
      (with-vc-properties
       file
       (vc-call-backend new-backend 'receive-file file 
			(< (vc-index-of old-backend)
			   (vc-index-of new-backend)))
       `((vc-backend ,new-backend))))
    (vc-resynch-buffer file t t)))

(defun vc-default-receive-file (backend file move)
  "Let BACKEND receive FILE from another version control system.

backend and its comment history is used as the initial contents
of the log entry buffer."
  (let ((old-backend (vc-backend file))
	(rev (vc-workfile-version file))
	(state (vc-state file))
	(comment (and move
		      (vc-find-backend-function old-backend 'comment-history)
		      (vc-call 'comment-history file))))
    (if move (vc-unregister file old-backend))
    (vc-file-clearprops file)
    (if (not (vc-call-backend backend 'registered file))
	(with-vc-properties 
	 file

      (vc-file-setprop file 'vc-state 'edited)
      (set-file-modes file
		      (logior (file-modes file) 128)))
    (when (or move (eq state 'edited))
      (vc-file-setprop file 'vc-state 'edited)
      ;; TODO: The comment history should actually become the
      ;; initial contents of the log entry buffer.
      (and comment (ring-insert vc-comment-ring comment))
      (vc-checkin file))))

(defun vc-rename-master (oldmaster newfile templates)
  "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
  (let* ((dir (file-name-directory (expand-file-name oldmaster)))
	 (newdir (or (file-name-directory newfile) ""))

32054:fef29341db1c

    
    ;; Do the right thing
    (if (not (vc-registered file))
	(vc-register verbose comment)
      (vc-recompute-state file)
      (if visited (vc-mode-line file))
      (setq state (vc-state file))
      (cond
       ;; up-to-date
       ((or (eq state 'up-to-date)
	    (and verbose (eq state 'needs-patch)))

		 (mapconcat
	             (lambda (f)
		       (if (not (vc-up-to-date-p f)) "@" ""))
		     files ""))
		(vc-next-action-dired nil nil "dummy")
	      (vc-start-entry nil nil nil nil
			      "Enter a change comment for the marked files."
			      'vc-next-action-dired))
	    (throw 'nogo nil)))
    (while vc-parent-buffer
      (pop-to-buffer vc-parent-buffer))

                      (read-string (format "Initial version level for %s: "
					   (buffer-name)))
                    ;; TODO: Use backend-specific init version.
                    vc-default-init-version)
                  (or comment (not vc-initial-comment))
		  nil
                  "Enter initial comment."
		  (lambda (file rev comment)
		    (message "Registering %s... " file)
		    (let ((backend (vc-responsible-backend file)))
		      (vc-file-clearprops file)

      (if buffer
	  (with-current-buffer buffer
	    (vc-resynch-window file keep noquery)))))
  (vc-dired-resynch-file file))

(defun vc-start-entry (file rev comment initial-contents msg action &optional after-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.  If COMMENT is a string and
INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
contents of the log entry buffer.  If COMMENT is a string and
INITIAL-CONTENTS is nil, do action immediately as if the user had
entered COMMENT.  If COMMENT is t, also do action immediately with an
empty comment.  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."
  (let ((parent (or (and file (get-file-buffer file)) (current-buffer))))
    (if vc-before-checkin-hook
        (if file
            (with-current-buffer parent
              (run-hooks 'vc-before-checkin-hook))
          (run-hooks 'vc-before-checkin-hook)))
    (if (and comment (not initial-contents))
	(set-buffer (get-buffer-create "*VC-log*"))
      (pop-to-buffer (get-buffer-create "*VC-log*")))
    (set (make-local-variable 'vc-parent-buffer) parent)
    (set (make-local-variable 'vc-parent-buffer-name)
	 (concat " from " (buffer-name vc-parent-buffer)))

    (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-version rev)
    (erase-buffer)
    (if (eq comment t)
	(vc-finish-logentry t)
      (if comment
	  (insert comment))
      (if (and comment (not initial-contents))
	  (vc-finish-logentry nil)
	(message "%s  Type C-c C-c when done" msg)))))

(defun vc-checkout (file &optional writable rev)
  "Retrieve a copy of the revision REV of FILE.
If WRITABLE is non-nil, make sure the retrieved file is writable.
REV defaults to the latest revision."

   (vc-call steal-lock file version)
   `((vc-state edited)))
  (vc-resynch-buffer file t t)
  (message "Stealing lock on %s...done" file))

(defun vc-checkin (file &optional rev comment initial-contents)
  "Check in FILE.
The optional argument REV may be a string specifying the new version
level (if nil increment the current level).  COMMENT is a comment
string; if omitted, a buffer is popped up to accept a comment.  If
INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
of the log entry buffer.

If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
that the version control system supports this mode of operation.

Runs the normal hook `vc-checkin-hook'."
  (vc-start-entry
   file rev comment initial-contents
   "Enter a change comment."
   (lambda (file rev comment)
     (message "Checking in %s..." file)
     ;; "This log message intentionally left almost blank".
     ;; RCS 5.7 gripes about white-space-only comments too.

    (let ((logbuf (get-buffer "*VC-log*")))
      (cond ((and logbuf vc-delete-logbuf-window)
	     (delete-windows-on logbuf (selected-frame))
	     ;; Kill buffer and delete any other dedicated windows/frames.
	     (kill-buffer logbuf))
	    (logbuf (pop-to-buffer "*VC-log*")
		    (bury-buffer)
		    (pop-to-buffer tmp-vc-parent-buffer))))
    ;; Now make sure we see the expanded headers
    (if log-file 
	(vc-resynch-buffer log-file vc-keep-workfiles t))
    (if vc-dired-mode
      (dired-move-to-filename))
    (run-hooks after-hook 'vc-finish-logentry-hook)))

;; Code for access to the comment ring

(defun vc-new-comment-index (stride len)

	  (if (vc-find-backend-function ',(vc-backend file) 'show-log-entry)
	      (vc-call-backend ',(vc-backend file)
			       'show-log-entry
			       ',(vc-workfile-version file))))))))

(defun vc-default-comment-history (backend file)
  "Return a string with all log entries that were made under BACKEND for FILE."
  (if (vc-find-backend-function backend 'print-log)
      (with-temp-buffer
	(vc-call print-log file)
	(vc-call wash-log file)
	(buffer-string))))

(defun vc-default-wash-log (backend file)
  "Remove all non-comment information from log output.
This default implementation works for RCS logs; backends should override
it if their logs are not in RCS format."
  (let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n"
			   "\\(branches: .*;\n\\)?"
			   "\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?")))
    (goto-char (point-max)) (forward-line -1)
    (while (looking-at "=*\n")
      (delete-char (- (match-end 0) (match-beginning 0)))
      (forward-line -1))
    (goto-char (point-min))
    (if (looking-at "[\b\t\n\v\f\r ]+")
	(delete-char (- (match-end 0) (match-beginning 0))))
    (goto-char (point-min))
    (re-search-forward separator nil t)
    (delete-region (point-min) (point))
    (while (re-search-forward separator nil t)
      (delete-region (match-beginning 0) (match-end 0)))))

;;;###autoload
(defun vc-revert-buffer ()
  "Revert the current buffer's file back to the version it was based on.
This asks for confirmation if the buffer contents are not identical
to that version.  Note that for RCS and CVS, this function does not

    (error "%s is not registered in %s" file backend))
  (vc-file-clearprops file)
  (vc-file-setprop file 'vc-backend backend)
  (vc-resynch-buffer file t t))

;;;autoload
(defun vc-transfer-file (file new-backend)
  "Transfer FILE to another version control system NEW-BACKEND.  
If NEW-BACKEND has a higher precedence than FILE's current backend
\(i.e. it comes earlier in vc-handled-backends), then register FILE in

	(error "%s is the current backend of %s"
	       new-backend file)
      (with-vc-properties
       file
       (vc-call-backend new-backend 'receive-file file 
			;; set MOVE argument if new-backend
			;; comes later in vc-handled-backends
			(memq new-backend 
			      (memq old-backend vc-handled-backends)))
       `((vc-backend ,new-backend))))
    (vc-resynch-buffer file t t)))

(defun vc-default-receive-file (backend file move)
  "Let BACKEND receive FILE from another version control system.

backend and its comment history is used as the initial contents
of the log entry buffer."
  (let ((old-backend (vc-backend file))
	(rev (vc-workfile-version file))
	(state (vc-state file))
	(comment (and move (vc-call comment-history file))))
    (if move (vc-unregister file old-backend))
    (vc-file-clearprops file)
    (if (not (vc-call-backend backend 'registered file))
	(with-vc-properties 
	 file

      (vc-file-setprop file 'vc-state 'edited)
      (set-file-modes file
		      (logior (file-modes file) 128)))
    (when (or move (eq state 'edited))
      (vc-file-setprop file 'vc-state 'edited)
      (vc-checkin file nil comment (stringp comment)))))

(defun vc-rename-master (oldmaster newfile templates)
  "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
  (let* ((dir (file-name-directory (expand-file-name oldmaster)))
	 (newdir (or (file-name-directory newfile) ""))