(defun vc-find-binary (name)
"Look for a command anywhere on the subprocess-command search path."
(or (cdr (assoc name vc-binary-assoc))
- (let ((full nil))
- (catch 'found
- (mapcar
- (function (lambda (s)
- (if (and s (file-exists-p (setq full (concat s "/" name))))
- (throw 'found nil))))
- exec-path))
- (if full
- (setq vc-binary-assoc (cons (cons name full) vc-binary-assoc)))
- full)))
+ (catch 'found
+ (mapcar
+ (function
+ (lambda (s)
+ (if s
+ (let ((full (concat s "/" name)))
+ (if (file-executable-p full)
+ (progn
+ (setq vc-binary-assoc
+ (cons (cons name full) vc-binary-assoc))
+ (throw 'found full)))))))
+ exec-path)
+ nil)))
(defun vc-do-command (okstatus command file &rest flags)
"Execute a version-control command, notifying user and checking for errors.
(exec-path (if vc-path (append exec-path vc-path) exec-path)))
(setq status (apply 'call-process command nil t nil squeezed)))
(goto-char (point-max))
- (previous-line 1)
+ (forward-line -1)
(if (or (not (integerp status)) (< okstatus status))
(progn
- (previous-line 1)
- (print (cons command squeezed))
- (next-line 1)
(pop-to-buffer "*vc*")
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)
(vc-start-entry nil nil nil
"Enter a change comment for the marked files."
'vc-next-action-dired)
- (throw 'nogo))))
+ (throw 'nogo nil))))
(while vc-parent-buffer
(pop-to-buffer vc-parent-buffer))
(if buffer-file-name
(error "No log operation is pending"))
;; Return to "parent" buffer of this checkin and remove checkin window
(pop-to-buffer vc-parent-buffer)
- (delete-windows-on (get-buffer "*VC-log*"))
- (kill-buffer "*VC-log*")
+ (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))
(if (> arg 0) -1
(if (< arg 0) 1 0))))
(setq vc-comment-ring-index
- (ring-mod (+ vc-comment-ring-index arg) len))
+ (mod (+ vc-comment-ring-index arg) len))
(message "%d" (1+ vc-comment-ring-index))
(insert (ring-ref vc-comment-ring vc-comment-ring-index))))))
(message "No changes to %s between %s and %s." file rel1 rel2)
(pop-to-buffer "*vc*"))))
+;;;###autoload
+(defun vc-version-other-window (rev)
+ "Visit version REV of the current buffer in another window.
+If the current buffer is named `F', the version is named `F.~REV~'.
+If `F.~REV~' already exists, it is used instead of being re-created."
+ (interactive "sVersion to visit (default is latest version): ")
+ (if vc-dired-mode
+ (set-buffer (find-file-noselect (dired-get-filename))))
+ (while vc-parent-buffer
+ (pop-to-buffer vc-parent-buffer))
+ (if (and buffer-file-name (vc-name buffer-file-name))
+ (let* ((version (if (string-equal rev "")
+ (vc-latest-version buffer-file-name)
+ rev))
+ (filename (concat buffer-file-name ".~" version "~")))
+ (or (file-exists-p filename)
+ (vc-backend-checkout buffer-file-name nil version filename))
+ (find-file-other-window filename))
+ (vc-registration-error buffer-file-name)))
+
;; Header-insertion code
;;;###autoload
;; Named-configuration entry points
-(defun vc-quiescent-p ()
- ;; Is the current directory ready to be snapshot?
- (catch 'quiet
+(defun vc-locked-example ()
+ ;; Return an example of why the current directory is not ready to be snapshot
+ ;; or nil if no such example exists.
+ (catch 'vc-locked-example
(vc-file-tree-walk
(function (lambda (f)
(if (and (vc-registered f) (vc-locking-user f))
- (throw 'quiet nil)))))
- t))
+ (throw 'vc-locked-example f)))))
+ nil))
;;;###autoload
(defun vc-create-snapshot (name)
directory. For each file, the version level of its latest
version becomes part of the named configuration."
(interactive "sNew snapshot name: ")
- (if (not (vc-quiescent-p))
- (error "Can't make a snapshot since some files are locked")
- (vc-file-tree-walk
- (function (lambda (f) (and
- (vc-name f)
- (vc-backend-assign-name f name)))))
- ))
+ (let ((locked (vc-locked-example)))
+ (if locked
+ (error "File %s is locked" locked)
+ (vc-file-tree-walk
+ (function (lambda (f) (and
+ (vc-name f)
+ (vc-backend-assign-name f name)))))
+ )))
;;;###autoload
(defun vc-retrieve-snapshot (name)
Otherwise, all registered files are checked out (unlocked) at their version
levels in the snapshot."
(interactive "sSnapshot name to retrieve: ")
- (if (not (vc-quiescent-p))
- (error "Can't retrieve snapshot sine some files are locked")
- (vc-file-tree-walk
- (function (lambda (f) (and
- (vc-name f)
- (vc-error-occurred (vc-backend-checkout f nil name))))))
- ))
+ (let ((locked (vc-locked-example)))
+ (if locked
+ (error "File %s is locked" locked)
+ (vc-file-tree-walk
+ (function (lambda (f) (and
+ (vc-name f)
+ (vc-error-occurred
+ (vc-backend-checkout f nil name))))))
+ )))
;; Miscellaneous other entry points
(progn
(vc-backend-print-log buffer-file-name)
(pop-to-buffer (get-buffer-create "*vc*"))
+ (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))))
(shrink-window-if-larger-than-buffer)
)
(vc-registration-error buffer-file-name)
(message "Registering %s...done" file)
)
-(defun vc-backend-checkout (file &optional writable rev)
+(defun vc-backend-checkout (file &optional writable rev workfile)
;; Retrieve a copy of a saved version into a workfile
- (message "Checking out %s..." file)
- (vc-backend-dispatch file
- (progn
+ (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 ;; RCS
+ ;; RCS doesn't let us check out into arbitrary file names directly.
+ ;; Use `co -p' and make stdout point to the correct file.
+ (let ((default-modes (default-file-modes))
+ (vc-modes (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (failed t))
+ (unwind-protect
+ (progn
+ (set-default-file-modes vc-modes)
+ (vc-do-command
+ 0 "/bin/sh" file "-c"
+ "filename=$1; shift; exec co \"$@\" >$filename"
+ "" ; dummy argument for shell's $0
+ filename
+ (if writable "-l")
+ (concat "-p" rev))
+ (setq failed nil))
+ (set-default-file-modes default-modes)
+ (and failed (file-exists-p filename) (delete-file filename))))
+ (vc-do-command 0 "co" file
+ (if writable "-l")
+ (and rev (concat "-r" 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)
+ (or workfile
+ (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))))
+ (message "Checking out %s...done" filename))
)
(defun vc-backend-logentry-check (file)
(vc-do-command 0 "unget" file "-n" (if rev (concat "-r" rev)))
(vc-do-command 0 "get" file "-g" (if rev (concat "-r" rev)))
)
- (vc-do-command 0 "rcs" "-M" (concat "-u" rev) (concat "-l" rev) file))
+ (vc-do-command 0 "rcs" file "-M" (concat "-u" rev) (concat "-l" rev)))
(vc-file-setprop file 'vc-locking-user (user-login-name))
(message "Stealing lock on %s...done" file)
)
\\[vc-revert-buffer] revert buffer to latest version
\\[vc-cancel-version] undo latest checkin
\\[vc-diff] show diffs between file versions
+\\[vc-version-other-window] visit old version in another window
\\[vc-directory] show all files locked by any user in or below .
\\[vc-update-change-log] add change log entry from recent checkins