* Testing the new VC code
2014-11-24 11:57 ` Michael Albinus
@ 2014-11-24 13:03 ` Eric S. Raymond
2014-11-24 18:35 ` Steinar Bang
2014-11-24 19:39 ` Michael Albinus
0 siblings, 2 replies; 41+ messages in thread
From: Eric S. Raymond @ 2014-11-24 13:03 UTC (permalink / raw)
To: Michael Albinus; +Cc: David Kastrup, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1107 bytes --]
Michael Albinus <michael.albinus@gmx.de>:
> I do worry as well, because I do a lot of vc operations over a remote
> (Tramp) connection. Is there a chance to test your code, maybe even
> before it enters trunk?
I would be *delighted* to have you test it. Others should pile in as
well. I can test thoroughly under git and RCS. I'm not really
worried about any of the other back ends except CVS and SVN, but those
could be trouble spots.
Patch enclosed. No warranties, I haven't done a lot of testing myself yet.
You will need to rebuild with a 'make bootstrap', as this alters vc-hooks.
Capabilities certainly not broken: git mode.
Capabilities only superficially changed and almost certainly not broken: arch,
bzr, hg, mtn, dav.
Capabilities changed significantly but seriously tested and almost certainly
not broken: RCS, except for RCS merging.
Probably OK, possibly broken, not well tested: CVS, SVN.
Most likely areas of breakage: File merging in RCS, CVS, and SVN.
Backends affected by removal of caching: SCCS, RCS, CVS, SVN.
--
<a href="http://www.catb.org/~esr/">Eric S. Raymond</a>
[-- Attachment #2: TRIAL --]
[-- Type: text/plain, Size: 74290 bytes --]
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index f60d660..1aafc17 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -29669,7 +29669,7 @@ For a description of possible values, see `vc-check-master-templates'.")
(custom-autoload 'vc-rcs-master-templates "vc-rcs" t)
-(defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
+(defun vc-rcs-registered (f) (vc-master-registered 'RCS f))
;;;***
\f
@@ -29683,7 +29683,7 @@ For a description of possible values, see `vc-check-master-templates'.")
(custom-autoload 'vc-sccs-master-templates "vc-sccs" t)
-(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))
+(defun vc-sccs-registered (f) (vc-master-registered 'SCCS f))
(defun vc-sccs-search-project-dir (_dirname basename) "\
Return the name of a master file in the SCCS project directory.
diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el
index 53b8e35..6d2e472 100644
--- a/lisp/vc/vc-arch.el
+++ b/lisp/vc/vc-arch.el
@@ -231,8 +231,7 @@ Only the value `maybe' can be trusted :-(."
"Return the administrative directory of FILE."
(expand-file-name "{arch}" (vc-arch-root file)))
-(defun vc-arch-register (files &optional rev _comment)
- (if rev (error "Explicit initial revision not supported for Arch"))
+(defun vc-arch-register (files &optional _comment)
(dolist (file files)
(let ((tagmet (vc-arch-tagging-method file)))
(if (and (memq tagmet '(tagline implicit)) comment-start)
@@ -496,8 +495,6 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
"A wrapper around `vc-do-command' for use in vc-arch.el."
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags))
-(defun vc-arch-init-revision () nil)
-
;;; Completion of versions and revisions.
(defun vc-arch--version-completion-table (root string)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 073c355..9e720ed 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -178,113 +178,6 @@ in the repository root directory of FILE."
(insert-file-contents-literally file)
(sha1 (current-buffer))))
-(defun vc-bzr-state-heuristic (file)
- "Like `vc-bzr-state' but hopefully without running Bzr."
- ;; `bzr status' could be slow with large histories and pending merges,
- ;; so this tries to avoid calling it if possible. bzr status is
- ;; faster now, so this is not as important as it was.
- ;;
- ;; This function tries first to parse Bzr internal file
- ;; `checkout/dirstate', but it may fail if Bzr internal file format
- ;; has changed. As a safeguard, the `checkout/dirstate' file is
- ;; only parsed if it contains the string `#bazaar dirstate flat
- ;; format 3' in the first line.
- ;; If the `checkout/dirstate' file cannot be parsed, fall back to
- ;; running `vc-bzr-state'."
- ;;
- ;; The format of the dirstate file is explained in bzrlib/dirstate.py
- ;; in the bzr distribution. Basically:
- ;; header-line giving the version of the file format in use.
- ;; a few lines of stuff
- ;; entries, one per line, with null-separated fields. Each line:
- ;; entry_key = dirname (may be empty), basename, file-id
- ;; current = common ( = kind, fingerprint, size, executable )
- ;; + working ( = packed_stat )
- ;; parent = common ( as above ) + history ( = rev_id )
- ;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
- (let* ((root (vc-bzr-root file))
- (dirstate (expand-file-name vc-bzr-admin-dirstate root)))
- (when root ; Short cut.
- (condition-case err
- (with-temp-buffer
- (insert-file-contents dirstate)
- (goto-char (point-min))
- (if (not (looking-at "#bazaar dirstate flat format 3"))
- (vc-bzr-state file) ; Some other unknown format?
- (let* ((relfile (file-relative-name file root))
- (reldir (file-name-directory relfile)))
- (cond
- ((not
- (re-search-forward
- (concat "^\0"
- (if reldir (regexp-quote
- (directory-file-name reldir)))
- "\0"
- (regexp-quote (file-name-nondirectory relfile))
- "\0"
- "[^\0]*\0" ;id?
- "\\([^\0]*\\)\0" ;"a/f/d", a=removed?
- "\\([^\0]*\\)\0" ;sha1 (empty if conflicted)?
- "\\([^\0]*\\)\0" ;size?p
- ;; y/n. Whether or not the current copy
- ;; was executable the last time bzr checked?
- "[^\0]*\0"
- "[^\0]*\0" ;?
- ;; Parent information. Absent in a new repo.
- "\\(?:\\([^\0]*\\)\0" ;"a/f/d" a=added?
- "\\([^\0]*\\)\0" ;sha1 again?
- "\\([^\0]*\\)\0" ;size again?
- ;; y/n. Whether or not the repo thinks
- ;; the file should be executable?
- "\\([^\0]*\\)\0"
- "[^\0]*\0\\)?" ;last revid?
- ;; There are more fields when merges are pending.
- )
- nil t))
- 'unregistered)
- ;; Apparently the second sha1 is the one we want: when
- ;; there's a conflict, the first sha1 is absent (and the
- ;; first size seems to correspond to the file with
- ;; conflict markers).
- ((eq (char-after (match-beginning 1)) ?a) 'removed)
- ;; If there is no parent, this must be a new repo.
- ;; If file is in dirstate, can only be added (b#8025).
- ((or (not (match-beginning 4))
- (eq (char-after (match-beginning 4)) ?a)) 'added)
- ((or (and (eq (string-to-number (match-string 3))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (save-match-data (vc-bzr-sha1 file)))
- ;; For a file, does the executable state match?
- ;; (Bug#7544)
- (or (not
- (eq (char-after (match-beginning 1)) ?f))
- (let ((exe
- (memq
- ?x
- (mapcar
- 'identity
- (nth 8 (file-attributes file))))))
- (if (eq (char-after (match-beginning 7))
- ?y)
- exe
- (not exe)))))
- (and
- ;; It looks like for lightweight
- ;; checkouts \2 is empty and we need to
- ;; look for size in \6.
- (eq (match-beginning 2) (match-end 2))
- (eq (string-to-number (match-string 6))
- (nth 7 (file-attributes file)))
- (equal (match-string 5)
- (vc-bzr-sha1 file))))
- 'up-to-date)
- (t 'edited)))))
- ;; The dirstate file can't be read, or some other problem.
- (error
- (message "Falling back on \"slow\" status detection (%S)" err)
- (vc-bzr-state file))))))
-
;; This is a cheap approximation that is autoloaded. If it finds a
;; possible match it loads this file and runs the real function.
;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too.
@@ -296,7 +189,7 @@ in the repository root directory of FILE."
(defun vc-bzr-registered (file)
"Return non-nil if FILE is registered with bzr."
- (let ((state (vc-bzr-state-heuristic file)))
+ (let ((state (vc-state file)))
(not (memq state '(nil unregistered ignored)))))
(defconst vc-bzr-state-words
@@ -497,8 +390,6 @@ in the branch repository (or whose status not be determined)."
(eq 'unchanged (car (vc-bzr-status file))))
(defun vc-bzr-working-revision (file)
- ;; Together with the code in vc-state-heuristic, this makes it possible
- ;; to get the initial VC state of a Bzr file even if Bzr is not installed.
(let* ((rootdir (vc-bzr-root file))
(branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
rootdir))
@@ -580,10 +471,6 @@ in the branch repository (or whose status not be determined)."
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional _file)
- "Always return nil, as Bzr cannot register explicit versions."
- nil)
-
(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
@@ -594,11 +481,8 @@ in the branch repository (or whose status not be determined)."
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev _comment)
- "Register FILES under bzr.
-Signal an error unless REV is nil.
-COMMENT is ignored."
- (if rev (error "Can't register explicit revision with bzr"))
+(defun vc-bzr-register (files &optional _comment)
+ "Register FILES under bzr."
(vc-bzr-command "add" nil 0 files))
;; Could run `bzr status' in the directory and see if it succeeds, but
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 4bce79c..af95be5 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -48,9 +48,6 @@
;; If the file is not writable (despite CVSREAD being
;; undefined), this is probably because the file is being
;; "watched" by other developers.
- ;; (If vc-mistrust-permissions was t, we actually shouldn't
- ;; trust this, but there is no other way to learn this from
- ;; CVS at the moment (version 1.9).)
(string-match "r-..-..-." (nth 8 attrib)))
'announce
'implicit))))))
@@ -110,34 +107,6 @@ This is only meaningful if you don't use the implicit checkout model
:version "21.1"
:group 'vc-cvs)
-(defcustom vc-cvs-stay-local 'only-file
- "Non-nil means use local operations when possible for remote repositories.
-This avoids slow queries over the network and instead uses heuristics
-and past information to determine the current status of a file.
-
-If value is the symbol `only-file', `vc-dir' will connect to the
-server, but heuristics will be used to determine the status for
-all other VC operations.
-
-The value can also be a regular expression or list of regular
-expressions to match against the host name of a repository; then VC
-only stays local for hosts that match it. Alternatively, the value
-can be a list of regular expressions where the first element is the
-symbol `except'; then VC always stays local except for hosts matched
-by these regular expressions."
- :type '(choice (const :tag "Always stay local" t)
- (const :tag "Only for file operations" only-file)
- (const :tag "Don't stay local" nil)
- (list :format "\nExamine hostname and %v"
- :tag "Examine hostname ..."
- (set :format "%v" :inline t
- (const :format "%t" :tag "don't" except))
- (regexp :format " stay local,\n%t: %v"
- :tag "if it matches")
- (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "23.1"
- :group 'vc-cvs)
-
(defcustom vc-cvs-sticky-date-format-string "%c"
"Format string for mode-line display of sticky date.
Format is according to `format-time-string'. Only used if
@@ -222,30 +191,11 @@ See also variable `vc-cvs-sticky-date-format-string'."
(defun vc-cvs-state (file)
"CVS-specific version of `vc-state'."
- (if (vc-stay-local-p file 'CVS)
- (let ((state (vc-file-getprop file 'vc-state)))
- ;; If we should stay local, use the heuristic but only if
- ;; we don't have a more precise state already available.
- (if (memq state '(up-to-date edited nil))
- (vc-cvs-state-heuristic file)
- state))
- (with-temp-buffer
- (cd (file-name-directory file))
- (let (process-file-side-effects)
- (vc-cvs-command t 0 file "status"))
- (vc-cvs-parse-status t))))
-
-(defun vc-cvs-state-heuristic (file)
- "CVS-specific state heuristic."
- ;; If the file has not changed since checkout, consider it `up-to-date'.
- ;; Otherwise consider it `edited'.
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- (cond
- ((equal checkout-time lastmod) 'up-to-date)
- ((string= (vc-working-revision file) "0") 'added)
- ((null checkout-time) 'unregistered)
- (t 'edited))))
+ (with-temp-buffer
+ (cd (file-name-directory file))
+ (let (process-file-side-effects)
+ (vc-cvs-command t 0 file "status"))
+ (vc-cvs-parse-status t)))
(defun vc-cvs-working-revision (file)
"CVS-specific version of `vc-working-revision'."
@@ -282,7 +232,7 @@ committed and support display of sticky tags."
(autoload 'vc-switches "vc")
-(defun vc-cvs-register (files &optional _rev comment)
+(defun vc-cvs-register (files &optional comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
@@ -440,6 +390,35 @@ REV is the revision to check out."
;; Make the file read-only by switching off all w-bits
(set-file-modes file (logand (file-modes file) 3950)))))
+(defun vc-cvs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from branch or revision "
+ "(default news on current branch): ")
+ (list file)
+ 'CVS))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-cvs-merge-news file)))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second revision: "
+ (list file) 'CVS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-cvs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))
+ (setq status (vc-cvs-merge file first-revision second-revision))))
+ status))
+
(defun vc-cvs-merge (file first-revision &optional second-revision)
"Merge changes into current working copy of FILE.
The changes are between FIRST-REVISION and SECOND-REVISION."
@@ -526,9 +505,7 @@ Remaining arguments are ignored."
(require 'vc-rcs)
;; It's just the catenation of the individual logs.
(vc-cvs-command
- buffer
- (if (vc-stay-local-p files 'CVS) 'async 0)
- files "log")
+ buffer 0 files "log")
(with-current-buffer buffer
(vc-run-delayed (vc-rcs-print-log-cleanup)))
(when limit 'limit-unsupported))
@@ -543,8 +520,6 @@ Remaining arguments are ignored."
(defun vc-cvs-diff (files &optional oldvers newvers buffer)
"Get a difference report using CVS between two revisions of FILE."
(let* (process-file-side-effects
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'CVS)))
(invoke-cvs-diff-list nil)
status)
;; Look through the file list and see if any files have backups
@@ -575,41 +550,46 @@ Remaining arguments are ignored."
(push file invoke-cvs-diff-list)))))
(when invoke-cvs-diff-list
(setq status (apply 'vc-cvs-command (or buffer "*vc-diff*")
- (if async 'async 1)
+ 1
invoke-cvs-diff-list "diff"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers))
(vc-switches 'CVS 'diff))))
- (if async 1 status))) ; async diff, pessimistic assumption
+ status))
(defconst vc-cvs-annotate-first-line-re "^[0-9]")
-(defun vc-cvs-annotate-process-filter (filter process string)
- (setq string (concat (process-get process 'output) string))
- (if (not (string-match vc-cvs-annotate-first-line-re string))
- ;; Still waiting for the first real line.
- (process-put process 'output string)
- (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
- (funcall filter process (substring string (match-beginning 0)))))
+;; FIXME: Lift this to an upper-level syncgronous annotation facility
+;;(defun vc-cvs-annotate-process-filter (filter process string)
+;; (setq string (concat (process-get process 'output) string))
+;; (if (not (string-match vc-cvs-annotate-first-line-re string))
+;; ;; Still waiting for the first real line.
+;; (process-put process 'output string)
+;; (remove-function (process-filter process) #'vc-cvs-annotate-process-filter)
+;; (funcall filter process (substring string (match-beginning 0)))))
(defun vc-cvs-annotate-command (file buffer &optional revision)
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
(vc-cvs-command buffer
- (if (vc-stay-local-p file 'CVS)
- 'async 0)
+ 0
file "annotate"
- (if revision (concat "-r" revision)))
- ;; Strip the leading few lines.
- (let ((proc (get-buffer-process buffer)))
- (if proc
- ;; If running asynchronously, use a process filter.
- (add-function :around (process-filter proc)
- #'vc-cvs-annotate-process-filter)
- (with-current-buffer buffer
- (goto-char (point-min))
- (re-search-forward vc-cvs-annotate-first-line-re)
- (delete-region (point-min) (1- (point)))))))
+ (if revision (concat "-r" revision))))
+
+;; FIXME: this needs to be lifted into back-end independent code
+;; It used to live inside vc-cvs-annotate-command and run after
+;; the unfiltered annotation report had been generated.
+;;
+;; ;; Strip the leading few lines.
+;; (let ((proc (get-buffer-process buffer)))
+;; (if proc
+;; ;; If running asynchronously, use a process filter.
+;; (add-function :around (process-filter proc)
+;; #'vc-cvs-annotate-process-filter)
+;; (with-current-buffer buffer
+;; (goto-char (point-min))
+;; (re-search-forward vc-cvs-annotate-first-line-re)
+;; (delete-region (point-min) (1- (point)))))))
(declare-function vc-annotate-convert-time "vc-annotate" (time))
@@ -731,9 +711,9 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
;;; Miscellaneous
;;;
-(defun vc-cvs-make-version-backups-p (file)
+(defun vc-cvs-make-version-backups-p (_file)
"Return non-nil if version backups should be made for FILE."
- (vc-stay-local-p file 'CVS))
+ nil)
(defun vc-cvs-check-headers ()
"Check if the current file has any headers in it."
@@ -757,23 +737,6 @@ and that it passes `vc-cvs-global-switches' to it before FLAGS."
(append vc-cvs-global-switches
flags))))
-(defun vc-cvs-stay-local-p (file) ;Back-compatibility.
- (vc-stay-local-p file 'CVS))
-
-(defun vc-cvs-repository-hostname (dirname)
- "Hostname of the CVS server associated to workarea DIRNAME."
- (let ((rootname (expand-file-name "CVS/Root" dirname)))
- (when (file-readable-p rootname)
- (with-temp-buffer
- (let ((coding-system-for-read
- (or file-name-coding-system
- default-file-name-coding-system)))
- (vc-insert-file rootname))
- (goto-char (point-min))
- (nth 2 (vc-cvs-parse-root
- (buffer-substring (point)
- (line-end-position))))))))
-
(defun vc-cvs-parse-uhp (path)
"parse user@host/path into (user@host /path)"
(if (string-match "\\([^/]+\\)\\(/.*\\)" path)
@@ -1018,17 +981,14 @@ state."
(defun vc-cvs-dir-status (dir update-function)
"Create a list of conses (file . state) for DIR."
;; FIXME check all files in DIR instead?
- (let ((local (vc-stay-local-p dir 'CVS)))
- (if (and local (not (eq local 'only-file)))
- (vc-cvs-dir-status-heuristic dir update-function)
- (vc-cvs-command (current-buffer) 'async dir "-f" "status")
- ;; Alternative implementation: use the "update" command instead of
- ;; the "status" command.
- ;; (vc-cvs-command (current-buffer) 'async
- ;; (file-relative-name dir)
- ;; "-f" "-n" "update" "-d" "-P")
- (vc-run-delayed
- (vc-cvs-after-dir-status update-function)))))
+ (vc-cvs-command (current-buffer) 'async dir "-f" "status")
+ ;; Alternative implementation: use the "update" command instead of
+ ;; the "status" command.
+ ;; (vc-cvs-command (current-buffer) 'async
+ ;; (file-relative-name dir)
+ ;; "-f" "-n" "update" "-d" "-P")
+ (vc-run-delayed
+ (vc-cvs-after-dir-status update-function)))
(defun vc-cvs-dir-status-files (dir files _default-state update-function)
"Create a list of conses (file . state) for DIR."
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index df7801f..8404bb6 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -77,7 +77,7 @@ See `vc-checkout-model' for a list of possible values."
"Return the current workfile version of URL."
"Unknown")
-(defun vc-dav-register (url &optional rev comment)
+(defun vc-dav-register (url &optional _comment)
"Register URL in the DAV backend."
;; Do we need to do anything here? FIXME?
)
@@ -133,10 +133,6 @@ It should return a status of either 0 (no differences found), or
;;; Optional functions
-;; Should be faster than vc-dav-state - but how?
-(defun vc-dav-state-heuristic (url)
- "Estimate the version control state of URL at visiting time."
- (vc-dav-state url))
;; This should use url-dav-get-properties with a depth of `1' to get
;; all the properties.
diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el
index bc8a8de..9813801 100644
--- a/lisp/vc/vc-filewise.el
+++ b/lisp/vc/vc-filewise.el
@@ -33,16 +33,17 @@
(eval-when-compile (require 'vc))
+;;;###autoload
(defun vc-master-name (file)
"Return the master name of FILE.
If the file is not registered, or the master name is not known, return nil."
- (or (vc-file-getprop file 'vc-name)
+ (or (vc-file-getprop file 'vc-master-name)
;; force computation of the property by calling
;; vc-BACKEND-registered explicitly
(let ((backend (vc-backend file)))
(if (and backend
(vc-call-backend backend 'registered file))
- (vc-file-getprop file 'vc-name)))))
+ (vc-file-getprop file 'vc-master-name)))))
(defun vc-rename-master (oldmaster newfile templates)
"Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
@@ -78,41 +79,7 @@ If the file is not registered, or the master name is not known, return nil."
(put backend 'vc-templates-grabbed t))
(let ((result (vc-check-master-templates file (symbol-value sym))))
(if (stringp result)
- (vc-file-setprop file 'vc-name result)
+ (vc-file-setprop file 'vc-master-name result)
nil)))) ; Not registered
-(defun vc-check-master-templates (file templates)
- "Return non-nil if there is a master corresponding to FILE.
-
-TEMPLATES is a list of strings or functions. If an element is a
-string, it must be a control string as required by `format', with two
-string placeholders, such as \"%sRCS/%s,v\". The directory part of
-FILE is substituted for the first placeholder, the basename of FILE
-for the second. If a file with the resulting name exists, it is taken
-as the master of FILE, and returned.
-
-If an element of TEMPLATES is a function, it is called with the
-directory part and the basename of FILE as arguments. It should
-return non-nil if it finds a master; that value is then returned by
-this function."
- (let ((dirname (or (file-name-directory file) ""))
- (basename (file-name-nondirectory file)))
- (catch 'found
- (mapcar
- (lambda (s)
- (let ((trial (vc-possible-master s dirname basename)))
- (when (and trial (file-exists-p trial)
- ;; Make sure the file we found with name
- ;; TRIAL is not the source file itself.
- ;; That can happen with RCS-style names if
- ;; the file name is truncated (e.g. to 14
- ;; chars). See if either directory or
- ;; attributes differ.
- (or (not (string= dirname
- (file-name-directory trial)))
- (not (equal (file-attributes file)
- (file-attributes trial)))))
- (throw 'found trial))))
- templates))))
-
(provide 'vc-filewise)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 7509890..547d834 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -50,7 +50,6 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
;; * working-revision (file) OK
;; - latest-on-branch-p (file) NOT NEEDED
;; * checkout-model (files) OK
@@ -59,7 +58,6 @@
;; STATE-CHANGING FUNCTIONS
;; * create-repo () OK
;; * register (files &optional rev comment) OK
-;; - init-revision (file) NOT NEEDED
;; - responsible-p (file) OK
;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
;; - receive-file (file rev) NOT NEEDED
@@ -94,7 +92,6 @@
;; - retrieve-tag (dir name update) OK
;; MISCELLANEOUS
;; - make-version-backups-p (file) NOT NEEDED
-;; - repository-hostname (dirname) NOT NEEDED
;; - previous-revision (file rev) OK
;; - next-revision (file rev) OK
;; - check-headers () COULD BE SUPPORTED
@@ -605,7 +602,7 @@ The car of the list is the current branch."
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional _rev _comment)
+(defun vc-git-register (files &optional _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index dab2c72..26ae356 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -43,7 +43,6 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
;; - dir-status (dir update-function) OK
;; - dir-status-files (dir files ds uf) OK
;; - dir-extra-headers (dir) OK
@@ -56,7 +55,6 @@
;; STATE-CHANGING FUNCTIONS
;; * register (files &optional rev comment) OK
;; * create-repo () OK
-;; - init-revision () NOT NEEDED
;; - responsible-p (file) OK
;; - could-register (file) OK
;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
@@ -86,7 +84,6 @@
;; - retrieve-tag (dir name update) OK FIXME UPDATE BUFFERS
;; MISCELLANEOUS
;; - make-version-backups-p (file) ??
-;; - repository-hostname (dirname) ??
;; - previous-revision (file rev) OK
;; - next-revision (file rev) OK
;; - check-headers () ??
@@ -448,9 +445,8 @@ Optional arg REVISION is a revision to annotate from."
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional _rev _comment)
+(defun vc-hg-register (files &optional _comment)
"Register FILES under hg.
-REV is ignored.
COMMENT is ignored."
(vc-hg-command nil 0 files "add"))
@@ -478,8 +474,7 @@ COMMENT is ignored."
(declare-function log-edit-extract-headers "log-edit" (headers string))
(defun vc-hg-checkin (files comment)
- "Hg-specific version of `vc-backend-checkin'.
-REV is ignored."
+ "Hg-specific version of `vc-backend-checkin'."
(apply 'vc-hg-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--user")
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index a084f9d..36499cb 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -170,80 +170,6 @@ control systems."
:type 'boolean
:group 'vc)
-;; If you fix bug#11490, probably you can set this back to nil.
-(defcustom vc-mistrust-permissions t
- "If non-nil, don't assume permissions/ownership track version-control status.
-If nil, do rely on the permissions.
-See also variable `vc-consult-headers'."
- :version "24.3" ; nil->t, bug#11490
- :type 'boolean
- :group 'vc)
-
-(defun vc-mistrust-permissions (file)
- "Internal access function to variable `vc-mistrust-permissions' for FILE."
- (or (eq vc-mistrust-permissions 't)
- (and vc-mistrust-permissions
- (funcall vc-mistrust-permissions
- (vc-backend-subdirectory-name file)))))
-
-(defcustom vc-stay-local 'only-file
- "Non-nil means use local operations when possible for remote repositories.
-This avoids slow queries over the network and instead uses heuristics
-and past information to determine the current status of a file.
-
-If value is the symbol `only-file', `vc-dir' will connect to the
-server, but heuristics will be used to determine the status for
-all other VC operations.
-
-The value can also be a regular expression or list of regular
-expressions to match against the host name of a repository; then VC
-only stays local for hosts that match it. Alternatively, the value
-can be a list of regular expressions where the first element is the
-symbol `except'; then VC always stays local except for hosts matched
-by these regular expressions."
- :type '(choice
- (const :tag "Always stay local" t)
- (const :tag "Only for file operations" only-file)
- (const :tag "Don't stay local" nil)
- (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
- (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
- (regexp :format " stay local,\n%t: %v" :tag "if it matches")
- (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "23.1"
- :group 'vc)
-
-(defun vc-stay-local-p (file &optional backend)
- "Return non-nil if VC should stay local when handling FILE.
-This uses the `repository-hostname' backend operation.
-If FILE is a list of files, return non-nil if any of them
-individually should stay local."
- (if (listp file)
- (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file))
- (setq backend (or backend (vc-backend file)))
- (let* ((sym (vc-make-backend-sym backend 'stay-local))
- (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
- (if (symbolp stay-local) stay-local
- (let ((dirname (if (file-directory-p file)
- (directory-file-name file)
- (file-name-directory file))))
- (eq 'yes
- (or (vc-file-getprop dirname 'vc-stay-local-p)
- (vc-file-setprop
- dirname 'vc-stay-local-p
- (let ((hostname (vc-call-backend
- backend 'repository-hostname dirname)))
- (if (not hostname)
- 'no
- (let ((default t))
- (if (eq (car-safe stay-local) 'except)
- (setq default nil stay-local (cdr stay-local)))
- (when (consp stay-local)
- (setq stay-local
- (mapconcat 'identity stay-local "\\|")))
- (if (if (string-match stay-local hostname)
- default (not default))
- 'yes 'no))))))))))))
-
;;; This is handled specially now.
;; Tell Emacs about this new kind of minor mode
;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
@@ -564,18 +490,12 @@ status of this file. Otherwise, the value returned is one of:
"Quickly recompute the `state' of FILE."
(vc-file-setprop
file 'vc-state
- (vc-call-backend backend 'state-heuristic file)))
+ (vc-call-backend backend 'state file)))
(defsubst vc-up-to-date-p (file)
"Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
(eq (vc-state file) 'up-to-date))
-(defun vc-default-state-heuristic (backend file)
- "Default implementation of vc-BACKEND-state-heuristic.
-It simply calls the real state computation function `vc-BACKEND-state'
-and does not employ any heuristic at all."
- (vc-call-backend backend 'state file))
-
(defun vc-workfile-unchanged-p (file)
"Return non-nil if FILE has not changed since the last checkout."
(let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
@@ -627,64 +547,6 @@ If FILE is not registered, this function always returns nil."
"`working-revision' not found: using the old `workfile-version' instead")
(vc-call-backend backend 'workfile-version file))
-(defun vc-default-registered (backend file)
- "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
- (let ((sym (vc-make-backend-sym backend 'master-templates)))
- (unless (get backend 'vc-templates-grabbed)
- (put backend 'vc-templates-grabbed t))
- (let ((result (vc-check-master-templates file (symbol-value sym))))
- (if (stringp result)
- (vc-file-setprop file 'vc-master-name result)
- nil)))) ; Not registered
-
-;;;###autoload
-(defun vc-possible-master (s dirname basename)
- (cond
- ((stringp s) (format s dirname basename))
- ((functionp s)
- ;; The template is a function to invoke. If the
- ;; function returns non-nil, that means it has found a
- ;; master. For backward compatibility, we also handle
- ;; the case that the function throws a 'found atom
- ;; and a pair (cons MASTER-FILE BACKEND).
- (let ((result (catch 'found (funcall s dirname basename))))
- (if (consp result) (car result) result)))))
-
-(defun vc-check-master-templates (file templates)
- "Return non-nil if there is a master corresponding to FILE.
-
-TEMPLATES is a list of strings or functions. If an element is a
-string, it must be a control string as required by `format', with two
-string placeholders, such as \"%sRCS/%s,v\". The directory part of
-FILE is substituted for the first placeholder, the basename of FILE
-for the second. If a file with the resulting name exists, it is taken
-as the master of FILE, and returned.
-
-If an element of TEMPLATES is a function, it is called with the
-directory part and the basename of FILE as arguments. It should
-return non-nil if it finds a master; that value is then returned by
-this function."
- (let ((dirname (or (file-name-directory file) ""))
- (basename (file-name-nondirectory file)))
- (catch 'found
- (mapcar
- (lambda (s)
- (let ((trial (vc-possible-master s dirname basename)))
- (when (and trial (file-exists-p trial)
- ;; Make sure the file we found with name
- ;; TRIAL is not the source file itself.
- ;; That can happen with RCS-style names if
- ;; the file name is truncated (e.g. to 14
- ;; chars). See if either directory or
- ;; attributes differ.
- (or (not (string= dirname
- (file-name-directory trial)))
- (not (equal (file-attributes file)
- (file-attributes trial)))))
- (throw 'found trial))))
- templates))))
-
-
;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made
;; obsolete earlier, it is ok for the latter to be an alias to the former,
;; since the latter will be removed first. We can't just make it
@@ -1108,6 +970,66 @@ current, and kill the buffer that visits the link."
(defun vc-default-extra-menu (_backend)
nil)
+(defun vc-possible-master (s dirname basename)
+ (cond
+ ((stringp s) (format s dirname basename))
+ ((functionp s)
+ ;; The template is a function to invoke. If the
+ ;; function returns non-nil, that means it has found a
+ ;; master. For backward compatibility, we also handle
+ ;; the case that the function throws a 'found atom
+ ;; and a pair (cons MASTER-FILE BACKEND).
+ (let ((result (catch 'found (funcall s dirname basename))))
+ (if (consp result) (car result) result)))))
+
+;; These have to live in here in the resident code because the
+;; autoloaded backend functions that claim reponsibility for masters need
+;; vc-master-registered to already be defined.
+
+(defun vc-check-master-templates (file templates)
+ "Return non-nil if there is a master corresponding to FILE.
+
+TEMPLATES is a list of strings or functions. If an element is a
+string, it must be a control string as required by `format', with two
+string placeholders, such as \"%sRCS/%s,v\". The directory part of
+FILE is substituted for the first placeholder, the basename of FILE
+for the second. If a file with the resulting name exists, it is taken
+as the master of FILE, and returned.
+
+If an element of TEMPLATES is a function, it is called with the
+directory part and the basename of FILE as arguments. It should
+return non-nil if it finds a master; that value is then returned by
+this function."
+ (let ((dirname (or (file-name-directory file) ""))
+ (basename (file-name-nondirectory file)))
+ (catch 'found
+ (mapcar
+ (lambda (s)
+ (let ((trial (vc-possible-master s dirname basename)))
+ (when (and trial (file-exists-p trial)
+ ;; Make sure the file we found with name
+ ;; TRIAL is not the source file itself.
+ ;; That can happen with RCS-style names if
+ ;; the file name is truncated (e.g. to 14
+ ;; chars). See if either directory or
+ ;; attributes differ.
+ (or (not (string= dirname
+ (file-name-directory trial)))
+ (not (equal (file-attributes file)
+ (file-attributes trial)))))
+ (throw 'found trial))))
+ templates))))
+
+(defun vc-master-registered (backend file)
+ "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
+ (let ((sym (vc-make-backend-sym backend 'master-templates)))
+ (unless (get backend 'vc-templates-grabbed)
+ (put backend 'vc-templates-grabbed t))
+ (let ((result (vc-check-master-templates file (symbol-value sym))))
+ (if (stringp result)
+ (vc-file-setprop file 'vc-master-name result)
+ nil)))) ; Not registered
+
(provide 'vc-hooks)
;;; vc-hooks.el ends here
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 145fdeb..f12ca0f 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -179,7 +179,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(_ ?:))
branch)))
-(defun vc-mtn-register (files &optional _rev _comment)
+(defun vc-mtn-register (files &optional _comment)
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 0b839a6..b5620b5 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -90,7 +90,7 @@ to use --brief and sets this variable to remember whether it worked."
:group 'vc-rcs)
;; This needs to be autoloaded because vc-rcs-registered uses it (via
-;; vc-default-registered), and vc-hooks needs to be able to check
+;; vc-master-registered), and vc-hooks needs to be able to check
;; for a registered backend without loading every backend.
;;;###autoload
(defcustom vc-rcs-master-templates
@@ -131,7 +131,7 @@ For a description of possible values, see `vc-check-master-templates'."
;; every file that is visited.
;;;###autoload
(progn
-(defun vc-rcs-registered (f) (vc-default-registered 'RCS f)))
+(defun vc-rcs-registered (f) (vc-master-registered 'RCS f)))
(defun vc-rcs-state (file)
"Implementation of `vc-state' for RCS."
@@ -155,51 +155,6 @@ For a description of possible values, see `vc-check-master-templates'."
'unlocked-changes
'edited))))))
-(defun vc-rcs-state-heuristic (file)
- "State heuristic for RCS."
- (let (vc-rcs-headers-result)
- (if (and vc-consult-headers
- (setq vc-rcs-headers-result
- (vc-rcs-consult-headers file))
- (eq vc-rcs-headers-result 'rev-and-lock))
- (let ((state (vc-file-getprop file 'vc-state)))
- ;; If the headers say that the file is not locked, the
- ;; permissions can tell us whether locking is used for
- ;; the file or not.
- (if (and (eq state 'up-to-date)
- (not (vc-mistrust-permissions file))
- (file-exists-p file))
- (cond
- ((string-match ".rw..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'implicit)
- (setq state
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- ((string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking))))
- state)
- (if (not (vc-mistrust-permissions file))
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (cond ((and permissions (string-match ".r-..-..-." permissions))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- 'up-to-date)
- ((and permissions (string-match ".rw..-..-." permissions))
- (if (eq (vc-rcs-checkout-model file) 'locking)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- (t
- ;; Strange permissions. Fall through to
- ;; expensive state computation.
- (vc-rcs-state file))))
- (vc-rcs-state file)))))
-
(autoload 'vc-expand-dirs "vc")
(defun vc-rcs-dir-status (dir update-function)
@@ -274,18 +229,15 @@ When VERSION is given, perform check for that version."
(autoload 'vc-switches "vc")
-(defun vc-rcs-register (files &optional rev comment)
+(defun vc-rcs-register (files &optional comment)
"Register FILES into the RCS version-control system.
-REV is the optional revision number for the files. COMMENT can be used
-to provide an initial description for each FILES.
+COMMENT can be used to provide an initial description for each FILES.
Passes either `vc-rcs-register-switches' or `vc-register-switches'
to the RCS command.
Automatically retrieve a read-only version of the file with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(let (subdir name)
- ;; When REV is specified, we need to force using "-t-".
- (when rev (unless comment (setq comment "")))
(dolist (file files)
(and (not (file-exists-p
(setq subdir (expand-file-name "RCS"
@@ -297,7 +249,6 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(apply #'vc-do-command "*vc*" 0 "ci" file
;; if available, use the secure registering option
(and (vc-rcs-release-p "5.6.4") "-i")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
(and comment (concat "-t-" comment))
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
@@ -334,7 +285,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(defun vc-rcs-receive-file (file rev)
"Implementation of receive-file for RCS."
(let ((checkout-model (vc-rcs-checkout-model (list file))))
- (vc-rcs-register file rev "")
+ (vc-rcs-register file "")
(when (eq checkout-model 'implicit)
(vc-rcs-set-non-strict-locking file))
(vc-rcs-set-default-branch file (concat rev ".1"))))
@@ -533,6 +484,31 @@ revert all registered files beneath it."
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
+(defun vc-rcs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file " from branch or revision: ")
+ (list file)
+ 'RCS))
+ second-revision)
+ (cond
+ ((string= first-revision "")
+ (error "A starting RCS revision is required"))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second RCS revision: "
+ (list file) 'RCS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-rcs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))))
+ (vc-rcs-merge file first-revision second-revision)))
+
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
@@ -1161,26 +1137,13 @@ Returns: nil if no headers were found
;; -------------------
(t nil))))
(if status (vc-file-setprop file 'vc-working-revision version))
- (and (eq status 'rev-and-lock)
+ (if (eq status 'rev-and-lock)
(vc-file-setprop file 'vc-state
(cond
((eq locking-user 'none) 'up-to-date)
((string= locking-user (vc-user-login-name file))
'edited)
- (t locking-user)))
- ;; If the file has headers, we don't want to query the
- ;; master file, because that would eliminate all the
- ;; performance gain the headers brought us. We therefore
- ;; use a heuristic now to find out whether locking is used
- ;; for this file. If we trust the file permissions, and the
- ;; file is not locked, then if the file is read-only we
- ;; assume that locking is used for the file, otherwise
- ;; locking is not used.
- (not (vc-mistrust-permissions file))
- (vc-up-to-date-p file)
- (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- (vc-file-setprop file 'vc-checkout-model 'implicit)))
+ (t locking-user))))
status))))
(defun vc-release-greater-or-equal (r1 r2)
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 780efc4..2d76232 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -75,7 +75,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:group 'vc-sccs)
;; This needs to be autoloaded because vc-sccs-registered uses it (via
-;; vc-default-registered), and vc-hooks needs to be able to check
+;; vc-master-registered), and vc-hooks needs to be able to check
;; for a registered backend without loading every backend.
;;;###autoload
(defcustom vc-sccs-master-templates
@@ -112,7 +112,7 @@ For a description of possible values, see `vc-check-master-templates'."
;; every file that is visited.
;;;###autoload
(progn
-(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)))
+(defun vc-sccs-registered (f) (vc-master-registered 'SCCS f)))
(defun vc-sccs-state (file)
"SCCS-specific function to compute the version control state."
@@ -132,29 +132,6 @@ For a description of possible values, see `vc-check-master-templates'."
locking-user)))
'up-to-date))))
-(defun vc-sccs-state-heuristic (file)
- "SCCS-specific state heuristic."
- (if (not (vc-mistrust-permissions 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.
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (if (string-match ".r-..-..-." permissions)
- 'up-to-date
- (if (string-match ".rw..-..-." permissions)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- ;; Strange permissions.
- ;; Fall through to real state computation.
- (vc-sccs-state file))))
- (vc-sccs-state file)))
-
(autoload 'vc-expand-dirs "vc")
(defun vc-sccs-dir-status (dir update-function)
@@ -220,10 +197,9 @@ Optional string REV is a revision."
(autoload 'vc-switches "vc")
-(defun vc-sccs-register (files &optional rev comment)
+(defun vc-sccs-register (files &optional comment)
"Register FILES into the SCCS version-control system.
-REV is the optional revision number for the file. COMMENT can be used
-to provide an initial description of FILES.
+COMMENT can be used to provide an initial description of FILES.
Passes either `vc-sccs-register-switches' or `vc-register-switches'
to the SCCS command.
@@ -237,7 +213,6 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(or project-file
(format (car vc-sccs-master-templates) dirname basename))))
(apply 'vc-sccs-do-command nil 0 "admin" vc-master-name
- (and rev (not (string= rev "")) (concat "-r" rev))
"-fb"
(concat "-i" (file-relative-name file))
(and comment (concat "-y" comment))
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index 520708c..070c4f1 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -31,7 +31,6 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
;; * dir-status (dir update-function) OK
;; - dir-status-files (dir files ds uf) ??
;; - dir-extra-headers (dir) NOT NEEDED
@@ -44,7 +43,6 @@
;; STATE-CHANGING FUNCTIONS
;; * register (files &optional rev comment) OK
;; * create-repo () OK
-;; - init-revision () NOT NEEDED
;; * responsible-p (file) OK
;; * could-register (file) OK
;; - receive-file (file rev) NOT NEEDED
@@ -74,7 +72,6 @@
;; - retrieve-tag (dir name update) ??
;; MISCELLANEOUS
;; - make-version-backups-p (file) ??
-;; - repository-hostname (dirname) NOT NEEDED
;; - previous-revision (file rev) ??
;; - next-revision (file rev) ??
;; - check-headers () ??
@@ -123,7 +120,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:group 'vc-src)
;; This needs to be autoloaded because vc-src-registered uses it (via
-;; vc-default-registered), and vc-hooks needs to be able to check
+;; vc-master-registered), and vc-hooks needs to be able to check
;; for a registered backend without loading every backend.
;;;###autoload
(defcustom vc-src-master-templates
@@ -153,7 +150,7 @@ For a description of possible values, see `vc-check-master-templates'."
;; every file that is visited.
;;;###autoload
(progn
-(defun vc-src-registered (f) (vc-default-registered 'src f)))
+(defun vc-src-registered (f) (vc-master-registered 'src f)))
(defun vc-src-state (file)
"SRC-specific version of `vc-state'."
@@ -230,9 +227,8 @@ This function differs from vc-do-command in that it invokes `vc-src-program'."
(autoload 'vc-switches "vc")
-(defun vc-src-register (files &optional _rev _comment)
+(defun vc-src-register (files &optional _comment)
"Register FILES under src.
-REV is ignored.
COMMENT is ignored."
(vc-src-command nil files "add"))
@@ -246,8 +242,7 @@ COMMENT is ignored."
(defalias 'vc-could-register 'vc-src-responsible-p)
(defun vc-src-checkin (files comment)
- "SRC-specific version of `vc-backend-checkin'.
-REV is ignored."
+ "SRC-specific version of `vc-backend-checkin'."
(vc-src-command nil files "commit" "-m" comment))
(defun vc-src-find-revision (file rev buffer)
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 30d66e4..23fbc0b 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -153,37 +153,15 @@ If you want to force an empty list of arguments, use t."
(let ((parsed (vc-svn-parse-status file)))
(and parsed (not (memq parsed '(ignored unregistered))))))))))
-(defun vc-svn-state (file &optional localp)
+(defun vc-svn-state (file)
"SVN-specific version of `vc-state'."
(let (process-file-side-effects)
- (setq localp (or localp (vc-stay-local-p file 'SVN)))
(with-temp-buffer
(cd (file-name-directory file))
- (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
+ (vc-svn-command t 0 file "status" "-u")
(vc-svn-parse-status file))))
-;; NB this does not handle svn properties, which can be changed
-;; without changing the file timestamp.
-;; Note that unlike vc-cvs-state-heuristic, this is not called from
-;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via
-;; vc-after-save (bug#7850). Therefore the fact that it ignores
-;; properties is irrelevant. If you want to make vc-svn-state call
-;; this, it should be extended to handle svn properties.
-(defun vc-svn-state-heuristic (file)
- "SVN-specific state heuristic."
- ;; If the file has not changed since checkout, consider it `up-to-date'.
- ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic.
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- (cond
- ((equal checkout-time lastmod) 'up-to-date)
- ((string= (vc-working-revision file) "0") 'added)
- ((null checkout-time) 'unregistered)
- (t 'edited))))
-
-;; FIXME it would be better not to have the "remote" argument,
-;; but to distinguish the two output formats based on content.
-(defun vc-svn-after-dir-status (callback &optional remote)
+(defun vc-svn-after-dir-status (callback)
(let ((state-map '((?A . added)
(?C . conflict)
(?I . ignored)
@@ -193,9 +171,7 @@ If you want to force an empty list of arguments, use t."
(?? . unregistered)
;; This is what vc-svn-parse-status does.
(?~ . edited)))
- (re (if remote "^\\(.\\)\\(.\\).....? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$"
- ;; Subexp 3 is a dummy in this case, so the numbers match.
- "^\\(.\\)\\(.\\)...\\(.\\).? \\(.*\\)$"))
+ (re "^\\(.\\)\\(.\\).....? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$")
result)
(goto-char (point-min))
(while (re-search-forward re nil t)
@@ -207,7 +183,7 @@ If you want to force an empty list of arguments, use t."
(and (memq propstat '(conflict edited))
(not (eq state 'conflict)) ; conflict always wins
(setq state propstat))
- (and remote (string-equal (match-string 3) "*")
+ (and (string-equal (match-string 3) "*")
;; FIXME are there other possible combinations?
(cond ((eq state 'edited) (setq state 'needs-merge))
((not state) (setq state 'needs-update))))
@@ -218,21 +194,13 @@ If you want to force an empty list of arguments, use t."
;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-(defun vc-svn-dir-status (dir callback)
+(defun vc-svn-dir-status (_dir callback)
"Run 'svn status' for DIR and update BUFFER via CALLBACK.
CALLBACK is called as (CALLBACK RESULT BUFFER), where
RESULT is a list of conses (FILE . STATE) for directory DIR."
- ;; FIXME should this rather be all the files in dir?
- ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up
- ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR
- ;; which is VERY SLOW for big trees and it makes emacs
- ;; completely unresponsive during that time.
- (let* ((local (and nil (vc-stay-local-p dir 'SVN)))
- (remote (or t (not local) (eq local 'only-file))))
- (vc-svn-command (current-buffer) 'async nil "status"
- (if remote "-u"))
+ (vc-svn-command (current-buffer) 'async nil "status" "-u")
(vc-run-delayed
- (vc-svn-after-dir-status callback remote))))
+ (vc-svn-after-dir-status callback)))
(defun vc-svn-dir-status-files (_dir files _default-state callback)
(apply 'vc-svn-command (current-buffer) 'async nil "status" files)
@@ -300,7 +268,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
(autoload 'vc-switches "vc")
-(defun vc-svn-register (files &optional _rev _comment)
+(defun vc-svn-register (files &optional _comment)
"Register FILES into the SVN version-control system.
The COMMENT argument is ignored This does an add but not a commit.
Passes either `vc-svn-register-switches' or `vc-register-switches'
@@ -407,6 +375,29 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY."
(unless contents-done
(vc-svn-command nil 0 file "revert")))
+(defun vc-svn-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from SVN revision "
+ "(default news on current branch): ")
+ (list file)
+ 'SVN))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-svn-merge-news file)))
+ (t
+ (setq second-revision
+ (vc-read-revision
+ "Second SVN revision: "
+ (list file) 'SVN nil
+ first-revision))
+ (setq status (vc-svn-merge file first-revision second-revision))))
+ status))
+
(defun vc-svn-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
@@ -539,7 +530,6 @@ If LIMIT is non-nil, show no more than this many entries."
'vc-svn-command
buffer
'async
- ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0)
(list file)
"log"
(append
@@ -578,22 +568,16 @@ If LIMIT is non-nil, show no more than this many entries."
(if vc-svn-diff-switches
(vc-switches 'SVN 'diff)
(list (concat "--diff-cmd=" diff-command) "-x"
- (mapconcat 'identity (vc-switches nil 'diff) " "))))
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'SVN)
- (or oldvers newvers)))) ; Svn diffs those locally.
+ (mapconcat 'identity (vc-switches nil 'diff) " ")))))
(apply 'vc-svn-command buffer
- (if async 'async 0)
+ 0
files "diff"
(append
switches
(when oldvers
(list "-r" (if newvers (concat oldvers ":" newvers)
oldvers)))))
- (if async 1 ; async diff => pessimistic assumption
- ;; For some reason `svn diff' does not return a useful
- ;; status w.r.t whether the diff was empty or not.
- (buffer-size (get-buffer buffer)))))
+ (buffer-size (get-buffer buffer))))
;;;
;;; Tag system
@@ -623,7 +607,7 @@ NAME is assumed to be a URL."
;; Subversion makes backups for us, so don't bother.
;; (defun vc-svn-make-version-backups-p (file)
;; "Return non-nil if version backups should be made for FILE."
-;; (vc-stay-local-p file 'SVN))
+;; nil)
(defun vc-svn-check-headers ()
"Check if the current file has any headers in it."
@@ -646,17 +630,6 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches flags))))
-(defun vc-svn-repository-hostname (dirname)
- (with-temp-buffer
- (let (process-file-side-effects)
- (vc-svn-command t t dirname "info" "--xml"))
- (goto-char (point-min))
- (when (re-search-forward "<url>\\(.*\\)</url>" nil t)
- ;; This is not a hostname but a URL. This may actually be considered
- ;; as a feature since it allows vc-svn-stay-local to specify different
- ;; behavior for different modules on the same server.
- (match-string 1))))
-
(defun vc-svn-resolve-when-done ()
"Call \"svn resolved\" if the conflict markers have been removed."
(save-excursion
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index aa9337c..1cd89b6 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -128,16 +128,7 @@
;; Return the current version control state of FILE. For a list of
;; possible values, see `vc-state'. This function should do a full and
;; reliable state computation; it is usually called immediately after
-;; C-x v v. If you want to use a faster heuristic when visiting a
-;; file, put that into `state-heuristic' below. Note that under most
-;; VCSes this won't be called at all, dir-status is used instead.
-;;
-;; - state-heuristic (file)
-;;
-;; If provided, this function is used to estimate the version control
-;; state of FILE at visiting time. It should be considerably faster
-;; than the implementation of `state'. For a list of possible values,
-;; see the doc string of `vc-state'.
+;; C-x v v.
;;
;; - dir-status (dir update-function)
;;
@@ -228,21 +219,16 @@
;; it so VC mode can add files to it. For file-oriented systems, this
;; need do no more than create a subdirectory with the right name.
;;
-;; * register (files &optional rev comment)
-;;
-;; Register FILES in this backend. Optionally, an initial revision REV
-;; and an initial description of the file, COMMENT, may be specified,
-;; but it is not guaranteed that the backend will do anything with this.
-;; The implementation should pass the value of vc-register-switches
-;; to the backend command. (Note: in older versions of VC, this
-;; command took a single file argument and not a list.)
-;; The REV argument is a historical leftover and is never used.
-;;
-;; - init-revision (file)
+;; * register (files &optional comment)
;;
-;; The initial revision to use when registering FILE if one is not
-;; specified by the user. If not provided, the variable
-;; vc-default-init-revision is used instead.
+;; Register FILES in this backend. Optionally, an initial
+;; description of the file, COMMENT, may be specified, but it is not
+;; guaranteed that the backend will do anything with this. The
+;; implementation should pass the value of vc-register-switches to
+;; the backend command. (Note: in older versions of VC, this
+;; command had an optional revision first argument that was
+;; not used; in still older ones it took a single file argument and
+;; not a list.)
;;
;; - responsible-p (file)
;;
@@ -314,7 +300,7 @@
;; 'cancel-version' and took a single file arg, not a list of
;; files.)
;;
-;; - merge (file rev1 rev2)
+;; - merge-file (file rev1 rev2)
;;
;; Merge the changes between REV1 and REV2 into the current working file
;; (for non-distributed VCS).
@@ -506,14 +492,6 @@
;;
;; Return the root of the VC controlled hierarchy for file.
;;
-;; - repository-hostname (dirname)
-;;
-;; Return the hostname that the backend will have to contact
-;; in order to operate on a file in DIRNAME. If the return value
-;; is nil, it means that the repository is local.
-;; This function is used in `vc-stay-local-p' which backends can use
-;; for their convenience.
-;;
;; - ignore (file &optional directory)
;;
;; Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
@@ -599,35 +577,71 @@
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
-;;; Todo:
-
-;; - Get rid of the "master file" terminology.
+;;; Changes from the pre-25.1 API:
+;;
+;; - The 'editable' optional argument of vc-checkout is gone. The
+;; upper level assumes that all files are checked out editable. This
+;; moves closer to emulating modern non-locking behavior even on very
+;; old VCSes.
+;;
+;; - vc-state-heuristic is gone. Previously defined in bzr, CVS,
+;; RCS, and SCCS, it was an attempt to circumvent the slowness of
+;; disk operations on older hardware (and in the case of bzr,
+;; unreasonable slowness of older bzr versions). With modern hardware
+;; the tradeoffs have changed; it's OK to go direct to disk, and by doing
+;; so avoid various TOCTOU bugs and issues with what happens if you
+;; perform version-control operations behind Emacs's back.
+;;
+;; - the vc-mistrust-permissions configuration variable is gone; the
+;; code no longer relies on permissions except in one corner case where
+;; CVS leavs no alternative (which was not gated by this variable). The
+;; only affected back end was RCS.
+;;
+;; - the vc-stay-local-p function, and associated backend methods and
+;; configuration variables (including repository-hostname), are
+;; gone. Affects the CVS and SVN back ends, but had previously to
+;; be half-disabled in the SVN back end anyway because of a
+;; performance limitation in the SVN tools. This change disables
+;; asynchronous diffs and asynchronous annotation in CVS and SVN,
+;; but that's OK as we need to make that an upper-level capability
+;; that extends across all backends.
+;;
+;; - The init-revision function and the default-initial-revision
+;; variable are gone. These have't made sense on anything shipped
+;; since RCS, and using them was a dumb stunt even on RCS.
+;;
+;; - The vc-register function and its backend implementations no longer
+;; take a first optional revision argument, since on no system since
+;; RCS has setting the initial revision been even possible, let alone
+;; sane.
+;;
+;; - The backend operation for non-distributed VCSes formerly called
+;; "merge" is now "merge-file" (to contrast with merge-branch), and
+;; does its own prompting for revisions. (This fixes a layer violation
+;; that produced bad behavior under SVN.) It is expected that with an
+;; empty first revision this will behave like the merge-news method.
+;;; Todo:
+;;
;; - Add key-binding for vc-delete-file.
;;;; New Primitives:
;;
-;; - deal with push/pull operations.
-;;
-;;;; Primitives that need changing:
-;;
-;; - vc-update/vc-merge should deal with VC systems that don't
-;; update/merge on a file basis, but on a whole repository basis.
-;; vc-update and vc-merge assume the arguments are always files,
-;; they don't deal with directories. Make sure the *vc-dir* buffer
-;; is updated after these operations.
-;; At least bzr, git and hg should benefit from this.
+;; - deal with push operations.
;;
;;;; Improved branch and tag handling:
;;
+;; - Make sure the *vc-dir* buffer is updated after merge-branch operations.
+;;
;; - add a generic mechanism for remembering the current branch names,
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;;;; Internal cleanups:
+;; - Add a primitives for switching to a branch (creating it if required.
;;
-;; - backends that care about vc-stay-local should try to take it into
-;; account for vc-dir. Is this likely to be useful??? YES!
+;; - Add the ability to list tags and branches.
+;;
+;;;; Internal cleanups:
;;
;; - vc-expand-dirs should take a backend parameter and only look for
;; files managed by that backend.
@@ -639,8 +653,34 @@
;; (or nil if it worked synchronously). Hopefully we can define the old
;; 4 operations in term of this one.
;;
+;;;; Unify two different versions of the amend capability
+;;
+;; - Some back ends (SCCS/RCS/SVN/SRC), have an amend capability that can
+;; be invoked from log-view.
+;;
+;; - The git backend supports amending, but in a different
+;; way (press `C-c C-e' in log-edit buffer, when making a new commit).
+;;
+;; - Second, `log-view-modify-change-comment' doesn't seem to support
+;; modern backends at all because `log-view-extract-comment'
+;; unconditionally calls `log-view-current-file'. This should be easy to
+;; fix.
+;;
+;; - Third, doing message editing in log-view might be a natural way to go
+;; about it, but editing any but the last commit (and even it, if it's
+;; been pushed) is a dangerous operation in Git, which we shouldn't make
+;; too easy for users to perform.
+;;
+;; There should be a check that the given comment is not reachable
+;; from any of the "remote" refs?
+;;
;;;; Other
;;
+;; - asynchronous checkin and commit, so you can keep working in other
+;; buffers while the repo operation happens.
+;;
+;; - Direct support for stash/shelve.
+;;
;; - when a file is in `conflict' state, turn on smerge-mode.
;;
;; - figure out what to do with conflicts that are not caused by the
@@ -715,14 +755,6 @@
(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2")
-(defcustom vc-default-init-revision "1.1"
- "A string used as the default revision number when a new file is registered.
-This can be overridden by giving a prefix argument to \\[vc-register]. This
-can also be overridden by a particular VC backend."
- :type 'string
- :group 'vc
- :version "20.3")
-
(defcustom vc-checkin-switches nil
"A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
@@ -1128,7 +1160,7 @@ For old-style locking-based version control systems, like RCS:
((eq state 'ignored)
(error "Fileset files are ignored by the version-control system"))
((or (null state) (eq state 'unregistered))
- (vc-register nil vc-fileset))
+ (vc-register vc-fileset))
;; Files are up-to-date, or need a merge and user specified a revision
((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
(cond
@@ -1294,12 +1326,11 @@ For old-style locking-based version control systems, like RCS:
(declare-function vc-dir-move-to-goal-column "vc-dir" ())
;;;###autoload
-(defun vc-register (&optional set-revision vc-fileset comment)
+(defun vc-register (&optional vc-fileset comment)
"Register into a version control system.
If VC-FILESET is given, register the files in that fileset.
-Otherwise register the current file.
-With prefix argument SET-REVISION, allow user to specify initial revision
-level. If COMMENT is present, use that as an initial comment.
+Otherwise register the current file. If COMMENT is present, use that
+as an initial comment.
The version control system to use is found by cycling through the list
`vc-handled-backends'. The first backend in that list which declares
@@ -1331,11 +1362,7 @@ first backend that could register the file is used."
(vc-buffer-sync)))))
(message "Registering %s... " files)
(mapc 'vc-file-clearprops files)
- (vc-call-backend backend 'register files
- (if set-revision
- (read-string (format "Initial revision level for %s: " files))
- (vc-call-backend backend 'init-revision))
- comment)
+ (vc-call-backend backend 'register files comment)
(mapc
(lambda (file)
(vc-file-setprop file 'vc-backend backend)
@@ -2041,42 +2068,18 @@ changes from the current branch."
;; If a branch-merge operation is defined, use it.
((vc-find-backend-function backend 'merge-branch)
(vc-call-backend backend 'merge-branch))
- ;; Otherwise, do a per-file merge.
- ((vc-find-backend-function backend 'merge)
+ ;; Otherwise, do a per-file merge on each file in the set.
+ ((vc-find-backend-function backend 'merge-file)
(vc-buffer-sync)
(dolist (file files)
(let* ((state (vc-state file))
- first-revision second-revision status)
+ status)
(cond
((stringp state) ;; Locking VCses only
(error "File %s is locked by %s" file state))
((not (vc-editable-p file))
(vc-checkout file t)))
- (setq first-revision
- (vc-read-revision
- (concat "Merge " file
- " from branch or revision "
- "(default news on current branch): ")
- (list file)
- backend))
- (cond
- ((string= first-revision "")
- (setq status (vc-call-backend backend 'merge-news file)))
- (t
- (if (not (vc-branch-p first-revision))
- (setq second-revision
- (vc-read-revision
- "Second revision: "
- (list file) backend nil
- ;; FIXME: This is CVS/RCS/SCCS specific.
- (concat (vc-branch-part first-revision) ".")))
- ;; We want to merge an entire branch. Set revisions
- ;; accordingly, so that vc-BACKEND-merge understands us.
- (setq second-revision first-revision)
- ;; first-revision must be the starting point of the branch
- (setq first-revision (vc-branch-part first-revision)))
- (setq status (vc-call-backend backend 'merge file
- first-revision second-revision))))
+ (setq status (vc-call-backend backend 'merge-file file))
(vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
(t
(error "Sorry, merging is not implemented for %s" backend)))))
@@ -2835,8 +2838,6 @@ This default implementation always returns non-nil, which means that
editing non-current revisions is not supported by default."
t)
-(defun vc-default-init-revision (_backend) vc-default-init-revision)
-
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated
^ permalink raw reply related [flat|nested] 41+ messages in thread