;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
-;; $Id: vc.el,v 1.215 1998/04/01 12:26:43 spiegel Exp rms $
+;; $Id: vc.el,v 1.235 1998/07/09 03:24:06 rms Exp spiegel $
;; This file is part of GNU Emacs.
"*A string used as the default version number when a new file is registered.
This can be overriden by giving a prefix argument to \\[vc-register]."
:type 'string
- :group 'vc)
+ :group 'vc
+ :version "20.3")
(defcustom vc-command-messages nil
"*If non-nil, display run messages from back-end commands."
string))
:group 'vc)
+(defcustom vc-dired-recurse t
+ "*If non-nil, show directory trees recursively in VC Dired."
+ :type 'boolean
+ :group 'vc
+ :version "20.3")
+
+(defcustom vc-dired-terse-display t
+ "*If non-nil, show only locked files in VC Dired."
+ :type 'boolean
+ :group 'vc
+ :version "20.3")
+
(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
"*List of directory names to be ignored while recursively walking file trees."
:type '(repeat string)
(defvar vc-comment-ring-index nil)
(defvar vc-last-comment-match nil)
-;; Back-portability to Emacs 18
-
-(defun file-executable-p-18 (f)
- (let ((modes (file-modes f)))
- (and modes (not (zerop (logand 292))))))
-
-(defun file-regular-p-18 (f)
- (let ((attributes (file-attributes f)))
- (and attributes (not (car attributes)))))
-
-; Conditionally rebind some things for Emacs 18 compatibility
-(if (not (boundp 'minor-mode-map-alist))
- (progn
- (setq compilation-old-error-list nil)
- (fset 'file-executable-p 'file-executable-p-18)
- (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
- ))
-
-(if (not (fboundp 'file-regular-p))
- (fset 'file-regular-p 'file-regular-p-18))
-
;;; Find and compare backend releases
(defun vc-backend-release (backend)
;; return t if REV is a revision on the trunk
(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+(defun vc-branch-p (rev)
+ ;; return t if REV is a branch revision
+ (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
+
(defun vc-branch-part (rev)
;; return the branch part of a revision number REV
(substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
;; CVS
t))
-(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))))
+(defun vc-ensure-vc-buffer ()
+ ;; Make sure that the current buffer visits a version-controlled file.
+ (if vc-dired-mode
+ (set-buffer (find-file-noselect (dired-get-filename)))
+ (while vc-parent-buffer
+ (pop-to-buffer vc-parent-buffer))
+ (if (not (buffer-file-name))
+ (error "Buffer %s is not associated with a file" (buffer-name))
+ (if (not (vc-backend (buffer-file-name)))
+ (error "File %s is not under version control" (buffer-file-name))))))
(defvar vc-binary-assoc nil)
-
+(defvar vc-binary-suffixes
+ (if (memq system-type '(ms-dos windows-nt))
+ '(".exe" ".com" ".bat" ".cmd" ".btm" "")
+ '("")))
(defun vc-find-binary (name)
"Look for a command anywhere on the subprocess-command search path."
(or (cdr (assoc name vc-binary-assoc))
(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)))))))
+ (let ((full (concat s "/" name))
+ (suffixes vc-binary-suffixes)
+ candidate)
+ (while suffixes
+ (setq candidate (concat full (car suffixes)))
+ (if (and (file-executable-p candidate)
+ (not (file-directory-p candidate)))
+ (progn
+ (setq vc-binary-assoc
+ (cons (cons name candidate) vc-binary-assoc))
+ (throw 'found candidate))
+ (setq suffixes (cdr suffixes))))))))
exec-path)
nil)))
(defun vc-next-action-on-file (file verbose &optional comment)
;;; If comment is specified, it will be used as an admin or checkin comment.
- (let ((vc-file (vc-name file))
- (vc-type (vc-backend file))
+ (let ((vc-type (vc-backend file))
owner version buffer)
(cond
- ;; 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 the file is not under version control, register it
+ ((not vc-type)
+ (vc-register verbose comment))
;; CVS: changes to the master file need to be
;; merged back into the working file
(let ((dired-buffer (current-buffer))
(dired-dir default-directory))
(dired-map-over-marks
- (let ((file (dired-get-filename)) p
- (default-directory default-directory))
+ (let ((file (dired-get-filename)))
(message "Processing %s..." file)
;; Adjust the default directory so that checkouts
;; go to the right place.
- (setq default-directory (file-name-directory file))
- (vc-next-action-on-file file nil comment)
- (set-buffer dired-buffer)
- (setq default-directory dired-dir)
- (dired-do-redisplay file)
+ (let ((default-directory (file-name-directory file)))
+ (vc-next-action-on-file file nil comment)
+ (set-buffer dired-buffer))
+ ;; Make sure that files don't vanish
+ ;; after they are checked in.
+ (let ((vc-dired-terse-mode nil))
+ (dired-do-redisplay file))
(set-window-configuration vc-dired-window-configuration)
(message "Processing %s...done" file))
nil t))
For RCS and SCCS files:
If the file is not already registered, this registers it for version
-control and then retrieves a writable, locked copy for editing.
+control.
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
(while vc-parent-buffer
(pop-to-buffer vc-parent-buffer))
(if buffer-file-name
- (vc-next-action-on-file buffer-file-name verbose)
- (vc-registration-error nil))))
+ (vc-next-action-on-file buffer-file-name verbose)
+ (error "Buffer %s is not associated with a file" (buffer-name)))))
;;; These functions help the vc-next-action entry point
;; we don't zap the *VC-log* buffer and the typing therein).
(let ((logbuf (get-buffer "*VC-log*")))
(cond (logbuf
- (delete-windows-on logbuf)
+ (delete-windows-on logbuf (selected-frame))
+ ;; Kill buffer and delete any other dedicated windows/frames.
(kill-buffer logbuf))))
;; Now make sure we see the expanded headers
(if buffer-file-name
With a prefix argument, it reads the file name to use
and two version designators specifying which versions to compare."
(interactive (list current-prefix-arg t))
- (if vc-dired-mode
- (set-buffer (find-file-noselect (dired-get-filename))))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
+ (vc-ensure-vc-buffer)
(if historic
(call-interactively 'vc-version-diff)
- (if (or (null buffer-file-name) (null (vc-name buffer-file-name)))
- (error
- "There is no version-control master associated with this buffer"))
(let ((file buffer-file-name)
unchanged)
(vc-buffer-sync not-urgent)
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)))
+ (vc-ensure-vc-buffer)
+ (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)))
;; Header-insertion code
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))
+ (vc-ensure-vc-buffer)
(save-excursion
(save-restriction
(widen)
(replace-match "$\\1$")))
(vc-restore-buffer-context context)))
-(defun vc-resolve-conflicts ()
+;;;###autoload
+(defun vc-merge ()
+ (interactive)
+ (vc-ensure-vc-buffer)
+ (vc-buffer-sync)
+ (let* ((file buffer-file-name)
+ (backend (vc-backend file))
+ first-version second-version locking-user)
+ (if (eq backend 'SCCS)
+ (error "Sorry, merging is not implemented for SCCS")
+ (setq locking-user (vc-locking-user file))
+ (if (eq (vc-checkout-model file) 'manual)
+ (if (not locking-user)
+ (if (not (y-or-n-p
+ (format "File must be %s for merging. %s now? "
+ (if (eq backend 'RCS) "locked" "writable")
+ (if (eq backend 'RCS) "Lock" "Check out"))))
+ (error "Merge aborted")
+ (vc-checkout file t))
+ (if (not (string= locking-user (vc-user-login-name)))
+ (error "File is locked by %s" locking-user))))
+ (setq first-version (read-string "Branch or version to merge from: "))
+ (if (and (>= (elt first-version 0) ?0)
+ (<= (elt first-version 0) ?9))
+ (if (not (vc-branch-p first-version))
+ (setq second-version
+ (read-string "Second version: "
+ (concat (vc-branch-part first-version) ".")))
+ ;; We want to merge an entire branch. Set versions
+ ;; accordingly, so that vc-backend-merge understands us.
+ (setq second-version first-version)
+ ;; first-version must be the starting point of the branch
+ (setq first-version (vc-branch-part first-version))))
+ (let ((status (vc-backend-merge file first-version second-version)))
+ (if (and (eq (vc-checkout-model file) 'implicit)
+ (not (vc-locking-user file)))
+ (vc-file-setprop file 'vc-locking-user nil))
+ (vc-resynch-buffer file t t)
+ (if (not (zerop status))
+ (if (y-or-n-p "Conflicts detected. Resolve them now? ")
+ (vc-resolve-conflicts "WORKFILE" "MERGE SOURCE")
+ (message "File contains conflict markers"))
+ (message "Merge successful"))))))
+
+;;;###autoload
+(defun vc-resolve-conflicts (&optional name-A name-B)
"Invoke ediff to resolve conflicts in the current buffer.
The conflicts must be marked with rcsmerge conflict markers."
(interactive)
+ (vc-ensure-vc-buffer)
(let* ((found nil)
(file-name (file-name-nondirectory buffer-file-name))
(your-buffer (generate-new-buffer
- (concat "*" file-name " WORKFILE*")))
+ (concat "*" file-name
+ " " (or name-A "WORKFILE") "*")))
(other-buffer (generate-new-buffer
- (concat "*" file-name " CHECKED-IN*")))
+ (concat "*" file-name
+ " " (or name-B "CHECKED-IN") "*")))
(result-buffer (current-buffer)))
(save-excursion
(set-buffer your-buffer)
the file named in the current Dired buffer line. `vv' invokes
`vc-next-action' on this file, or on all files currently marked.
There is a special command, `*l', to mark all files currently locked."
- (make-local-variable 'dired-after-readin-hook)
- (add-hook 'dired-after-readin-hook 'vc-dired-hook)
+ (make-local-hook 'dired-after-readin-hook)
+ (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
+ ;; The following is slightly modified from dired.el,
+ ;; because file lines look a bit different in vc-dired-mode.
+ (set (make-local-variable 'dired-move-to-filename-regexp)
+ (let*
+ ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+ ;; In some locales, month abbreviations are as short as 2 letters,
+ ;; and they can be padded on the right with spaces.
+ (month (concat l l "+ *"))
+ ;; Recognize any non-ASCII character.
+ ;; The purpose is to match a Kanji character.
+ (k "[^\0-\177]")
+ ;; (k "[^\x00-\x7f\x80-\xff]")
+ (s " ")
+ (yyyy "[0-9][0-9][0-9][0-9]")
+ (mm "[ 0-1][0-9]")
+ (dd "[ 0-3][0-9]")
+ (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+ (western (concat "\\(" month s dd "\\|" dd s month "\\)"
+ s "\\(" HH:MM "\\|" s yyyy "\\)"))
+ (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
+ (concat s "\\(" western "\\|" japanese "\\)" s)))
+ (and (boundp 'vc-dired-switches)
+ vc-dired-switches
+ (set (make-local-variable 'dired-actual-switches)
+ vc-dired-switches))
+ (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
(setq vc-dired-mode t))
(define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
(define-key vc-dired-mode-map "v" vc-prefix-map)
-(define-key vc-dired-mode-map "=" 'vc-diff)
+
+(defun vc-dired-toggle-terse-mode ()
+ "Toggle terse display in VC Dired."
+ (interactive)
+ (if (not vc-dired-mode)
+ nil
+ (setq vc-dired-terse-mode (not vc-dired-terse-mode))
+ (if vc-dired-terse-mode
+ (vc-dired-hook)
+ (revert-buffer))))
+
+(define-key vc-dired-mode-map "vt" 'vc-dired-toggle-terse-mode)
(defun vc-dired-mark-locked ()
"Mark all files currently locked."
(defun vc-fetch-cvs-status (dir)
(let ((default-directory dir))
- (vc-do-command "*vc-info*" 0 "cvs" nil nil "status" dir)
+ ;; Don't specify DIR in this command, the default-directory is
+ ;; enough. Otherwise it might fail with remote repositories.
+ (vc-do-command "*vc-info*" 0 "cvs" nil nil "status")
(save-excursion
(set-buffer (get-buffer "*vc-info*"))
(goto-char (point-min))
(if state (concat "(" state ")"))))
(defun vc-dired-reformat-line (x)
- ;; Reformat a directory-listing line, plugging in version control info in
- ;; place of the user and group info.
+ ;; Reformat a directory-listing line, replacing various columns with
+ ;; version control information.
;; This code, like dired, assumes UNIX -l format.
(beginning-of-line)
- (let ((pos (point)) limit perm owner date-and-file)
+ (let ((pos (point)) limit perm date-and-file)
(end-of-line)
(setq limit (point))
(goto-char pos)
- (cond
- ((or
- (re-search-forward ;; owner and group
-"^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
- limit t)
- (re-search-forward ;; only owner displayed
-"^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
- limit t))
- (setq perm (match-string 1)
- owner (match-string 2)
- date-and-file (match-string 3)))
- ((re-search-forward ;; OS/2 -l format, no links, owner, group
-"^\\(..[drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
- limit t)
+ (when
+ (or
+ (re-search-forward ;; owner and group
+ "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)"
+ limit t)
+ (re-search-forward ;; only owner displayed
+ "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)"
+ limit t)
+ (re-search-forward ;; OS/2 -l format, no links, owner, group
+ "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)"
+ limit t))
(setq perm (match-string 1)
- date-and-file (match-string 2))))
- (setq x (substring (concat x " ") 0 10))
- (replace-match (concat perm x date-and-file))))
+ date-and-file (match-string 2))
+ (setq x (substring (concat x " ") 0 10))
+ (replace-match (concat perm x date-and-file)))))
(defun vc-dired-hook ()
;; Called by dired after any portion of a vc-dired buffer has been read in.
;; Reformat the listing according to version control.
(message "Getting version information... ")
- (let (subdir filename (buffer-read-only nil))
+ (let (subdir filename (buffer-read-only nil) cvs-dir)
(goto-char (point-min))
(while (not (eq (point) (point-max)))
(cond
;; subdir header line
((setq subdir (dired-get-subdir))
(if (file-directory-p (concat subdir "/CVS"))
- (vc-fetch-cvs-status (file-name-as-directory subdir)))
+ (progn
+ (vc-fetch-cvs-status (file-name-as-directory subdir))
+ (setq cvs-dir t))
+ (setq cvs-dir nil))
(forward-line 1)
;; erase (but don't remove) the "total" line
(let ((start (point)))
(delete-region start (point))
(beginning-of-line)
(forward-line 1)))
- ;; an ordinary file line
+ ;; directory entry
((setq filename (dired-get-filename nil t))
(cond
+ ;; subdir
((file-directory-p filename)
- (if (member (file-name-nondirectory filename)
- vc-directory-exclusion-list)
- (dired-kill-line)
+ (cond
+ ((member (file-name-nondirectory filename)
+ vc-directory-exclusion-list)
+ (let ((pos (point)))
+ (dired-kill-tree filename)
+ (goto-char pos)
+ (dired-kill-line)))
+ (vc-dired-terse-mode
+ ;; Don't show directories in terse mode. Don't use
+ ;; dired-kill-line to remove it, because in recursive listings,
+ ;; that would remove the directory contents as well.
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
+ (dired-kill-line))
+ (t
(vc-dired-reformat-line nil)
- (forward-line 1)))
- ((vc-backend filename)
+ (forward-line 1))))
+ ;; ordinary file
+ ((if cvs-dir
+ (and (eq (vc-file-getprop filename 'vc-backend) 'CVS)
+ (or (not vc-dired-terse-mode)
+ (not (eq (vc-cvs-status filename) 'up-to-date))))
+ (and (vc-backend filename)
+ (or (not vc-dired-terse-mode)
+ (vc-locking-user filename))))
(vc-dired-reformat-line (vc-dired-state-info filename))
(forward-line 1))
(t
(dired-kill-line))))
;; any other line
- (t (forward-line 1)))))
- (message "Getting version information... done"))
+ (t (forward-line 1))))
+ (vc-dired-purge))
+ (message "Getting version information... done")
+ (save-restriction
+ (widen)
+ (cond ((eq (count-lines (point-min) (point-max)) 1)
+ (goto-char (point-min))
+ (message "No files locked under %s" default-directory)))))
+
+(defun vc-dired-purge ()
+ ;; Remove empty subdirs
+ (let (subdir)
+ (goto-char (point-min))
+ (while (setq subdir (dired-get-subdir))
+ (forward-line 2)
+ (if (dired-get-filename nil t)
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max)))
+ (forward-line -2)
+ (if (not (string= (dired-current-directory) default-directory))
+ (dired-do-kill-lines t "")
+ ;; We cannot remove the top level directory.
+ ;; Just make it look a little nicer.
+ (forward-line 1)
+ (kill-line)
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max))))))
+ (goto-char (point-min))))
;;;###autoload
(defun vc-directory (dirname read-switches)
(interactive "DDired under VC (directory): \nP")
- (let ((switches
- (if read-switches (read-string "Dired listing switches: "
- dired-listing-switches))))
+ (let ((vc-dired-switches (concat dired-listing-switches
+ (if vc-dired-recurse "R" ""))))
+ (if read-switches
+ (setq vc-dired-switches
+ (read-string "Dired listing switches: "
+ vc-dired-switches)))
(require 'dired)
(require 'dired-aux)
;; force a trailing slash
(setq dirname (concat dirname "/")))
(switch-to-buffer
(dired-internal-noselect (expand-file-name dirname)
- (or switches dired-listing-switches)
+ (or vc-dired-switches dired-listing-switches)
'vc-dired-mode))))
;; Named-configuration support for SCCS
(defun vc-print-log ()
"List the change log of the current buffer in a window."
(interactive)
- (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 ((file buffer-file-name))
- (vc-backend-print-log file)
- (pop-to-buffer (get-buffer-create "*vc*"))
- (setq default-directory (file-name-directory file))
- (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))))
- (shrink-window-if-larger-than-buffer)
- ;; move point to the log entry for the current version
- (and (not (eq (vc-backend file) 'SCCS))
- (re-search-forward
- ;; also match some context, for safety
- (concat "----\nrevision " (vc-workfile-version file)
- "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
- ;; set the display window so that
- ;; the whole log entry is displayed
- (let (start end lines)
- (beginning-of-line) (forward-line -1) (setq start (point))
- (if (not (re-search-forward "^----*\nrevision" nil t))
- (setq end (point-max))
- (beginning-of-line) (forward-line -1) (setq end (point)))
- (setq lines (count-lines start end))
- (cond
- ;; if the global information and this log entry fit
- ;; into the window, display from the beginning
- ((< (count-lines (point-min) end) (window-height))
- (goto-char (point-min))
- (recenter 0)
- (goto-char start))
- ;; if the whole entry fits into the window,
- ;; display it centered
- ((< (1+ lines) (window-height))
- (goto-char start)
- (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
- ;; otherwise (the entry is too large for the window),
- ;; display from the start
- (t
- (goto-char start)
- (recenter 0)))))
- )
- (vc-registration-error buffer-file-name)
- )
- )
+ (vc-ensure-vc-buffer)
+ (let ((file buffer-file-name))
+ (vc-backend-print-log file)
+ (pop-to-buffer (get-buffer-create "*vc*"))
+ (setq default-directory (file-name-directory file))
+ (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))))
+ (shrink-window-if-larger-than-buffer)
+ ;; move point to the log entry for the current version
+ (and (not (eq (vc-backend file) 'SCCS))
+ (re-search-forward
+ ;; also match some context, for safety
+ (concat "----\nrevision " (vc-workfile-version file)
+ "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
+ ;; set the display window so that
+ ;; the whole log entry is displayed
+ (let (start end lines)
+ (beginning-of-line) (forward-line -1) (setq start (point))
+ (if (not (re-search-forward "^----*\nrevision" nil t))
+ (setq end (point-max))
+ (beginning-of-line) (forward-line -1) (setq end (point)))
+ (setq lines (count-lines start end))
+ (cond
+ ;; if the global information and this log entry fit
+ ;; into the window, display from the beginning
+ ((< (count-lines (point-min) end) (window-height))
+ (goto-char (point-min))
+ (recenter 0)
+ (goto-char start))
+ ;; if the whole entry fits into the window,
+ ;; display it centered
+ ((< (1+ lines) (window-height))
+ (goto-char start)
+ (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
+ ;; otherwise (the entry is too large for the window),
+ ;; display from the start
+ (t
+ (goto-char start)
+ (recenter 0)))))))
;;;###autoload
(defun vc-revert-buffer ()
automatically pick up newer changes found in the master file;
use C-u \\[vc-next-action] RET to do so."
(interactive)
- (if vc-dired-mode
- (find-file-other-window (dired-get-filename)))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
+ (vc-ensure-vc-buffer)
(let ((file buffer-file-name)
;; This operation should always ask for confirmation.
(vc-suppress-confirm nil)
"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))
+ (vc-ensure-vc-buffer)
(cond
- ((not (vc-registered (buffer-file-name)))
- (vc-registration-error (buffer-file-name)))
((eq (vc-backend (buffer-file-name)) 'CVS)
(error "Unchecking files under CVS is dangerous and not supported in VC"))
((vc-locking-user (buffer-file-name))
(changelog (find-change-log))
;; Presumably not portable to non-Unixy systems, along with rcs2log:
(tempfile (make-temp-name
- (concat (file-name-as-directory
- (directory-file-name (or (getenv "TMPDIR")
- (getenv "TMP")
- (getenv "TEMP")
- "/tmp")))
- "vc")))
+ (expand-file-name "vc" temporary-file-directory)))
(full-name (or add-log-full-name
(user-full-name)
(user-login-name)
`vc-annotate-very-old-color' defines the mapping of time to
colors. `vc-annotate-background' specifies the background color."
(interactive "p")
- (if (not (eq (vc-buffer-backend) 'CVS)) ; This only works with CVS
- (vc-registration-error (buffer-file-name)))
+ (vc-ensure-vc-buffer)
+ (if (not (eq (vc-backend (buffer-file-name)) 'CVS))
+ (error "Sorry, vc-annotate is only implemented for CVS"))
(message "Annotating...")
(let ((temp-buffer-name (concat "*cvs annotate " (buffer-name) "*"))
(temp-buffer-show-function 'vc-annotate-display)
;; Checking out explicit versions is not supported under SCCS, yet.
;; We always "revert" to the latest version; therefore
;; vc-workfile-version is cleared here so that it gets recomputed.
- (vc-file-setprop 'vc-workfile-version nil))
+ (vc-file-setprop file 'vc-workfile-version nil))
;; RCS
(vc-do-command nil 0 "co" file 'MASTER
"-f" (concat "-u" (vc-workfile-version file)))
(and newvers (concat "-r" newvers))
(if (listp diff-switches)
diff-switches
- (list diff-switches)))))
- (t
- (vc-registration-error file)))))
+ (list diff-switches))))))))
(defun vc-backend-merge-news (file)
;; Merge in any new changes made to FILE.
(vc-file-setprop file 'vc-workfile-version (match-string 1)))
;; get file status
(if (re-search-forward
- (concat "^\\([CMU]\\) "
- (regexp-quote (file-name-nondirectory file)))
+ (concat "^\\(\\([CMU]\\) \\)?"
+ (regexp-quote (file-name-nondirectory file))
+ "\\( already contains the differences between \\)?")
nil t)
(cond
;; Merge successful, we are in sync with repository now
- ((string= (match-string 1) "U")
- (vc-file-setprop file 'vc-locking-user 'none)
+ ((or (string= (match-string 2) "U")
+ ;; Special case: file contents in sync with
+ ;; repository anyhow:
+ (match-string 3))
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file)))
0) ;; indicate success to the caller
;; Merge successful, but our own changes are still in the file
- ((string= (match-string 1) "M")
+ ((string= (match-string 2) "M")
(vc-file-setprop file 'vc-locking-user (vc-file-owner file))
(vc-file-setprop file 'vc-checkout-time 0)
0) ;; indicate success to the caller
;; Conflicts detected!
- ((string= (match-string 1) "C")
+ ((string= (match-string 2) "C")
(vc-file-setprop file 'vc-locking-user (vc-file-owner file))
(vc-file-setprop file 'vc-checkout-time 0)
1) ;; signal the error to the caller
(error "Couldn't analyze cvs update result"))))
(message "Merging changes into %s...done" file)))
+(defun vc-backend-merge (file first-version &optional second-version)
+ ;; Merge the changes between FIRST-VERSION and SECOND-VERSION into
+ ;; the current working copy of FILE. It is assumed that FILE is
+ ;; locked and writable (vc-merge ensures this).
+ (vc-backend-dispatch file
+ ;; SCCS
+ (error "Sorry, merging is not implemented for SCCS")
+ ;; RCS
+ (vc-do-command nil 1 "rcsmerge" file 'MASTER
+ "-kk" ;; ignore keyword conflicts
+ (concat "-r" first-version)
+ (if second-version (concat "-r" second-version)))
+ ;; CVS
+ (progn
+ (vc-do-command nil 0 "cvs" file 'WORKFILE
+ "update" "-kk"
+ (concat "-j" first-version)
+ (concat "-j" second-version))
+ (save-excursion
+ (set-buffer (get-buffer "*vc*"))
+ (goto-char (point-min))
+ (if (re-search-forward "conflicts during merge" nil t)
+ 1 ;; signal error
+ 0 ;; signal success
+ )))))
+
(defun vc-check-headers ()
"Check if the current file has any headers in it."
(interactive)