# HG changeset patch # User Richard M. Stallman # Date 789343895 0 # Node ID e5638e0a5a6046505cc274dca4d6465776d4e789 # Parent 56222f67ee4cfdf0116e09c5bbc7fa8312829373 (vc-do-command): Change RCS handling so rcsdiff won't strip away relative-pathname information. This function no longer sets the default directory. Also, mark the *vc* output buffer unmodified. (vc-revert-buffer1): Handle font-lock mode correctly. (vc-diff, vc-print-log): vc-do-command no longer sets the default directory, but doing so is advantageous for these cases. (file-executable-p-18): Better portability to Emacs 18. (vc-directory-exclusion-list, vc-file-tree-walk-internal): Implement the new variable vc-directory-exclusion-list to prune tree walks. Initial value tells it to ignore SCCS and RCS subdirectories. diff -r 56222f67ee4c -r e5638e0a5a60 lisp/vc.el --- a/lisp/vc.el Thu Jan 05 12:32:54 1995 +0000 +++ b/lisp/vc.el Thu Jan 05 22:11:35 1995 +0000 @@ -4,7 +4,7 @@ ;; Author: Eric S. Raymond ;; 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. @@ -29,10 +29,15 @@ ;; This was designed and implemented by Eric Raymond . ;; Paul Eggert , Sebastian Kremer , ;; and Richard Stallman contributed valuable criticism, support, and testing. +;; CVS support was added by Per Cederqvist +;; 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. @@ -93,6 +98,8 @@ (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.") @@ -159,6 +166,20 @@ (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)))))) + +; 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) + )) + ;; File property caching (defun vc-file-clearprops (file) @@ -203,9 +224,13 @@ "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)) + (let* ((pwd (expand-file-name default-directory)) + (preflen (length pwd))) + (if (string= (substring file 0 preflen) pwd) + (setq file (substring file preflen)))) (if vc-command-messages (message "Running %s on %s..." command file)) (let ((obuf (current-buffer)) (camefrom (current-buffer)) @@ -219,19 +244,14 @@ (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) + (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") @@ -239,6 +259,7 @@ process-environment))) (setq status (apply 'call-process command nil t nil squeezed))) (goto-char (point-max)) + (not-modified) (forward-line -1) (if (or (not (integerp status)) (< okstatus status)) (progn @@ -324,8 +345,16 @@ (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 @@ -893,7 +922,7 @@ ;; 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) @@ -1103,10 +1132,6 @@ (if verbose "registered" "locked") default-directory)) )) -; Emacs 18 also lacks these. -(or (boundp 'compilation-old-error-list) - (setq compilation-old-error-list nil)) - ;; Named-configuration support for SCCS (defun vc-add-triple (name file rev) @@ -1198,9 +1223,10 @@ (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)) @@ -1424,7 +1450,7 @@ (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 @@ -1602,7 +1628,7 @@ ;; 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 @@ -1654,7 +1680,7 @@ (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))) @@ -1737,7 +1763,7 @@ (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 @@ -1746,7 +1772,7 @@ 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)) @@ -1791,7 +1817,7 @@ (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 @@ -1813,7 +1839,7 @@ "-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) @@ -1853,14 +1879,14 @@ 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 ) ) @@ -1878,6 +1904,7 @@ (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)) @@ -1886,10 +1913,10 @@ (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. @@ -1901,12 +1928,12 @@ (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) @@ -1921,7 +1948,7 @@ 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 () @@ -2041,6 +2068,7 @@ (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