X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3d30b8bc56cfe56c36f4e813c1396e04fc6f88a4..66495b0787f38fbdc316bfd60e54a02cdf362d3b:/lisp/vc.el diff --git a/lisp/vc.el b/lisp/vc.el index b14791931a..eadd64fe91 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -5,7 +5,7 @@ ;; Author: Eric S. Raymond ;; Maintainer: Andre Spiegel -;; $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. @@ -116,7 +116,8 @@ If FORM3 is `RCS', use FORM2 for CVS as well as RCS. "*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." @@ -153,6 +154,18 @@ These are passed to the checkin program by \\[vc-register]." 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) @@ -318,27 +331,6 @@ If nil, VC itself computes this value when it is first needed." (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) @@ -409,6 +401,10 @@ If nil, VC itself computes this value when it is first needed." ;; 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))) @@ -498,13 +494,22 @@ If nil, VC itself computes this value when it is first needed." ;; 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)) @@ -513,12 +518,18 @@ If nil, VC itself computes this value when it is first needed." (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))) @@ -744,18 +755,13 @@ before the filename." (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 @@ -895,16 +901,17 @@ before the filename." (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)) @@ -926,7 +933,7 @@ lock steals will raise an error. 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 @@ -974,8 +981,8 @@ merge in the changes into your working copy." (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 @@ -1233,7 +1240,8 @@ May be useful as a `vc-checkin-hook' to update change logs automatically." ;; 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 @@ -1314,15 +1322,9 @@ checked in version of that file. This uses no arguments. 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) @@ -1423,19 +1425,14 @@ files in or below it." 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 @@ -1445,10 +1442,7 @@ If `F.~REV~' already exists, it is used instead of being re-created." 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) @@ -1488,16 +1482,64 @@ the variable `vc-header-alist'." (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) @@ -1583,13 +1625,50 @@ is redefined as the version control prefix, so that you can type 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." @@ -1604,7 +1683,9 @@ There is a special command, `*l', to 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)) @@ -1631,45 +1712,45 @@ There is a special command, `*l', to mark all files currently locked." (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))) @@ -1677,30 +1758,80 @@ There is a special command, `*l', to mark all files currently locked." (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 @@ -1708,7 +1839,7 @@ There is a special command, `*l', to mark all files currently locked." (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 @@ -1832,58 +1963,50 @@ locked are updated to the latest versions." (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 () @@ -1893,10 +2016,7 @@ to that version. Note that for RCS and CVS, this function does not 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) @@ -1918,13 +2038,8 @@ use C-u \\[vc-next-action] RET to do so." "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)) @@ -2092,12 +2207,7 @@ default directory." (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) @@ -2228,8 +2338,9 @@ mode-specific menu. `vc-annotate-color-map' and `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) @@ -2679,7 +2790,7 @@ THRESHOLD, nil otherwise" ;; 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))) @@ -2794,9 +2905,7 @@ THRESHOLD, nil otherwise" (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. @@ -2824,23 +2933,27 @@ THRESHOLD, nil otherwise" (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 @@ -2849,6 +2962,32 @@ THRESHOLD, nil otherwise" (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)