;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: eggert@twinsun.com
(require 'vc-hooks)
(require 'ring)
+(eval-when-compile (require 'dired)) ; for dired-map-over-marks macro
(if (not (assoc 'vc-parent-buffer minor-mode-alist))
(setq minor-mode-alist
(defvar vc-log-operation nil)
(defvar vc-log-after-operation-hook 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)
(if vc-file
(setq squeezed (append squeezed (list vc-file))))
(let ((default-directory (file-name-directory (or file "./")))
- (exec-path (if vc-path (append exec-path vc-path) exec-path)))
+ (exec-path (if vc-path (append exec-path vc-path) exec-path))
+ ;; Add vc-path to PATH for the execution of this command.
+ (process-environment
+ (cons (concat "PATH=" (getenv "PATH")
+ ":" (mapconcat 'identity vc-path ":"))
+ process-environment)))
(setq status (apply 'call-process command nil t nil squeezed)))
(goto-char (point-max))
(forward-line -1)
;; 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)))
+ (vc-register verbose comment))
;; if there is no lock on the file, assert one and get it
((not (setq owner (vc-locking-user file)))
(if vc-dired-mode
(let ((files (dired-get-marked-files)))
(if (= (length files) 1)
- (find-file-other-window (dired-get-filename))
+ (find-file-other-window (car files))
(vc-start-entry nil nil nil
"Enter a change comment for the marked files."
'vc-next-action-dired)
(defun vc-register (&optional override comment)
"Register the current file into your version-control system."
(interactive "P")
- (if (vc-name buffer-file-name)
- (error "This file is already registered"))
+ (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))
(delete-window)
(kill-buffer (current-buffer))))))
-(defun vc-start-entry (file rev comment msg action)
+(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 parent-buffer (current one if no file).
+ ;; 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 comment
(set-buffer (get-buffer-create "*VC-log*"))
(concat " from " (buffer-name vc-parent-buffer)))
(vc-mode-line (or file " (no file)"))
(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)
"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."
- (vc-start-entry file rev
- (or comment (not vc-initial-comment))
- "Enter initial comment." 'vc-backend-admin))
+ (vc-start-entry file rev
+ (or comment (not vc-initial-comment))
+ "Enter initial comment." 'vc-backend-admin
+ nil))
(defun vc-checkout (file &optional writable)
"Retrieve a copy of the latest version of the given file."
(defun vc-steal-lock (file rev &optional owner)
"Steal the lock on the current workfile."
- (interactive)
- (if (not owner)
- (setq owner (vc-locking-user file)))
- (if (not (y-or-n-p (format "Take the lock on %s:%s from %s? " file rev 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 "%s:%s" file rev) nil nil nil
- (list (list 'vc-finish-steal file rev)))
- (goto-char (point-max))
- (insert
- (format "I stole the lock on %s:%s, " file rev)
- (current-time-string)
- ".\n")
- (message "Please explain why you stole the lock. Type C-c C-c when done."))
+ (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)
- (vc-resynch-window file t t))
+ (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.
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))
+ "Enter a change comment." 'vc-backend-checkin
+ 'vc-checkin-hook))
;;; Here is a checkin hook that may prove useful to sites using the
;;; ChangeLog facility supported by Emacs.
(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)
- (vc-buffer-sync))
+ (or vc-dired-mode
+ (vc-buffer-sync)))
;; OK, do it to it
(if vc-log-operation
(save-excursion
vc-log-version
(buffer-string)))
(error "No log operation is pending"))
- ;; 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
+ ;; 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 vc-log-after-operation-hook))
+ (run-hooks after-hook)))
;; Code for access to the comment ring
(vc-checkout (buffer-file-name) nil)))
))
+;;;###autoload
(defun vc-rename-file (old new)
"Rename file OLD to NEW, and rename its master file likewise."
(interactive "fVC rename file: \nFRename to: ")
(message "Computing change log entries... %s"
(if (or (null args)
(eq 0 (apply 'call-process "rcs2log" nil t nil
+ "-n"
+ (user-login-name)
+ (user-full-name)
+ user-mail-address
(mapcar (function
(lambda (f)
(file-relative-name
(let ((filename (or workfile file)))
(message "Checking out %s..." filename)
(vc-backend-dispatch file
- (vc-do-command 0 "get" file ;; SCCS
- (if writable "-e")
- (if workfile (concat "-G" workfile))
- (and rev (concat "-r" (vc-lookup-triple file rev))))
+ (if workfile ;; SCCS
+ ;; Some SCCS implementations allow checking out directly to a
+ ;; file using the -G option, but then some don't so use the
+ ;; least common denominator approach and use the -p option
+ ;; ala RCS.
+ (let ((vc-modes (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (failed t))
+ (unwind-protect
+ (progn
+ (vc-do-command
+ 0 "/bin/sh" file "-c"
+ ;; Some shells make the "" dummy argument into $0
+ ;; while others use the shell's name as $0 and
+ ;; use the "" as $1. The if-statement
+ ;; converts the latter case to the former.
+ (format "if [ x\"$1\" = x ]; then shift; fi; \
+ umask %o; exec >\"$1\" || exit; \
+ shift; umask %o; exec get \"$@\""
+ (logand 511 (lognot vc-modes))
+ (logand 511 (lognot (default-file-modes))))
+ "" ; dummy argument for shell's $0
+ filename
+ (if writable "-e")
+ "-p" (and rev (concat "-r" (vc-lookup-triple file rev))))
+ (setq failed nil))
+ (and failed (file-exists-p filename) (delete-file filename))))
+ (vc-do-command 0 "get" file ;; SCCS
+ (if writable "-e")
+ (and rev (concat "-r" (vc-lookup-triple file rev)))))
(if workfile ;; RCS
;; RCS doesn't let us check out into arbitrary file names directly.
;; Use `co -p' and make stdout point to the correct file.
(progn
(vc-do-command
0 "/bin/sh" file "-c"
- (format "umask %o; exec >\"$1\" || exit; shift; umask %o; exec co \"$@\""
+ ;; See the SCCS case, above, regarding the if-statement.
+ (format "if [ x\"$1\" = x ]; then shift; fi; \
+ umask %o; exec >\"$1\" || exit; \
+ shift; umask %o; exec co \"$@\""
(logand 511 (lognot vc-modes))
(logand 511 (lognot (default-file-modes))))
"" ; dummy argument for shell's $0
HCoop / bpt / emacs.git / blobdiff