mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-20 18:17:20 +00:00
* vc.el (vc-editable-p): Minor optimization.
(edit-vc-file, vc-next-action-on-file): Don't use find-file. (vc-find-new-backend): New function split from vc-responsible-backend. (vc-register): Use it. (vc-responsible-backend): Remove REGISTER arg and add BACKENDS arg. (vc-unregister): Drop BACKEND arg (it doesn't work anyway). (vc-default-unregister, vc-revert-buffer): Docstring fix. (vc-clear-headers): Don't use find-file. (vc-revert-buffer): Use `and' again (must have been a braino). (vc-switch-backend): Only prompt if requested. (vc-default-receive-file): Update call to vc-unregister. * vc-rcs.el (vc-rcs-unregister): Keep a backup of the master file. (vc-rcs-receive-file): Avoid with-vc-properties. Update call to vc-unregister. Use constant `RCS' rather than (dynamically bound) var `backend'.
This commit is contained in:
parent
65f75351d3
commit
7849e1791b
@ -5,7 +5,7 @@
|
||||
;; Author: FSF (see vc.el for full credits)
|
||||
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
|
||||
|
||||
;; $Id: vc-rcs.el,v 1.7 2000/09/22 11:57:30 gerd Exp $
|
||||
;; $Id: vc-rcs.el,v 1.8 2000/10/01 11:17:42 spiegel Exp $
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
@ -29,7 +29,7 @@
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'vc)) ;for macros defined there
|
||||
(require 'cl))
|
||||
|
||||
(defcustom vc-rcs-release nil
|
||||
"*The release number of your RCS installation, as a string.
|
||||
@ -716,8 +716,12 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
|
||||
If this leaves the RCS subdirectory empty, ask the user
|
||||
whether to remove it."
|
||||
(let* ((master (vc-name file))
|
||||
(dir (file-name-directory master)))
|
||||
(delete-file master)
|
||||
(dir (file-name-directory master))
|
||||
(backup-info (find-backup-file-name master)))
|
||||
(if (not backup-info)
|
||||
(delete-file master)
|
||||
(rename-file master (car backup-info) 'ok-if-already-exists)
|
||||
(dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
|
||||
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
|
||||
;; check whether RCS dir is empty, i.e. it does not
|
||||
;; contain any files except "." and ".."
|
||||
@ -733,22 +737,20 @@ whether to remove it."
|
||||
(state (vc-state file))
|
||||
(checkout-model (vc-checkout-model file))
|
||||
(comment (and move (vc-call comment-history file))))
|
||||
(if move (vc-unregister file old-backend))
|
||||
(if move (vc-unregister file))
|
||||
(vc-file-clearprops file)
|
||||
(if (not (vc-rcs-registered file))
|
||||
(progn
|
||||
(with-vc-properties
|
||||
file
|
||||
;; TODO: If the file was 'edited under the old backend,
|
||||
;; this should actually register the version
|
||||
;; it was based on.
|
||||
(vc-rcs-register file rev "")
|
||||
`((vc-backend ,backend)))
|
||||
;; TODO: If the file was 'edited under the old backend,
|
||||
;; this should actually register the version
|
||||
;; it was based on.
|
||||
(vc-rcs-register file rev "")
|
||||
(vc-file-setprop file 'vc-backend 'RCS)
|
||||
(if (eq checkout-model 'implicit)
|
||||
(vc-rcs-set-non-strict-locking file))
|
||||
(if (not move)
|
||||
(vc-do-command nil 0 "rcs" file (concat "-b" rev ".1"))))
|
||||
(vc-file-setprop file 'vc-backend backend)
|
||||
(vc-file-setprop file 'vc-backend 'RCS)
|
||||
(vc-file-setprop file 'vc-state 'edited)
|
||||
(set-file-modes file
|
||||
(logior (file-modes file) 128)))
|
||||
|
104
lisp/vc.el
104
lisp/vc.el
@ -150,6 +150,7 @@
|
||||
(require 'vc-hooks)
|
||||
(require 'ring)
|
||||
(eval-when-compile
|
||||
(require 'cl)
|
||||
(require 'compile)
|
||||
(require 'dired) ; for dired-map-over-marks macro
|
||||
(require 'dired-aux)) ; for dired-kill-{line,tree}
|
||||
@ -492,8 +493,7 @@ of two-element lists, each of which has the form (PROPERTY VALUE)."
|
||||
|
||||
(defsubst vc-editable-p (file)
|
||||
(or (eq (vc-checkout-model file) 'implicit)
|
||||
(eq (vc-state file) 'edited)
|
||||
(eq (vc-state file) 'needs-merge)))
|
||||
(memq (vc-state file) '(edited needs-merge))))
|
||||
|
||||
;;; Two macros for elisp programming
|
||||
;;;###autoload
|
||||
@ -522,7 +522,7 @@ 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)
|
||||
(set-buffer (find-file-noselect ,file))
|
||||
,@body
|
||||
(save-buffer)))
|
||||
|
||||
@ -821,7 +821,7 @@ If VERBOSE is non-nil, query the user rather than using default parameters."
|
||||
;; will check whether the file on disk is newer.
|
||||
(if vc-dired-mode
|
||||
(find-file-other-window file)
|
||||
(find-file file))
|
||||
(set-buffer (find-file-noselect file)))
|
||||
(if (not (verify-visited-file-modtime (current-buffer)))
|
||||
(if (yes-or-no-p "Replace file on disk with buffer contents? ")
|
||||
(write-file (buffer-file-name))
|
||||
@ -1067,7 +1067,7 @@ first backend that could register the file is used."
|
||||
"Enter initial comment."
|
||||
(lambda (file rev comment)
|
||||
(message "Registering %s... " file)
|
||||
(let ((backend (vc-responsible-backend file)))
|
||||
(let ((backend (vc-find-new-backend file)))
|
||||
(vc-file-clearprops file)
|
||||
(vc-call-backend backend 'register file rev comment)
|
||||
(vc-file-setprop file 'vc-backend backend)
|
||||
@ -1076,27 +1076,34 @@ first backend that could register the file is used."
|
||||
(setq backup-inhibited t)))
|
||||
(message "Registering %s... done" file))))
|
||||
|
||||
(defun vc-responsible-backend (file &optional register)
|
||||
(defun vc-responsible-backend (file &optional backends)
|
||||
"Return the name of the backend system that is responsible for FILE.
|
||||
If no backend in variable `vc-handled-backends' declares itself
|
||||
responsible, the first backend in that list will be returned (if optional
|
||||
arg REGISTER is non-nil, return the first backend that could register the
|
||||
file).
|
||||
FILE can also be a directory name (ending with a slash)."
|
||||
(if (null vc-handled-backends)
|
||||
(error "Cannot register, no backends in `vc-handled-backends'"))
|
||||
(or (and (not (file-directory-p file)) (vc-backend file))
|
||||
(catch 'found
|
||||
(mapcar (lambda (backend)
|
||||
(if (vc-call-backend backend 'responsible-p file)
|
||||
(throw 'found backend)))
|
||||
vc-handled-backends)
|
||||
(if register
|
||||
(mapcar (lambda (backend)
|
||||
(if (vc-call-backend backend 'could-register file)
|
||||
(throw 'found backend)))
|
||||
vc-handled-backends)
|
||||
(car vc-handled-backends)))))
|
||||
responsible, the first backend in that list will be returned.
|
||||
FILE can also be a directory name (ending with a slash).
|
||||
If BACKENDS is non-nil it overrides any current backend or
|
||||
`vc-handled-backends'."
|
||||
(or (and (not backends) (not (file-directory-p file)) (vc-backend file))
|
||||
(progn
|
||||
(unless backends (setq backends vc-handled-backends))
|
||||
(unless backends (error "No reponsible backend"))
|
||||
(catch 'found
|
||||
(dolist (backend backends)
|
||||
(if (vc-call-backend backend 'responsible-p file)
|
||||
(throw 'found backend)))
|
||||
(car backends)))))
|
||||
|
||||
(defun vc-find-new-backend (file)
|
||||
"Find a new backend to register FILE."
|
||||
(let (backends)
|
||||
;; We can't register if it's already registered
|
||||
(dolist (backend vc-handled-backends)
|
||||
(when (and (not (vc-call-backend backend 'registered file))
|
||||
(vc-call-backend backend 'could-register file))
|
||||
(push backend backends)))
|
||||
(unless backends
|
||||
(error "Cannot register, no appropriate backend in `vc-handled-backends'"))
|
||||
(vc-responsible-backend file (nreverse backends))))
|
||||
|
||||
(defun vc-default-responsible-p (backend file)
|
||||
"Indicate whether BACKEND is reponsible for FILE.
|
||||
@ -1108,13 +1115,13 @@ The default is to return nil always."
|
||||
The default implementation returns t for all files."
|
||||
t)
|
||||
|
||||
(defun vc-unregister (file backend)
|
||||
(defun vc-unregister (file)
|
||||
"Unregister FILE from version control system BACKEND."
|
||||
(vc-call-backend backend 'unregister file)
|
||||
(vc-call unregister file)
|
||||
(vc-file-clearprops file))
|
||||
|
||||
(defun vc-default-unregister (backend file)
|
||||
"Default implementation of vc-unregister, signals an error."
|
||||
"Default implementation of `vc-unregister', signals an error."
|
||||
(error "Unregistering files is not supported for %s" backend))
|
||||
|
||||
(defun vc-resynch-window (file &optional keep noquery)
|
||||
@ -1588,7 +1595,7 @@ I.e. reset them to the non-expanded form."
|
||||
(save-excursion
|
||||
(vc-call-backend backend 'clear-headers))
|
||||
(vc-restore-buffer-context context))
|
||||
(find-file filename)
|
||||
(set-buffer (find-file-noselect filename))
|
||||
(vc-call-backend backend 'clear-headers)
|
||||
(kill-buffer filename)))))
|
||||
|
||||
@ -2138,9 +2145,8 @@ it if their logs are not in RCS format."
|
||||
(defun vc-revert-buffer ()
|
||||
"Revert the current buffer's file back to the version it was based on.
|
||||
This asks for confirmation if the buffer contents are not identical
|
||||
to that version. Note that for RCS and CVS, this function does not
|
||||
automatically pick up newer changes found in the master file;
|
||||
use \\[universal-argument] \\[vc-next-action] to do so."
|
||||
to that version. This function does not automatically pick up newer
|
||||
changes found in the master file; use \\[universal-argument] \\[vc-next-action] to do so."
|
||||
(interactive)
|
||||
(vc-ensure-vc-buffer)
|
||||
(let ((file buffer-file-name)
|
||||
@ -2153,9 +2159,9 @@ use \\[universal-argument] \\[vc-next-action] to do so."
|
||||
(unwind-protect
|
||||
(if (not (yes-or-no-p "Discard changes? "))
|
||||
(error "Revert canceled"))
|
||||
(if (or (window-dedicated-p (selected-window))
|
||||
(one-window-p t 'selected-frame))
|
||||
(make-frame-invisible (selected-frame))
|
||||
(if (and (window-dedicated-p (selected-window))
|
||||
(one-window-p t))
|
||||
(make-frame-invisible)
|
||||
(delete-window))))
|
||||
(set-buffer obuf)
|
||||
;; Do the reverting
|
||||
@ -2218,14 +2224,34 @@ A prefix argument NOREVERT means do not revert the buffer afterwards."
|
||||
|
||||
;;;autoload
|
||||
(defun vc-switch-backend (file backend)
|
||||
"Make BACKEND the current version control system for FILE.
|
||||
"Make BACKEND the current version control system for FILE.
|
||||
FILE must already be registered in BACKEND. The change is not
|
||||
permanent, only for the current session. This function only changes
|
||||
VC's perspective on FILE, it does not register or unregister it."
|
||||
(interactive
|
||||
VC's perspective on FILE, it does not register or unregister it.
|
||||
By default, this command cycles through the registered backends.
|
||||
To get a prompt, use a prefix argument."
|
||||
(interactive
|
||||
(list
|
||||
buffer-file-name
|
||||
(intern (upcase (read-string "Switch to backend: ")))))
|
||||
(let ((backend (vc-backend buffer-file-name))
|
||||
(backends nil))
|
||||
;; Find the registered backends.
|
||||
(dolist (backend vc-handled-backends)
|
||||
(when (vc-call-backend backend 'registered buffer-file-name)
|
||||
(push backend backends)))
|
||||
;; Find the next backend.
|
||||
(let ((def (car (delq backend (memq backend (append backends backends)))))
|
||||
(others (delete backend backends)))
|
||||
(cond
|
||||
((null others) (error "No other backend to switch to"))
|
||||
(current-prefix-arg
|
||||
(intern
|
||||
(upcase
|
||||
(completing-read
|
||||
(format "Switch to backend [%s]: " def)
|
||||
(mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
|
||||
nil t nil nil (downcase (symbol-name def))))))
|
||||
(t def))))))
|
||||
(unless (vc-call-backend backend 'registered file)
|
||||
(error "%s is not registered in %s" file backend))
|
||||
(vc-file-clearprops file)
|
||||
@ -2265,7 +2291,7 @@ of the log entry buffer."
|
||||
(rev (vc-workfile-version file))
|
||||
(state (vc-state file))
|
||||
(comment (and move (vc-call comment-history file))))
|
||||
(if move (vc-unregister file old-backend))
|
||||
(if move (vc-unregister file))
|
||||
(vc-file-clearprops file)
|
||||
(if (not (vc-call-backend backend 'registered file))
|
||||
(with-vc-properties
|
||||
|
Loading…
Reference in New Issue
Block a user