comparison lisp/vc.el @ 12311:d33ef5819d81

(vc-register): Inhibit backups for the file's buffer (vc-add-triple, vc-lookup-triple, vc-record-rename): Use absolute file names to access the SCCS named configuration files ("VC-names"). (vc-retrieve-snapshot): Use vc-checkout instead of vc-backend-checkout, as the former also updates the current buffer. (vc-file-tree-walk, vc-file-tree-walk-internal): Use expand-file-name, so that FUNC gets called with an unabbreviated name.

12310:afad1c3ce9bd

  "*Display run messages from back-end commands.")
(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-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.")

	  (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 ":"))
		 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 (and (not (buffer-modified-p))
	   (zerop (buffer-size))
	   (not (file-exists-p buffer-file-name)))
      (set-buffer-modified-p t))
  (vc-buffer-sync)
  (vc-admin
   buffer-file-name
   (and override
	(read-string
	 (format "Initial version level for %s: " buffer-file-name))))

  "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)

;; 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))
    (goto-char (point-max))
    (insert name "\t:\t" file "\t" rev "\n")
    (basic-save-buffer)
    (kill-buffer (current-buffer))
    ))

(defun vc-record-rename (file newname)
  (save-excursion
    (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
    (goto-char (point-min))
    ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
    (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t)
      (replace-match (concat ":" newname) nil nil))
    (basic-save-buffer)

	   (and (>= firstchar ?0) (<= firstchar ?9)))
	 name)
	(t
	 (save-excursion
	   (set-buffer (get-buffer-create "*vc-info*"))
	   (vc-insert-file (concat 
			    (vc-backend-subdirectory-name file) 
			    "/" vc-name-assoc-file))
	   (prog1
	       (car (vc-parse-buffer
		     (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1))))
	     (kill-buffer "*vc-info*"))))
	 ))

	(error "File %s is locked" locked)
      (vc-file-tree-walk
       (function (lambda (f) (and
			      (vc-name f)
			      (vc-error-occurred
			       (vc-backend-checkout f nil name))))))
      )))

;; Miscellaneous other entry points

;;;###autoload

;;; These things should probably be generally available

(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)
  (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)
    (let ((dir (file-name-as-directory file)))
      (mapcar
       (function
	(lambda (f) (or
		     (string-equal f ".")

12311:d33ef5819d81

  "*Display run messages from back-end commands.")
(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-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.")

	  (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")
			 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 (and (not (buffer-modified-p))
	   (zerop (buffer-size))
	   (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
	(read-string
	 (format "Initial version level for %s: " buffer-file-name))))

  "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)

;; Named-configuration support for SCCS

(defun vc-add-triple (name file rev)
  (save-excursion
    (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)
    (kill-buffer (current-buffer))
    ))

(defun vc-record-rename (file newname)
  (save-excursion
    (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)
      (replace-match (concat ":" newname) nil nil))
    (basic-save-buffer)

	   (and (>= firstchar ?0) (<= firstchar ?9)))
	 name)
	(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*"))))
	 ))

	(error "File %s is locked" locked)
      (vc-file-tree-walk
       (function (lambda (f) (and
			      (vc-name f)
			      (vc-error-occurred
			       (vc-checkout f nil name))))))
      )))

;; Miscellaneous other entry points

;;;###autoload

;;; These things should probably be generally available

(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 (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..." (abbreviate-file-name file))
    (let ((dir (file-name-as-directory file)))
      (mapcar
       (function
	(lambda (f) (or
		     (string-equal f ".")