;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
-;; $Id: vc.el,v 1.228 1998/06/03 15:07:04 spiegel Exp spiegel $
+;; $Id: vc.el,v 1.242 1999/01/02 21:54:32 rms Exp spiegel $
;; This file is part of GNU Emacs.
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.
;; CVS
t))
+;;; 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)))
+
+;;;###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
(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)))
(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))
;; 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
;;;###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)
(vc-ensure-vc-buffer)
(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 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
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."
(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)
- (let ((pos (point)))
- (dired-kill-tree filename)
- (goto-char pos)
- (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)))
- ((if cvs-dir
- (eq (vc-file-getprop filename 'vc-backend) 'CVS)
- (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 ((vc-dired-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
(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.")
("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]+\\)): "
(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
;; 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))))))))
+ 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 "^\\(\\([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")
+ (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