;;; 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.
+;; Modified by:
+;; ttn@netcom.com
+;; Per Cederqvist <ceder@lysator.liu.edu>
+;; Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
;; 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.
(cons '(vc-parent-buffer vc-parent-buffer-name)
minor-mode-alist)))
+;; To implement support for a new version-control system, add another
+;; branch to the vc-backend-dispatch macro and fill it in in each
+;; call. The variable vc-master-templates in vc-hooks.el will also
+;; have to change.
+
+(defmacro vc-backend-dispatch (f s r c)
+ "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively.
+If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
+\(CVS shares some code with RCS)."
+ (list 'let (list (list 'type (list 'vc-backend f)))
+ (list 'cond
+ (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS
+ (list (list 'eq 'type (quote 'RCS)) r) ;; RCS
+ (list (list 'eq 'type (quote 'CVS)) ;; CVS
+ (if (eq c 'RCS) r c))
+ )))
+
;; General customization
-(defvar vc-default-back-end nil
- "*Back-end actually used by this interface; may be SCCS or RCS.
-The value is only computed when needed to avoid an expensive search.")
(defvar vc-suppress-confirm nil
"*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
-(defvar vc-keep-workfiles t
- "*If non-nil, don't delete working files after registering changes.
-If the back-end is CVS, workfiles are always kept, regardless of the
-value of this flag.")
(defvar vc-initial-comment nil
"*Prompt for initial comment when a file is registered.")
(defvar vc-command-messages nil
"*Display run messages from back-end commands.")
-(defvar vc-mistrust-permissions 'file-symlink-p
- "*Don't assume that permissions and ownership track version-control status.")
(defvar vc-checkin-switches nil
"*Extra switches passed to the checkin program by \\[vc-checkin].")
(defvar vc-checkout-switches nil
"*Extra switches passed to the checkout program by \\[vc-checkout].")
-(defvar vc-path
- (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" "CVS")
+ "*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)
-;; File property caching
+;; Back-portability to Emacs 18
-(defun vc-file-clearprops (file)
- ;; clear all properties of a given file
- (setplist (intern file vc-file-prop-obarray) nil))
+(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-clear-context ()
"Clear all cached file properties and the comment ring."
;; log buffer with a nonzero local value of vc-comment-ring-index.
(setq vc-comment-ring nil))
+(defun vc-file-clear-masterprops (file)
+ ;; clear all properties of FILE that were retrieved
+ ;; from the master file
+ (vc-file-setprop file 'vc-latest-version nil)
+ (vc-file-setprop file 'vc-your-latest-version nil)
+ (vc-backend-dispatch file
+ (progn ;; SCCS
+ (vc-file-setprop file 'vc-master-locks nil))
+ (progn ;; RCS
+ (vc-file-setprop file 'vc-default-branch nil)
+ (vc-file-setprop file 'vc-head-version nil)
+ (vc-file-setprop file 'vc-top-version nil)
+ (vc-file-setprop file 'vc-master-locks nil))
+ (progn
+ (vc-file-setprop file 'vc-cvs-status nil))))
+
+;;; functions that operate on RCS revision numbers
+
+(defun vc-trunk-p (rev)
+ ;; return t if REV is a revision on the trunk
+ (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+
+(defun vc-branch-part (rev)
+ ;; return the branch part of a revision number REV
+ (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
+
;; Random helper functions
(defun vc-registration-error (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 (append vc-path exec-path))
;; Add vc-path to PATH for the execution of this command.
(process-environment
(cons (concat "PATH=" (getenv "PATH")
- ":" (mapconcat 'identity vc-path ":"))
+ path-separator
+ (mapconcat 'identity vc-path path-separator))
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)
;; Reparse affected compilation buffers.
(or (equal checkout-time lastmod)
(and (or (not checkout-time) want-differences-if-changed)
(let ((unchanged (zerop (vc-backend-diff file nil nil
- (not want-differences-if-changed)))))
+ (not want-differences-if-changed)))))
;; 0 stands for an unknown time; it can't match any mod time.
(vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
unchanged)))))
(defun vc-next-action-on-file (file verbose &optional comment)
;;; If comment is specified, it will be used as an admin or checkin comment.
(let ((vc-file (vc-name file))
- (vc-type (vc-backend-deduce file))
+ (vc-type (vc-backend file))
owner version)
(cond
;; 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.
(vc-revert-buffer1 t t)
(vc-checkout-writable-buffer file))
)
- (vc-checkout-writable-buffer file)))
+ (if verbose
+ (if (not (eq vc-type 'SCCS))
+ (let ((rev (read-string "Branch or version to move to: ")))
+ (if (eq vc-type 'RCS)
+ (vc-do-command 0 "rcs" file 'MASTER (concat "-b" rev)))
+ (vc-checkout file nil rev))
+ (error "Sorry, this is not implemented for SCCS."))
+ (vc-checkout-writable-buffer file))))
;; a checked-out version exists, but the user may not own the lock
((and (not (eq vc-type 'CVS)) ;There are no locks in CVS.
(error "Sorry, you can't steal the lock on %s this way" file))
(vc-steal-lock
file
- (and verbose (read-string "Version to steal: "))
+ (if verbose (read-string "Version to steal: ")
+ (vc-workfile-version file))
owner))
- ;; changes to the master file needs to be merged back into the
- ;; working file
+ ;; CVS: changes to the master file need to be
+ ;; merged back into the working file
((and (eq vc-type 'CVS)
;; "0" means "added, but not yet committed"
- (not (string= (vc-file-getprop file 'vc-your-latest-version) "0"))
- (progn
- (vc-fetch-properties file)
- (not (string= (vc-file-getprop file 'vc-your-latest-version)
- (vc-file-getprop file 'vc-latest-version)))))
+ (not (string= (vc-workfile-version file) "0"))
+ (not (string= (vc-workfile-version file)
+ (vc-latest-version file))))
(vc-buffer-sync)
(if (yes-or-no-p (format "%s is not up-to-date. Merge in changes now? "
(buffer-name)))
(error "%s needs update" (buffer-name))))
- ((and buffer-read-only (eq vc-type 'CVS))
- (toggle-read-only)
- ;; Sites who make link farms to a read-only gold tree (or
- ;; something similar) can use the hook below to break the
- ;; sym-link.
- (run-hooks 'vc-make-buffer-writable-hook))
-
- ;; OK, user owns the lock on the file (or we are running CVS)
+ ;; CVS: Buffer is read-only. Make the file "locked", i.e.
+ ;; make the buffer writable, and assert the user to be the locker
+ ((and (eq vc-type 'CVS) buffer-read-only)
+ (if verbose
+ (let ((rev (read-string "Trunk version to move to: ")))
+ (if (not (string= rev ""))
+ (vc-checkout file nil rev)
+ (vc-do-command 0 "cvs" file 'WORKFILE "update" "-A")
+ (vc-checkout file)))
+ (setq buffer-read-only nil)
+ (vc-file-setprop file 'vc-locking-user (user-login-name))
+ (vc-mode-line file)
+ ;; Sites who make link farms to a read-only gold tree (or
+ ;; something similar) can use the hook below to break the
+ ;; sym-link.
+ (run-hooks 'vc-make-buffer-writable-hook)))
+
+ ;; OK, user owns the lock on the file
(t
(find-file file)
;; after finishing the log entry.
(if (and (vc-workfile-unchanged-p file)
(not (buffer-modified-p)))
- (progn
- (if (eq vc-type 'CVS)
- (message "No changes to %s" file)
-
- (vc-backend-revert file)
- ;; DO NOT revert the file without asking the user!
- (vc-resynch-window file t nil)))
+ ;; DO NOT revert the file without asking the user!
+ (cond
+ ((yes-or-no-p "Revert to master version? ")
+ (vc-backend-revert file)
+ (vc-resynch-window file t t)))
;; user may want to set nonstandard parameters
(if verbose
;; 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.
;;;###autoload
(defun vc-next-action (verbose)
"Do the next logical checkin or checkout operation on the current file.
+ If you call this from within a VC dired buffer with no files marked,
+it will operate on the file in the current line.
+ If you call this from within a VC dired buffer, and one or more
+files are marked, it will accept a log message and then operate on
+each one. The log message will be used as a comment for any register
+or checkin operations, but ignored when doing checkouts. Attempted
+lock steals will raise an error.
+ A prefix argument lets you specify the version number to use.
For RCS and SCCS files:
If the file is not already registered, this registers it for version
message has been entered, it checks in the resulting changes along
with the logmessage as change commentary. A writable file is retained.
If the repository file is changed, you are asked if you want to
-merge in the changes into your working copy.
-
-The following is true regardless of which version control system you
-are using:
+merge in the changes into your working copy."
- If you call this from within a VC dired buffer with no files marked,
-it will operate on the file in the current line.
- If you call this from within a VC dired buffer, and one or more
-files are marked, it will accept a log message and then operate on
-each one. The log message will be used as a comment for any register
-or checkin operations, but ignored when doing checkouts. Attempted
-lock steals will raise an error.
-
- For checkin, a prefix argument lets you specify the version number to use."
(interactive "P")
(catch 'nogo
(if vc-dired-mode
;;; These functions help the vc-next-action entry point
-(defun vc-checkout-writable-buffer (&optional file)
+(defun vc-checkout-writable-buffer (&optional file rev)
"Retrieve a writable copy of the latest version of the current buffer's file."
- (vc-checkout (or file (buffer-file-name)) t)
+ (vc-checkout (or file (buffer-file-name)) t rev)
)
;;;###autoload
(defun vc-register (&optional override comment)
"Register the current file into your version-control system."
(interactive "P")
+ (or buffer-file-name
+ (error "No visited file"))
(let ((master (vc-name buffer-file-name)))
(and master (file-exists-p master)
(error "This file is already registered"))
(not (file-exists-p buffer-file-name)))
(set-buffer-modified-p t))
(vc-buffer-sync)
+ (cond ((not vc-make-backup-files)
+ ;; inhibit backup for this buffer
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
(vc-admin
buffer-file-name
(and override
(and (string= buffer-file-name file)
(if keep
(progn
+ ;; temporarily remove vc-find-file-hook, so that
+ ;; we don't lose the properties
+ (remove-hook 'find-file-hooks 'vc-find-file-hook)
(vc-revert-buffer1 t noquery)
+ (add-hook 'find-file-hooks 'vc-find-file-hook)
(vc-mode-line buffer-file-name))
- (progn
- (delete-window)
- (kill-buffer (current-buffer))))))
+ (kill-buffer (current-buffer)))))
(defun vc-start-entry (file rev comment msg action &optional after-hook)
;; Accept a comment for an operation on FILE revision REV. If COMMENT
"Enter initial comment." 'vc-backend-admin
nil))
-(defun vc-checkout (file &optional writable)
+(defun vc-checkout (file &optional writable rev)
"Retrieve a copy of the latest version of the given file."
;; If ftp is on this system and the name matches the ange-ftp format
;; for a remote file, the user is trying something that won't work.
(if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp"))
(error "Sorry, you can't check out files over FTP"))
- (vc-backend-checkout file writable)
+ (vc-backend-checkout file writable rev)
(if (string-equal file buffer-file-name)
(vc-resynch-window file t t))
)
(indent-to indentation))
(setq end (point))))
;; Fill the inserted text, preserving open-parens at bol.
- (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s("))
- (paragraph-start (concat paragraph-start "\\|^\\s *\\s(")))
+ (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s("))
+ (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
(beginning-of-line)
(fill-region (point) end))
;; Canonicalize the white space at the end of the entry so it is
;; 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)
(let* ((delims (cdr (assq major-mode vc-comment-alist)))
(comment-start-vc (or (car delims) comment-start "#"))
(comment-end-vc (or (car (cdr delims)) comment-end ""))
- (hdstrings (cdr (assoc (vc-backend-deduce (buffer-file-name)) vc-header-alist))))
+ (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist))))
(mapcar (function (lambda (s)
(insert comment-start-vc "\t" s "\t"
comment-end-vc "\n")))
(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 "FVC 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 (expand-file-name 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
(defun vc-add-triple (name file rev)
(save-excursion
- (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
+ (find-file (expand-file-name
+ vc-name-assoc-file
+ (file-name-as-directory
+ (expand-file-name (vc-backend-subdirectory-name file)
+ (file-name-directory file)))))
(goto-char (point-max))
(insert name "\t:\t" file "\t" rev "\n")
(basic-save-buffer)
(defun vc-record-rename (file newname)
(save-excursion
- (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
+ (find-file
+ (expand-file-name
+ vc-name-assoc-file
+ (file-name-as-directory
+ (expand-file-name (vc-backend-subdirectory-name file)
+ (file-name-directory file)))))
(goto-char (point-min))
;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
(while (re-search-forward (concat ":" (regexp-quote file) "$") nil t)
(and (>= firstchar ?0) (<= firstchar ?9)))
name)
(t
- (car (vc-master-info
- (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)
- (list (concat name "\t:\t" file "\t\\(.+\\)"))))
- )))
+ (save-excursion
+ (set-buffer (get-buffer-create "*vc-info*"))
+ (vc-insert-file
+ (expand-file-name
+ vc-name-assoc-file
+ (file-name-as-directory
+ (expand-file-name (vc-backend-subdirectory-name file)
+ (file-name-directory file)))))
+ (prog1
+ (car (vc-parse-buffer
+ (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1))))
+ (kill-buffer "*vc-info*"))))
+ ))
;; Named-configuration entry points
(function (lambda (f) (and
(vc-name f)
(vc-error-occurred
- (vc-backend-checkout f nil name))))))
+ (vc-checkout f nil name))))))
)))
;; Miscellaneous other entry points
(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))
(find-file-other-window (dired-get-filename)))
(while vc-parent-buffer
(pop-to-buffer vc-parent-buffer))
+ (if (eq (vc-backend (buffer-file-name)) 'CVS)
+ (error "Unchecking files under CVS is dangerous and not supported in VC"))
(let* ((target (concat (vc-latest-version (buffer-file-name))))
(yours (concat (vc-your-latest-version (buffer-file-name))))
(prompt (if (string-equal yours target)
;; consider to be wrong. When the famous, long-awaited rename database is
;; implemented things might change for the better. This is unlikely to occur
;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51
- (if (eq (vc-backend-deduce old) 'CVS)
+ (if (eq (vc-backend old) 'CVS)
(error "Renaming files under CVS is dangerous and not supported in VC."))
(let ((oldbuf (get-file-buffer old)))
(if (and oldbuf (buffer-modified-p oldbuf))
(error "This is not a safe thing to do in the presence of symbolic links"))
(rename-file
oldmaster
- (let ((backend (vc-backend-deduce old))
+ (let ((backend (vc-backend old))
(newdir (or (file-name-directory new) ""))
(newbase (file-name-nondirectory new)))
(catch 'found
file)
(while buffers
(setq file (buffer-file-name (car buffers)))
- (and file (vc-backend-deduce file)
+ (and file (vc-backend file)
(setq files (cons file files)))
(setq buffers (cdr buffers)))
files))
(message "Computing change log entries... %s"
(if (or (null args)
(eq 0 (apply 'call-process "rcs2log" nil t nil
- "-n"
- (user-login-name)
- (user-full-name)
- user-mail-address
+ "-u"
+ (concat (user-login-name)
+ "\t"
+ (user-full-name)
+ "\t"
+ user-mail-address)
(mapcar (function
(lambda (f)
(file-relative-name
args))))
"done" "failed"))))
-;; Functions for querying the master and lock files.
-
-(defun vc-match-substring (bn)
- (buffer-substring (match-beginning bn) (match-end bn)))
-
-(defun vc-parse-buffer (patterns &optional file properties)
- ;; Use PATTERNS to parse information out of the current buffer
- ;; by matching each regular expression in the list and returning \\1.
- ;; If a regexp has two tag brackets, assume the second is a date
- ;; field and we want the most recent entry matching the template.
- ;; If FILE and PROPERTIES are given, the latter must be a list of
- ;; properties of the same length as PATTERNS; each property is assigned
- ;; the corresponding value.
- (mapcar (function (lambda (p)
- (goto-char (point-min))
- (if (string-match "\\\\(.*\\\\(" p)
- (let ((latest-date "") (latest-val))
- (while (re-search-forward p nil t)
- (let ((date (vc-match-substring 2)))
- (if (string< latest-date date)
- (progn
- (setq latest-date date)
- (setq latest-val
- (vc-match-substring 1))))))
- latest-val))
- (prog1
- (let ((value nil))
- (if (re-search-forward p nil t)
- (setq value (vc-match-substring 1)))
- (if file
- (vc-file-setprop file (car properties) value))
- value)
- (setq properties (cdr properties)))))
- patterns)
- )
-
-(defun vc-master-info (file fields &optional rfile properties)
- ;; Search for information in a master file.
- (if (and file (file-exists-p file))
- (save-excursion
- (let ((buf))
- (setq buf (create-file-buffer file))
- (set-buffer buf))
- (erase-buffer)
- (insert-file-contents file nil)
- (set-buffer-modified-p nil)
- (auto-save-mode nil)
- (prog1
- (vc-parse-buffer fields rfile properties)
- (kill-buffer (current-buffer)))
- )
- (if rfile
- (mapcar
- (function (lambda (p) (vc-file-setprop rfile p nil)))
- properties))
- )
- )
-
-(defun vc-log-info (command file last flags patterns &optional properties)
- ;; Search for information in log program output
- (if (and file (file-exists-p file))
- (save-excursion
- (set-buffer (get-buffer-create "*vc*"))
- (apply 'vc-do-command 0 command file last flags)
- (set-buffer-modified-p nil)
- (prog1
- (vc-parse-buffer patterns file properties)
- (kill-buffer (current-buffer))
- )
- )
- (if file
- (mapcar
- (function (lambda (p) (vc-file-setprop file p nil)))
- properties))
- )
- )
-
-(defun vc-locking-user (file)
- "Return the name of the person currently holding a lock on FILE.
-Return nil if there is no such person.
-Under CVS, a file is considered locked if it has been modified since it
-was checked out. Under CVS, this will sometimes return the uid of
-the owner of the file (as a number) instead of a string."
- (setq file (expand-file-name file));; ??? Work around bug in 19.0.4
- (cond
- ((eq (vc-backend-deduce file) 'CVS)
- (if (vc-workfile-unchanged-p file t)
- nil
- ;; The expression below should return the username of the owner
- ;; of the file. It doesn't. It returns the username if it is
- ;; you, or otherwise the UID of the owner of the file. The
- ;; return value from this function is only used by
- ;; vc-dired-reformat-line, and it does the proper thing if a UID
- ;; is returned.
- ;;
- ;; The *proper* way to fix this would be to implement a built-in
- ;; function in Emacs, say, (username UID), that returns the
- ;; username of a given UID.
- ;;
- ;; The result of this hack is that vc-directory will print the
- ;; name of the owner of the file for any files that are
- ;; modified.
- (let ((uid (nth 2 (file-attributes file))))
- (if (= uid (user-uid))
- (user-login-name)
- uid))))
- (t
- (if (or (not vc-keep-workfiles)
- (eq vc-mistrust-permissions 't)
- (and vc-mistrust-permissions
- (funcall vc-mistrust-permissions (vc-backend-subdirectory-name
- file))))
- (vc-true-locking-user file)
- ;; This implementation assumes that any file which is under version
- ;; control and has -rw-r--r-- is locked by its owner. This is true
- ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
- ;; We have to be careful not to exclude files with execute bits on;
- ;; scripts can be under version control too. Also, we must ignore
- ;; the group-read and other-read bits, since paranoid users turn them off.
- ;; This hack wins because calls to the very expensive vc-fetch-properties
- ;; function only have to be made if (a) the file is locked by someone
- ;; other than the current user, or (b) some untoward manipulation
- ;; behind vc's back has changed the owner or the `group' or `other'
- ;; write bits.
- (let ((attributes (file-attributes file)))
- (cond ((string-match ".r-..-..-." (nth 8 attributes))
- nil)
- ((and (= (nth 2 attributes) (user-uid))
- (string-match ".rw..-..-." (nth 8 attributes)))
- (user-login-name))
- (t
- (vc-true-locking-user file))))))))
-
-(defun vc-true-locking-user (file)
- ;; The slow but reliable version
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-locking-user))
-
-(defun vc-latest-version (file)
- ;; Return version level of the latest version of FILE
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-latest-version))
-
-(defun vc-your-latest-version (file)
- ;; Return version level of the latest version of FILE checked in by you
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-your-latest-version))
-
;; Collect back-end-dependent stuff here
-;;
-;; Everything eventually funnels through these functions. To implement
-;; support for a new version-control system, add another branch to the
-;; vc-backend-dispatch macro and fill it in in each call. The variable
-;; vc-master-templates in vc-hooks.el will also have to change.
-
-(defmacro vc-backend-dispatch (f s r c)
- "Execute FORM1, FORM2 or FORM3 depending whether we're using SCCS, RCS or CVS.
-If FORM3 is RCS, use FORM2 even if we are using CVS. (CVS shares some code
-with RCS)."
- (list 'let (list (list 'type (list 'vc-backend-deduce f)))
- (list 'cond
- (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS
- (list (list 'eq 'type (quote 'RCS)) r) ;; RCS
- (list (list 'eq 'type (quote 'CVS)) ;; CVS
- (if (eq c 'RCS) r c))
- )))
-
-(defun vc-lock-file (file)
- ;; Generate lock file name corresponding to FILE
- (let ((master (vc-name file)))
- (and
- master
- (string-match "\\(.*/\\)s\\.\\(.*\\)" master)
- (concat
- (substring master (match-beginning 1) (match-end 1))
- "p."
- (substring master (match-beginning 2) (match-end 2))))))
-
-
-(defun vc-fetch-properties (file)
- ;; Re-fetch all properties associated with the given file.
- ;; Currently these properties are:
- ;; vc-locking-user
- ;; vc-locked-version
- ;; vc-latest-version
- ;; vc-your-latest-version
- (vc-backend-dispatch
- file
- ;; SCCS
- (progn
- (vc-master-info (vc-lock-file file)
- (list
- "^[^ ]+ [^ ]+ \\([^ ]+\\)"
- "^\\([^ ]+\\)")
- file
- '(vc-locking-user vc-locked-version))
- (vc-master-info (vc-name file)
- (list
- "^\001d D \\([^ ]+\\)"
- (concat "^\001d D \\([^ ]+\\) .* "
- (regexp-quote (user-login-name)) " ")
- )
- file
- '(vc-latest-version vc-your-latest-version))
- )
- ;; RCS
- (vc-log-info "rlog" file 'MASTER nil
- (list
- "^locks: strict\n\t\\([^:]+\\)"
- "^locks: strict\n\t[^:]+: \\(.+\\)"
- "^revision[\t ]+\\([0-9.]+\\).*\ndate: \\([ /0-9:]+\\);"
- (concat
- "^revision[\t ]+\\([0-9.]+\\)\n.*author: "
- (regexp-quote (user-login-name))
- ";"))
- '(vc-locking-user vc-locked-version
- vc-latest-version vc-your-latest-version))
- ;; CVS
- ;; Don't fetch vc-locking-user and vc-locked-version here, since they
- ;; 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 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
- ;; implemented it is impossible to use additional groups.
- '("R[eC][pS][ositry]* [VRr]e[rv][si][is]i?on:[\t ]+\\([0-9.]+\\)")
- '(vc-latest-version))
- ))
-
-(defun vc-backend-subdirectory-name (&optional file)
- ;; Where the master and lock files for the current directory are kept
- (symbol-name
- (or
- (and file (vc-backend-deduce file))
- vc-default-back-end
- (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))))
(defun vc-backend-admin (file &optional rev comment)
;; Register a file into the version-control system
(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)))
(and failed (file-exists-p filename) (delete-file filename))))
(apply 'vc-do-command 0 "get" file 'MASTER;; SCCS
(if writable "-e")
- (and rev (concat "-r" (vc-lookup-triple file rev))))
- vc-checkout-switches)
+ (and rev (concat "-r" (vc-lookup-triple file rev)))
+ vc-checkout-switches)
+ (vc-file-setprop file 'vc-workfile-version nil))
(if workfile;; RCS
;; RCS doesn't let us check out into arbitrary file names directly.
;; Use `co -p' and make stdout point to the correct file.
vc-checkout-switches)
(setq failed nil))
(and failed (file-exists-p filename) (delete-file filename))))
- (apply 'vc-do-command 0 "co" file 'MASTER
- (if writable "-l")
- (and rev (concat "-r" rev)))
- vc-checkout-switches)
+ (progn
+ (apply 'vc-do-command
+ 0 "co" file 'MASTER
+ (if writable "-l")
+ (if rev (concat "-r" rev)
+ ;; if no explicit revision was specified,
+ ;; check out that of the working file
+ (let ((workrev (vc-workfile-version file)))
+ (if workrev (concat "-r" workrev)
+ nil)))
+ vc-checkout-switches)
+ (save-excursion
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t)
+ (vc-file-setprop file 'vc-workfile-version
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ (vc-file-setprop file 'vc-workfile-version nil)))))
(if workfile;; CVS
;; CVS is much like RCS
(let ((failed t))
(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
+ "update"
(and rev (concat "-r" rev))
- file
- vc-checkout-switches))
+ vc-checkout-switches)
+ (vc-file-setprop file 'vc-workfile-version nil))
))
- (or workfile
- (vc-file-setprop file
- 'vc-checkout-time (nth 5 (file-attributes file))))
+ (cond
+ ((not workfile)
+ (vc-file-clear-masterprops file)
+ (if writable
+ (vc-file-setprop file 'vc-locking-user (user-login-name)))
+ (vc-file-setprop file
+ 'vc-checkout-time (nth 5 (file-attributes file)))))
(message "Checking out %s...done" filename))
)
;; Automatically retrieves a read-only version of the file with
;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
;; it deletes the workfile.
+ ;; Adaption for RCS branch support: if this is an explicit checkin,
+ ;; or if the checkin creates a new branch, set the master file branch
+ ;; accordingly.
(message "Checking in %s..." file)
+ ;; "This log message intentionally left almost blank".
+ (and (or (not comment) (string= comment ""))
+ (setq comment "*** empty log message ***"))
(save-excursion
;; Change buffers to get local value of vc-checkin-switches.
(set-buffer (or (get-file-buffer file) (current-buffer)))
(vc-backend-dispatch file
+ ;; SCCS
(progn
(apply 'vc-do-command 0 "delta" file 'MASTER
(if rev (concat "-r" rev))
(concat "-y" comment)
vc-checkin-switches)
+ (vc-file-setprop file 'vc-locking-user 'none)
+ (vc-file-setprop file 'vc-workfile-version nil)
(if vc-keep-workfiles
(vc-do-command 0 "get" file 'MASTER))
)
- (apply 'vc-do-command 0 "ci" file 'MASTER
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (concat "-m" comment)
- vc-checkin-switches)
+ ;; RCS
+ (let ((old-version (vc-workfile-version file)) new-version)
+ (apply 'vc-do-command 0 "ci" file 'MASTER
+ (concat (if vc-keep-workfiles "-u" "-r") rev)
+ (concat "-m" comment)
+ vc-checkin-switches)
+ (vc-file-setprop file 'vc-locking-user 'none)
+ (vc-file-setprop file 'vc-workfile-version nil)
+
+ ;; determine the new workfile version
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (if (or (re-search-forward
+ "new revision: \\([0-9.]+\\);" nil t)
+ (re-search-forward
+ "reverting to previous revision \\([0-9.]+\\)" nil t))
+ (progn (setq new-version (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ (vc-file-setprop file 'vc-workfile-version new-version)))
+
+ ;; if we got to a different branch, adjust the default
+ ;; branch accordingly, and remove any remaining
+ ;; lock on the old version.
+ (cond
+ ((and old-version new-version
+ (not (string= (vc-branch-part old-version)
+ (vc-branch-part new-version))))
+ (vc-do-command 0 "rcs" file 'MASTER
+ (if (vc-trunk-p new-version) "-b"
+ (concat "-b" (vc-branch-part new-version))))
+ ;; exit status of 1 is also accepted.
+ ;; It means that the lock was removed before.
+ (vc-do-command 1 "rcs" file 'MASTER
+ (concat "-u" old-version)))))
+ ;; CVS
(progn
- (apply 'vc-do-command 0 "cvs" file 'BASE
- "ci" "-m" comment
+ ;; explicit check-in to the trunk requires a
+ ;; double check-in (first unexplicit) (CVS-1.3)
+ (if (and rev (vc-trunk-p rev))
+ (apply 'vc-do-command 0 "cvs" file 'WORKFILE
+ "ci" "-m" "intermediate"
+ vc-checkin-switches))
+ (apply 'vc-do-command 0 "cvs" file 'WORKFILE
+ "ci" (if rev (concat "-r" rev))
+ (concat "-m" comment)
vc-checkin-switches)
+ ;; determine and store the new workfile version
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)
+ (vc-file-setprop file 'vc-workfile-version
+ (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ (vc-file-setprop file 'vc-workfile-version nil))
+ ;; if this was an explicit check-in, remove the sticky tag
+ (if rev
+ (vc-do-command 0 "cvs" file 'WORKFILE "update" "-A"))
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file))))
- ))
- (vc-file-setprop file 'vc-locking-user nil)
- (message "Checking in %s...done" file)
- )
+ (nth 5 (file-attributes file))))))
+ (vc-file-clear-masterprops file)
+ (message "Checking in %s...done" file))
(defun vc-backend-revert (file)
;; Revert file to latest checked-in version.
+ ;; (for RCS, to workfile version)
(message "Reverting %s..." file)
(vc-backend-dispatch
file
- (progn ;; SCCS
+ ;; SCCS
+ (progn
(vc-do-command 0 "unget" file 'MASTER nil)
(vc-do-command 0 "get" file 'MASTER nil))
- (vc-do-command 0 "co" file 'MASTER ;; RCS. This deletes the work file.
- "-f" "-u")
- (progn ;; CVS
+ ;; RCS
+ (vc-do-command 0 "co" file 'MASTER
+ "-f" (concat "-u" (vc-workfile-version file)))
+ ;; CVS
+ (progn
(delete-file file)
- (vc-do-command 0 "cvs" file 'BASE "update"))
- )
- (vc-file-setprop file 'vc-locking-user nil)
+ (vc-do-command 0 "cvs" file 'WORKFILE "update")))
+ (vc-file-setprop file 'vc-locking-user 'none)
+ (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
(message "Reverting %s...done" file)
)
(vc-backend-dispatch file
(vc-do-command 0 "rmdel" file 'MASTER (concat "-r" target))
(vc-do-command 0 "rcs" file 'MASTER (concat "-o" target))
- (error "Unchecking files under CVS is dangerous and not supported in VC.")
+ nil ;; this is never reached under CVS
)
(message "Removing last change from %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
)
)
(defun vc-backend-diff (file &optional oldvers newvers cmp)
;; Get a difference report between two versions of FILE.
;; Get only a brief comparison report if CMP, a difference report otherwise.
- (let ((backend (vc-backend-deduce file)))
+ (let ((backend (vc-backend file)))
(cond
((eq backend 'SCCS)
(setq oldvers (vc-lookup-triple file oldvers))
- (setq newvers (vc-lookup-triple file newvers))))
- (cond
+ (setq newvers (vc-lookup-triple file newvers)))
+ ((eq backend 'RCS)
+ (if (not oldvers) (setq oldvers (vc-workfile-version file)))))
;; SCCS and RCS shares a lot of code.
+ (cond
((or (eq backend 'SCCS) (eq backend 'RCS))
(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.
;; cmp is not yet implemented -- we always do a full diff.
((eq backend 'CVS)
- (if (string= (vc-file-getprop file 'vc-your-latest-version) "0") ;CVS
+ (if (string= (vc-workfile-version file) "0") ;CVS
;; This file is added but not yet committed; there is no master file.
;; diff it against /dev/null.
(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 ()
(defun vc-file-tree-walk (func &rest args)
"Walk recursively through default directory.
Invoke FUNC f ARGS on each non-directory file f underneath it."
- (vc-file-tree-walk-internal default-directory func args)
+ (vc-file-tree-walk-internal (expand-file-name default-directory) func args)
(message "Traversing directory %s...done" default-directory))
(defun vc-file-tree-walk-internal (file func args)
(if (not (file-directory-p file))
(apply func file args)
- (message "Traversing directory %s..." file)
+ (message "Traversing directory %s..." (abbreviate-file-name file))
(let ((dir (file-name-as-directory file)))
(mapcar
(function
(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
;;;
;;; These may be useful to anyone who has to debug or extend the package.
+;;; (Note that this information corresponds to versions 5.x. Some of it
+;;; might have been invalidated by the additions to support branching
+;;; and RCS keyword lookup. AS, 1995/03/24)
;;;
;;; A fundamental problem in VC is that there are time windows between
;;; vc-next-action's computations of the file's version-control state and
HCoop / bpt / emacs.git / blobdiff