comparison lisp/vc.el @ 12885:5c1941d38daa

(vc-next-action-on-file): Changed doc string, CVS case. (vc-backend-checkin): Clear master properties before doing the check-in. In the CVS case, catch error and display an appropriate message in the echo area. (vc-backend-revert): Clear master properties, because some might get outdated by the operation. (vc-backend-merge-news): Scan the output of "cvs update" and find out whether conflicts have occurred. (vc-finish-logentry): Delete the *VC-log* buffer *before* doing the actual check-in. That leads to a better display in case the check-in fails. (vc-latest-on-branch-p): Defined it for CVS in the obvious way. (vc-next-action-on-file): Removed special CVS cases. At this level, CVS is now mostly handled like the other backends. (vc-backend-checkout): CVS case: Clear sticky tag as default when doing a verbose checkout. (This used to be done in vc-next-action-on-file.)

12884:f47248851f26

		     "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)))))
	   (if (get-buffer "*vc-info*") 
	       (kill-buffer (get-buffer "*vc-info*")))
	   (string= tip-version workfile-version))))
     ;; CVS
     (error "vc-latest-on-branch-p is not defined for CVS files")))

(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))))

      (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
     ((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-diff*")
		(goto-char (point-min))

		  (vc-checkout-writable-buffer file
		     (vc-branch-part (vc-workfile-version 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
       (if verbose (read-string "Version to steal: ")
	 (vc-workfile-version file))
       owner))

     ;; CVS: changes to the master file need to be 
     ;; merged back into the working file
     ((and (eq vc-type 'CVS)
	   ;; "0" means "added, but not yet committed"
	   (not (string= (vc-workfile-version file) "0"))
	   (not (string= (vc-workfile-version file)
			 (vc-latest-version file))))
      (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 
			   "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))))

     ;; CVS: Buffer is read-only. Make the file "locked", i.e.
     ;; make the buffer writable, and assert the user to be the locker
     ((and (eq vc-type 'CVS) buffer-read-only)
      (if verbose
	  (let ((rev (read-string "Trunk version to move to: ")))
	    (if (not (string= rev ""))
		(vc-checkout file nil rev)
	      (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")
	      (vc-checkout file)))
	(setq buffer-read-only nil)
	(vc-file-setprop file 'vc-locking-user (user-login-name))
	(vc-mode-line file)
	;; 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
     (t
	  (find-file file)

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

  ;; 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-version
		 (buffer-string)))
    (error "No log operation is pending"))
  ;; save the vc-log-after-operation-hook of log buffer
  (let ((after-hook vc-log-after-operation-hook))
    ;; Return to "parent" buffer of this checkin and remove checkin window
    (pop-to-buffer vc-parent-buffer)
    (let ((logbuf (get-buffer "*VC-log*")))
      (delete-windows-on logbuf)
      (kill-buffer logbuf))
    ;; Now make sure we see the expanded headers
    (if buffer-file-name
	(vc-resynch-window buffer-file-name vc-keep-workfiles t))
    (run-hooks after-hook)))

			   (concat "-r" rev)
			   "-p"
			   vc-checkout-switches)
		    (setq failed nil))
		(and failed (file-exists-p filename) (delete-file filename))))
	  (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
		 "update"
		 (and rev (concat "-r" rev))
		 vc-checkout-switches)
	  (vc-file-setprop file 'vc-workfile-version nil))

  (or (and comment (string-match "[^\t\n ]" comment))
      (setq comment "*** empty log message ***"))
  (save-excursion
    ;; Change buffers to get local value of vc-checkin-switches.
    (set-buffer (or (get-file-buffer file) (current-buffer)))
    (vc-backend-dispatch file
      ;; SCCS
      (progn
	(apply 'vc-do-command nil 0 "delta" file 'MASTER
	       (if rev (concat "-r" rev))

			 (concat "-u" old-version)))))
      ;; CVS
      (progn
	;; explicit check-in to the trunk requires a 
        ;; double check-in (first unexplicit) (CVS-1.3)
	(if (and rev (vc-trunk-p rev))
	    (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
		   "ci" "-m" "intermediate"
		   vc-checkin-switches))
	(apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
	       "ci" (if rev (concat "-r" rev))
	       (concat "-m" comment)
	       vc-checkin-switches)
	;; determine and store the new workfile version
	(set-buffer "*vc*")
	(goto-char (point-min))
	(if (re-search-forward 
	     "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)

	(if rev
	    (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
	(vc-file-setprop file 'vc-locking-user 'none)
	(vc-file-setprop file 'vc-checkout-time 
			 (nth 5 (file-attributes file))))))
  (vc-file-clear-masterprops file)
  (message "Checking in %s...done" file))

(defun vc-backend-revert (file)
  ;; Revert file to latest checked-in version.
  ;; (for RCS, to workfile version)
  (message "Reverting %s..." file)
  (vc-backend-dispatch
   file
   ;; SCCS
   (progn
     (vc-do-command nil 0 "unget" file 'MASTER nil)

     (t
      (vc-registration-error file)))))

(defun vc-backend-merge-news (file)
  ;; Merge in any new changes made to FILE.
  (vc-backend-dispatch 
   file
   (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
   (error "vc-backend-merge-news not meaningful for RCS files")	;RCS
   (progn  ; CVS
     (vc-file-clear-masterprops file)
     (vc-file-setprop file 'vc-workfile-version nil)
     (vc-file-setprop file 'vc-locking-user nil)
     (vc-do-command nil 1 "cvs" file 'WORKFILE "update"))
   ))

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

12885:5c1941d38daa

		     "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)))))
	   (if (get-buffer "*vc-info*") 
	       (kill-buffer (get-buffer "*vc-info*")))
	   (string= tip-version workfile-version))))
     ;; CVS
     (string= (vc-workfile-version file) (vc-latest-version file))))

(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))))

      (if vc-initial-comment
	  (setq vc-log-after-operation-hook
		'vc-checkout-writable-buffer-hook)
	(vc-checkout-writable-buffer file)))

     ;; CVS: changes to the master file need to be 
     ;; merged back into the working file
     ((and (eq vc-type 'CVS)
	   (or (eq (vc-cvs-status file) 'needs-checkout)
	       (eq (vc-cvs-status file) 'needs-merge)))
      (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 
			   "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))))

     ;; if there is no lock on the file, assert one and get it
     ((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-diff*")
		(goto-char (point-min))

		  (vc-checkout-writable-buffer file
		     (vc-branch-part (vc-workfile-version file))))))
	  )))

     ;; a checked-out version exists, but the user may not own the lock
     ((and (not (eq vc-type '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
       (if verbose (read-string "Version to steal: ")
	 (vc-workfile-version file))
       owner))

     ;; OK, user owns the lock on the file
     (t
	  (find-file file)

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

  ;; But not if it is a vc-dired buffer.
  (save-excursion
    (set-buffer vc-parent-buffer)
    (or vc-dired-mode
	(vc-buffer-sync)))
  (if (not vc-log-operation) (error "No log operation is pending"))
  ;; save the parameters held in buffer-local variables
  (let ((log-operation vc-log-operation)
	(log-file vc-log-file)
	(log-version vc-log-version)
	(log-entry (buffer-string))
	(after-hook vc-log-after-operation-hook))
    ;; Return to "parent" buffer of this checkin and remove checkin window
    (pop-to-buffer vc-parent-buffer)
    (let ((logbuf (get-buffer "*VC-log*")))
      (delete-windows-on logbuf)
      (kill-buffer logbuf))
    ;; OK, do it to it
    (save-excursion
      (funcall log-operation 
	       log-file
	       log-version
	       log-entry))
    ;; Now make sure we see the expanded headers
    (if buffer-file-name
	(vc-resynch-window buffer-file-name vc-keep-workfiles t))
    (run-hooks after-hook)))

			   (concat "-r" rev)
			   "-p"
			   vc-checkout-switches)
		    (setq failed nil))
		(and failed (file-exists-p filename) (delete-file filename))))
	  ;; default for verbose checkout: clear the sticky tag
	  ;; so that the actual update will go to the head of the trunk
	  (and rev (string= rev "")
	       (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A")
	       (setq rev nil))
	  (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
		 "update"
		 (and rev (concat "-r" rev))
		 vc-checkout-switches)
	  (vc-file-setprop file 'vc-workfile-version nil))

  (or (and comment (string-match "[^\t\n ]" comment))
      (setq comment "*** empty log message ***"))
  (save-excursion
    ;; Change buffers to get local value of vc-checkin-switches.
    (set-buffer (or (get-file-buffer file) (current-buffer)))
    ;; Clear the master-properties.  Do that here, not at the
    ;; end, because if the check-in fails we want them to get
    ;; re-computed before the next try.
    (vc-file-clear-masterprops file)
    (vc-backend-dispatch file
      ;; SCCS
      (progn
	(apply 'vc-do-command nil 0 "delta" file 'MASTER
	       (if rev (concat "-r" rev))

			 (concat "-u" old-version)))))
      ;; CVS
      (progn
	;; explicit check-in to the trunk requires a 
        ;; double check-in (first unexplicit) (CVS-1.3)
	(condition-case nil
	    (progn
	      (if (and rev (vc-trunk-p rev))
		  (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
			 "ci" "-m" "intermediate"
			 vc-checkin-switches))
	      (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
		     "ci" (if rev (concat "-r" rev))
		     (concat "-m" comment)
		     vc-checkin-switches))
	  (error (if (eq (vc-cvs-status file) 'needs-merge)
		     ;; The CVS output will be on top of this message.
		     (error "Type C-x 0 C-x C-q to merge in changes.")
		   (error "Check in FAILED."))))
	;; determine and store the new workfile version
	(set-buffer "*vc*")
	(goto-char (point-min))
	(if (re-search-forward 
	     "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)

	(if rev
	    (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
	(vc-file-setprop file 'vc-locking-user 'none)
	(vc-file-setprop file 'vc-checkout-time 
			 (nth 5 (file-attributes file))))))
  (message "Checking in %s...done" file))

(defun vc-backend-revert (file)
  ;; Revert file to latest checked-in version.
  ;; (for RCS, to workfile version)
  (message "Reverting %s..." file)
  (vc-file-clear-masterprops file)
  (vc-backend-dispatch
   file
   ;; SCCS
   (progn
     (vc-do-command nil 0 "unget" file 'MASTER nil)

     (t
      (vc-registration-error file)))))

(defun vc-backend-merge-news (file)
  ;; Merge in any new changes made to FILE.
  (message "Merging changes into %s..." file)
  (prog1
      (vc-backend-dispatch 
       file
       (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
       (error "vc-backend-merge-news not meaningful for RCS files")	;RCS
       (save-excursion  ; CVS
	 (vc-file-clear-masterprops file)
	 (vc-file-setprop file 'vc-workfile-version nil)
	 (vc-file-setprop file 'vc-locking-user nil)
	 (vc-do-command nil 0 "cvs" file 'WORKFILE "update")
	 ;; CVS doesn't return an error code if conflicts are detected.
	 ;; Since we want to warn the user about it (and possibly start
	 ;; emerge later), scan the output and see if this occurred.
	 (set-buffer (get-buffer "*vc*"))
	 (goto-char (point-min))
	 (if (re-search-forward "^cvs update: conflicts found in .*" nil t)
	     1  ;; error code for caller
	   0  ;; no conflict detected
	   )))
    (message "Merging changes into %s...done" file)))

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