X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/26174ef4fe149cc46484a7d985b5df7531fe3435..66495b0787f38fbdc316bfd60e54a02cdf362d3b:/lisp/vc.el diff --git a/lisp/vc.el b/lisp/vc.el index 51d3748943..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.226 1998/05/16 03:44:16 rms Exp rms $ +;; $Id: vc.el,v 1.235 1998/07/09 03:24:06 rms Exp spiegel $ ;; This file is part of GNU Emacs. @@ -154,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) @@ -494,7 +506,10 @@ If nil, VC itself computes this value when it is first needed." (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)) @@ -503,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))) @@ -880,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)) @@ -1218,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 @@ -1625,11 +1648,27 @@ There is a special command, `*l', to mark all files currently locked." 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." @@ -1719,32 +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))) - ((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 ((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 @@ -1752,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 @@ -2846,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