diff options
Diffstat (limited to 'lisp/vc/vc.el')
| -rw-r--r-- | lisp/vc/vc.el | 82 |
1 files changed, 51 insertions, 31 deletions
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index fe666413168..65775f8e46e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -553,6 +553,13 @@ ;; Return the list of files where conflict resolution is needed in ;; the project that contains DIR. ;; FIXME: what should it do with non-text conflicts? +;; +;; - repository-url (file-or-dir &optional remote-name) +;; +;; Returns the URL of the repository of the current checkout +;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the +;; remote (in Git parlance) whose URL is to be returned. It has +;; only a meaning for distributed VCS and is ignored otherwise. ;;; Changes from the pre-25.1 API: ;; @@ -957,7 +964,7 @@ use." (throw 'found bk)))) ;;;###autoload -(defun vc-responsible-backend (file) +(defun vc-responsible-backend (file &optional no-error) "Return the name of a backend system that is responsible for FILE. If FILE is already registered, return the @@ -967,7 +974,10 @@ responsible for FILE is returned. Note that if FILE is a symbolic link, it will not be resolved -- the responsible backend system for the symbolic link itself will -be reported." +be reported. + +If NO-ERROR is nil, signal an error that no VC backend is +responsible for the given file." (or (and (not (file-directory-p file)) (vc-backend file)) (catch 'found ;; First try: find a responsible backend. If this is for registration, @@ -975,7 +985,8 @@ be reported." (dolist (backend vc-handled-backends) (and (vc-call-backend backend 'responsible-p file) (throw 'found backend)))) - (error "No VC backend is responsible for %s" file))) + (unless no-error + (error "No VC backend is responsible for %s" file)))) (defun vc-expand-dirs (file-or-dir-list backend) "Expands directories in a file list specification. @@ -1006,35 +1017,47 @@ Within directories, only files already under version control are noticed." (declare-function vc-dir-current-file "vc-dir" ()) (declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) +(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing)) -(defun vc-deduce-fileset (&optional observer allow-unregistered +(defun vc-deduce-fileset (&optional not-state-changing + allow-unregistered state-model-only-files) "Deduce a set of files and a backend to which to apply an operation. -Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL). +Return a list of the form: + + (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL) -If we're in VC-dir mode, FILESET is the list of marked files, -or the directory if no files are marked. -Otherwise, if in a buffer visiting a version-controlled file, -FILESET is a single-file fileset containing that file. +where the last 3 members are optional, and must be present only if +STATE-MODEL-ONLY-FILES is non-nil. + +NOT-STATE-CHANGING, if non-nil, means that the operation +requesting the fileset doesn't intend to change the VC state, +such as when printing the log or showing the diffs. + +If the current buffer is in `vc-dir' or Dired mode, FILESET is the +list of marked files, or the current directory if no files are +marked. +Otherwise, if the current buffer is visiting a version-controlled +file, FILESET is a single-file list containing that file's name. Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file -is unregistered, FILESET is a single-file fileset containing it. +is unregistered, FILESET is a single-file list containing the +name of the visited file. Otherwise, throw an error. -STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs -the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that -part may be skipped. +STATE-MODEL-ONLY-FILES, if non-nil, means that the caller needs +the FILESET-ONLY-FILES, STATE, and CHECKOUT-MODEL info, where +FILESET-ONLY-FILES means only files in similar VC states, +possible values of STATE are explained in `vc-state', and MODEL in +`vc-checkout-model'. Otherwise, these 3 members may be omitted from +the returned list. BEWARE: this function may change the current buffer." - ;; FIXME: OBSERVER is unused. The name is not intuitive and is not - ;; documented. It's set to t when called from diff and print-log. (let (backend) (cond ((derived-mode-p 'vc-dir-mode) (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) - (if observer - (vc-dired-deduce-fileset) - (error "State changing VC operations not supported in `dired-mode'"))) + (dired-vc-deduce-fileset state-model-only-files not-state-changing)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -1046,15 +1069,14 @@ BEWARE: this function may change the current buffer." ;; FIXME: Why this test? --Stef (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer - (derived-mode-p 'vc-dir-mode)))) + (or (derived-mode-p 'vc-dir-mode) + (derived-mode-p 'dired-mode))))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) - (vc-deduce-fileset observer allow-unregistered state-model-only-files))) - ((and (derived-mode-p 'log-view-mode) + (vc-deduce-fileset not-state-changing allow-unregistered state-model-only-files))) + ((and (not buffer-file-name) (setq backend (vc-responsible-backend default-directory))) (list backend nil)) - ((not buffer-file-name) - (error "Buffer %s is not associated with a file" (buffer-name))) ((and allow-unregistered (not (vc-registered buffer-file-name))) (if state-model-only-files (list (vc-backend-for-registration (buffer-file-name)) @@ -1066,10 +1088,6 @@ BEWARE: this function may change the current buffer." (list buffer-file-name)))) (t (error "File is not under version control"))))) -(defun vc-dired-deduce-fileset () - (list (vc-responsible-backend default-directory) - (dired-map-over-marks (dired-get-filename nil t) nil))) - (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." (cond @@ -2537,15 +2555,17 @@ with its diffs (if the underlying VCS supports that)." ;;;###autoload (defun vc-print-branch-log (branch) - "Show the change log for BRANCH in a window." + "Show the change log for BRANCH root in a window." (interactive (list (vc-read-revision "Branch to log: "))) (when (equal branch "") (error "No branch specified")) - (vc-print-log-internal (vc-responsible-backend default-directory) - (list default-directory) branch t - (when (> vc-log-show-limit 0) vc-log-show-limit))) + (let* ((backend (vc-responsible-backend default-directory)) + (rootdir (vc-call-backend backend 'root default-directory))) + (vc-print-log-internal backend + (list rootdir) branch t + (when (> vc-log-show-limit 0) vc-log-show-limit)))) ;;;###autoload (defun vc-log-incoming (&optional remote-location) |