diff options
author | Philip Kaludercic <philipk@posteo.net> | 2022-10-08 11:56:23 +0200 |
---|---|---|
committer | Philip Kaludercic <philipk@posteo.net> | 2022-10-08 11:56:23 +0200 |
commit | 8cfeb8a9e0f69e3cd11aebe03da876e1c713a85f (patch) | |
tree | 8c659b28a97749655e862647e84e8e1d58c2303e /lisp/vc | |
parent | bb2bd2ed91e123d66dfdf296a14e4cdd6739e2b6 (diff) | |
parent | 59df0a7bd9e54003108c938519d64f6607cf48d8 (diff) | |
download | emacs-8cfeb8a9e0f69e3cd11aebe03da876e1c713a85f.tar.gz emacs-8cfeb8a9e0f69e3cd11aebe03da876e1c713a85f.tar.bz2 emacs-8cfeb8a9e0f69e3cd11aebe03da876e1c713a85f.zip |
Merge branch 'master' into feature/package+vc
Diffstat (limited to 'lisp/vc')
-rw-r--r-- | lisp/vc/add-log.el | 4 | ||||
-rw-r--r-- | lisp/vc/diff-mode.el | 49 | ||||
-rw-r--r-- | lisp/vc/ediff-init.el | 2 | ||||
-rw-r--r-- | lisp/vc/ediff-wind.el | 8 | ||||
-rw-r--r-- | lisp/vc/log-edit.el | 20 | ||||
-rw-r--r-- | lisp/vc/log-view.el | 1 | ||||
-rw-r--r-- | lisp/vc/pcvs-util.el | 2 | ||||
-rw-r--r-- | lisp/vc/vc-bzr.el | 16 | ||||
-rw-r--r-- | lisp/vc/vc-cvs.el | 2 | ||||
-rw-r--r-- | lisp/vc/vc-dir.el | 12 | ||||
-rw-r--r-- | lisp/vc/vc-dispatcher.el | 276 | ||||
-rw-r--r-- | lisp/vc/vc-git.el | 238 | ||||
-rw-r--r-- | lisp/vc/vc-hg.el | 16 | ||||
-rw-r--r-- | lisp/vc/vc-hooks.el | 9 | ||||
-rw-r--r-- | lisp/vc/vc-svn.el | 2 | ||||
-rw-r--r-- | lisp/vc/vc.el | 337 |
16 files changed, 775 insertions, 219 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index d710578ffff..e3c0e2ca06d 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -208,8 +208,6 @@ a case simply use the directory containing the changed file." '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." :version "21.1") -(define-obsolete-face-alias 'change-log-acknowledgement - 'change-log-acknowledgment "24.3") (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") @@ -808,7 +806,7 @@ if it were to exist." (defun add-log-find-changelog-buffer (changelog-file-name) "Find a ChangeLog buffer for CHANGELOG-FILE-NAME. -Respect `add-log-use-pseudo-changelog', which see." +Respect `add-log--pseudo-changelog-buffer-name', which see." (if (or (file-exists-p changelog-file-name) (not add-log-dont-create-changelog-file)) (find-file-noselect changelog-file-name) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index e4a1996c1bb..a9591c9d82e 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -279,20 +279,21 @@ and hunk-based syntax highlighting otherwise as a fallback." :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." (key-description diff-minor-mode-prefix) diff-mode-shared-map) -(define-minor-mode diff-auto-refine-mode - "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). +(with-suppressed-warnings ((obsolete diff-auto-refine-mode)) + (define-minor-mode diff-auto-refine-mode + "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). Diff Auto Refine mode is a buffer-local minor mode used with `diff-mode'. When enabled, Emacs automatically highlights changes in detail as the user visits hunks. When transitioning from disabled to enabled, it tries to refine the current hunk, as well." - :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine" - (if diff-auto-refine-mode - (progn - (customize-set-variable 'diff-refine 'navigation) - (condition-case-unless-debug nil (diff-refine-hunk) (error nil))) - (customize-set-variable 'diff-refine nil))) + :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine" + (if diff-auto-refine-mode + (progn + (customize-set-variable 'diff-refine 'navigation) + (condition-case-unless-debug nil (diff-refine-hunk) (error nil))) + (customize-set-variable 'diff-refine nil)))) (make-obsolete 'diff-auto-refine-mode "set `diff-refine' instead." "27.1") (make-obsolete-variable 'diff-auto-refine-mode "set `diff-refine' instead." "27.1") @@ -633,7 +634,7 @@ See https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html") (when (looking-at regexp-hunk) ; Hunk header. (throw 'headerp (point))) (forward-line -1) - (when (re-search-forward regexp-file (point-at-eol 4) t) ; File header. + (when (re-search-forward regexp-file (line-end-position 4) t) ; File header. (forward-line 0) (throw 'headerp (point))) (goto-char orig) @@ -2336,10 +2337,22 @@ Call FUN with two args (BEG and END) for each hunk." (let ((inhibit-read-only t)) (undo arg))) +;;;###autoload +(defcustom diff-add-log-use-relative-names nil + "Use relative file names when generating ChangeLog skeletons. +The files will be relative to the root directory of the VC +repository. This option affects the behavior of +`diff-add-log-current-defuns'." + :type 'boolean + :safe #'booleanp + :version "29.1") + (defun diff-add-log-current-defuns () "Return an alist of defun names for the current diff. The elements of the alist are of the form (FILE . (DEFUN...)), -where DEFUN... is a list of function names found in FILE." +where DEFUN... is a list of function names found in FILE. If +`diff-add-log-use-relative-names' is non-nil, file names in the alist +are relative to the root directory of the VC repository." (save-excursion (goto-char (point-min)) (let* ((defuns nil) @@ -2373,7 +2386,12 @@ where DEFUN... is a list of function names found in FILE." ;; hunks (e.g., "diff --git ..." etc). (re-search-forward diff-hunk-header-re nil t) (setq hunk-end (save-excursion (diff-end-of-hunk))) - (pcase-let* ((filename (substring-no-properties (diff-find-file-name))) + (pcase-let* ((filename (substring-no-properties + (if diff-add-log-use-relative-names + (file-relative-name + (diff-find-file-name) + (vc-root-dir)) + (diff-find-file-name)))) (=lines 0) (+lines 0) (-lines 0) @@ -2928,6 +2946,15 @@ hunk text is not found in the source file." (forward-line 1))) (nreverse props))) +;;;###autoload +(defun diff-vc-deduce-fileset () + (let ((backend (vc-responsible-backend default-directory)) + files) + (save-excursion + (goto-char (point-min)) + (while (progn (diff-file-next) (not (eobp))) + (push (diff-find-file-name nil t) files))) + (list backend (nreverse files) nil nil 'patch))) (defun diff--filter-substring (str) (when diff-font-lock-prettify diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index a3e77200ddf..c956cdd2ee6 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -765,7 +765,7 @@ Ediff needs to find fine differences." "Set stipple pixmap of FACE to PIXMAP on a monochrome display." (if (and (display-graphic-p) (not (display-color-p))) (condition-case nil - (set-face-background-pixmap face pixmap) + (set-face-stipple face pixmap) (error (message "Pixmap not found for %S: %s" (face-name face) pixmap) (sit-for 1))))) diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index d45e13ea725..bd2e9f19773 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -36,14 +36,6 @@ :group 'ediff :group 'frames) - -;; Determine which window setup function to use based on current window system. -(defun ediff-choose-window-setup-function-automatically () - (declare (obsolete ediff-setup-windows-default "24.3")) - (if (display-graphic-p) - #'ediff-setup-windows-multiframe - #'ediff-setup-windows-plain)) - (defcustom ediff-window-setup-function #'ediff-setup-windows-default "Function called to set up windows. Ediff provides a choice of three functions: diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index e958673fea8..4624ada4179 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -325,6 +325,11 @@ automatically." (defface log-edit-summary '((t :inherit font-lock-function-name-face)) "Face for the summary in `log-edit-mode' buffers.") +(defface log-edit-headers-separator + '((t :height 0.1 :inverse-video t :extend t)) + "Face for the separator line in `log-edit-mode' buffers." + :version "29.1") + (defface log-edit-header '((t :inherit font-lock-keyword-face)) "Face for the headers in `log-edit-mode' buffers.") @@ -393,7 +398,7 @@ The first subexpression is the actual text of the field.") nil lax)) ("^\n" (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil - (0 '(face (:height 0.1 :inverse-video t :extend t) + (0 '(face log-edit-headers-separator display-line-numbers-disable t rear-nonsticky t)))) (log-edit--match-first-line (0 'log-edit-summary)))) @@ -664,6 +669,19 @@ comment history, see `log-edit-comment-ring', and hides `log-edit-files-buf'." (indent-rigidly (point) (point-max) (- log-edit-common-indent common))))) +(defvar vc-patch-string) + +(autoload 'vc-diff-patch-string "vc") +(defun log-edit-diff-patch () + (vc-diff-patch-string vc-patch-string)) + +(defvar vc-log-fileset) + +(defun log-edit-diff-fileset () + "Display diffs for the files to be committed." + (interactive) + (vc-diff nil nil (list log-edit-vc-backend vc-log-fileset))) + (defun log-edit-show-diff () "Show the diff for the files to be committed." (interactive) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 415b1564eda..7a710386fee 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -359,6 +359,7 @@ log entries." (overlay-put ov 'log-view-self ov) (overlay-put ov 'log-view-marked (nth 1 entry)))))))) +;;;###autoload (defun log-view-get-marked () "Return the list of tags for the marked log entries." (save-excursion diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 89f8d26880b..ddc3ea6e810 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -164,8 +164,6 @@ arguments. If ARGS is not a list, no argument will be passed." (if oneline (line-end-position) (point-max)))) (file-error nil))) -(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3") - ;;;; ;;;; file names ;;;; diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 743ee237a0f..307c5fa500d 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -339,7 +339,7 @@ in the repository root directory of FILE." "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") ;; To be called via vc-pull from vc.el, which requires vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) (declare-function vc-compilation-mode "vc-dispatcher" (backend)) @@ -1327,6 +1327,20 @@ stream. Standard error output is discarded." (match-string 1) (error "Cannot determine Bzr repository URL"))))) +(defun vc-bzr-prepare-patch (rev) + (with-current-buffer (generate-new-buffer " *vc-bzr-prepare-patch*") + (vc-bzr-command + "send" t 0 '() + "--revision" (concat (vc-bzr-previous-revision nil rev) ".." rev) + "--output" "-") + (let (subject) + ;; Extract the subject line + (goto-char (point-min)) + (search-forward-regexp "^[^#].*") + (setq subject (match-string 0)) + ;; Return the extracted data + (list :subject subject :buffer (current-buffer))))) + (provide 'vc-bzr) ;;; vc-bzr.el ends here diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 7d348240ba4..0ebc258b5be 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -545,7 +545,7 @@ Will fail unless you have administrative privileges on the repo." ;;; ;; Follows vc-cvs-command, which uses vc-do-command from vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (defun vc-cvs-print-log (files buffer &optional _shortlog _start-revision limit) "Print commit log associated with FILES into specified BUFFER. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 068a66b25b8..037de415e62 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -266,7 +266,7 @@ See `run-hooks'." :enable (vc-find-backend-function vc-dir-backend 'push) :help "Push the current branch's changes")) (define-key map [update] - '(menu-item "Update to Latest Version" vc-update + '(menu-item "Update to Latest Version" vc-pull :help "Update the current fileset's files to their tip revisions")) (define-key map [revert] '(menu-item "Revert to Base Version" vc-revert @@ -306,8 +306,8 @@ See `run-hooks'." (define-key map "=" #'vc-diff) ;; C-x v = (define-key map "D" #'vc-root-diff) ;; C-x v D (define-key map "i" #'vc-register) ;; C-x v i - (define-key map "+" #'vc-update) ;; C-x v + - ;; I'd prefer some kind of symmetry with vc-update: + (define-key map "+" #'vc-pull) ;; C-x v + + ;; I'd prefer some kind of symmetry with vc-pull: (define-key map "P" #'vc-push) ;; C-x v P (define-key map "l" #'vc-print-log) ;; C-x v l (define-key map "L" #'vc-print-root-log) ;; C-x v L @@ -356,10 +356,10 @@ See `run-hooks'." (define-key map "G" #'vc-dir-ignore) (let ((branch-map (make-sparse-keymap))) - (define-key map "B" branch-map) - (define-key branch-map "c" #'vc-create-tag) + (define-key map "b" branch-map) + (define-key branch-map "c" #'vc-create-branch) (define-key branch-map "l" #'vc-print-branch-log) - (define-key branch-map "s" #'vc-retrieve-tag)) + (define-key branch-map "s" #'vc-switch-branch)) (let ((mark-map (make-sparse-keymap))) (define-key map "*" mark-map) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index e2a490092b5..dc3ed526506 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -109,6 +109,8 @@ ;; TODO: ;; - log buffers need font-locking. +(eval-when-compile (require 'cl-lib)) + ;; General customization (defcustom vc-logentry-check-hook nil @@ -194,7 +196,7 @@ Another is that undo information is not kept." (defvar vc-sentinel-movepoint) ;Dynamically scoped. -(defun vc--process-sentinel (p code) +(defun vc--process-sentinel (p code &optional success) (let ((buf (process-buffer p))) ;; Impatient users sometime kill "slow" buffers; check liveness ;; to avoid "error in process sentinel: Selecting deleted buffer". @@ -215,7 +217,7 @@ Another is that undo information is not kept." ;; each sentinel read&set process-mark, but since `cmd' needs ;; to work both for async and sync processes, this would be ;; difficult to achieve. - (vc-exec-after code) + (vc-exec-after code success) (move-marker m (point))) ;; But sometimes the sentinels really want to move point. (when vc-sentinel-movepoint @@ -232,11 +234,14 @@ Another is that undo information is not kept." 'help-echo "A command is in progress in this buffer")))) -(defun vc-exec-after (code) +(defun vc-exec-after (code &optional success) "Eval CODE when the current buffer's process is done. If the current buffer has no process, just evaluate CODE. Else, add CODE to the process' sentinel. -CODE should be a function of no arguments." +CODE should be a function of no arguments. + +If SUCCESS, it should be a process object. Only run CODE if the +SUCCESS process has a zero exit code." (let ((proc (get-buffer-process (current-buffer)))) (cond ;; If there's no background process, just execute the code. @@ -247,13 +252,15 @@ CODE should be a function of no arguments." ((or (null proc) (eq (process-status proc) 'exit)) ;; Make sure we've read the process's output before going further. (when proc (accept-process-output proc)) - (if (functionp code) (funcall code) (eval code t))) + (when (or (not success) + (zerop (process-exit-status success))) + (if (functionp code) (funcall code) (eval code t)))) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) (vc-set-mode-line-busy-indicator) (letrec ((fun (lambda (p _msg) (remove-function (process-sentinel p) fun) - (vc--process-sentinel p code)))) + (vc--process-sentinel p code success)))) (add-function :after (process-sentinel proc) fun))) (t (error "Unexpected process state")))) nil) @@ -262,6 +269,13 @@ CODE should be a function of no arguments." (declare (indent 0) (debug (def-body))) `(vc-exec-after (lambda () ,@body))) +(defvar vc-filter-command-function #'list + "Function called to transform VC commands before execution. +The function is called inside the buffer in which the command +will be run and is passed the COMMAND, FILE-OR-LIST and FLAGS +arguments to `vc-do-command'. It should return a list of three +elements, the new values for these arguments.") + (defvar vc-post-command-functions nil "Hook run at the end of `vc-do-command'. Each function is called inside the buffer in which the command was run @@ -282,6 +296,23 @@ the man pages for \"torsocks\" for more details about Tor." :version "27.1" :group 'vc) +(defun vc-user-edit-command (command file-or-list flags) + "Prompt the user to edit VC command COMMAND and FLAGS. +Intended to be used as the value of `vc-filter-command-function'." + (let* ((files-separator-p (string= "--" (car (last flags)))) + (edited (split-string-and-unquote + (read-shell-command + (format "Edit VC command & arguments%s: " + (if file-or-list + " (files list to be appended)" + "")) + (combine-and-quote-strings + (cons command (remq nil (if files-separator-p + (butlast flags) + flags)))))))) + (list (car edited) file-or-list + (nconc (cdr edited) (and files-separator-p '("--")))))) + ;;;###autoload (defun vc-do-command (buffer okstatus command file-or-list &rest flags) "Execute a slave command, notifying user and checking for errors. @@ -296,117 +327,142 @@ FILE-OR-LIST is the name of a working file; it may be a list of files or be nil (to execute commands that don't expect a file name or set of files). If an optional list of FLAGS is present, that is inserted into the command line before the filename. + Return the return value of the slave command in the synchronous case, and the process object in the asynchronous case." - ;; FIXME: file-relative-name can return a bogus result because - ;; it doesn't look at the actual file-system to see if symlinks - ;; come into play. - (let* ((files - (mapcar (lambda (f) (file-relative-name (expand-file-name f))) - (if (listp file-or-list) file-or-list (list file-or-list)))) - ;; Keep entire commands in *Messages* but avoid resizing the - ;; echo area. Messages in this function are formatted in - ;; a such way that the important parts are at the beginning, - ;; due to potential truncation of long messages. - (message-truncate-lines t) - (full-command - (concat (if vc-tor "torsocks " "") - (if (string= (substring command -1) "\n") - (substring command 0 -1) - command) - " " (vc-delistify flags) - " " (vc-delistify files))) - (vc-inhibit-message - (or (eq vc-command-messages 'log) - (eq (selected-window) (active-minibuffer-window))))) + (let (;; Keep entire commands in *Messages* but avoid resizing the + ;; echo area. Messages in this function are formatted in + ;; a such way that the important parts are at the beginning, + ;; due to potential truncation of long messages. + (message-truncate-lines t) + (vc-inhibit-message + (or (eq vc-command-messages 'log) + (eq (selected-window) (active-minibuffer-window))))) (save-current-buffer (unless (or (eq buffer t) (and (stringp buffer) (string= (buffer-name) buffer)) (eq buffer (current-buffer))) - (vc-setup-buffer buffer)) - ;; If there's some previous async process still running, just kill it. - (let ((squeezed (remq nil flags)) - (inhibit-read-only t) - (status 0)) - (when files - (setq squeezed (nconc squeezed files))) - (let (;; Since some functions need to parse the output - ;; from external commands, set LC_MESSAGES to C. - (process-environment (cons "LC_MESSAGES=C" process-environment)) - (w32-quote-process-args t)) - (if (eq okstatus 'async) - ;; Run asynchronously. - (let ((proc - (let ((process-connection-type nil)) - (apply #'start-file-process command (current-buffer) - command squeezed)))) - (when vc-command-messages - (let ((inhibit-message vc-inhibit-message)) - (message "Running in background: %s" full-command))) - ;; Get rid of the default message insertion, in case we don't - ;; set a sentinel explicitly. - (set-process-sentinel proc #'ignore) - (set-process-filter proc #'vc-process-filter) - (setq status proc) - (when vc-command-messages - (vc-run-delayed - (let ((message-truncate-lines t) - (inhibit-message vc-inhibit-message)) - (message "Done in background: %s" full-command))))) - ;; Run synchronously - (when vc-command-messages - (let ((inhibit-message vc-inhibit-message)) - (message "Running in foreground: %s" full-command))) - (let ((buffer-undo-list t)) - (setq status (apply #'process-file command nil t nil squeezed))) - (when (and (not (eq t okstatus)) - (or (not (integerp status)) - (and okstatus (< okstatus status)))) - (unless (eq ?\s (aref (buffer-name (current-buffer)) 0)) - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer)) - (error "Failed (%s): %s" - (if (integerp status) (format "status %d" status) status) - full-command)) - (when vc-command-messages - (let ((inhibit-message vc-inhibit-message)) - (message "Done (status=%d): %s" status full-command))))) - (vc-run-delayed - (run-hook-with-args 'vc-post-command-functions - command file-or-list flags)) - status)))) + (vc-setup-buffer buffer)) + (cl-destructuring-bind (command file-or-list flags) + (funcall vc-filter-command-function command file-or-list flags) + (when vc-tor + (push command flags) + (setq command "torsocks")) + (let* (;; FIXME: file-relative-name can return a bogus result + ;; because it doesn't look at the actual file-system to + ;; see if symlinks come into play. + (files + (mapcar (lambda (f) + (file-relative-name (expand-file-name f))) + (if (listp file-or-list) + file-or-list + (list file-or-list)))) + (full-command + (concat (if (string= (substring command -1) "\n") + (substring command 0 -1) + command) + " " (vc-delistify flags) + " " (vc-delistify files))) + (squeezed (remq nil flags)) + (inhibit-read-only t) + (status 0)) + ;; If there's some previous async process still running, + ;; just kill it. + (when files + (setq squeezed (nconc squeezed files))) + (let (;; Since some functions need to parse the output + ;; from external commands, set LC_MESSAGES to C. + (process-environment + (cons "LC_MESSAGES=C" process-environment)) + (w32-quote-process-args t)) + (if (eq okstatus 'async) + ;; Run asynchronously. + (let ((proc + (let ((process-connection-type nil)) + (apply #'start-file-process command + (current-buffer) command squeezed)))) + (when vc-command-messages + (let ((inhibit-message vc-inhibit-message)) + (message "Running in background: %s" + full-command))) + ;; Get rid of the default message insertion, in case + ;; we don't set a sentinel explicitly. + (set-process-sentinel proc #'ignore) + (set-process-filter proc #'vc-process-filter) + (setq status proc) + (when vc-command-messages + (vc-run-delayed + (let ((message-truncate-lines t) + (inhibit-message vc-inhibit-message)) + (message "Done in background: %s" + full-command))))) + ;; Run synchronously + (when vc-command-messages + (let ((inhibit-message vc-inhibit-message)) + (message "Running in foreground: %s" full-command))) + (let ((buffer-undo-list t)) + (setq status (apply #'process-file + command nil t nil squeezed))) + (when (and (not (eq t okstatus)) + (or (not (integerp status)) + (and okstatus (< okstatus status)))) + (unless (eq ?\s (aref (buffer-name (current-buffer)) 0)) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (shrink-window-if-larger-than-buffer)) + (error "Failed (%s): %s" + (if (integerp status) + (format "status %d" status) + status) + full-command)) + (when vc-command-messages + (let ((inhibit-message vc-inhibit-message)) + (message "Done (status=%d): %s" + status full-command))))) + (vc-run-delayed + (run-hook-with-args 'vc-post-command-functions + command file-or-list flags)) + status))))) + +(defvar vc--inhibit-async-window nil) (defun vc-do-async-command (buffer root command &rest args) "Run COMMAND asynchronously with ARGS, displaying the result. Send the output to BUFFER, which should be a buffer or the name of a buffer, which is created. ROOT should be the directory in which the command should be run. +The process object is returned. Display the buffer in some window, but don't select it." - (let* ((dir default-directory) - (inhibit-read-only t) - window new-window-start) + (let ((dir default-directory) + (inhibit-read-only t) + new-window-start proc) (setq buffer (get-buffer-create buffer)) (if (get-buffer-process buffer) (error "Another VC action on %s is running" root)) (with-current-buffer buffer (setq default-directory root) - (goto-char (point-max)) - (unless (eq (point) (point-min)) - (insert "\n")) - (setq new-window-start (point)) - (insert "Running \"" command) - (dolist (arg args) - (insert " " arg)) - (insert "\"...\n") - ;; Run in the original working directory. - (let ((default-directory dir)) - (apply #'vc-do-command t 'async command nil args))) - (setq window (display-buffer buffer)) - (if window - (set-window-start window new-window-start)) - buffer)) + (let* (;; Run in the original working directory. + (default-directory dir) + (orig-fun vc-filter-command-function) + (vc-filter-command-function + (lambda (&rest args) + (cl-destructuring-bind (&whole args cmd _ flags) + (apply orig-fun args) + (goto-char (point-max)) + (unless (eq (point) (point-min)) + (insert "\n")) + (setq new-window-start (point)) + (insert "Running \"" cmd) + (dolist (flag flags) + (insert " " flag)) + (insert "\"...\n") + args)))) + (setq proc (apply #'vc-do-command t 'async command nil args)))) + (unless vc--inhibit-async-window + (when-let ((window (display-buffer buffer))) + (set-window-start window new-window-start))) + proc)) (defvar compilation-error-regexp-alist) @@ -624,6 +680,8 @@ NOT-URGENT means it is ok to continue if the user says not to save." (declare-function log-edit-empty-buffer-p "log-edit" ()) +(defvar vc-patch-string) + (defun vc-log-edit (fileset mode backend) "Set up `log-edit' for use on FILE." (setq default-directory @@ -653,15 +711,17 @@ NOT-URGENT means it is ok to continue if the user says not to save." (mapcar (lambda (file) (file-relative-name file root)) fileset)))) - (log-edit-diff-function . vc-diff) + (log-edit-diff-function + . ,(if vc-patch-string 'log-edit-diff-patch 'log-edit-diff-fileset)) (log-edit-vc-backend . ,backend) - (vc-log-fileset . ,fileset)) + (vc-log-fileset . ,fileset) + (vc-patch-string . ,vc-patch-string)) nil mode) (set-buffer-modified-p nil) (setq buffer-file-name nil)) -(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend) +(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend patch-string) "Accept a comment for an operation on FILES. If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the action on close to ACTION. If COMMENT is a string and @@ -673,7 +733,8 @@ empty comment. Remember the file's buffer in `vc-parent-buffer' \(current one if no file). Puts the log-entry buffer in major mode MODE, defaulting to `log-edit-mode' if MODE is nil. AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'. -BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." +BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer. +PATCH-STRING is a patch to check in." (let ((parent (if (vc-dispatcher-browsing) ;; If we are called from a directory browser, the parent buffer is @@ -688,6 +749,8 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." (setq-local vc-parent-buffer parent) (setq-local vc-parent-buffer-name (concat " from " (buffer-name vc-parent-buffer))) + (when patch-string + (setq-local vc-patch-string patch-string)) (vc-log-edit files mode backend) (make-local-variable 'vc-log-after-operation-hook) (when after-hook @@ -697,7 +760,11 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." (erase-buffer) (when (stringp comment) (insert comment))) (if (or (not comment) initial-contents) - (message "%s Type C-c C-c when done" msg) + (message (substitute-command-keys + (if (eq major-mode 'log-edit-mode) + "%s Type \\[log-edit-done] when done" + "%s Type \\`C-c C-c' when done")) + msg) (vc-finish-logentry (eq comment t))))) ;; vc-finish-logentry is typically called from a log-edit buffer (see @@ -753,7 +820,8 @@ the buffer contents as a comment." (defun vc-dispatcher-browsing () "Are we in a directory browser buffer?" (or (derived-mode-p 'vc-dir-mode) - (derived-mode-p 'dired-mode))) + (derived-mode-p 'dired-mode) + (derived-mode-p 'diff-mode))) ;; These are unused. ;; (defun vc-dispatcher-in-fileset-p (fileset) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index a5fd6b1413d..8ffe41758ed 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -53,7 +53,8 @@ ;; - responsible-p (file) OK ;; - receive-file (file rev) NOT NEEDED ;; - unregister (file) OK -;; * checkin (files rev comment) OK +;; * checkin (files comment rev) OK +;; - checkin-patch (patch-string comment) OK ;; * find-revision (file rev buffer) OK ;; * checkout (file &optional rev) OK ;; * revert (file &optional contents-done) OK @@ -81,7 +82,7 @@ ;; - annotate-time () OK ;; - annotate-current-time () NOT NEEDED ;; - annotate-extract-revision-at-line () OK -;; TAG SYSTEM +;; TAG/BRANCH SYSTEM ;; - create-tag (dir name branchp) OK ;; - retrieve-tag (dir name update) OK ;; MISCELLANEOUS @@ -94,6 +95,7 @@ ;; - find-file-hook () OK ;; - conflicted-files OK ;; - repository-url (file-or-dir) OK +;; - prepare-patch (rev) OK ;;; Code: @@ -127,6 +129,12 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." (repeat :tag "Argument List" :value ("") string)) :version "25.1") +;; Check if local value of `vc-git-annotate-switches' is safe. +;; Currently only "-w" (ignore whitespace) is considered safe, but +;; this list might be extended in the future (probably most options +;; are perfectly safe.) +;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable (lambda (switches) (equal switches "-w"))) + (defcustom vc-git-log-switches nil "String or list of strings specifying switches for Git log under VC." :type '(choice (const :tag "None" nil) @@ -617,7 +625,7 @@ or an empty string if none." ;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command ;; from vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) ;; Follows vc-exec-after. (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) @@ -857,6 +865,47 @@ The car of the list is the current branch." ;;; STATE-CHANGING FUNCTIONS +(defcustom vc-git-log-edit-summary-target-len nil + "Target length for Git commit summary lines. +If a number, characters in Summary: lines beyond this length are +displayed in the `vc-git-log-edit-summary-target-warning' face. +A value of any other type means no highlighting. + +By setting this to an integer around 50, you can improve the +compatibility of your commit messages with Git commands that +print the summary line in width-constrained contexts. However, +many commit summaries will need to exceed this length. + +See also `vc-git-log-edit-summary-max-len'." + :type '(choice (const :tag "No target" nil) + (natnum :tag "Target length")) + :safe (lambda (x) (or (not x) (natnump x)))) + +(defface vc-git-log-edit-summary-target-warning + '((t :inherit warning)) + "Face for Git commit summary lines beyond the target length. +See `vc-git-log-edit-summary-target-len'.") + +(defcustom vc-git-log-edit-summary-max-len 68 + "Maximum length for Git commit summary lines. +If a number, characters in summary lines beyond this length are +displayed in the `vc-git-log-edit-summary-max-warning' face. +A value of any other type means no highlighting. + +It is good practice to avoid writing summary lines longer than +this because otherwise the summary line will be truncated in many +contexts in which Git commands display summary lines. + +See also `vc-git-log-edit-summary-target-len'." + :type '(choice (const :tag "No target" nil) + (natnum :tag "Target length")) + :safe (lambda (x) (or (not x) (natnump x)))) + +(defface vc-git-log-edit-summary-max-warning + '((t :inherit error)) + "Face for Git commit summary lines beyond the maximum length. +See `vc-git-log-edit-summary-max-len'.") + (defun vc-git-create-repo () "Create a new Git repository." (vc-git-command nil 0 nil "init")) @@ -910,9 +959,38 @@ If toggling on, also insert its message into the buffer." "C-c C-n" #'vc-git-log-edit-toggle-no-verify "C-c C-e" #'vc-git-log-edit-toggle-amend) +(defun vc-git--log-edit-summary-check (limit) + (and (re-search-forward "^Summary: " limit t) + (when-let ((regex + (cond ((and (natnump vc-git-log-edit-summary-max-len) + (natnump vc-git-log-edit-summary-target-len)) + (format ".\\{,%d\\}\\(.\\{,%d\\}\\)\\(.*\\)" + vc-git-log-edit-summary-target-len + (- vc-git-log-edit-summary-max-len + vc-git-log-edit-summary-target-len))) + ((natnump vc-git-log-edit-summary-max-len) + (format ".\\{,%d\\}\\(?2:.*\\)" + vc-git-log-edit-summary-max-len)) + ((natnump vc-git-log-edit-summary-target-len) + (format ".\\{,%d\\}\\(.*\\)" + vc-git-log-edit-summary-target-len))))) + (re-search-forward regex limit t)))) + (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git" "Major mode for editing Git log messages. -It is based on `log-edit-mode', and has Git-specific extensions.") +It is based on `log-edit-mode', and has Git-specific extensions." + (setq-local + log-edit-font-lock-keywords + (append log-edit-font-lock-keywords + '((vc-git--log-edit-summary-check + (1 'vc-git-log-edit-summary-target-warning prepend t) + (2 'vc-git-log-edit-summary-max-warning prepend t)))))) + +(defvar vc-git-patch-string nil) + +(defun vc-git-checkin-patch (patch-string comment) + (let ((vc-git-patch-string patch-string)) + (vc-git-checkin nil comment))) (defun vc-git-checkin (files comment &optional _rev) (let* ((file1 (or (car files) default-directory)) @@ -936,12 +1014,45 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (if (eq system-type 'windows-nt) (let ((default-directory (file-name-directory file1))) (make-nearby-temp-file "git-msg"))))) + (when vc-git-patch-string + (unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet")) + ;; Check that all staged changes also exist in the patch. + ;; This is needed to allow adding/removing files that are + ;; currently staged to the index. So remove the whole file diff + ;; from the patch because commit will take it from the index. + (with-temp-buffer + (vc-git-command (current-buffer) t nil "diff" "--cached") + (goto-char (point-min)) + (let ((pos (point)) file-diff file-beg) + (while (not (eobp)) + (forward-line 1) ; skip current "diff --git" line + (search-forward "diff --git" nil 'move) + (move-beginning-of-line 1) + (setq file-diff (buffer-substring pos (point))) + (if (and (setq file-beg (string-search + file-diff vc-git-patch-string)) + ;; Check that file diff ends with an empty string + ;; or the beginning of the next file diff. + (string-match-p "\\`\\'\\|\\`diff --git" + (substring + vc-git-patch-string + (+ file-beg (length file-diff))))) + (setq vc-git-patch-string + (string-replace file-diff "" vc-git-patch-string)) + (user-error "Index not empty")) + (setq pos (point)))))) + (let ((patch-file (make-temp-file "git-patch"))) + (with-temp-file patch-file + (insert vc-git-patch-string)) + (unwind-protect + (vc-git-command nil 0 patch-file "apply" "--cached") + (delete-file patch-file)))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) ;; When operating on the whole tree, better pass "-a" than ".", since "." ;; fails when we're committing a merge. - (apply #'vc-git-command nil 0 (if only files) + (apply #'vc-git-command nil 0 (if (and only (not vc-git-patch-string)) files) (nconc (if msg-file (list "commit" "-F" (file-local-name msg-file)) (list "commit" "-m")) @@ -959,7 +1070,8 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (write-region (car args) nil msg-file)) (setq args (cdr args))) args) - (if only (list "--only" "--") '("-a"))))) + (unless vc-git-patch-string + (if only (list "--only" "--") '("-a")))))) (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)))) (defun vc-git-find-revision (file rev buffer) @@ -1006,31 +1118,37 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (defun vc-git--pushpull (command prompt extra-args) "Run COMMAND (a string; either push or pull) on the current Git branch. If PROMPT is non-nil, prompt for the Git command to run." + (require 'vc-dispatcher) (let* ((root (vc-git-root default-directory)) (buffer (format "*vc-git : %s*" (expand-file-name root))) - (git-program vc-git-program) - args) - ;; If necessary, prompt for the exact command. - ;; TODO if pushing, prompt if no default push location - cf bzr. - (when prompt - (setq args (split-string - (read-shell-command - (format "Git %s command: " command) - (format "%s %s" git-program command) - 'vc-git-history) - " " t)) - (setq git-program (car args) - command (cadr args) - args (cddr args))) - (setq args (nconc args extra-args)) - (require 'vc-dispatcher) - (apply #'vc-do-async-command buffer root git-program command args) + (git-program vc-git-program) + ;; TODO if pushing, prompt if no default push location - cf bzr. + (vc-filter-command-function + (if prompt + (lambda (&rest args) + (cl-destructuring-bind (&whole args git _ flags) + (apply #'vc-user-edit-command args) + (setq git-program git + command (car flags) + extra-args (cdr flags)) + args)) + vc-filter-command-function)) + (proc (apply #'vc-do-async-command + buffer root git-program command extra-args))) + ;; "git pull" includes progress output that uses ^M to move point + ;; to the beginning of the line. Just translate these to newlines + ;; (but don't do anything with the CRLF sequence). + (add-function :around (process-filter proc) + (lambda (filter process string) + (funcall filter process + (replace-regexp-in-string "\r\\(\\'\\|[^\n]\\)" + "\n\\1" string)))) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) (setq-local compile-command (concat git-program " " command " " - (mapconcat #'identity args " "))) + (mapconcat #'identity extra-args " "))) (setq-local compilation-directory root) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. @@ -1039,7 +1157,8 @@ If PROMPT is non-nil, prompt for the Git command to run." (list compile-command nil (lambda (_name-of-mode) buffer) nil)))) - (vc-set-async-update buffer))) + (vc-set-async-update buffer) + proc)) (defun vc-git-pull (prompt) "Pull changes into the current Git branch. @@ -1053,6 +1172,25 @@ Normally, this runs \"git push\". If PROMPT is non-nil, prompt for the Git command to run." (vc-git--pushpull "push" prompt nil)) +(defun vc-git-pull-and-push (prompt) + "Pull changes into the current Git branch, and then push. +The push will only be performed if the pull was successful. + +Normally, this runs \"git pull\". If PROMPT is non-nil, prompt +for the Git command to run." + (let ((proc (vc-git--pushpull "pull" prompt '("--stat")))) + (when (process-buffer proc) + (with-current-buffer (process-buffer proc) + (if (and (eq (process-status proc) 'exit) + (zerop (process-exit-status proc))) + (let ((vc--inhibit-async-window t)) + (vc-git-push nil)) + (vc-exec-after + (lambda () + (let ((vc--inhibit-async-window t)) + (vc-git-push nil))) + proc)))))) + (defun vc-git-merge-branch () "Merge changes into the current Git branch. This prompts for a branch to merge from." @@ -1212,7 +1350,12 @@ If LIMIT is a revision string, use it as an end-revision." (defun vc-git-log-incoming (buffer remote-location) (vc-setup-buffer buffer) - (vc-git-command nil 0 nil "fetch") + (vc-git-command nil 0 nil "fetch" + (unless (string= remote-location "") + ;; `remote-location' is in format "repository/branch", + ;; so remove everything except a repository name. + (replace-regexp-in-string + "/.*" "" remote-location))) (vc-git-command buffer 'async nil "log" @@ -1485,13 +1628,25 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (expand-file-name fname (vc-git-root default-directory)))) revision))))) -;;; TAG SYSTEM +;;; TAG/BRANCH SYSTEM + +(declare-function vc-read-revision "vc" + (prompt &optional files backend default initial-input)) (defun vc-git-create-tag (dir name branchp) - (let ((default-directory dir)) - (and (vc-git-command nil 0 nil "update-index" "--refresh") + (let ((default-directory dir) + (start-point (when branchp (vc-read-revision + (format-prompt "Start point" + (car (vc-git-branches))) + (list dir) 'Git)))) + (and (or (zerop (vc-git-command nil t nil "update-index" "--refresh")) + (y-or-n-p "Modified files exist. Proceed? ") + (user-error (format "Can't create %s with modified files" + (if branchp "branch" "tag")))) (if branchp - (vc-git-command nil 0 nil "checkout" "-b" name) + (vc-git-command nil 0 nil "checkout" "-b" name + (when (and start-point (not (eq start-point ""))) + start-point)) (vc-git-command nil 0 nil "tag" name))))) (defun vc-git-retrieve-tag (dir name _update) @@ -1591,6 +1746,29 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-root (file) (vc-find-root file ".git")) +(defun vc-git-prepare-patch (rev) + (with-current-buffer (generate-new-buffer " *vc-git-prepare-patch*") + (vc-git-command + t 0 '() "format-patch" + "--no-numbered" "--stdout" + ;; From gitrevisions(7): ^<n> means the <n>th parent + ;; (i.e. <rev>^ is equivalent to <rev>^1). As a + ;; special rule, <rev>^0 means the commit itself and + ;; is used when <rev> is the object name of a tag + ;; object that refers to a commit object. + (concat rev "^.." rev)) + (let (subject) + ;; Extract the subject line + (goto-char (point-min)) + (search-forward-regexp "^Subject: \\(.+\\)") + (setq subject (match-string 1)) + ;; Jump to the beginning for the patch + (search-forward-regexp "\n\n") + ;; Return the extracted data + (list :subject subject + :buffer (current-buffer) + :body-start (point))))) + ;; grep-compute-defaults autoloads grep. (declare-function grep-read-regexp "grep" ()) (declare-function grep-read-files "grep" (regexp)) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index a4ef7f35509..ee54f34201c 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -80,6 +80,7 @@ ;; - delete-file (file) TEST IT ;; - rename-file (old new) OK ;; - find-file-hook () added for bug#10709 +;; - prepare-patch (rev) OK ;; 2) Implement Stefan Monnier's advice: ;; vc-hg-registered and vc-hg-state @@ -907,7 +908,7 @@ if we don't understand a construct, we signal ;; should cover the common cases. Remember that we fall back ;; to regular hg commands if we see something we don't like. (save-restriction - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (cond ((looking-at "[ \t]*\\(?:#.*\\)?$")) ((looking-at "syntax:[ \t]*re[ \t]*$") (setf default-syntax 'vc-hg--hgignore-add-pcre)) @@ -1347,7 +1348,7 @@ REV is the revision to check out into WORKFILE." ;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command ;; from vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) ;; Follows vc-exec-after. (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) @@ -1509,6 +1510,17 @@ This runs the command \"hg merge\"." (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg))) (vc-set-async-update buffer))) +(defun vc-hg-prepare-patch (rev) + (with-current-buffer (generate-new-buffer " *vc-hg-prepare-patch*") + (vc-hg-command t 0 '() "export" "--rev" rev) + (let (subject) + ;; Extract the subject line + (goto-char (point-min)) + (search-forward-regexp "^[^#].*") + (setq subject (match-string 0)) + ;; Return the extracted data + (list :subject subject :buffer (current-buffer))))) + ;;; Internal functions (defun vc-hg-command (buffer okstatus file-or-list &rest flags) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1f0eeb7e18a..6ad26cfe674 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -857,6 +857,9 @@ In the latter case, VC mode is deactivated for this buffer." ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) (defvar-keymap vc-prefix-map "a" #'vc-update-change-log + "b c" #'vc-create-branch + "b l" #'vc-print-branch-log + "b s" #'vc-switch-branch "d" #'vc-dir "g" #'vc-annotate "G" #'vc-ignore @@ -879,13 +882,11 @@ In the latter case, VC mode is deactivated for this buffer." "=" #'vc-diff "D" #'vc-root-diff "~" #'vc-revision-other-window - "x" #'vc-delete-file) + "x" #'vc-delete-file + "!" #'vc-edit-next-command) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) -(with-suppressed-warnings ((obsolete vc-switch-backend)) - (keymap-set vc-prefix-map "b" #'vc-switch-backend)) - (defvar vc-menu-map (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 6a6e586e17e..1aebf30c2a3 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -207,7 +207,7 @@ switches." ;; dir-status-files called from vc-dir, which loads vc, ;; which loads vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) +(declare-function vc-exec-after "vc-dispatcher" (code &optional success)) (autoload 'vc-expand-dirs "vc") diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index fe0cb42e31b..14b149310c4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -247,6 +247,11 @@ ;; revision argument is only supported with some older VCSes, like ;; RCS and CVS, and is otherwise silently ignored. ;; +;; - checkin-patch (patch-string comment) +;; +;; Commit a single patch PATCH-STRING to this backend, bypassing +;; the changes in filesets. COMMENT is used as a check-in comment. +;; ;; * find-revision (file rev buffer) ;; ;; Fetch revision REV of file FILE and put it into BUFFER. @@ -444,7 +449,7 @@ ;; ;; Return the common ancestor between REV1 and REV2 revisions. -;; TAG SYSTEM +;; TAG/BRANCH SYSTEM ;; ;; - create-tag (dir name branchp) ;; @@ -459,8 +464,9 @@ ;; - retrieve-tag (dir name update) ;; ;; Retrieve the version tagged by NAME of all registered files at or below DIR. +;; If NAME is a branch name, switch to that branch. ;; If UPDATE is non-nil, then update buffers of any files in the -;; tag that are currently visited. The default implementation +;; tag/branch that are currently visited. The default implementation ;; does a sanity check whether there aren't any uncommitted changes at ;; or below DIR, and then performs a tree walk, using the `checkout' ;; function to retrieve the corresponding revisions. @@ -569,15 +575,20 @@ ;; remote (in Git parlance) whose URL is to be returned. It has ;; only a meaning for distributed VCS and is ignored otherwise. ;; +;; - prepare-patch (rev) +;; +;; Prepare a patch and return a property list with the keys +;; `:subject' indicating the patch message as a string, `:buffer' +;; with a buffer object that contains the entire patch message and +;; `:body-start' and `:body-end' demarcating what part of said +;; buffer should be inserted into an inline patch. If the two last +;; properties are omitted, `point-min' and `point-max' will +;; respectively be used instead. +;; ;; - clone (remote directory) ;; ;; Attempt to clone a REMOTE repository, into a local DIRECTORY. ;; Returns the symbol of the backend used if successful. -;; -;; - send-patch (addr &optional rev-list) -;; -;; Send a patch to ADDR - ;;; Changes from the pre-25.1 API: ;; @@ -669,8 +680,6 @@ ;; display the branch name in the mode-line. Replace ;; vc-cvs-sticky-tag with that. ;; -;; - Add a primitives for switching to a branch (creating it if required. -;; ;; - Add the ability to list tags and branches. ;; ;;;; Unify two different versions of the amend capability @@ -814,12 +823,12 @@ not specific to any particular backend." (defcustom vc-annotate-switches nil "A string or list of strings specifying switches for annotate under VC. When running annotate under a given BACKEND, VC uses the first -non-nil value of `vc-BACKEND-annotate-switches', `vc-annotate-switches', -and `annotate-switches', in that order. Since nil means to check the -next variable in the sequence, either of the first two may use -the value t to mean no switches at all. `vc-annotate-switches' -should contain switches that are specific to version control, but -not specific to any particular backend. +non-nil value of `vc-BACKEND-annotate-switches' and +`vc-annotate-switches', in that order. Since nil means to check +the next variable in the sequence, setting the first to the value +t means no switches at all. `vc-annotate-switches' should +contain switches that are specific to version control, but not +specific to any particular backend. As very few switches (if any) are used across different VC tools, please consider using the specific `vc-BACKEND-annotate-switches' @@ -1020,7 +1029,11 @@ responsible for the given file." (lambda (backend) (when-let ((dir (vc-call-backend backend 'responsible-p file))) - (cons backend dir))) + ;; We run DIR through `expand-file-name' + ;; so that abbreviated directories, such + ;; as "~/", wouldn't look "less specific" + ;; due to their artificially shorter length. + (cons backend (expand-file-name dir)))) vc-handled-backends)))) ;; Just a single response (or none); use it. (if (< (length dirs) 2) @@ -1055,7 +1068,8 @@ Within directories, only files already under version control are noticed." ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) ((derived-mode-p 'diff-mode) diff-vc-backend) ;; Maybe we could even use comint-mode rather than shell-mode? - ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode) + ((derived-mode-p + 'dired-mode 'shell-mode 'eshell-mode 'compilation-mode) (ignore-errors (vc-responsible-backend default-directory))) (vc-mode (vc-backend buffer-file-name)))) @@ -1112,6 +1126,8 @@ BEWARE: this function may change the current buffer." (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) (dired-vc-deduce-fileset state-model-only-files not-state-changing)) + ((derived-mode-p 'diff-mode) + (diff-vc-deduce-fileset)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -1124,7 +1140,8 @@ BEWARE: this function may change the current buffer." (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer (or (derived-mode-p 'vc-dir-mode) - (derived-mode-p 'dired-mode))))) + (derived-mode-p 'dired-mode) + (derived-mode-p 'diff-mode))))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) (vc-deduce-fileset-1 not-state-changing allow-unregistered state-model-only-files))) @@ -1240,6 +1257,8 @@ with, using the most specific one." (error "Fileset files are missing, so cannot be operated on")) ((eq state 'ignored) (error "Fileset files are ignored by the version-control system")) + ((eq model 'patch) + (vc-checkin files backend nil nil nil (buffer-string))) ((or (null state) (eq state 'unregistered)) (cond (verbose (let ((backend (vc-read-backend "Backend to register to: "))) @@ -1623,15 +1642,18 @@ Type \\[vc-next-action] to check in changes.") (format "I stole the lock on %s, " file-description) (current-time-string) ".\n") - (message "Please explain why you stole the lock. Type C-c C-c when done."))) + (message + (substitute-command-keys + "Please explain why you stole the lock. Type \\`C-c C-c' when done")))) -(defun vc-checkin (files backend &optional comment initial-contents rev) +(defun vc-checkin (files backend &optional comment initial-contents rev patch-string) "Check in FILES. COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment. If INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents of the log entry buffer. The optional argument REV may be a string specifying the new revision level (only supported for some older VCSes, like RCS and CVS). +The optional argument PATCH-STRING is a string to check in as a patch. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (run-hooks 'vc-before-checkin-hook) @@ -1653,7 +1675,9 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; vc-checkin-switches, but 'the' local buffer is ;; not a well-defined concept for filesets. (progn - (vc-call-backend backend 'checkin files comment rev) + (if patch-string + (vc-call-backend backend 'checkin-patch patch-string comment) + (vc-call-backend backend 'checkin files comment rev)) (mapc #'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) (vc-checkout-time . ,(file-attribute-modification-time @@ -1661,7 +1685,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-working-revision . nil))) (message "Checking in %s...done" (vc-delistify files))) 'vc-checkin-hook - backend)) + backend + patch-string)) ;;; Additional entry points for examining version histories @@ -1789,6 +1814,26 @@ objects, and finally killing buffer ORIGINAL." (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") +(defvar vc-patch-string nil) + +(defun vc-diff-patch-string (patch-string) + "Report diffs to be committed from the patch. +Like `vc-diff-internal' but uses PATCH-STRING to display +in the output buffer." + (let ((buffer "*vc-diff*")) + (vc-setup-buffer buffer) + (let ((buffer-undo-list t) + (inhibit-read-only t)) + (insert patch-string)) + (setq buffer-read-only t) + (diff-mode) + (setq-local diff-vc-backend (vc-responsible-backend default-directory)) + (setq-local revert-buffer-function + (lambda (_ _) (vc-diff-patch-string patch-string))) + (setq-local vc-patch-string patch-string) + (pop-to-buffer (current-buffer)) + (vc-run-delayed (vc-diff-finish (current-buffer) nil)))) + (defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer) "Report diffs between two revisions of a fileset. Output goes to the buffer BUFFER, which defaults to *vc-diff*. @@ -1880,19 +1925,29 @@ Return t if the buffer had changes, nil otherwise." (defvar vc-revision-history nil "History for `vc-read-revision'.") -(defun vc-read-revision (prompt &optional files backend default initial-input) +(defun vc-read-revision (prompt &optional files backend default initial-input multiple) (cond ((null files) (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef (setq files (cadr vc-fileset)) (setq backend (car vc-fileset)))) ((null backend) (setq backend (vc-backend (car files))))) - (let ((completion-table - (vc-call-backend backend 'revision-completion-table files))) + ;; Override any `vc-filter-command-function' value, as user probably + ;; doesn't want to edit the command to get the completions. + (let* ((vc-filter-command-function #'list) + (completion-table + (vc-call-backend backend 'revision-completion-table files))) (if completion-table - (completing-read prompt completion-table - nil nil initial-input 'vc-revision-history default) - (read-string prompt initial-input nil default)))) + (funcall + (if multiple #'completing-read-multiple #'completing-read) + prompt completion-table nil nil initial-input 'vc-revision-history default) + (let ((answer (read-string prompt initial-input nil default))) + (if multiple + (split-string answer "[ \t]*,[ \t]*") + answer))))) + +(defun vc-read-multiple-revisions (prompt &optional files backend default initial-input) + (vc-read-revision prompt files backend default initial-input t)) (defun vc-diff-build-argument-list-internal (&optional fileset) "Build argument list for calling internal diff functions." @@ -1978,19 +2033,20 @@ state of each file in the fileset." (when buffer-file-name (vc-buffer-sync not-urgent)))) ;;;###autoload -(defun vc-diff (&optional historic not-urgent) +(defun vc-diff (&optional historic not-urgent fileset) "Display diffs between file revisions. Normally this compares the currently selected fileset with their working revisions. With a prefix argument HISTORIC, it reads two revision designators specifying which revisions to compare. The optional argument NOT-URGENT non-nil means it is ok to say no to -saving the buffer." +saving the buffer. The optional argument FILESET can override the +deduced fileset." (interactive (list current-prefix-arg t)) (if historic (call-interactively 'vc-version-diff) (vc-maybe-buffer-sync not-urgent) - (let ((fileset (vc-deduce-fileset t))) + (let ((fileset (or fileset (vc-deduce-fileset t)))) (vc-buffer-sync-fileset fileset not-urgent) (vc-diff-internal t fileset nil nil (called-interactively-p 'interactive))))) @@ -2304,7 +2360,7 @@ changes from the current branch." ((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) + ((vc-find-backend-function backend 'merge-file) (vc-buffer-sync) (dolist (file files) (let* ((state (vc-state file)) @@ -2407,7 +2463,23 @@ checked out in that new branch." (message "Making %s... done" (if branchp "branch" "tag"))) ;;;###autoload -(defun vc-retrieve-tag (dir name) +(defun vc-create-branch (dir name) + "Descending recursively from DIR, make a branch called NAME. +After a new branch is made, the files are checked out in that new branch. +Uses `vc-create-tag' with the non-nil arg `branchp'." + (interactive + (let ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity))) + (list + (if (eq granularity 'repository) + default-directory + (read-directory-name "Directory: " default-directory default-directory t)) + (read-string "New branch name: " nil 'vc-revision-history)))) + (vc-create-tag dir name t)) + +;;;###autoload +(defun vc-retrieve-tag (dir name &optional branchp) "For each file in or below DIR, retrieve their tagged version NAME. NAME can name a branch, in which case this command will switch to the named branch in the directory DIR. @@ -2417,6 +2489,8 @@ 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). +If the prefix argument BRANCHP is given, switch the branch +and check out the files in that branch. This function runs the hook `vc-retrieve-tag-hook' when finished." (interactive (let* ((granularity @@ -2432,15 +2506,21 @@ This function runs the hook `vc-retrieve-tag-hook' when finished." (read-directory-name "Directory: " default-directory nil t)))) (list dir - (vc-read-revision (format-prompt "Tag name to retrieve" "latest revisions") + (vc-read-revision (format-prompt + (if current-prefix-arg + "Switch to branch" + "Tag name to retrieve") + "latest revisions") (list dir) - (vc-responsible-backend dir))))) + (vc-responsible-backend dir)) + current-prefix-arg))) (let* ((backend (vc-responsible-backend dir)) (update (when (vc-call-backend backend 'update-on-retrieve-tag) (yes-or-no-p "Update any affected buffers? "))) (msg (if (or (not name) (string= name "")) (format "Updating %s... " (abbreviate-file-name dir)) - (format "Retrieving tag %s into %s... " + (format "Retrieving %s %s into %s... " + (if branchp "branch" "tag") name (abbreviate-file-name dir))))) (message "%s" msg) (vc-call-backend backend 'retrieve-tag dir name update) @@ -2448,6 +2528,25 @@ This function runs the hook `vc-retrieve-tag-hook' when finished." (run-hooks 'vc-retrieve-tag-hook) (message "%s" (concat msg "done")))) +;;;###autoload +(defun vc-switch-branch (dir name) + "Switch to the branch NAME in the directory DIR. +If NAME is empty, it refers to the latest revisions of the current branch. +Uses `vc-retrieve-tag' with the non-nil arg `branchp'." + (interactive + (let* ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity)) + (dir + (if (eq granularity 'repository) + (expand-file-name (vc-root-dir)) + (read-directory-name "Directory: " default-directory nil t)))) + (list + dir + (vc-read-revision (format-prompt "Switch to branch" "latest revisions") + (list dir) + (vc-responsible-backend dir))))) + (vc-retrieve-tag dir name t)) ;; Miscellaneous other entry points @@ -2673,8 +2772,10 @@ with its diffs (if the underlying VCS supports that)." (defun vc-print-branch-log (branch) "Show the change log for BRANCH root in a window." (interactive - (list - (vc-read-revision "Branch to log: "))) + (let* ((backend (vc-responsible-backend default-directory)) + (rootdir (vc-call-backend backend 'root default-directory))) + (list + (vc-read-revision "Branch to log: " (list rootdir) backend)))) (when (equal branch "") (error "No branch specified")) (let* ((backend (vc-responsible-backend default-directory)) @@ -2686,10 +2787,11 @@ with its diffs (if the underlying VCS supports that)." ;;;###autoload (defun vc-log-incoming (&optional remote-location) "Show log of changes that will be received with pull from REMOTE-LOCATION. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION." +When called interactively with a prefix argument, prompt for REMOTE-LOCATION. +In some version control systems REMOTE-LOCATION can be a remote branch name." (interactive (when current-prefix-arg - (list (read-string "Remote location (empty for default): ")))) + (list (read-string "Remote location/branch (empty for default): ")))) (let ((backend (vc-deduce-backend))) (unless backend (error "Buffer is not version controlled")) @@ -2699,10 +2801,11 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION." ;;;###autoload (defun vc-log-outgoing (&optional remote-location) "Show log of changes that will be sent with a push operation to REMOTE-LOCATION. -When called interactively with a prefix argument, prompt for REMOTE-LOCATION." +When called interactively with a prefix argument, prompt for REMOTE-LOCATION. +In some version control systems REMOTE-LOCATION can be a remote branch name." (interactive (when current-prefix-arg - (list (read-string "Remote location (empty for default): ")))) + (list (read-string "Remote location/branch (empty for default): ")))) (let ((backend (vc-deduce-backend))) (unless backend (error "Buffer is not version controlled")) @@ -2889,6 +2992,28 @@ It also signals an error in a Bazaar bound branch." (vc-call-backend backend 'push arg) (user-error "VC push is unsupported for `%s'" backend)))) +;;;###autoload +(defun vc-pull-and-push (&optional arg) + "First pull, and then push the current branch. +The push will only be performed if the pull operation was successful. + +You must be visiting a version controlled file, or in a `vc-dir' buffer. + +On a distributed version control system, this runs a \"pull\" +operation on the current branch, prompting for the precise +command if required. Optional prefix ARG non-nil forces a prompt +for the VCS command to run. If this is successful, a \"push\" +operation will then be done. + +On a non-distributed version control system, this signals an error. +It also signals an error in a Bazaar bound branch." + (interactive "P") + (let* ((vc-fileset (vc-deduce-fileset t)) + (backend (car vc-fileset))) + (if (vc-find-backend-function backend 'pull-and-push) + (vc-call-backend backend 'pull-and-push arg) + (user-error "VC pull-and-push is unsupported for `%s'" backend)))) + (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. If version backups should be used for FILE, and there exists @@ -3134,6 +3259,132 @@ log entries should be gathered." (vc-call-backend (vc-responsible-backend default-directory) 'update-changelog args)) +(defvar vc-filter-command-function) + +;;;###autoload +(defun vc-edit-next-command () + "Request editing the next VC shell command before execution. +This is a prefix command. It affects only a VC command executed +immediately after this one." + (interactive) + (letrec ((minibuffer-depth (minibuffer-depth)) + (command this-command) + (keys (key-description (this-command-keys))) + (old vc-filter-command-function) + (echofun (lambda () keys)) + (postfun + (lambda () + (unless (or (eq this-command command) + (> (minibuffer-depth) minibuffer-depth)) + (remove-hook 'post-command-hook postfun) + (remove-hook 'prefix-command-echo-keystrokes-functions + echofun) + (setq vc-filter-command-function old))))) + (add-hook 'post-command-hook postfun) + (add-hook 'prefix-command-echo-keystrokes-functions echofun) + (setq vc-filter-command-function + (lambda (&rest args) + (apply #'vc-user-edit-command (apply old args)))))) + +(defcustom vc-prepare-patches-separately t + "Non-nil means that `vc-prepare-patch' creates a single message. +A single message is created by attaching all patches to the body +of a single message. If nil, each patch will be sent out in a +separate message, which will be prepared sequentially." + :type 'boolean + :safe #'booleanp + :version "29.1") + +(defcustom vc-default-patch-addressee nil + "Default addressee for `vc-prepare-patch'. +If nil, no default will be used. This option may be set locally." + :type '(choice (const :tag "No default" nil) + (string :tag "Addressee")) + :safe #'stringp + :version "29.1") + +(declare-function message--name-table "message" (orig-string)) +(declare-function mml-attach-buffer "mml" + (buffer &optional type description disposition)) +(declare-function log-view-get-marked "log-view" ()) + +(defun vc-default-prepare-patch (rev) + (let ((backend (vc-backend buffer-file-name))) + (with-current-buffer (generate-new-buffer " *vc-default-prepare-patch*") + (vc-diff-internal + nil (list backend) rev + (vc-call-backend backend 'previous-revision + buffer-file-name rev) + nil t) + (list :subject (concat "Patch for " + (file-name-nondirectory + (directory-file-name + (vc-root-dir)))) + :buffer (current-buffer))))) + +;;;###autoload +(defun vc-prepare-patch (addressee subject revisions) + "Compose an Email sending patches for REVISIONS to ADDRESSEE. +If `vc-prepare-patches-separately' is non-nil, SUBJECT will be used +as the default subject for the message. Otherwise a separate +message will be composed for each revision. + +When invoked interactively in a Log View buffer with marked +revisions, these revisions will be used." + (interactive + (let ((revs (or (log-view-get-marked) + (vc-read-multiple-revisions "Revisions: "))) + to) + (require 'message) + (while (null (setq to (completing-read-multiple + (format-prompt + "Addressee" + vc-default-patch-addressee) + (message--name-table "") + nil nil nil nil + vc-default-patch-addressee))) + (message "At least one addressee required.") + (sit-for blink-matching-delay)) + (list (string-join to ", ") + (and (not vc-prepare-patches-separately) + (read-string "Subject: " "[PATCH] " nil nil t)) + revs))) + (save-current-buffer + (vc-ensure-vc-buffer) + (let ((patches (mapcar (lambda (rev) + (vc-call-backend + (vc-responsible-backend default-directory) + 'prepare-patch rev)) + revisions))) + (if vc-prepare-patches-separately + (dolist (patch patches) + (compose-mail addressee + (plist-get patch :subject) + nil nil nil nil + `((kill-buffer ,(plist-get patch :buffer)) + (exit-recursive-edit))) + (rfc822-goto-eoh) (forward-line) + (save-excursion ;don't jump to the end + (insert-buffer-substring + (plist-get patch :buffer) + (plist-get patch :body-start) + (plist-get patch :body-end))) + (recursive-edit)) + (compose-mail addressee subject nil nil nil nil + (mapcar + (lambda (p) + (list #'kill-buffer (plist-get p :buffer))) + patches)) + (rfc822-goto-eoh) + (forward-line) + (save-excursion + (dolist (patch patches) + (mml-attach-buffer (buffer-name (plist-get patch :buffer)) + "text/x-patch" + (plist-get patch :subject) + "attachment"))) + (open-line 2))))) + (defun vc-default-responsible-p (_backend _file) "Indicate whether BACKEND is responsible for FILE. The default is to return nil always." @@ -3270,8 +3521,6 @@ If BACKEND is nil, iterate through every known backend in ;; These things should probably be generally available -(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3") - (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each VC-managed file f underneath it." |