;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: ttn@netcom.com
-;; Version: 5.5 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994.
+;; Version: 5.6
;; This file is part of GNU Emacs.
;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
;; and Richard Stallman contributed valuable criticism, support, and testing.
+;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
+;; in Jan-Feb 1994.
;;
-;; Supported version-control systems presently include SCCS and RCS;
-;; the RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
+;; Supported version-control systems presently include SCCS, RCS, and CVS.
+;; The RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
;; or newer. Currently (January 1994) that is only a beta test release.
+;; Even initial checkins will fail if your RCS version is so old that ci
+;; doesn't understand -t-; this has been known to happen to people running
+;; NExTSTEP 3.0.
;;
;; The RCS code assumes strict locking. You can support the RCS -x option
;; by adding pairs to the vc-master-templates list.
(if (file-exists-p "/usr/sccs")
'("/usr/sccs") nil)
"*List of extra directories to search for version control commands.")
+(defvar vc-directory-exclusion-list '("SCCS" "RCS")
+ "*Directory names ignored by functions that recursively walk file trees.")
(defconst vc-maximum-comment-ring-size 32
"Maximum number of saved comments in the comment ring.")
(defvar vc-comment-ring-index nil)
(defvar vc-last-comment-match nil)
+;; Back-portability to Emacs 18
+
+(defun file-executable-p-18 (f)
+ (let ((modes (file-modes f)))
+ (and modes (not (zerop (logand 292))))))
+
+(defun file-regular-p-18 (f)
+ (let ((attributes (file-attributes f)))
+ (and attributes (not (car attributes)))))
+
+; Conditionally rebind some things for Emacs 18 compatibility
+(if (not (boundp 'minor-mode-map-alist))
+ (progn
+ (setq compilation-old-error-list nil)
+ (fset 'file-executable-p 'file-executable-p-18)
+ (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
+ ))
+
+(if (not (boundp 'file-regular-p))
+ (fset 'file-regular-p 'file-regular-p-18))
+
;; File property caching
(defun vc-file-clearprops (file)
"Execute a version-control command, notifying user and checking for errors.
The command is successful if its exit status does not exceed OKSTATUS.
Output from COMMAND goes to buffer *vc*. The last argument of the command is
-the master name of FILE if LAST is 'MASTER, or the basename of FILE if LAST is
-'BASE; this is appended to an optional list of FLAGS."
+the master name of FILE if LAST is 'MASTER, or the workfile of FILE if LAST is
+'WORKFILE; this is appended to an optional list of FLAGS."
(setq file (expand-file-name file))
(if vc-command-messages
(message "Running %s on %s..." command file))
(let ((obuf (current-buffer)) (camefrom (current-buffer))
(squeezed nil)
(vc-file (and file (vc-name file)))
+ (olddir default-directory)
status)
(set-buffer (get-buffer-create "*vc*"))
(set (make-local-variable 'vc-parent-buffer) camefrom)
(set (make-local-variable 'vc-parent-buffer-name)
(concat " from " (buffer-name camefrom)))
+ (setq default-directory olddir)
(erase-buffer)
- ;; This is so that command arguments typed in the *vc* buffer will
- ;; have reasonable defaults.
- (setq default-directory (file-name-directory file))
-
(mapcar
(function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
flags)
(if (and vc-file (eq last 'MASTER))
(setq squeezed (append squeezed (list vc-file))))
- (if (eq last 'BASE)
- (setq squeezed (append squeezed (list (file-name-nondirectory file)))))
- (let ((default-directory (file-name-directory (or file "./")))
- (exec-path (if vc-path (append exec-path vc-path) exec-path))
+ (if (eq last 'WORKFILE)
+ (progn
+ (let* ((pwd (expand-file-name default-directory))
+ (preflen (length pwd)))
+ (if (string= (substring file 0 preflen) pwd)
+ (setq file (substring file preflen))))
+ (setq squeezed (append squeezed (list file)))))
+ (let ((exec-path (if vc-path (append exec-path vc-path) exec-path))
;; Add vc-path to PATH for the execution of this command.
(process-environment
(cons (concat "PATH=" (getenv "PATH")
process-environment)))
(setq status (apply 'call-process command nil t nil squeezed)))
(goto-char (point-max))
+ (set-buffer-modified-p nil)
(forward-line -1)
(if (or (not (integerp status)) (< okstatus status))
(progn
(if buffer-error-marked-p buffer))))
(buffer-list)))))))
- ;; the actual revisit
- (revert-buffer arg no-confirm)
+ (let ((in-font-lock-mode (and (boundp 'font-lock-fontified)
+ font-lock-fontified)))
+ (if in-font-lock-mode
+ (font-lock-mode 0))
+
+ ;; the actual revisit
+ (revert-buffer arg no-confirm)
+
+ (if in-font-lock-mode
+ (font-lock-mode 1)))
;; Reparse affected compilation buffers.
(while reparse
;; if there is no master file corresponding, create one
((not vc-file)
- (vc-register verbose comment))
+ (vc-register verbose comment)
+ (if vc-initial-comment
+ (setq vc-log-after-operation-hook
+ 'vc-checkout-writable-buffer-hook)
+ (vc-checkout-writable-buffer file)))
;; if there is no lock on the file, assert one and get it
((and (not (eq vc-type 'CVS)) ;There are no locks in CVS.
;; We've accepted a log comment, now do a vc-next-action using it on all
;; marked files.
(set-buffer vc-parent-buffer)
- (dired-map-over-marks
- (save-window-excursion
- (let ((file (dired-get-filename)))
- (message "Processing %s..." file)
- (vc-next-action-on-file file nil comment)
- (message "Processing %s...done" file)))
- nil t)
+ (let ((configuration (current-window-configuration)))
+ (dired-map-over-marks
+ (save-window-excursion
+ (let ((file (dired-get-filename)))
+ (message "Processing %s..." file)
+ (vc-next-action-on-file file nil comment)
+ (message "Processing %s...done" file)))
+ nil t)
+ (set-window-configuration configuration))
)
;; Here's the major entry point.
;; visited. This plays hell with numerous assumptions in
;; the diff.el and compile.el machinery.
(pop-to-buffer "*vc*")
- (pop-to-buffer "*vc*")
+ (setq default-directory (file-name-directory file))
(if (= 0 (buffer-size))
(progn
(setq unchanged t)
(cond
((re-search-forward "\\([0-9]+ \\)\\([^ ]+\\)\\( .*\\)" nil 0)
(save-excursion
- (goto-char (match-beginning 2))
- (insert "(")
- (goto-char (1+ (match-end 2)))
- (insert ")")
- (delete-char (- 17 (- (match-end 2) (match-beginning 2))))
- (insert (substring " " 0
- (- 7 (- (match-end 2) (match-beginning 2)))))))))
+ (goto-char (match-beginning 2))
+ (insert "(")
+ (goto-char (1+ (match-end 2)))
+ (insert ")")
+ (delete-char (- 17 (- (match-end 2) (match-beginning 2))))
+ (insert (substring " " 0
+ (- 7 (- (match-end 2) (match-beginning 2)))))))))
(t
(if x (setq x (concat "(" x ")")))
(if (re-search-forward "\\([0-9]+ \\).................\\( .*\\)" nil 0)
- (let ((rep (substring (concat x " ") 0 9)))
- (replace-match (concat "\\1" rep "\\2") t)))
+ (let ((rep (substring (concat x " ") 0 9)))
+ (replace-match (concat "\\1" rep "\\2") t)))
)))
+;;; Note in Emacs 18 the following defun gets overridden
+;;; with the symbol 'vc-directory-18. See below.
;;;###autoload
-(defun vc-directory (dir verbose &optional nested)
- "Show version-control status of all files in the directory DIR.
-If the second argument VERBOSE is non-nil, show all files;
-otherwise show only files that current locked in the version control system.
-Interactively, supply a prefix arg to make VERBOSE non-nil.
-
-If the optional third argument NESTED is non-nil,
-scan the entire tree of subdirectories of the current directory."
- (interactive "DVC status of directory: \nP")
- (let* (nonempty
- (dl (length dir))
- (filelist nil) (userlist nil)
- dired-buf
- dired-buf-mod-count
- (subfunction
- (function (lambda (f)
- (if (vc-registered f)
- (let ((user (vc-locking-user f)))
- (and (or verbose user)
- (setq filelist (cons (substring f dl) filelist))
- (setq userlist (cons user userlist)))))))))
- (let ((default-directory dir))
- (if nested
- (vc-file-tree-walk subfunction)
- (vc-dir-all-files subfunction)))
+(defun vc-directory (verbose)
+ "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 "P")
+ (let (nonempty
+ (dl (length default-directory))
+ (filelist nil) (userlist nil)
+ dired-buf
+ dired-buf-mod-count)
+ (vc-file-tree-walk
+ (function (lambda (f)
+ (if (vc-registered f)
+ (let ((user (vc-locking-user f)))
+ (and (or verbose user)
+ (setq filelist (cons (substring f dl) filelist))
+ (setq userlist (cons user userlist))))))))
(save-excursion
;; This uses a semi-documented feature of dired; giving a switch
;; argument forces the buffer to refresh each time.
(dired
- (cons dir (nreverse filelist))
+ (cons default-directory (nreverse filelist))
dired-listing-switches)
(setq dired-buf (current-buffer))
(setq nonempty (not (zerop (buffer-size)))))
(if verbose "registered" "locked") default-directory))
))
-; Emacs 18 also lacks these.
-(or (boundp 'compilation-old-error-list)
- (setq compilation-old-error-list nil))
+;; 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
+ (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
(while vc-parent-buffer
(pop-to-buffer vc-parent-buffer))
(if (and buffer-file-name (vc-name buffer-file-name))
- (progn
- (vc-backend-print-log buffer-file-name)
+ (let ((file buffer-file-name))
+ (vc-backend-print-log file)
(pop-to-buffer (get-buffer-create "*vc*"))
+ (setq default-directory (file-name-directory file))
(while (looking-at "=*\n")
(delete-char (- (match-end 0) (match-beginning 0)))
(forward-line -1))
(setq buf (create-file-buffer file))
(set-buffer buf))
(erase-buffer)
- (insert-file-contents file nil)
+ (insert-file-contents file)
(set-buffer-modified-p nil)
(auto-save-mode nil)
(prog1
;; should always be nil anyhow. Don't fetch vc-your-latest-version, since
;; that is done in vc-find-cvs-master.
(vc-log-info
- "cvs" file 'BASE '("status")
+ "cvs" file 'WORKFILE '("status")
;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
;; and CVS 1.4a1 says "Repository revision:". The regexp below
;; matches much more, but because of the way vc-log-info is
(and comment (concat "-t-" comment))
file))
((eq backend 'CVS)
- (vc-do-command 0 "cvs" file 'BASE ;; CVS
+ (vc-do-command 0 "cvs" file 'WORKFILE ;; CVS
"add"
(and comment (not (string= comment ""))
(concat "-m" comment)))
(unwind-protect
(progn
(apply 'vc-do-command
- 0 "/bin/sh" file 'BASE "-c"
+ 0 "/bin/sh" file 'WORKFILE "-c"
"exec >\"$1\" || exit; shift; exec cvs update \"$@\""
"" ; dummy argument for shell's $0
workfile
vc-checkout-switches)
(setq failed nil))
(and failed (file-exists-p filename) (delete-file filename))))
- (apply 'vc-do-command 0 "cvs" file 'BASE
+ (apply 'vc-do-command 0 "cvs" file 'WORKFILE
(and rev (concat "-r" rev))
file
vc-checkout-switches))
(concat "-m" comment)
vc-checkin-switches)
(progn
- (apply 'vc-do-command 0 "cvs" file 'BASE
+ (apply 'vc-do-command 0 "cvs" file 'WORKFILE
"ci" "-m" comment
vc-checkin-switches)
(vc-file-setprop file 'vc-checkout-time
"-f" "-u")
(progn ;; CVS
(delete-file file)
- (vc-do-command 0 "cvs" file 'BASE "update"))
+ (vc-do-command 0 "cvs" file 'WORKFILE "update"))
)
(vc-file-setprop file 'vc-locking-user nil)
(message "Reverting %s...done" file)
file
(vc-do-command 0 "prs" file 'MASTER)
(vc-do-command 0 "rlog" file 'MASTER)
- (vc-do-command 0 "cvs" file 'BASE "rlog")))
+ (vc-do-command 0 "cvs" file 'WORKFILE "rlog")))
(defun vc-backend-assign-name (file name)
;; Assign to a FILE's latest version a given NAME.
(vc-backend-dispatch file
(vc-add-triple name file (vc-latest-version file)) ;; SCCS
(vc-do-command 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS
- (vc-do-command 0 "cvs" file 'BASE "tag" name) ;; CVS
+ (vc-do-command 0 "cvs" file 'WORKFILE "tag" name) ;; CVS
)
)
(let* ((command (if (eq backend 'SCCS)
"vcdiff"
"rcsdiff"))
+ (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER))
(options (append (list (and cmp "--brief")
"-q"
(and oldvers (concat "-r" oldvers))
(if (listp diff-switches)
diff-switches
(list diff-switches)))))
- (status (apply 'vc-do-command 2 command file options)))
+ (status (apply 'vc-do-command 2 command file mode options)))
;; Some RCS versions don't understand "--brief"; work around this.
(if (eq status 2)
- (apply 'vc-do-command 1 command file 'MASTER
+ (apply 'vc-do-command 1 command file 'WORKFILE
(if cmp (cdr options) options))
status)))
;; CVS is different.
(if (or oldvers newvers)
(error "No revisions of %s exists" file)
(apply 'vc-do-command
- 1 "diff" file 'BASE "/dev/null"
+ 1 "diff" file 'WORKFILE "/dev/null"
(if (listp diff-switches)
diff-switches
(list diff-switches))))
(apply 'vc-do-command
- 1 "cvs" file 'BASE "diff"
+ 1 "cvs" file 'WORKFILE "diff"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers))
(if (listp diff-switches)
file
(error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
(error "vc-backend-merge-news not meaningful for RCS files") ;RCS
- (vc-do-command 1 "cvs" file 'BASE "update") ;CVS
+ (vc-do-command 1 "cvs" file 'WORKFILE "update") ;CVS
))
(defun vc-check-headers ()
(lambda (f) (or
(string-equal f ".")
(string-equal f "..")
+ (member f vc-directory-exclusion-list)
(let ((dirf (concat dir f)))
(or
(file-symlink-p dirf) ;; Avoid possible loops
(vc-file-tree-walk-internal dirf func args))))))
(directory-files dir)))))
-(defun vc-dir-all-files (func &rest args)
- "Invoke FUNC f ARGS on each regular file f in default directory."
- (let ((dir default-directory))
- (message "Scanning directory %s..." dir)
- (mapcar (function (lambda (f)
- (let ((dirf (expand-file-name f dir)))
- (if (file-regular-p dirf)
- (apply func dirf args)))))
- (directory-files dir))
- (message "Scanning directory %s...done" dir)))
-
(provide 'vc)
;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE