X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4b81132cafbf7497edbb0b96535e5f1de0a25bf1..85b5a0254674475e1fbd5b51c8ed8b5fa67f3c8e:/lisp/vc.el diff --git a/lisp/vc.el b/lisp/vc.el index dc3233cfa3..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.220 1998/04/09 13:45:44 spiegel 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 @@ -1603,11 +1627,48 @@ the file named in the current Dired buffer line. `vv' invokes There is a special command, `*l', to mark all files currently locked." (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." @@ -1622,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)) @@ -1649,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)) + (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) - 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) - (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))) @@ -1695,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 @@ -1726,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 @@ -2094,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) @@ -2682,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))) @@ -2825,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