diff options
Diffstat (limited to 'lisp/vc/vc.el')
| -rw-r--r-- | lisp/vc/vc.el | 279 |
1 files changed, 213 insertions, 66 deletions
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 353299cbed9..4cac1539289 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1992-1998, 2000-2019 Free Software Foundation, Inc. -;; Author: FSF (see below for full credits) +;; Author: FSF (see below for full credits) ;; Maintainer: emacs-devel@gnu.org ;; Keywords: vc tools @@ -337,6 +337,10 @@ ;; Insert in BUFFER the revision log for the changes that will be ;; received when performing a pull operation from REMOTE-LOCATION. ;; +;; - log-search (pattern) +;; +;; Search for PATTERN in the revision log. +;; ;; - log-view-mode () ;; ;; Mode to use for the output of print-log. This defaults to @@ -429,6 +433,10 @@ ;; - region-history-mode () ;; ;; Major mode to use for the output of `region-history'. +;; +;; - mergebase (rev1 &optional rev2) +;; +;; Return the common ancestor between REV1 and REV2 revisions. ;; TAG SYSTEM ;; @@ -729,13 +737,6 @@ "Emacs interface to version control systems." :group 'tools) -(defcustom vc-initial-comment nil - "If non-nil, prompt for initial comment when a file is registered." - :type 'boolean - :group 'vc) - -(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2") - (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]." @@ -743,8 +744,7 @@ These are passed to the checkin program by \\[vc-checkin]." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") - string)) - :group 'vc) + string))) (defcustom vc-checkout-switches nil "A string or list of strings specifying extra switches for checkout. @@ -753,8 +753,7 @@ These are passed to the checkout program by \\[vc-checkout]." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") - string)) - :group 'vc) + string))) (defcustom vc-register-switches nil "A string or list of strings; extra switches for registering a file. @@ -763,8 +762,7 @@ These are passed to the checkin program by \\[vc-register]." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") - string)) - :group 'vc) + string))) (defcustom vc-diff-switches nil "A string or list of strings specifying switches for diff under VC. @@ -779,7 +777,6 @@ not specific to any particular backend." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :group 'vc :version "21.1") (defcustom vc-annotate-switches nil @@ -799,15 +796,13 @@ for the backend you use." (const :tag "None" t) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) - :group 'vc :version "25.1") (defcustom vc-log-show-limit 2000 "Limit the number of items shown by the VC log commands. Zero means unlimited. Not all VC backends are able to support this feature." - :type 'integer - :group 'vc) + :type 'integer) (defcustom vc-allow-async-revert nil "Specifies whether the diff during \\[vc-revert] may be asynchronous. @@ -815,7 +810,6 @@ Enabling this option means that you can confirm a revert operation even if the local changes in the file have not been found and displayed yet." :type '(choice (const :tag "No" nil) (const :tag "Yes" t)) - :group 'vc :version "22.1") ;;;###autoload @@ -823,7 +817,6 @@ if the local changes in the file have not been found and displayed yet." "Normal hook (list of functions) run after checking out a file. See `run-hooks'." :type 'hook - :group 'vc :version "21.1") ;;;###autoload @@ -831,20 +824,22 @@ See `run-hooks'." "Normal hook (list of functions) run after commit or file checkin. See also `log-edit-done-hook'." :type 'hook - :options '(log-edit-comment-to-change-log) - :group 'vc) + :options '(log-edit-comment-to-change-log)) ;;;###autoload (defcustom vc-before-checkin-hook nil "Normal hook (list of functions) run before a commit or a file checkin. See `run-hooks'." + :type 'hook) + +(defcustom vc-retrieve-tag-hook nil + "Normal hook (list of functions) run after retrieving a tag." :type 'hook - :group 'vc) + :version "27.1") (defcustom vc-revert-show-diff t "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying." :type 'boolean - :group 'vc :version "24.1") ;; Header-insertion hair @@ -857,8 +852,7 @@ A %s in the template is replaced with the first string associated with the file's version control type in `vc-BACKEND-header'." :type '(repeat (cons :format "%v" (regexp :tag "File Type") - (string :tag "Header String"))) - :group 'vc) + (string :tag "Header String")))) (defcustom vc-comment-alist '((nroff-mode ".\\\"" "")) @@ -869,8 +863,12 @@ is sensitive to blank lines." :type '(repeat (list :format "%v" (symbol :tag "Mode") (string :tag "Comment Start") - (string :tag "Comment End"))) - :group 'vc) + (string :tag "Comment End")))) + +(defcustom vc-find-revision-no-save nil + "If non-nil, `vc-find-revision' doesn't write the created buffer to file." + :type 'boolean + :version "27.1") ;; File property caching @@ -935,7 +933,7 @@ use." ;; 'create-repo method. (completing-read (format "%s is not in a version controlled directory.\nUse VC backend: " file) - (mapcar 'symbol-name possible-backends) nil t))) + (mapcar #'symbol-name possible-backends) nil t))) (repo-dir (let ((def-dir (file-name-directory file))) ;; read the directory where to create the @@ -988,6 +986,7 @@ Within directories, only files already under version control are noticed." (defvar log-view-vc-backend) (defvar log-edit-vc-backend) (defvar diff-vc-backend) +(defvar diff-vc-revisions) (defun vc-deduce-backend () (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) @@ -1062,27 +1061,27 @@ BEWARE: this function may change the current buffer." (t (error "File is not under version control"))))) (defun vc-dired-deduce-fileset () - (let ((backend (vc-responsible-backend default-directory))) - (unless backend (error "Directory not under VC")) - (list backend - (dired-map-over-marks (dired-get-filename nil t) nil)))) + (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 ((derived-mode-p 'vc-dir-mode) (set-buffer (find-file-noselect (vc-dir-current-file)))) + ((derived-mode-p 'dired-mode) + (set-buffer (find-file-noselect (dired-get-filename)))) (t (while (and vc-parent-buffer (buffer-live-p vc-parent-buffer) ;; Avoid infinite looping when vc-parent-buffer and ;; current buffer are the same buffer. (not (eq vc-parent-buffer (current-buffer)))) - (set-buffer vc-parent-buffer)) - (if (not buffer-file-name) - (error "Buffer %s is not associated with a file" (buffer-name)) - (unless (vc-backend buffer-file-name) - (error "File %s is not under version control" buffer-file-name)))))) + (set-buffer vc-parent-buffer)))) + (if (not buffer-file-name) + (error "Buffer %s is not associated with a file" (buffer-name)) + (unless (vc-backend buffer-file-name) + (error "File %s is not under version control" buffer-file-name)))) ;;; Support for the C-x v v command. ;; This is where all the single-file-oriented code from before the fileset @@ -1103,7 +1102,7 @@ BEWARE: this function may change the current buffer." (defun vc-read-backend (prompt) (intern - (completing-read prompt (mapcar 'symbol-name vc-handled-backends) + (completing-read prompt (mapcar #'symbol-name vc-handled-backends) nil 'require-match))) ;; Here's the major entry point. @@ -1361,7 +1360,7 @@ first backend that could register the file is used." (set-buffer-modified-p t)) (vc-buffer-sync))))) (message "Registering %s... " files) - (mapc 'vc-file-clearprops files) + (mapc #'vc-file-clearprops files) (vc-call-backend backend 'register files comment) (mapc (lambda (file) @@ -1488,7 +1487,8 @@ After check-out, runs the normal hook `vc-checkout-hook'." nil) 'up-to-date 'edited)) - (vc-checkout-time . ,(nth 5 (file-attributes file)))))) + (vc-checkout-time . ,(file-attribute-modification-time + (file-attributes file)))))) (vc-resynch-buffer file t t) (run-hooks 'vc-checkout-hook)) @@ -1542,8 +1542,7 @@ The optional argument REV may be a string specifying the new revision level (only supported for some older VCSes, like RCS and CVS). Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." - (when vc-before-checkin-hook - (run-hooks 'vc-before-checkin-hook)) + (run-hooks 'vc-before-checkin-hook) (vc-start-logentry files comment initial-contents "Enter a change comment." @@ -1563,9 +1562,10 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; not a well-defined concept for filesets. (progn (vc-call-backend backend 'checkin files comment rev) - (mapc 'vc-delete-automatic-version-backups files)) + (mapc #'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-checkout-time . ,(file-attribute-modification-time + (file-attributes file))) (vc-working-revision . nil))) (message "Checking in %s...done" (vc-delistify files))) 'vc-checkin-hook @@ -1649,11 +1649,6 @@ to override the value of `vc-diff-switches' and `diff-switches'." ;; any switches in diff-switches. (when (listp switches) switches)))) -;; Old def for compatibility with Emacs-21.[123]. -(defmacro vc-diff-switches-list (backend) - (declare (obsolete vc-switches "22.1")) - `(vc-switches ',backend 'diff)) - (defun vc-diff-finish (buffer messages) ;; The empty sync output case has already been handled, so the only ;; possibility of an empty output is for an async process. @@ -1725,7 +1720,7 @@ Return t if the buffer had changes, nil otherwise." (error "No revisions of %s exist" file) ;; We regard this as "changed". ;; Diff it against /dev/null. - (apply 'vc-do-command buffer + (apply #'vc-do-command buffer (if async 'async 1) "diff" file (append (vc-switches nil 'diff) '("/dev/null")))))) (setq files (nreverse filtered)))) @@ -1733,6 +1728,7 @@ Return t if the buffer had changes, nil otherwise." (set-buffer buffer) (diff-mode) (set (make-local-variable 'diff-vc-backend) (car vc-fileset)) + (set (make-local-variable 'diff-vc-revisions) (list rev1 rev2)) (set (make-local-variable 'revert-buffer-function) (lambda (_ignore-auto _noconfirm) (vc-diff-internal async vc-fileset rev1 rev2 verbose))) @@ -1774,9 +1770,9 @@ Return t if the buffer had changes, nil otherwise." nil nil initial-input 'vc-revision-history default) (read-string prompt initial-input nil default)))) -(defun vc-diff-build-argument-list-internal () +(defun vc-diff-build-argument-list-internal (&optional fileset) "Build argument list for calling internal diff functions." - (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef + (let* ((vc-fileset (or fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef (files (cadr vc-fileset)) (backend (car vc-fileset)) (first (car files)) @@ -1830,6 +1826,32 @@ state of each file in the fileset." (called-interactively-p 'interactive))) ;;;###autoload +(defun vc-root-version-diff (_files rev1 rev2) + "Report diffs between REV1 and REV2 revisions of the whole tree." + (interactive + (vc-diff-build-argument-list-internal + (or (ignore-errors (vc-deduce-fileset t)) + (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory)))) + (list backend (list (vc-call-backend backend 'root default-directory))))))) + ;; This is a mix of `vc-root-diff' and `vc-version-diff' + (when (and (not rev1) rev2) + (error "Not a valid revision range")) + (let ((backend (vc-deduce-backend)) + (default-directory default-directory) + rootdir) + (if backend + (setq rootdir (vc-call-backend backend 'root default-directory)) + (setq rootdir (read-directory-name "Directory for VC root-diff: ")) + (setq backend (vc-responsible-backend rootdir)) + (if backend + (setq default-directory rootdir) + (error "Directory is not version controlled"))) + (let ((default-directory rootdir)) + (vc-diff-internal + t (list backend (list rootdir)) rev1 rev2 + (called-interactively-p 'interactive))))) + +;;;###autoload (defun vc-diff (&optional historic not-urgent) "Display diffs between file revisions. Normally this compares the currently selected fileset with their @@ -1845,6 +1867,33 @@ saving the buffer." (vc-diff-internal t (vc-deduce-fileset t) nil nil (called-interactively-p 'interactive)))) +;;;###autoload +(defun vc-diff-mergebase (_files rev1 rev2) + "Report diffs between the merge base of REV1 and REV2 revisions. +The merge base is a common ancestor between REV1 and REV2 revisions." + (interactive + (vc-diff-build-argument-list-internal + (or (ignore-errors (vc-deduce-fileset t)) + (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory)))) + (list backend (list (vc-call-backend backend 'root default-directory))))))) + (when (and (not rev1) rev2) + (error "Not a valid revision range")) + (let ((backend (vc-deduce-backend)) + (default-directory default-directory) + rootdir) + (if backend + (setq rootdir (vc-call-backend backend 'root default-directory)) + (setq rootdir (read-directory-name "Directory for VC root-diff: ")) + (setq backend (vc-responsible-backend rootdir)) + (if backend + (setq default-directory rootdir) + (error "Directory is not version controlled"))) + (let ((default-directory rootdir) + (rev1 (vc-call-backend backend 'mergebase rev1 rev2))) + (vc-diff-internal + t (list backend (list rootdir)) rev1 rev2 + (called-interactively-p 'interactive))))) + (declare-function ediff-load-version-control "ediff" (&optional silent)) (declare-function ediff-vc-internal "ediff-vers" (rev1 rev2 &optional startup-hooks)) @@ -1908,10 +1957,8 @@ The optional argument NOT-URGENT non-nil means it is ok to say no to saving the buffer." (interactive (list current-prefix-arg t)) (if historic - ;; FIXME: this does not work right, `vc-version-diff' ends up - ;; calling `vc-deduce-fileset' to find the files to diff, and - ;; that's not what we want here, we want the diff for the VC root dir. - (call-interactively 'vc-version-diff) + ;; We want the diff for the VC root dir. + (call-interactively 'vc-root-version-diff) (when buffer-file-name (vc-buffer-sync not-urgent)) (let ((backend (vc-deduce-backend)) (default-directory default-directory) @@ -1967,6 +2014,13 @@ If `F.~REV~' already exists, use it instead of checking it out again." (defun vc-find-revision (file revision &optional backend) "Read REVISION of FILE into a buffer and return the buffer. Use BACKEND as the VC backend if specified." + (if vc-find-revision-no-save + (vc-find-revision-no-save file revision backend) + (vc-find-revision-save file revision backend))) + +(defun vc-find-revision-save (file revision &optional backend) + "Read REVISION of FILE into a buffer and return the buffer. +Saves the buffer to the file." (let ((automatic-backup (vc-version-backup-file-name file revision)) (filebuf (or (get-file-buffer file) (current-buffer))) (filename (vc-version-backup-file-name file revision 'manual))) @@ -2002,6 +2056,51 @@ Use BACKEND as the VC backend if specified." (set (make-local-variable 'vc-parent-buffer) filebuf)) result-buf))) +(defun vc-find-revision-no-save (file revision &optional backend buffer) + "Read REVISION of FILE into BUFFER and return the buffer. +If BUFFER omitted or nil, this function creates a new buffer and sets +`buffer-file-name' to the name constructed from the file name and the +revision number. +Unlike `vc-find-revision-save', doesn't save the buffer to the file." + (let* ((buffer (when (buffer-live-p buffer) buffer)) + (filebuf (or buffer (get-file-buffer file) (current-buffer))) + (filename (unless buffer (vc-version-backup-file-name file revision 'manual)))) + (unless (and (not buffer) + (or (get-file-buffer filename) + (file-exists-p filename))) + (with-current-buffer filebuf + (let ((failed t)) + (unwind-protect + (with-current-buffer (or buffer (create-file-buffer filename)) + (unless buffer (setq buffer-file-name filename)) + (let ((outbuf (current-buffer))) + (with-current-buffer filebuf + (if backend + (vc-call-backend backend 'find-revision file revision outbuf) + (vc-call find-revision file revision outbuf)))) + (decode-coding-inserted-region (point-min) (point-max) file) + (after-insert-file-set-coding (- (point-max) (point-min))) + (goto-char (point-min)) + (if buffer + ;; For non-interactive, skip any questions + (let ((enable-local-variables :safe) ;; to find `mode:' + (buffer-file-name file)) + (ignore-errors (set-auto-mode))) + (normal-mode)) + (set-buffer-modified-p nil) + (setq buffer-read-only t)) + (setq failed nil) + (when (and failed (unless buffer (get-file-buffer filename))) + (with-current-buffer (get-file-buffer filename) + (set-buffer-modified-p nil)) + (kill-buffer (get-file-buffer filename))))))) + (let ((result-buf (or buffer + (get-file-buffer filename) + (find-file-noselect filename)))) + (with-current-buffer result-buf + (set (make-local-variable 'vc-parent-buffer) filebuf)) + result-buf))) + ;; Header-insertion code ;;;###autoload @@ -2108,6 +2207,7 @@ changes from the current branch." ;; `default-next-file' variable for its default file (M-n), and ;; we could then set it upon mark-resolve, so C-x C-s C-x C-f M-n would ;; automatically offer the next conflicted file. +;;;###autoload (defun vc-find-conflicted-file () "Visit the next conflicted file in the current project." (interactive) @@ -2178,7 +2278,8 @@ otherwise use the repository root of the current buffer. If NAME is empty, it refers to the latest revisions of the current branch. If locking is used for the files in DIR, then there must not be any locked files at or below DIR (but if NAME is empty, locked files are -allowed and simply skipped)." +allowed and simply skipped). +This function runs the hook `vc-retrieve-tag-hook' when finished." (interactive (let* ((granularity (vc-call-backend (vc-responsible-backend default-directory) @@ -2205,6 +2306,7 @@ allowed and simply skipped)." (vc-call-backend (vc-responsible-backend dir) 'retrieve-tag dir name update) (vc-resynch-buffer dir t t t) + (run-hooks 'vc-retrieve-tag-hook) (message "%s" (concat msg "done")))) @@ -2294,11 +2396,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." setup-buttons-func goto-location-func rev-buff-func) - (let (retval) - (with-current-buffer (get-buffer-create buffer-name) + (let (retval (buffer (get-buffer-create buffer-name))) + (with-current-buffer buffer (set (make-local-variable 'vc-log-view-type) type)) (setq retval (funcall backend-func backend buffer-name type files)) - (with-current-buffer (get-buffer buffer-name) + (with-current-buffer buffer (let ((inhibit-read-only t)) ;; log-view-mode used to be called with inhibit-read-only bound ;; to t, so let's keep doing it, just in case. @@ -2309,7 +2411,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." rev-buff-func))) ;; Display after setting up major-mode, so display-buffer-alist can know ;; the major-mode. - (pop-to-buffer buffer-name) + (pop-to-buffer buffer) (vc-run-delayed (let ((inhibit-read-only t)) (funcall setup-buttons-func backend files retval) @@ -2429,17 +2531,60 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION." "*vc-outgoing*" 'log-outgoing))) ;;;###autoload +(defun vc-log-search (pattern) + "Search the log of changes for PATTERN. + +PATTERN is usually interpreted as a regular expression. However, its +exact semantics is up to the backend's log search command; some can +only match fixed strings. + +Display all entries that match log messages in long format. +With a prefix argument, ask for a command to run that will output +log entries." + (interactive (list (unless current-prefix-arg + (read-regexp "Search log with pattern: ")))) + (let ((backend (vc-deduce-backend))) + (unless backend + (error "Buffer is not version controlled")) + (vc-incoming-outgoing-internal backend pattern + "*vc-search-log*" 'log-search))) + +;;;###autoload +(defun vc-log-mergebase (_files rev1 rev2) + "Show a log of changes between the merge base of REV1 and REV2 revisions. +The merge base is a common ancestor between REV1 and REV2 revisions." + (interactive + (vc-diff-build-argument-list-internal + (or (ignore-errors (vc-deduce-fileset t)) + (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory)))) + (list backend (list (vc-call-backend backend 'root default-directory))))))) + (let ((backend (vc-deduce-backend)) + (default-directory default-directory) + rootdir) + (if backend + (setq rootdir (vc-call-backend backend 'root default-directory)) + (setq rootdir (read-directory-name "Directory for VC root-log: ")) + (setq backend (vc-responsible-backend rootdir)) + (unless backend + (error "Directory is not version controlled"))) + (setq default-directory rootdir) + (setq rev1 (vc-call-backend backend 'mergebase rev1 rev2)) + (vc-print-log-internal backend (list rootdir) rev1 t (or rev2 "")))) + +;;;###autoload (defun vc-region-history (from to) "Show the history of the region between FROM and TO. If called interactively, show the history between point and mark." (interactive "r") - (let* ((lfrom (line-number-at-pos from)) - (lto (line-number-at-pos (1- to))) + (let* ((lfrom (line-number-at-pos from t)) + (lto (line-number-at-pos (1- to) t)) (file buffer-file-name) (backend (vc-backend file)) (buf (get-buffer-create "*VC-history*"))) + (unless backend + (error "Buffer is not version controlled")) (with-current-buffer buf (setq-local vc-log-view-type 'long)) (vc-call region-history file buf lfrom lto) @@ -2592,7 +2737,8 @@ its name; otherwise return nil." (vc-delete-automatic-version-backups file)) (vc-call revert file backup-file)) `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))))) + (vc-checkout-time . ,(file-attribute-modification-time + (file-attributes file))))) (vc-resynch-buffer file t t)) ;;;###autoload @@ -2703,7 +2849,8 @@ If called interactively, read FILE, defaulting to the current buffer's file name if it's under version control." (interactive (list (read-file-name "VC delete file: " nil (when (vc-backend buffer-file-name) - buffer-file-name) t))) + buffer-file-name) + t))) (setq file (expand-file-name file)) (let ((buf (get-file-buffer file)) (backend (vc-backend file))) |