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)) ;;;*** @@ -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 address@hidden/path into (address@hidden /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 "\\(.*\\)" 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