;; 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.256 1999/10/02 10:53:18 spiegel Exp $
;; This file is part of GNU Emacs.
:type 'boolean
:group 'vc)
+(defcustom vc-delete-logbuf-window t
+ "*If non-nil, delete the *VC-log* buffer and window after each logical action.
+If nil, bury that buffer instead.
+This is most useful if you have multiple windows on a frame and would like to
+preserve the setting."
+ :type 'boolean
+ :group 'vc)
+
(defcustom vc-initial-comment nil
"*If non-nil, prompt for initial comment when a file is registered."
:type 'boolean
"*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)
"*The release number of your RCS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
- string)
+ string
+ (const :tag "Unknown" unknown))
:group 'vc)
(defcustom vc-sccs-release nil
"*The release number of your SCCS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
- string)
+ string
+ (const :tag "Unknown" unknown))
:group 'vc)
(defcustom vc-cvs-release nil
"*The release number of your CVS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
- string)
+ string
+ (const :tag "Unknown" unknown))
:group 'vc)
;; Variables the user doesn't need to know about.
(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))))
+;;; Two macros for elisp programming
+;;;###autoload
+(defmacro with-vc-file (file comment &rest body)
+ "Execute BODY, checking out a writable copy of FILE first if necessary.
+After BODY has been executed, check-in FILE with COMMENT (a string).
+FILE is passed through `expand-file-name'; BODY executed within
+`save-excursion'. If FILE is not under version control, or locked by
+somebody else, signal error."
+ `(let ((file (expand-file-name ,file)))
+ (or (vc-registered file)
+ (error (format "File not under version control: `%s'" file)))
+ (let ((locking-user (vc-locking-user file)))
+ (cond ((and (not locking-user)
+ (eq (vc-checkout-model file) 'manual))
+ (vc-checkout file t))
+ ((and (stringp locking-user)
+ (not (string= locking-user (vc-user-login-name))))
+ (error (format "`%s' is locking `%s'" locking-user file)))))
+ (save-excursion
+ ,@body)
+ (vc-checkin file nil ,comment)))
-(defvar vc-binary-assoc nil)
+;;;###autoload
+(defmacro edit-vc-file (file comment &rest body)
+ "Edit FILE under version control, executing BODY. Checkin with COMMENT.
+This macro uses `with-vc-file', passing args to it.
+However, before executing BODY, find FILE, and after BODY, save buffer."
+ `(with-vc-file
+ ,file ,comment
+ (find-file ,file)
+ ,@body
+ (save-buffer)))
+
+(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)))
(let ((new-mark (vc-find-position-by-context mark-context)))
(if new-mark (set-mark new-mark))))))
+;; Maybe this "smart mark preservation" could be added directly
+;; to revert-buffer since it can be generally useful. -sm
(defun vc-revert-buffer1 (&optional arg no-confirm)
;; Revert buffer, try to keep point and mark where user expects them in spite
;; of changes because of expanded version-control key words.
(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
(vc-checkin file version comment)
)))))
+(defvar vc-dired-window-configuration)
+
(defun vc-next-action-dired (file rev comment)
;; Do a vc-next-action-on-file on all the marked files, possibly
;; passing on the log comment we've just entered.
(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
(or (eobp) (looking-at "\n\n")
(insert "\n"))))
-
(defun vc-finish-logentry (&optional nocomment)
"Complete the operation implied by the current log entry."
(interactive)
(log-file vc-log-file)
(log-version vc-log-version)
(log-entry (buffer-string))
- (after-hook vc-log-after-operation-hook))
+ (after-hook vc-log-after-operation-hook)
+ (tmp-vc-parent-buffer vc-parent-buffer))
(pop-to-buffer vc-parent-buffer)
;; OK, do it to it
(save-excursion
;; Remove checkin window (after the checkin so that if that fails
;; we don't zap the *VC-log* buffer and the typing therein).
(let ((logbuf (get-buffer "*VC-log*")))
- (cond (logbuf
- (delete-windows-on logbuf)
- (kill-buffer logbuf))))
+ (cond ((and logbuf vc-delete-logbuf-window)
+ (delete-windows-on logbuf (selected-frame))
+ ;; Kill buffer and delete any other dedicated windows/frames.
+ (kill-buffer logbuf))
+ (t (pop-to-buffer "*VC-log*")
+ (bury-buffer)
+ (pop-to-buffer tmp-vc-parent-buffer))))
;; Now make sure we see the expanded headers
(if buffer-file-name
(vc-resynch-window buffer-file-name vc-keep-workfiles t))
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
;;;###autoload
(defun vc-insert-headers ()
"Insert headers in a file for use with your version-control system.
-Headers desired are inserted at the start of the buffer, and are pulled from
+Headers desired are inserted at point, 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"))))))
+
+(defvar vc-ediff-windows)
+(defvar vc-ediff-result)
+
+;;;###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 VC directory major mode. Coopt Dired for this.
;; All VC commands get mapped into logical equivalents.
+(defvar vc-dired-switches)
+(defvar vc-dired-terse-mode)
+
(define-derived-mode vc-dired-mode dired-mode "Dired under VC"
"The major mode used in VC directory buffers. It works like Dired,
but lists only files under version control, with the current VC state of
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"\\|" yyyy s "\\)"))
+ (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" "-l")
(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))
(let ((odefault 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")))
+ (tempfile (make-temp-file
+ (expand-file-name "vc"
+ (or small-temporary-file-directory
+ temporary-file-directory))))
(full-name (or add-log-full-name
(user-full-name)
(user-login-name)
(delete-file tempfile)))))
\f
;; vc-annotate functionality (CVS only).
-(defvar vc-annotate-mode nil
- "Variable indicating if VC-Annotate mode is active.")
-
(defvar vc-annotate-mode-map nil
"Local keymap used for VC-Annotate mode.")
`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)
("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))))
(set-buffer buffer)
(display-buffer buffer)
- (if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done
+ (or (eq major-mode 'vc-annotate-mode) ; Turn on vc-annotate-mode if not done
(vc-annotate-mode))
+ ;; Delete old overlays
+ (mapcar
+ (lambda (overlay)
+ (if (overlay-get overlay 'vc-annotation)
+ (delete-overlay overlay)))
+ (overlays-in (point-min) (point-max)))
(goto-char (point-min)) ; Position at the top of the buffer.
(while (re-search-forward
"^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): "
(day (string-to-number (match-string 1)))
(month (cdr (assoc (match-string 2) local-month-numbers)))
(year-tmp (string-to-number (match-string 3)))
- (year (+ (if (> 100 year-tmp) 1900 0) year-tmp)) ; Possible millenium problem
+ ;; Years 0..68 are 2000..2068.
+ ;; Years 69..99 are 1969..1999.
+ (year (+ (cond ((> 69 year-tmp) 2000)
+ ((> 100 year-tmp) 1900)
+ (t 0))
+ year-tmp))
(high (- (car (current-time))
(car (encode-time 0 0 0 day month year))))
(color (cond ((vc-annotate-compcar high (cond (color-map)
(if vc-annotate-background
(set-face-background tmp-face vc-annotate-background))
tmp-face)))) ; Return the face
- (point (point)))
+ (point (point))
+ overlay)
(forward-line 1)
- (overlay-put (make-overlay point (point) nil) 'face face)))))
+ (setq overlay (make-overlay point (point)))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'vc-annotation t)))))
\f
;; Collect back-end-dependent stuff here
(failed t))
(unwind-protect
(progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-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)))
- switches)
- (setq failed nil))
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (apply 'vc-do-command
+ (current-buffer) 0 "get" file 'MASTER
+ "-s" ;; suppress diagnostic output
+ (if writable "-e")
+ "-p"
+ (and rev
+ (concat "-r"
+ (vc-lookup-triple file rev)))
+ switches)))
+ (set-file-modes filename
+ (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (setq failed nil))
(and failed (file-exists-p filename)
(delete-file filename))))
(apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
(failed t))
(unwind-protect
(progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; 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
- filename
- (if writable "-l")
- (concat "-p" rev)
- switches)
- (setq failed nil))
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (apply 'vc-do-command
+ (current-buffer) 0 "co" file 'MASTER
+ "-q" ;; suppress diagnostic output
+ (if writable "-l")
+ (concat "-p" rev)
+ switches)))
+ (set-file-modes filename
+ (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (setq failed nil))
(and failed (file-exists-p filename) (delete-file filename))))
(let (new-version)
;; if we should go to the head of the trunk,
(let ((failed t))
(unwind-protect
(progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'WORKFILE "-c"
- "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
- "" ; dummy argument for shell's $0
- workfile
- (concat "-r" rev)
- "-p"
- switches)
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (apply 'vc-do-command
+ (current-buffer) 0 "cvs" file 'WORKFILE
+ "-Q" ;; suppress diagnostic output
+ "update"
+ (concat "-r" rev)
+ "-p"
+ switches)))
(setq failed nil))
(and failed (file-exists-p filename) (delete-file filename))))
;; default for verbose checkout: clear the sticky tag
;; 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)))
;; CVS
- ;; Check out via standard output (caused by the final argument
- ;; FILE below), so that no sticky tag is set.
- (vc-backend-checkout file nil (vc-workfile-version file) file))
+ (progn
+ ;; Check out via standard output (caused by the final argument
+ ;; FILE below), so that no sticky tag is set.
+ (vc-backend-checkout file nil (vc-workfile-version file) file)
+ ;; If "cvs edit" was used to make the file writeable,
+ ;; call "cvs unedit" now to undo that.
+ (if (eq (vc-checkout-model file) 'manual)
+ (vc-do-command nil 0 "cvs" file 'WORKFILE "unedit"))))
(vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
(message "Reverting %s...done" file)
;; diff it against /dev/null.
(apply 'vc-do-command
"*vc-diff*" 1 "diff" file 'WORKFILE
- (append (if (listp diff-switches)
- diff-switches
- (list diff-switches)) '("/dev/null")))))
+ (append diff-switches-list '("/dev/null")))))
;; cmp is not yet implemented -- we always do a full diff.
(apply 'vc-do-command
"*vc-diff*" 1 "cvs" file 'WORKFILE "diff"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers))
- (if (listp diff-switches)
- diff-switches
- (list diff-switches)))))
- (t
- (vc-registration-error file)))))
+ diff-switches-list))))))
(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 "^\\(\\([CMUP]\\) \\)?"
+ (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")
+ (string= (match-string 2) "P")
+ ;; 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)