;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
-;; $Id: vc.el,v 1.219 1998/04/05 18:54:35 spiegel Exp spiegel $
+;; $Id: vc.el,v 1.259 2000/01/26 10:31:13 gerd Exp $
;; This file is part of GNU Emacs.
:type 'boolean
:group 'vc)
+(defcustom vc-delete-logbuf-window t
+ "*If non-nil, delete the *VC-log* buffer and window after each logical action.
+If nil, bury that buffer instead.
+This is most useful if you have multiple windows on a frame and would like to
+preserve the setting."
+ :type 'boolean
+ :group 'vc)
+
(defcustom vc-initial-comment nil
"*If non-nil, prompt for initial comment when a file is registered."
:type 'boolean
"*A string used as the default version number when a new file is registered.
This can be overriden by giving a prefix argument to \\[vc-register]."
:type 'string
- :group 'vc)
+ :group 'vc
+ :version "20.3")
(defcustom vc-command-messages nil
"*If non-nil, display run messages from back-end commands."
string))
:group 'vc)
+(defcustom vc-dired-recurse t
+ "*If non-nil, show directory trees recursively in VC Dired."
+ :type 'boolean
+ :group 'vc
+ :version "20.3")
+
+(defcustom vc-dired-terse-display t
+ "*If non-nil, show only locked files in VC Dired."
+ :type 'boolean
+ :group 'vc
+ :version "20.3")
+
(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
"*List of directory names to be ignored while recursively walking file trees."
:type '(repeat string)
"*The release number of your RCS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
- string)
+ string
+ (const :tag "Unknown" unknown))
:group 'vc)
(defcustom vc-sccs-release nil
"*The release number of your SCCS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
- string)
+ string
+ (const :tag "Unknown" unknown))
:group 'vc)
(defcustom vc-cvs-release nil
"*The release number of your CVS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
- string)
+ string
+ (const :tag "Unknown" unknown))
:group 'vc)
;; Variables the user doesn't need to know about.
;; CVS
t))
+;;; Two macros for elisp programming
+;;;###autoload
+(defmacro with-vc-file (file comment &rest body)
+ "Execute BODY, checking out a writable copy of FILE first if necessary.
+After BODY has been executed, check-in FILE with COMMENT (a string).
+FILE is passed through `expand-file-name'; BODY executed within
+`save-excursion'. If FILE is not under version control, or locked by
+somebody else, signal error."
+ `(let ((file (expand-file-name ,file)))
+ (or (vc-registered file)
+ (error (format "File not under version control: `%s'" file)))
+ (let ((locking-user (vc-locking-user file)))
+ (cond ((and (not locking-user)
+ (eq (vc-checkout-model file) 'manual))
+ (vc-checkout file t))
+ ((and (stringp locking-user)
+ (not (string= locking-user (vc-user-login-name))))
+ (error (format "`%s' is locking `%s'" locking-user file)))))
+ (save-excursion
+ ,@body)
+ (vc-checkin file nil ,comment)))
+
+;;;###autoload
+(defmacro edit-vc-file (file comment &rest body)
+ "Edit FILE under version control, executing BODY. Checkin with COMMENT.
+This macro uses `with-vc-file', passing args to it.
+However, before executing BODY, find FILE, and after BODY, save buffer."
+ `(with-vc-file
+ ,file ,comment
+ (find-file ,file)
+ ,@body
+ (save-buffer)))
+
(defun vc-ensure-vc-buffer ()
;; Make sure that the current buffer visits a version-controlled file.
(if vc-dired-mode
(error "File %s is not under version control" (buffer-file-name))))))
(defvar vc-binary-assoc nil)
-
+(defvar vc-binary-suffixes
+ (if (memq system-type '(ms-dos windows-nt))
+ '(".exe" ".com" ".bat" ".cmd" ".btm" "")
+ '("")))
(defun vc-find-binary (name)
"Look for a command anywhere on the subprocess-command search path."
(or (cdr (assoc name vc-binary-assoc))
(function
(lambda (s)
(if s
- (let ((full (concat s "/" name)))
- (if (file-executable-p full)
- (progn
- (setq vc-binary-assoc
- (cons (cons name full) vc-binary-assoc))
- (throw 'found full)))))))
+ (let ((full (concat s "/" name))
+ (suffixes vc-binary-suffixes)
+ candidate)
+ (while suffixes
+ (setq candidate (concat full (car suffixes)))
+ (if (and (file-executable-p candidate)
+ (not (file-directory-p candidate)))
+ (progn
+ (setq vc-binary-assoc
+ (cons (cons name candidate) vc-binary-assoc))
+ (throw 'found candidate))
+ (setq suffixes (cdr suffixes))))))))
exec-path)
nil)))
(let ((new-mark (vc-find-position-by-context mark-context)))
(if new-mark (set-mark new-mark))))))
+;; Maybe this "smart mark preservation" could be added directly
+;; to revert-buffer since it can be generally useful. -sm
(defun vc-revert-buffer1 (&optional arg no-confirm)
;; Revert buffer, try to keep point and mark where user expects them in spite
;; of changes because of expanded version-control key words.
(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 file))
+ (let ((vc-type (vc-backend file))
owner version buffer)
(cond
- ;; if there is no master file corresponding, create one
- ((not vc-file)
- (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 the file is not under version control, register it
+ ((not vc-type)
+ (vc-register verbose comment))
;; CVS: changes to the master file need to be
;; merged back into the working file
(vc-checkin file version comment)
)))))
+(defvar vc-dired-window-configuration)
+
(defun vc-next-action-dired (file rev comment)
;; Do a vc-next-action-on-file on all the marked files, possibly
;; passing on the log comment we've just entered.
(let ((dired-buffer (current-buffer))
(dired-dir default-directory))
(dired-map-over-marks
- (let ((file (dired-get-filename)) p
- (default-directory default-directory))
+ (let ((file (dired-get-filename)))
(message "Processing %s..." file)
;; Adjust the default directory so that checkouts
;; go to the right place.
- (setq default-directory (file-name-directory file))
- (vc-next-action-on-file file nil comment)
- (set-buffer dired-buffer)
- (setq default-directory dired-dir)
- (dired-do-redisplay file)
+ (let ((default-directory (file-name-directory file)))
+ (vc-next-action-on-file file nil comment)
+ (set-buffer dired-buffer))
+ ;; Make sure that files don't vanish
+ ;; after they are checked in.
+ (let ((vc-dired-terse-mode nil))
+ (dired-do-redisplay file))
(set-window-configuration vc-dired-window-configuration)
(message "Processing %s...done" file))
nil t))
For RCS and SCCS files:
If the file is not already registered, this registers it for version
-control and then retrieves a writable, locked copy for editing.
+control.
If the file is registered and not locked by anyone, this checks out
a writable and locked file ready for editing.
If the file is checked out and locked by the calling user, this
(or (eobp) (looking-at "\n\n")
(insert "\n"))))
-
(defun vc-finish-logentry (&optional nocomment)
"Complete the operation implied by the current log entry."
(interactive)
(log-file vc-log-file)
(log-version vc-log-version)
(log-entry (buffer-string))
- (after-hook vc-log-after-operation-hook))
+ (after-hook vc-log-after-operation-hook)
+ (tmp-vc-parent-buffer vc-parent-buffer))
(pop-to-buffer vc-parent-buffer)
;; OK, do it to it
(save-excursion
;; Remove checkin window (after the checkin so that if that fails
;; we don't zap the *VC-log* buffer and the typing therein).
(let ((logbuf (get-buffer "*VC-log*")))
- (cond (logbuf
- (delete-windows-on logbuf)
- (kill-buffer logbuf))))
+ (cond ((and logbuf vc-delete-logbuf-window)
+ (delete-windows-on logbuf (selected-frame))
+ ;; Kill buffer and delete any other dedicated windows/frames.
+ (kill-buffer logbuf))
+ (t (pop-to-buffer "*VC-log*")
+ (bury-buffer)
+ (pop-to-buffer tmp-vc-parent-buffer))))
;; Now make sure we see the expanded headers
(if buffer-file-name
(vc-resynch-window buffer-file-name vc-keep-workfiles t))
If FILE is a directory, generate diffs between versions for all registered
files in or below it."
(interactive
- (let ((file (read-file-name (if buffer-file-name
- "File or dir to diff: (default visited file) "
- "File or dir to diff: ")
- default-directory buffer-file-name t))
+ (let ((file (expand-file-name
+ (read-file-name (if buffer-file-name
+ "File or dir to diff: (default visited file) "
+ "File or dir to diff: ")
+ default-directory buffer-file-name t)))
(rel1-default nil) (rel2-default nil))
;; compute default versions based on the file state
(cond
;;;###autoload
(defun vc-insert-headers ()
"Insert headers in a file for use with your version-control system.
-Headers desired are inserted at the start of the buffer, and are pulled from
+Headers desired are inserted at point, and are pulled from
the variable `vc-header-alist'."
(interactive)
(vc-ensure-vc-buffer)
(message "File contains conflict markers"))
(message "Merge successful"))))))
+(defvar vc-ediff-windows)
+(defvar vc-ediff-result)
+
;;;###autoload
(defun vc-resolve-conflicts (&optional name-A name-B)
"Invoke ediff to resolve conflicts in the current buffer.
;; The VC directory major mode. Coopt Dired for this.
;; All VC commands get mapped into logical equivalents.
+(defvar vc-dired-switches)
+(defvar vc-dired-terse-mode)
+
(define-derived-mode vc-dired-mode dired-mode "Dired under VC"
"The major mode used in VC directory buffers. It works like Dired,
but lists only files under version control, with the current VC state of
There is a special command, `*l', to mark all files currently locked."
(make-local-hook 'dired-after-readin-hook)
(add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
+ ;; The following is slightly modified from dired.el,
+ ;; because file lines look a bit different in vc-dired-mode.
+ (set (make-local-variable 'dired-move-to-filename-regexp)
+ (let*
+ ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+ ;; In some locales, month abbreviations are as short as 2 letters,
+ ;; and they can be padded on the right with spaces.
+ (month (concat l l "+ *"))
+ ;; Recognize any non-ASCII character.
+ ;; The purpose is to match a Kanji character.
+ (k "[^\0-\177]")
+ ;; (k "[^\x00-\x7f\x80-\xff]")
+ (s " ")
+ (yyyy "[0-9][0-9][0-9][0-9]")
+ (mm "[ 0-1][0-9]")
+ (dd "[ 0-3][0-9]")
+ (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+ (western (concat "\\(" month s dd "\\|" dd s month "\\)"
+ s "\\(" HH:MM "\\|" s yyyy"\\|" yyyy s "\\)"))
+ (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
+ (concat s "\\(" western "\\|" japanese "\\)" s)))
+ (and (boundp 'vc-dired-switches)
+ vc-dired-switches
+ (set (make-local-variable 'dired-actual-switches)
+ vc-dired-switches))
+ (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
(setq vc-dired-mode t))
(define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
(define-key vc-dired-mode-map "v" vc-prefix-map)
-(define-key vc-dired-mode-map "=" 'vc-diff)
+
+(defun vc-dired-toggle-terse-mode ()
+ "Toggle terse display in VC Dired."
+ (interactive)
+ (if (not vc-dired-mode)
+ nil
+ (setq vc-dired-terse-mode (not vc-dired-terse-mode))
+ (if vc-dired-terse-mode
+ (vc-dired-hook)
+ (revert-buffer))))
+
+(define-key vc-dired-mode-map "vt" 'vc-dired-toggle-terse-mode)
(defun vc-dired-mark-locked ()
"Mark all files currently locked."
(defun vc-fetch-cvs-status (dir)
(let ((default-directory dir))
- (vc-do-command "*vc-info*" 0 "cvs" nil nil "status" dir)
+ ;; Don't specify DIR in this command, the default-directory is
+ ;; enough. Otherwise it might fail with remote repositories.
+ (vc-do-command "*vc-info*" 0 "cvs" nil nil "status" "-l")
(save-excursion
(set-buffer (get-buffer "*vc-info*"))
(goto-char (point-min))
(if state (concat "(" state ")"))))
(defun vc-dired-reformat-line (x)
- ;; Reformat a directory-listing line, plugging in version control info in
- ;; place of the user and group info.
+ ;; Reformat a directory-listing line, replacing various columns with
+ ;; version control information.
;; This code, like dired, assumes UNIX -l format.
(beginning-of-line)
- (let ((pos (point)) limit perm owner date-and-file)
+ (let ((pos (point)) limit perm date-and-file)
(end-of-line)
(setq limit (point))
(goto-char pos)
- (cond
- ((or
- (re-search-forward ;; owner and group
-"^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
- limit t)
- (re-search-forward ;; only owner displayed
-"^\\(..[drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
- limit t))
+ (when
+ (or
+ (re-search-forward ;; owner and group
+ "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[^ ]+ +[0-9]+\\( .*\\)"
+ limit t)
+ (re-search-forward ;; only owner displayed
+ "^\\(..[drwxlts-]+ \\) *[0-9]+ [^ ]+ +[0-9]+\\( .*\\)"
+ limit t)
+ (re-search-forward ;; OS/2 -l format, no links, owner, group
+ "^\\(..[drwxlts-]+ \\) *[0-9]+\\( .*\\)"
+ limit t))
(setq perm (match-string 1)
- owner (match-string 2)
- date-and-file (match-string 3)))
- ((re-search-forward ;; OS/2 -l format, no links, owner, group
-"^\\(..[drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
- limit t)
- (setq perm (match-string 1)
- date-and-file (match-string 2))))
- (setq x (substring (concat x " ") 0 10))
- (replace-match (concat perm x date-and-file))))
+ date-and-file (match-string 2))
+ (setq x (substring (concat x " ") 0 10))
+ (replace-match (concat perm x date-and-file)))))
(defun vc-dired-hook ()
;; Called by dired after any portion of a vc-dired buffer has been read in.
;; Reformat the listing according to version control.
(message "Getting version information... ")
- (let (subdir filename (buffer-read-only nil))
+ (let (subdir filename (buffer-read-only nil) cvs-dir)
(goto-char (point-min))
(while (not (eq (point) (point-max)))
(cond
;; subdir header line
((setq subdir (dired-get-subdir))
(if (file-directory-p (concat subdir "/CVS"))
- (vc-fetch-cvs-status (file-name-as-directory subdir)))
+ (progn
+ (vc-fetch-cvs-status (file-name-as-directory subdir))
+ (setq cvs-dir t))
+ (setq cvs-dir nil))
(forward-line 1)
;; erase (but don't remove) the "total" line
(let ((start (point)))
(delete-region start (point))
(beginning-of-line)
(forward-line 1)))
- ;; an ordinary file line
+ ;; directory entry
((setq filename (dired-get-filename nil t))
(cond
+ ;; subdir
((file-directory-p filename)
- (if (member (file-name-nondirectory filename)
- vc-directory-exclusion-list)
- (dired-kill-line)
+ (cond
+ ((member (file-name-nondirectory filename)
+ vc-directory-exclusion-list)
+ (let ((pos (point)))
+ (dired-kill-tree filename)
+ (goto-char pos)
+ (dired-kill-line)))
+ (vc-dired-terse-mode
+ ;; Don't show directories in terse mode. Don't use
+ ;; dired-kill-line to remove it, because in recursive listings,
+ ;; that would remove the directory contents as well.
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
+ (dired-kill-line))
+ (t
(vc-dired-reformat-line nil)
- (forward-line 1)))
- ((vc-backend filename)
+ (forward-line 1))))
+ ;; ordinary file
+ ((if cvs-dir
+ (and (eq (vc-file-getprop filename 'vc-backend) 'CVS)
+ (or (not vc-dired-terse-mode)
+ (not (eq (vc-cvs-status filename) 'up-to-date))))
+ (and (vc-backend filename)
+ (or (not vc-dired-terse-mode)
+ (vc-locking-user filename))))
(vc-dired-reformat-line (vc-dired-state-info filename))
(forward-line 1))
(t
(dired-kill-line))))
;; any other line
- (t (forward-line 1)))))
- (message "Getting version information... done"))
+ (t (forward-line 1))))
+ (vc-dired-purge))
+ (message "Getting version information... done")
+ (save-restriction
+ (widen)
+ (cond ((eq (count-lines (point-min) (point-max)) 1)
+ (goto-char (point-min))
+ (message "No files locked under %s" default-directory)))))
+
+(defun vc-dired-purge ()
+ ;; Remove empty subdirs
+ (let (subdir)
+ (goto-char (point-min))
+ (while (setq subdir (dired-get-subdir))
+ (forward-line 2)
+ (if (dired-get-filename nil t)
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max)))
+ (forward-line -2)
+ (if (not (string= (dired-current-directory) default-directory))
+ (dired-do-kill-lines t "")
+ ;; We cannot remove the top level directory.
+ ;; Just make it look a little nicer.
+ (forward-line 1)
+ (kill-line)
+ (if (not (dired-next-subdir 1 t))
+ (goto-char (point-max))))))
+ (goto-char (point-min))))
;;;###autoload
(defun vc-directory (dirname read-switches)
(interactive "DDired under VC (directory): \nP")
- (let ((switches
- (if read-switches (read-string "Dired listing switches: "
- dired-listing-switches))))
+ (let ((vc-dired-switches (concat dired-listing-switches
+ (if vc-dired-recurse "R" ""))))
+ (if read-switches
+ (setq vc-dired-switches
+ (read-string "Dired listing switches: "
+ vc-dired-switches)))
(require 'dired)
(require 'dired-aux)
;; force a trailing slash
(setq dirname (concat dirname "/")))
(switch-to-buffer
(dired-internal-noselect (expand-file-name dirname)
- (or switches dired-listing-switches)
+ (or vc-dired-switches dired-listing-switches)
'vc-dired-mode))))
;; Named-configuration support for SCCS
(let ((odefault default-directory)
(changelog (find-change-log))
;; Presumably not portable to non-Unixy systems, along with rcs2log:
- (tempfile (make-temp-name
- (concat (file-name-as-directory
- (directory-file-name (or (getenv "TMPDIR")
- (getenv "TMP")
- (getenv "TEMP")
- "/tmp")))
- "vc")))
+ (tempfile (make-temp-file
+ (expand-file-name "vc"
+ (or small-temporary-file-directory
+ temporary-file-directory))))
(full-name (or add-log-full-name
(user-full-name)
(user-login-name)
(unwind-protect
(progn
(cd odefault)
- (if (eq 0 (apply 'call-process "rcs2log" nil
- (list t tempfile) nil
- "-c" changelog
- "-u" (concat (vc-user-login-name)
- "\t" full-name
- "\t" mailing-address)
- (mapcar
- (function
- (lambda (f)
- (file-relative-name
- (if (file-name-absolute-p f)
- f
- (concat odefault f)))))
- args)))
- "done"
+ (if (eq 0 (apply 'call-process
+ (expand-file-name "rcs2log" exec-directory)
+ nil
+ (list t tempfile) nil
+ "-c" changelog
+ "-u" (concat (vc-user-login-name)
+ "\t" full-name
+ "\t" mailing-address)
+ (mapcar
+ (function
+ (lambda (f)
+ (file-relative-name
+ (if (file-name-absolute-p f)
+ f
+ (concat odefault f)))))
+ args)))
+ "done"
(pop-to-buffer
(set-buffer (get-buffer-create "*vc*")))
(erase-buffer)
(delete-file tempfile)))))
\f
;; vc-annotate functionality (CVS only).
-(defvar vc-annotate-mode nil
- "Variable indicating if VC-Annotate mode is active.")
-
(defvar vc-annotate-mode-map nil
"Local keymap used for VC-Annotate mode.")
("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))))
(set-buffer buffer)
(display-buffer buffer)
- (if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done
+ (or (eq major-mode 'vc-annotate-mode) ; Turn on vc-annotate-mode if not done
(vc-annotate-mode))
+ ;; Delete old overlays
+ (mapcar
+ (lambda (overlay)
+ (if (overlay-get overlay 'vc-annotation)
+ (delete-overlay overlay)))
+ (overlays-in (point-min) (point-max)))
(goto-char (point-min)) ; Position at the top of the buffer.
(while (re-search-forward
"^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): "
(day (string-to-number (match-string 1)))
(month (cdr (assoc (match-string 2) local-month-numbers)))
(year-tmp (string-to-number (match-string 3)))
- (year (+ (if (> 100 year-tmp) 1900 0) year-tmp)) ; Possible millenium problem
+ ;; Years 0..68 are 2000..2068.
+ ;; Years 69..99 are 1969..1999.
+ (year (+ (cond ((> 69 year-tmp) 2000)
+ ((> 100 year-tmp) 1900)
+ (t 0))
+ year-tmp))
(high (- (car (current-time))
(car (encode-time 0 0 0 day month year))))
(color (cond ((vc-annotate-compcar high (cond (color-map)
(if vc-annotate-background
(set-face-background tmp-face vc-annotate-background))
tmp-face)))) ; Return the face
- (point (point)))
+ (point (point))
+ overlay)
(forward-line 1)
- (overlay-put (make-overlay point (point) nil) 'face face)))))
+ (setq overlay (make-overlay point (point)))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'vc-annotation t)))))
\f
;; Collect back-end-dependent stuff here
(failed t))
(unwind-protect
(progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; Some shells make the "" dummy argument into $0
- ;; while others use the shell's name as $0 and
- ;; use the "" as $1. The if-statement
- ;; converts the latter case to the former.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
- umask %o; exec >\"$1\" || exit; \
- shift; umask %o; exec get \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-e")
- "-p"
- (and rev
- (concat "-r" (vc-lookup-triple file rev)))
- switches)
- (setq failed nil))
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (apply 'vc-do-command
+ (current-buffer) 0 "get" file 'MASTER
+ "-s" ;; suppress diagnostic output
+ (if writable "-e")
+ "-p"
+ (and rev
+ (concat "-r"
+ (vc-lookup-triple file rev)))
+ switches)))
+ (set-file-modes filename
+ (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (setq failed nil))
(and failed (file-exists-p filename)
(delete-file filename))))
(apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
(failed t))
(unwind-protect
(progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'MASTER "-c"
- ;; See the SCCS case, above, regarding the
- ;; if-statement.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
- umask %o; exec >\"$1\" || exit; \
- shift; umask %o; exec co \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-l")
- (concat "-p" rev)
- switches)
- (setq failed nil))
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (apply 'vc-do-command
+ (current-buffer) 0 "co" file 'MASTER
+ "-q" ;; suppress diagnostic output
+ (if writable "-l")
+ (concat "-p" rev)
+ switches)))
+ (set-file-modes filename
+ (logior (file-modes (vc-name file))
+ (if writable 128 0)))
+ (setq failed nil))
(and failed (file-exists-p filename) (delete-file filename))))
(let (new-version)
;; if we should go to the head of the trunk,
(let ((failed t))
(unwind-protect
(progn
- (apply 'vc-do-command
- nil 0 "/bin/sh" file 'WORKFILE "-c"
- "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
- "" ; dummy argument for shell's $0
- workfile
- (concat "-r" rev)
- "-p"
- switches)
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file filename
+ (apply 'vc-do-command
+ (current-buffer) 0 "cvs" file 'WORKFILE
+ "-Q" ;; suppress diagnostic output
+ "update"
+ (concat "-r" rev)
+ "-p"
+ switches)))
(setq failed nil))
(and failed (file-exists-p filename) (delete-file filename))))
;; default for verbose checkout: clear the sticky tag
;; Checking out explicit versions is not supported under SCCS, yet.
;; We always "revert" to the latest version; therefore
;; vc-workfile-version is cleared here so that it gets recomputed.
- (vc-file-setprop 'vc-workfile-version nil))
+ (vc-file-setprop file 'vc-workfile-version nil))
;; RCS
(vc-do-command nil 0 "co" file 'MASTER
"-f" (concat "-u" (vc-workfile-version file)))
;; CVS
- ;; Check out via standard output (caused by the final argument
- ;; FILE below), so that no sticky tag is set.
- (vc-backend-checkout file nil (vc-workfile-version file) file))
+ (progn
+ ;; Check out via standard output (caused by the final argument
+ ;; FILE below), so that no sticky tag is set.
+ (vc-backend-checkout file nil (vc-workfile-version file) file)
+ ;; If "cvs edit" was used to make the file writeable,
+ ;; call "cvs unedit" now to undo that.
+ (if (eq (vc-checkout-model file) 'manual)
+ (vc-do-command nil 0 "cvs" file 'WORKFILE "unedit"))))
(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)
;; If --brief didn't work, do a double-take and remember it
;; for the future.
(if (eq status 2)
- (prog1
- (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE
- (if cmp (cdr options) options))
- (if cmp (setq vc-rcsdiff-knows-brief 'no)))
+ (setq status
+ (prog1
+ (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE
+ (if cmp (cdr options) options))
+ (if cmp (setq vc-rcsdiff-knows-brief 'no))))
;; If --brief DID work, remember that, too.
(and cmp (not vc-rcsdiff-knows-brief)
(setq vc-rcsdiff-knows-brief 'yes))
;; diff it against /dev/null.
(apply 'vc-do-command
"*vc-diff*" 1 "diff" file 'WORKFILE
- (append (if (listp diff-switches)
- diff-switches
- (list diff-switches)) '("/dev/null")))))
+ (append diff-switches-list '("/dev/null")))))
;; cmp is not yet implemented -- we always do a full diff.
(apply 'vc-do-command
"*vc-diff*" 1 "cvs" file 'WORKFILE "diff"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers))
- (if (listp diff-switches)
- diff-switches
- (list diff-switches))))))))
+ diff-switches-list))))))
(defun vc-backend-merge-news (file)
;; Merge in any new changes made to FILE.
(vc-file-setprop file 'vc-workfile-version (match-string 1)))
;; get file status
(if (re-search-forward
- (concat "^\\([CMU]\\) "
- (regexp-quote (file-name-nondirectory file)))
+ (concat "^\\(\\([CMUP]\\) \\)?"
+ (regexp-quote (file-name-nondirectory file))
+ "\\( already contains the differences between \\)?")
nil t)
(cond
;; Merge successful, we are in sync with repository now
- ((string= (match-string 1) "U")
- (vc-file-setprop file 'vc-locking-user 'none)
+ ((or (string= (match-string 2) "U")
+ (string= (match-string 2) "P")
+ ;; Special case: file contents in sync with
+ ;; repository anyhow:
+ (match-string 3))
+ (vc-file-setprop file 'vc-locking-user 'none)
(vc-file-setprop file 'vc-checkout-time
(nth 5 (file-attributes file)))
0) ;; indicate success to the caller
;; Merge successful, but our own changes are still in the file
- ((string= (match-string 1) "M")
+ ((string= (match-string 2) "M")
(vc-file-setprop file 'vc-locking-user (vc-file-owner file))
(vc-file-setprop file 'vc-checkout-time 0)
0) ;; indicate success to the caller
;; Conflicts detected!
- ((string= (match-string 1) "C")
+ ((string= (match-string 2) "C")
(vc-file-setprop file 'vc-locking-user (vc-file-owner file))
(vc-file-setprop file 'vc-checkout-time 0)
1) ;; signal the error to the caller
HCoop / bpt / emacs.git / blobdiff