;; Modified by:
;; ttn@netcom.com
;; Per Cederqvist <ceder@lysator.liu.edu>
-;; Andre Spiegel <spiegel@bruessel.informatik.uni-stuttgart.de>
+;; Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
;; This file is part of GNU Emacs.
(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-suppress-confirm 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")
+(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
;; log buffer with a nonzero local value of vc-comment-ring-index.
(setq vc-comment-ring nil))
-;;; functions that operate on RCS revision numbers
+(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))))
-;; vc-occurences and vc-branch-p moved to vc-hooks.el
+;;; 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-minor-revision (rev)
- ;; return the minor revision number of REV,
- ;; i.e. the number after the last dot.
- (substring rev (1+ (string-match "\\.[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)))
;; 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))
status)
)
-;; 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 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))
- )))
-
;;; Save a bit of the text around POSN in the current buffer, to help
;;; us find the corresponding position again later. This works even
;;; if all markers are destroyed or corrupted.
(if buffer-error-marked-p buffer))))
(buffer-list)))))))
- (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)))
+ (revert-buffer arg no-confirm)
;; Reparse affected compilation buffers.
(while reparse
(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
in all these directories. With a prefix argument, it lists all files."
(interactive "P")
(let (nonempty
- (dl (length default-directory))
+ (dl (length (expand-file-name default-directory)))
(filelist nil) (userlist nil)
dired-buf
dired-buf-mod-count)
(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
(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)
(apply 'vc-do-command 0 "get" file 'MASTER;; SCCS
(if writable "-e")
(and rev (concat "-r" (vc-lookup-triple file rev)))
- vc-checkout-switches))
+ 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.
(apply 'vc-do-command 0 "cvs" file 'WORKFILE
"update"
(and rev (concat "-r" rev))
- 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))
)
;; 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)))
(if rev (concat "-r" rev))
(concat "-y" comment)
vc-checkin-switches)
- (vc-file-setprop file 'vc-locking-user nil)
+ (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))
)
;; RCS
- (let ((lock-version nil))
- ;; if this is an explicit check-in to a different branch,
- ;; remember the workfile version (in order to remove the lock later)
- (if (and rev
- (not (vc-trunk-p rev))
- (not (string= (vc-branch-part rev)
- (vc-branch-part (vc-workfile-version file)))))
- (setq lock-version (vc-workfile-version file)))
-
- (apply 'vc-do-command 0 "ci" file 'MASTER
+ (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 nil)
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-workfile-version nil)
- ;; determine the new workfile version and
- ;; adjust the master file branch accordingly
- ;; (this currently has to be done on every check-in)
- (progn
- (set-buffer "*vc*")
- (goto-char (point-min))
- (if (re-search-forward "new revision: \\([0-9.]+\\);" nil t)
- (progn (setq rev (buffer-substring (match-beginning 1)
- (match-end 1)))
- (vc-file-setprop file 'vc-workfile-version rev)))
- (if (vc-trunk-p rev)
- (vc-do-command 0 "rcs" file 'MASTER "-b")
- (vc-do-command 0 "rcs" file 'MASTER
- (concat "-b" (vc-branch-part rev))))
- (if lock-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" lock-version)))))
+ ;; 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
;; explicit check-in to the trunk requires a
vc-checkin-switches))
(apply 'vc-do-command 0 "cvs" file 'WORKFILE
"ci" (if rev (concat "-r" rev))
- (if (and comment (not (string= comment "")))
- (concat "-m" comment)
- "-m-")
+ (concat "-m" comment)
vc-checkin-switches)
;; determine and store the new workfile version
(set-buffer "*vc*")
;; 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 nil)
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file))))))
- (message "Checking in %s...done" file)
- )
+ (vc-file-clear-masterprops file)
+ (message "Checking in %s...done" file))
(defun vc-backend-revert (file)
;; Revert file to latest checked-in version.
(progn
(delete-file file)
(vc-do-command 0 "cvs" file 'WORKFILE "update")))
- (vc-file-setprop file 'vc-locking-user nil)
+ (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)
)
(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
HCoop / bpt / emacs.git / blobdiff