Commit 3d30b8bc authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(vc-next-action-dired): Use dired-do-redisplay. Handle

window configuration correctly.
(vc-next-action): Save window configuration for vc-next-action-dired.
(vc-finish-logentry): Only kill log buffer if it does exist.
(vc-dired-mode): Rewritten so that it works entirely through
dired-after-readin-hook.  Subdirectories are handled just as in
ordinary dired.
(vc-dired-hook): New function.
(vc-state-info, vc-dired-reformat-line): Adapted.
(vc-dired-update, vc-dired-update-line): Removed.
(vc-directory): Rewritten.
(vc-directory-18): Removed.
(vc-dired-mark-locked): New function, bound to "*l" in vc-dired-mode.
(vc-do-command): Only compute vc-name if it is really needed.
(vc-fetch-cvs-status): New function.
(vc-dired-hook): Use it.
parent 8aa81ea8
;;; vc.el --- drive a version-control system from within Emacs ;;; vc.el --- drive a version-control system from within Emacs
;; Copyright (C) 1992, 93, 94, 95, 96, 97 Free Software Foundation, Inc. ;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com> ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de> ;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
;; $Id: vc.el,v 1.214 1998/03/31 18:08:36 spiegel Exp spiegel $ ;; $Id: vc.el,v 1.215 1998/04/01 12:26:43 spiegel Exp rms $
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
...@@ -32,7 +32,7 @@ ...@@ -32,7 +32,7 @@
;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>, ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
;; and Richard Stallman contributed valuable criticism, support, and testing. ;; and Richard Stallman contributed valuable criticism, support, and testing.
;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se> ;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
;; in Jan-Feb 1994. Further enhancements came from ttn.netcom.com and ;; in Jan-Feb 1994. Further enhancements came from ttn@netcom.com and
;; Andre Spiegel <spiegel@inf.fu-berlin.de>. ;; Andre Spiegel <spiegel@inf.fu-berlin.de>.
;; ;;
;; Supported version-control systems presently include SCCS, RCS, and CVS. ;; Supported version-control systems presently include SCCS, RCS, and CVS.
...@@ -540,9 +540,8 @@ before the filename." ...@@ -540,9 +540,8 @@ before the filename."
(message "Running %s on %s..." command file)) (message "Running %s on %s..." command file))
(let ((obuf (current-buffer)) (camefrom (current-buffer)) (let ((obuf (current-buffer)) (camefrom (current-buffer))
(squeezed nil) (squeezed nil)
(vc-file (and file (vc-name file)))
(olddir default-directory) (olddir default-directory)
status) vc-file status)
(set-buffer (get-buffer-create buffer)) (set-buffer (get-buffer-create buffer))
(set (make-local-variable 'vc-parent-buffer) camefrom) (set (make-local-variable 'vc-parent-buffer) camefrom)
(set (make-local-variable 'vc-parent-buffer-name) (set (make-local-variable 'vc-parent-buffer-name)
...@@ -554,7 +553,7 @@ before the filename." ...@@ -554,7 +553,7 @@ before the filename."
(mapcar (mapcar
(function (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
flags) flags)
(if (and vc-file (eq last 'MASTER)) (if (and (eq last 'MASTER) file (setq vc-file (vc-name file)))
(setq squeezed (append squeezed (list vc-file)))) (setq squeezed (append squeezed (list vc-file))))
(if (and file (eq last 'WORKFILE)) (if (and file (eq last 'WORKFILE))
(progn (progn
...@@ -893,8 +892,7 @@ before the filename." ...@@ -893,8 +892,7 @@ before the filename."
(defun vc-next-action-dired (file rev comment) (defun vc-next-action-dired (file rev comment)
;; Do a vc-next-action-on-file on all the marked files, possibly ;; Do a vc-next-action-on-file on all the marked files, possibly
;; passing on the log comment we've just entered. ;; passing on the log comment we've just entered.
(let ((configuration (current-window-configuration)) (let ((dired-buffer (current-buffer))
(dired-buffer (current-buffer))
(dired-dir default-directory)) (dired-dir default-directory))
(dired-map-over-marks (dired-map-over-marks
(let ((file (dired-get-filename)) p (let ((file (dired-get-filename)) p
...@@ -906,10 +904,11 @@ before the filename." ...@@ -906,10 +904,11 @@ before the filename."
(vc-next-action-on-file file nil comment) (vc-next-action-on-file file nil comment)
(set-buffer dired-buffer) (set-buffer dired-buffer)
(setq default-directory dired-dir) (setq default-directory dired-dir)
(vc-dired-update-line file) (dired-do-redisplay file)
(set-window-configuration configuration) (set-window-configuration vc-dired-window-configuration)
(message "Processing %s...done" file)) (message "Processing %s...done" file))
nil t))) nil t))
(dired-move-to-filename))
;; Here's the major entry point. ;; Here's the major entry point.
...@@ -956,6 +955,8 @@ merge in the changes into your working copy." ...@@ -956,6 +955,8 @@ merge in the changes into your working copy."
(catch 'nogo (catch 'nogo
(if vc-dired-mode (if vc-dired-mode
(let ((files (dired-get-marked-files))) (let ((files (dired-get-marked-files)))
(set (make-local-variable 'vc-dired-window-configuration)
(current-window-configuration))
(if (string= "" (if (string= ""
(mapconcat (mapconcat
(function (lambda (f) (function (lambda (f)
...@@ -1231,11 +1232,14 @@ May be useful as a `vc-checkin-hook' to update change logs automatically." ...@@ -1231,11 +1232,14 @@ May be useful as a `vc-checkin-hook' to update change logs automatically."
;; Remove checkin window (after the checkin so that if that fails ;; Remove checkin window (after the checkin so that if that fails
;; we don't zap the *VC-log* buffer and the typing therein). ;; we don't zap the *VC-log* buffer and the typing therein).
(let ((logbuf (get-buffer "*VC-log*"))) (let ((logbuf (get-buffer "*VC-log*")))
(delete-windows-on logbuf) (cond (logbuf
(kill-buffer logbuf)) (delete-windows-on logbuf)
(kill-buffer logbuf))))
;; Now make sure we see the expanded headers ;; Now make sure we see the expanded headers
(if buffer-file-name (if buffer-file-name
(vc-resynch-window buffer-file-name vc-keep-workfiles t)) (vc-resynch-window buffer-file-name vc-keep-workfiles t))
(if vc-dired-mode
(dired-move-to-filename))
(run-hooks after-hook 'vc-finish-logentry-hook))) (run-hooks after-hook 'vc-finish-logentry-hook)))
;; Code for access to the comment ring ;; Code for access to the comment ring
...@@ -1568,42 +1572,69 @@ The conflicts must be marked with rcsmerge conflict markers." ...@@ -1568,42 +1572,69 @@ The conflicts must be marked with rcsmerge conflict markers."
;; All VC commands get mapped into logical equivalents. ;; All VC commands get mapped into logical equivalents.
(define-derived-mode vc-dired-mode dired-mode "Dired under VC" (define-derived-mode vc-dired-mode dired-mode "Dired under VC"
"The major mode used in VC directory buffers. It is derived from Dired. "The major mode used in VC directory buffers. It works like Dired,
All Dired commands operate normally. Users currently locking listed files but lists only files under version control, with the current VC state of
are listed in place of the file's owner and group. each file being indicated in the place of the file's link count, owner,
Keystrokes bound to VC commands will execute as though they had been called group and size. Subdirectories are also listed, and you may insert them
on a buffer attached to the file named in the current Dired buffer line." into the buffer as desired, like in Dired.
All Dired commands operate normally, with the exception of `v', which
is redefined as the version control prefix, so that you can type
`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
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)
(setq vc-dired-mode t)) (setq vc-dired-mode t))
(define-key vc-dired-mode-map "\C-xv" vc-prefix-map) (define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
(define-key vc-dired-mode-map "g" 'vc-dired-update) (define-key vc-dired-mode-map "v" vc-prefix-map)
(define-key vc-dired-mode-map "=" 'vc-diff) (define-key vc-dired-mode-map "=" 'vc-diff)
(defun vc-dired-mark-locked ()
"Mark all files currently locked."
(interactive)
(dired-mark-if (let ((f (dired-get-filename nil t)))
(and f
(not (file-directory-p f))
(vc-locking-user f)))
"locked file"))
(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
(defun vc-fetch-cvs-status (dir)
(let ((default-directory dir))
(vc-do-command "*vc-info*" 0 "cvs" nil nil "status" dir)
(save-excursion
(set-buffer (get-buffer "*vc-info*"))
(goto-char (point-min))
(while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t)
(narrow-to-region (match-beginning 0) (match-end 0))
(vc-parse-cvs-status)
(goto-char (point-max))
(widen)))))
(defun vc-dired-state-info (file) (defun vc-dired-state-info (file)
;; Return the string that indicates the version control status ;; Return the string that indicates the version control status
;; on a VC dired line. ;; on a VC dired line.
(let ((cvs-state (and (eq (vc-backend file) 'CVS) (let* ((cvs-state (and (eq (vc-backend file) 'CVS)
(vc-cvs-status file)))) (vc-cvs-status file)))
(if cvs-state (state
(cond ((eq cvs-state 'up-to-date) nil) (if cvs-state
((eq cvs-state 'needs-checkout) "patch") (cond ((eq cvs-state 'up-to-date) nil)
((eq cvs-state 'locally-modified) "modified") ((eq cvs-state 'needs-checkout) "patch")
((eq cvs-state 'needs-merge) "merge") ((eq cvs-state 'locally-modified) "modified")
((eq cvs-state 'unresolved-conflict) "conflict") ((eq cvs-state 'needs-merge) "merge")
((eq cvs-state 'locally-added) "added")) ((eq cvs-state 'unresolved-conflict) "conflict")
(vc-locking-user file)))) ((eq cvs-state 'locally-added) "added"))
(vc-locking-user file))))
(if state (concat "(" state ")"))))
(defun vc-dired-reformat-line (x) (defun vc-dired-reformat-line (x)
;; Hack a directory-listing line, plugging in locking-user info in ;; Reformat a directory-listing line, plugging in version control info in
;; place of the user and group info. Should have the beneficial ;; place of the user and group info.
;; side-effect of shortening the listing line. Each call starts with
;; point immediately following the dired mark area on the line to be
;; hacked.
;;
;; Simplest possible one:
;; (insert (concat x "\t")))
;;
;; This code, like dired, assumes UNIX -l format. ;; 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 owner date-and-file)
(end-of-line) (end-of-line)
(setq limit (point)) (setq limit (point))
...@@ -1611,144 +1642,74 @@ on a buffer attached to the file named in the current Dired buffer line." ...@@ -1611,144 +1642,74 @@ on a buffer attached to the file named in the current Dired buffer line."
(cond (cond
((or ((or
(re-search-forward ;; owner and group (re-search-forward ;; owner and group
"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" "^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
limit t) limit t)
(re-search-forward ;; only owner displayed (re-search-forward ;; only owner displayed
"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" "^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
limit t)) limit t))
(setq perm (match-string 1) (setq perm (match-string 1)
owner (match-string 2) owner (match-string 2)
date-and-file (match-string 3))) date-and-file (match-string 3)))
((re-search-forward ;; OS/2 -l format, no links, owner, group ((re-search-forward ;; OS/2 -l format, no links, owner, group
"\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" "^\\(..[drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
limit t) limit t)
(setq perm (match-string 1) (setq perm (match-string 1)
date-and-file (match-string 2)))) date-and-file (match-string 2))))
(if x (setq x (concat "(" x ")"))) (setq x (substring (concat x " ") 0 10))
(let ((rep (substring (concat x " ") 0 10))) (replace-match (concat perm x date-and-file))))
(replace-match (concat perm rep date-and-file)))))
(defun vc-dired-hook ()
(defun vc-dired-update-line (file) ;; Called by dired after any portion of a vc-dired buffer has been read in.
;; Update the vc-dired listing line of file -- it is assumed ;; Reformat the listing according to version control.
;; that point is already on this line. Don't use dired-do-redisplay (message "Getting version information... ")
;; for this, because it cannot handle the way vc-dired deals with (let (subdir filename (buffer-read-only nil))
;; subdirectories. (goto-char (point-min))
(beginning-of-line) (while (not (eq (point) (point-max)))
(forward-char 2) (cond
(let ((start (point))) ;; subdir header line
(forward-line 1) ((setq subdir (dired-get-subdir))
(beginning-of-line) (if (file-directory-p (concat subdir "/CVS"))
(delete-region start (point)) (vc-fetch-cvs-status (file-name-as-directory subdir)))
(insert-directory file dired-listing-switches) (forward-line 1)
(forward-line -1) ;; erase (but don't remove) the "total" line
(end-of-line) (let ((start (point)))
(delete-char (- (length file))) (end-of-line)
(insert (substring file (length (expand-file-name default-directory)))) (delete-region start (point))
(goto-char start)) (beginning-of-line)
(vc-dired-reformat-line (vc-dired-state-info file))) (forward-line 1)))
;; an ordinary file line
(defun vc-dired-update (verbose) ((setq filename (dired-get-filename nil t))
(interactive "P") (cond
(vc-directory default-directory verbose)) ((file-directory-p filename)
(if (member (file-name-nondirectory filename)
vc-directory-exclusion-list)
(dired-kill-line)
(vc-dired-reformat-line nil)
(forward-line 1)))
((vc-backend 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"))
;;; Note in Emacs 18 the following defun gets overridden
;;; with the symbol 'vc-directory-18. See below.
;;;###autoload ;;;###autoload
(defun vc-directory (dirname verbose) (defun vc-directory (dirname read-switches)
"Show version-control status of the current directory and subdirectories.
Normally it creates a Dired buffer that lists only the locked files
in all these directories. With a prefix argument, it lists all files."
(interactive "DDired under VC (directory): \nP") (interactive "DDired under VC (directory): \nP")
(require 'dired) (let ((switches
(setq dirname (expand-file-name dirname)) (if read-switches (read-string "Dired listing switches: "
;; force a trailing slash dired-listing-switches))))
(if (not (eq (elt dirname (1- (length dirname))) ?/)) (require 'dired)
(setq dirname (concat dirname "/"))) (require 'dired-aux)
(let (nonempty ;; force a trailing slash
(dl (length dirname)) (if (not (eq (elt dirname (1- (length dirname))) ?/))
(filelist nil) (statelist nil) (setq dirname (concat dirname "/")))
(old-dir default-directory) (switch-to-buffer
dired-buf (dired-internal-noselect (expand-file-name dirname)
dired-buf-mod-count) (or switches dired-listing-switches)
(vc-file-tree-walk 'vc-dired-mode))))
dirname
(function
(lambda (f)
(if (vc-registered f)
(let ((state (vc-dired-state-info f)))
(and (or verbose state)
(setq filelist (cons (substring f dl) filelist))
(setq statelist (cons state statelist))))))))
(save-window-excursion
(save-excursion
;; This uses a semi-documented feature of dired; giving a switch
;; argument forces the buffer to refresh each time.
(setq dired-buf
(dired-internal-noselect
(cons dirname (nreverse filelist))
dired-listing-switches 'vc-dired-mode))
(setq nonempty (not (eq 0 (length filelist))))))
(switch-to-buffer dired-buf)
;; Make a few modifications to the header
(setq buffer-read-only nil)
(goto-char (point-min))
(forward-line 1) ;; Skip header line
(let ((start (point))) ;; Erase (but don't remove) the
(end-of-line) ;; "wildcard" line.
(delete-region start (point)))
(beginning-of-line)
(if nonempty
(progn
;; Plug the version information into the individual lines
(mapcar
(function
(lambda (x)
(forward-char 2) ;; skip dired's mark area
(vc-dired-reformat-line x)
(forward-line 1))) ;; go to next line
(nreverse statelist))
(setq buffer-read-only t)
(goto-char (point-min))
(dired-next-line 2)
)
(dired-next-line 1)
(insert " ")
(setq buffer-read-only t)
(message "No files are currently %s under %s"
(if verbose "registered" "locked") dirname))
))
;; Emacs 18 version
(defun vc-directory-18 (verbose)
"Show version-control status of all files under the current directory."
(interactive "P")
(let (nonempty (dir default-directory))
(save-excursion
(set-buffer (get-buffer-create "*vc-status*"))
(erase-buffer)
(cd dir)
(vc-file-tree-walk
default-directory
(function (lambda (f)
(if (vc-registered f)
(let ((user (vc-locking-user f)))
(if (or user verbose)
(insert (format
"%s %s\n"
(concat user) f))))))))
(setq nonempty (not (zerop (buffer-size)))))
(if nonempty
(progn
(pop-to-buffer "*vc-status*" t)
(goto-char (point-min))
(shrink-window-if-larger-than-buffer)))
(message "No files are currently %s under %s"
(if verbose "registered" "locked") default-directory))
)
(or (boundp 'minor-mode-map-alist)
(fset 'vc-directory 'vc-directory-18))
;; Named-configuration support for SCCS ;; Named-configuration support for SCCS
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment