X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/edcb979fe496aedb4ddaa70e2382481711427392..ca2ebe63eba27e234394e9c5c20229dcdce87b33:/lisp/vc.el diff --git a/lisp/vc.el b/lisp/vc.el index 9197d2a2da..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.222 1998/04/15 09:48:04 schwab Exp spiegel $ +;; $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) @@ -493,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)) @@ -502,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))) @@ -879,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)) @@ -1217,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 @@ -1624,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." @@ -1643,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)) @@ -1698,14 +1740,17 @@ There is a special command, `*l', to mark all files currently locked." ;; 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))) @@ -1713,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 @@ -1744,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 @@ -2112,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) @@ -2843,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