Mercurial > emacs
changeset 111350:8027e412df98
Backport VC improvements from trunk.
* vc/log-edit.el (log-edit-rewrite-fixes): New var.
(log-edit-author): New dynamic var.
(log-edit-changelog-ours-p, log-edit-insert-changelog-entries):
Use it to return the author if different from committer.
(log-edit-insert-changelog): Use them to add Author: and Fixes headers.
* vc/vc-hooks.el (vc-default-mode-line-string): Doc fix.
* vc/vc.el (vc-deduce-backend): New fun. Handle diff buffers.
(vc-root-diff, vc-print-root-log, vc-log-incoming)
(vc-log-outgoing): Use it.
(vc-diff-internal): Set diff-vc-backend.
* vc/diff-mode.el (diff-vc-backend): New var.
* vc/vc.el (vc-diff-internal): Set `revert-buffer-function'
buffer-locally to lambda that re-runs the vc diff command.
(Bug#6447)
* vc/log-view.el (log-view-mode-map): Bind revert-buffer.
Make 'g' (AKA revert-buffer) rerun VC log, log-incoming and
log-outgoing commands.
* vc/vc.el (vc-log-internal-common): Add a new argument and use it
to create a buffer local revert-buffer-function variable.
(vc-print-log-internal, vc-log-incoming, vc-log-outgoing): Pass a
revert-buffer-function lambda.
Improve VC create/retrieve tag/branch.
* vc.el (vc-create-tag): Do not read the directory name for VCs
with repository revision granularity. Adjust the tag/branch
prompt. Reset VC properties.
(vc-retrieve-tag): Do not read the directory name for VCs
with repository revision granularity. Reset VC properties.
Add optional support for resetting VC properties.
* vc-dispatcher.el (vc-resynch-window): Add new optional argument,
call vc-file-clearprops when true.
(vc-resynch-buffer): Add new optional argument, pass it down.
(vc-resynch-buffers-in-directory): Likewise.
Improve support for special markup in the VC commit message.
* vc-mtn.el (vc-mtn-checkin): Support Author: and Date: markup.
* vc-hg.el (vc-hg-checkin): Add support for Date:.
* vc-git.el (vc-git-checkin):
* vc-bzr.el (vc-bzr-checkin): Likewise.
Add support for vc-log-incoming, improve vc-log-outgoing for Git.
* vc-git.el (vc-git-log-view-mode): Fix font lock for
incoming/outgoing logs.
(vc-git-log-outgoing, vc-git-log-incoming): New functions.
* vc-git.el (vc-git-log-outgoing): Use the same format as the
short log.
(vc-git-log-incoming): Likewise. Run "git fetch" before the log
command
Add bindings for vc-log-incoming and vc-log-outgoing.
* vc-hooks.el (vc-prefix-map): Add bindings for vc-log-incoming
and vc-log-outgoing.
* vc-dir.el (vc-dir-menu-map): Add menu bindings for vc-log-incoming
and vc-log-outgoing.
Improve state updating for VC tag commands.
* vc.el (vc-create-tag, vc-retrieve-tag): Call vc-resynch-buffer
to update the state of all buffers in the directory.
* vc-dir.el (vc-dir): Don't pop-up-windows. (Bug#6204)
* vc.el (vc-checkin, vc-modify-change-comment):
Adjust to new vc-start/finish-logentry.
(vc-find-conflicted-file): New command.
(vc-transfer-file): Adjust to new vc-checkin.
(vc-next-action): Improve scoping.
* vc-git.el (vc-git-checkin): Use log-edit-extract-headers.
(vc-git-commits-coding-system): Rename from git-commits-coding-system.
* vc-dispatcher.el (vc-log-edit): Shorten names for
log-edit-show-files.
* vc-bzr.el (vc-bzr-checkin): Use log-edit-extract-headers.
(vc-bzr-conflicted-files): New function.
* log-edit.el (log-edit-summary, log-edit-header)
(log-edit-unknown-header): New faces.
(log-edit-headers-alist): New var.
(log-edit-header-contents-regexp): New const.
(log-edit-match-to-eoh): New function.
(log-edit-font-lock-keywords): Use them.
(log-edit): Insert a "Summary:" header as default.
(log-edit-mode): Mark font-lock rules as case-insensitive.
(log-edit-done): Cleanup headers.
(log-edit-extract-headers): New function to replace it.
* vc-dispatcher.el (vc-finish-logentry): Don't mess so badly with
the windows/frames.
* vc-bzr.el (vc-bzr-shelve-apply): Don't use *vc-bzr-shelve*.
* vc-dir.el (vc-dir-kill-line): New command.
(vc-dir-mode-map): Bind it to C-k.
(vc-dir-headers): Abbreviate the working dir.
* vc-git.el (vc-git-revision-table): Include remote branches.
New VC methods: vc-log-incoming and vc-log-outgoing.
* vc.el (vc-print-log-setup-buttons, vc-log-internal-common)
(vc-incoming-outgoing-internal, vc-log-incoming, vc-log-outgoing):
New functions.
(vc-print-log-internal): Just call vc-log-internal-common.
(vc-log-view-type): New permanent local variable.
* vc-hooks.el (vc-menu-map): Bind vc-log-incoming and vc-log-outgoing.
* vc-bzr.el (vc-bzr-log-view-mode): Use vc-log-view-type instead
of the dynamic bound vc-short-log.
(vc-bzr-log-incoming, vc-bzr-log-outgoing): New functions.
* vc-git.el (vc-git-log-outgoing): New function.
(vc-git-log-view-mode): Use vc-log-view-type instead
of the dynamic bound vc-short-log.
* vc-hg.el (vc-hg-log-view-mode): Use vc-log-view-type instead of
the dynamic bound vc-short-log. Highlight the tag.
(vc-hg-log-incoming, vc-hg-log-outgoing): New functions.
(vc-hg-outgoing, vc-hg-incoming, vc-hg-outgoing-mode):
(vc-hg-incoming-mode): Remove.
(vc-hg-extra-menu-map): Do not bind vc-hg-incoming and vc-hg-outgoing.
Fix default-directory for vc-root-diff.
* vc.el (vc-root-diff): Bind default-directory to the root
directory for the diff command.
* vc-hg.el (vc-hg-push, vc-hg-pull): Use `apply' when calling
`vc-hg-command' with a list of flags.
* vc-bzr.el (vc-bzr-log-edit-mode): Add --fixes support to
log-edit-before-checkin-process.
* vc.el (vc-modify-change-comment): Pass MODE to vc-start-logentry.
* vc-bzr.el, vc-hg.el (log-edit-mode): Declare.
* vc-dispatcher.el (vc-start-logentry): Doc fix.
(log-view-process-buffer, log-edit-extra-flags): Declare.
Add special markup processing for commit logs.
* log-edit.el (log-edit): Add new argument MODE. Use that mode
when non-nil instead of the log-view-mode.
* vc.el (vc-default-log-edit-mode): New function.
* vc-dispatcher.el (vc-log-edit): Add a mode argument, pass it to
log-edit.
Support for shelving snapshots and for showing shelves.
* vc-bzr.el (vc-bzr-shelve-show, vc-bzr-shelve-show-at-point)
(vc-bzr-shelve-apply-and-keep-at-point, vc-bzr-shelve-snapshot):
New functions.
(vc-bzr-shelve-map, vc-bzr-shelve-menu-map)
(vc-bzr-extra-menu-map): Map them.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sun, 31 Oct 2010 23:13:42 -0400 |
| parents | 518ba8ef471b |
| children | 83594fbec156 |
| files | etc/NEWS lisp/ChangeLog lisp/diff-mode.el lisp/log-edit.el lisp/log-view.el lisp/vc-arch.el lisp/vc-bzr.el lisp/vc-dir.el lisp/vc-dispatcher.el lisp/vc-git.el lisp/vc-hg.el lisp/vc-hooks.el lisp/vc-mtn.el lisp/vc.el |
| diffstat | 14 files changed, 955 insertions(+), 279 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Sun Oct 31 19:30:15 2010 -0700 +++ b/etc/NEWS Sun Oct 31 23:13:42 2010 -0400 @@ -34,6 +34,42 @@ ** The appt-add command takes an optional argument for the warning time. This can be used in place of the default appt-message-warning-time. +** VC and related modes + +*** New VC commands: vc-log-incoming, vc-log-outgoing, vc-find-conflicted-file. + +**** vc-log-incoming for Git runs "git fetch" so that the necessary +data is available locally. + +**** vc-log-incoming and vc-log-outgoing for Git require version 1.7 (or newer). + +*** New key bindings: C-x v I and C-x v O bound to vc-log-incoming and +vc-log-outgoing, respectively. + +*** The 'g' key in VC diff, log, log-incoming and log-outgoing buffers +reruns the corresponding VC command to compute an up to date version +of the buffer. + +*** vc-dir for Bzr supports viewing shelve contents and shelving snapshots. + +*** Special markup can be added to log-edit buffers. +The log-edit buffers are expected to have a format similar to email messages +with headers of the form: + Author: <author of this change> + Summary: <one line summary of this change> + Fixes: <reference to the bug fixed by this change> +Some backends handle some of those headers specially, but any unknown header +is just left as is in the message, so it is not lost. + +**** vc-git handles Author: and Date: +**** vc-hg handles Author: and Date: +**** vc-bzr handles Author:, Date: and Fixes: +**** vc-mtn handles Author: and Date: + +*** Pressing g in a *vc-diff* buffer reruns vc-diff, so it will +produce an up to date diff. + + ** Obsolete packages +++
--- a/lisp/ChangeLog Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/ChangeLog Sun Oct 31 23:13:42 2010 -0400 @@ -1,3 +1,188 @@ +2010-10-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/log-edit.el (log-edit-rewrite-fixes): New var. + (log-edit-author): New dynamic var. + (log-edit-changelog-ours-p, log-edit-insert-changelog-entries): + Use it to return the author if different from committer. + (log-edit-insert-changelog): Use them to add Author: and Fixes headers. + +2010-10-31 Eli Zaretskii <eliz@gnu.org> + + * vc/vc-hooks.el (vc-default-mode-line-string): Doc fix. + +2010-10-31 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc.el (vc-deduce-backend): New fun. Handle diff buffers. + (vc-root-diff, vc-print-root-log, vc-log-incoming) + (vc-log-outgoing): Use it. + (vc-diff-internal): Set diff-vc-backend. + + * vc/diff-mode.el (diff-vc-backend): New var. + +2010-10-31 Juri Linkov <juri@jurta.org> + + * vc/vc.el (vc-diff-internal): Set `revert-buffer-function' + buffer-locally to lambda that re-runs the vc diff command. + (Bug#6447) + +2010-10-31 Dan Nicolaescu <dann@ics.uci.edu> + + * vc/log-view.el (log-view-mode-map): Bind revert-buffer. + + Make 'g' (AKA revert-buffer) rerun VC log, log-incoming and + log-outgoing commands. + * vc/vc.el (vc-log-internal-common): Add a new argument and use it + to create a buffer local revert-buffer-function variable. + (vc-print-log-internal, vc-log-incoming, vc-log-outgoing): Pass a + revert-buffer-function lambda. + + Improve VC create/retrieve tag/branch. + * vc.el (vc-create-tag): Do not read the directory name for VCs + with repository revision granularity. Adjust the tag/branch + prompt. Reset VC properties. + (vc-retrieve-tag): Do not read the directory name for VCs + with repository revision granularity. Reset VC properties. + + Add optional support for resetting VC properties. + * vc-dispatcher.el (vc-resynch-window): Add new optional argument, + call vc-file-clearprops when true. + (vc-resynch-buffer): Add new optional argument, pass it down. + (vc-resynch-buffers-in-directory): Likewise. + + Improve support for special markup in the VC commit message. + * vc-mtn.el (vc-mtn-checkin): Support Author: and Date: markup. + * vc-hg.el (vc-hg-checkin): Add support for Date:. + * vc-git.el (vc-git-checkin): + * vc-bzr.el (vc-bzr-checkin): Likewise. + + Add support for vc-log-incoming, improve vc-log-outgoing for Git. + * vc-git.el (vc-git-log-view-mode): Fix font lock for + incoming/outgoing logs. + (vc-git-log-outgoing, vc-git-log-incoming): New functions. + + * vc-git.el (vc-git-log-outgoing): Use the same format as the + short log. + (vc-git-log-incoming): Likewise. Run "git fetch" before the log + command + + Add bindings for vc-log-incoming and vc-log-outgoing. + * vc-hooks.el (vc-prefix-map): Add bindings for vc-log-incoming + and vc-log-outgoing. + * vc-dir.el (vc-dir-menu-map): Add menu bindings for vc-log-incoming + and vc-log-outgoing. + + Improve state updating for VC tag commands. + * vc.el (vc-create-tag, vc-retrieve-tag): Call vc-resynch-buffer + to update the state of all buffers in the directory. + +2010-05-19 Glenn Morris <rgm@gnu.org> + + * vc-dir.el (vc-dir): Don't pop-up-windows. (Bug#6204) + +2010-10-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc.el (vc-checkin, vc-modify-change-comment): + Adjust to new vc-start/finish-logentry. + (vc-find-conflicted-file): New command. + (vc-transfer-file): Adjust to new vc-checkin. + (vc-next-action): Improve scoping. + + * vc-git.el (vc-git-checkin): Use log-edit-extract-headers. + (vc-git-commits-coding-system): Rename from git-commits-coding-system. + + * vc-dispatcher.el (vc-log-edit): Shorten names for + log-edit-show-files. + + * vc-bzr.el (vc-bzr-checkin): Use log-edit-extract-headers. + (vc-bzr-conflicted-files): New function. + + * log-edit.el (log-edit-summary, log-edit-header) + (log-edit-unknown-header): New faces. + (log-edit-headers-alist): New var. + (log-edit-header-contents-regexp): New const. + (log-edit-match-to-eoh): New function. + (log-edit-font-lock-keywords): Use them. + (log-edit): Insert a "Summary:" header as default. + (log-edit-mode): Mark font-lock rules as case-insensitive. + (log-edit-done): Cleanup headers. + (log-edit-extract-headers): New function to replace it. + + * vc-dispatcher.el (vc-finish-logentry): Don't mess so badly with + the windows/frames. + + * vc-bzr.el (vc-bzr-shelve-apply): Don't use *vc-bzr-shelve*. + + * vc-dir.el (vc-dir-kill-line): New command. + (vc-dir-mode-map): Bind it to C-k. + (vc-dir-headers): Abbreviate the working dir. + + * vc-git.el (vc-git-revision-table): Include remote branches. + +2010-10-31 Dan Nicolaescu <dann@ics.uci.edu> + + New VC methods: vc-log-incoming and vc-log-outgoing. + * vc.el (vc-print-log-setup-buttons, vc-log-internal-common) + (vc-incoming-outgoing-internal, vc-log-incoming, vc-log-outgoing): + New functions. + (vc-print-log-internal): Just call vc-log-internal-common. + (vc-log-view-type): New permanent local variable. + + * vc-hooks.el (vc-menu-map): Bind vc-log-incoming and vc-log-outgoing. + + * vc-bzr.el (vc-bzr-log-view-mode): Use vc-log-view-type instead + of the dynamic bound vc-short-log. + (vc-bzr-log-incoming, vc-bzr-log-outgoing): New functions. + + * vc-git.el (vc-git-log-outgoing): New function. + (vc-git-log-view-mode): Use vc-log-view-type instead + of the dynamic bound vc-short-log. + + * vc-hg.el (vc-hg-log-view-mode): Use vc-log-view-type instead of + the dynamic bound vc-short-log. Highlight the tag. + (vc-hg-log-incoming, vc-hg-log-outgoing): New functions. + (vc-hg-outgoing, vc-hg-incoming, vc-hg-outgoing-mode): + (vc-hg-incoming-mode): Remove. + (vc-hg-extra-menu-map): Do not bind vc-hg-incoming and vc-hg-outgoing. + + Fix default-directory for vc-root-diff. + * vc.el (vc-root-diff): Bind default-directory to the root + directory for the diff command. + +2010-10-31 Sam Steingold <sds@gnu.org> + + * vc-hg.el (vc-hg-push, vc-hg-pull): Use `apply' when calling + `vc-hg-command' with a list of flags. + +2010-10-31 Glenn Morris <rgm@gnu.org> + + * vc-bzr.el (vc-bzr-log-edit-mode): Add --fixes support to + log-edit-before-checkin-process. + + * vc.el (vc-modify-change-comment): Pass MODE to vc-start-logentry. + + * vc-bzr.el, vc-hg.el (log-edit-mode): Declare. + + * vc-dispatcher.el (vc-start-logentry): Doc fix. + (log-view-process-buffer, log-edit-extra-flags): Declare. + +2010-10-31 Dan Nicolaescu <dann@ics.uci.edu> + + Add special markup processing for commit logs. + * log-edit.el (log-edit): Add new argument MODE. Use that mode + when non-nil instead of the log-view-mode. + + * vc.el (vc-default-log-edit-mode): New function. + + * vc-dispatcher.el (vc-log-edit): Add a mode argument, pass it to + log-edit. + + Support for shelving snapshots and for showing shelves. + * vc-bzr.el (vc-bzr-shelve-show, vc-bzr-shelve-show-at-point) + (vc-bzr-shelve-apply-and-keep-at-point, vc-bzr-shelve-snapshot): + New functions. + (vc-bzr-shelve-map, vc-bzr-shelve-menu-map) + (vc-bzr-extra-menu-map): Map them. + 2010-10-30 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-handle-insert-file-contents): For root,
--- a/lisp/diff-mode.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/diff-mode.el Sun Oct 31 23:13:42 2010 -0400 @@ -97,6 +97,9 @@ :options '(diff-delete-empty-files diff-make-unified) :group 'diff-mode) +(defvar diff-vc-backend nil + "The VC backend that created the current Diff buffer, if any.") + (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -138,6 +141,7 @@ ;; Standard M-r is useful, so don't change M-r or M-R. ;;("r" . diff-restrict-view) ;;("R" . diff-reverse-direction) + ("g" . revert-buffer) ("q" . quit-window)) "Basic keymap for `diff-mode', bound to various prefix keys.")
--- a/lisp/log-edit.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/log-edit.el Sun Oct 31 23:13:42 2010 -0400 @@ -125,6 +125,7 @@ :type 'boolean) (defcustom log-edit-hook '(log-edit-insert-cvs-template + log-edit-show-files log-edit-insert-changelog) "Hook run at the end of `log-edit'." :group 'log-edit @@ -188,6 +189,7 @@ (defvar log-edit-callback nil) (defvar log-edit-diff-function nil) (defvar log-edit-listfun nil) + (defvar log-edit-parent-buffer nil) ;;; Originally taken from VC-Log mode @@ -312,15 +314,59 @@ ;;; Actual code ;;; +(defface log-edit-summary '((t :inherit font-lock-function-name-face)) + "Face for the summary in `log-edit-mode' buffers.") + +(defface log-edit-header '((t :inherit font-lock-keyword-face)) + "Face for the headers in `log-edit-mode' buffers.") + +(defface log-edit-unknown-header '((t :inherit font-lock-comment-face)) + "Face for unknown headers in `log-edit-mode' buffers.") + +(defvar log-edit-headers-alist '(("Summary" . log-edit-summary) + ("Fixes") ("Author")) + "AList of known headers and the face to use to highlight them.") + +(defconst log-edit-header-contents-regexp + "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?") + +(defun log-edit-match-to-eoh (limit) + ;; FIXME: copied from message-match-to-eoh. + (let ((start (point))) + (rfc822-goto-eoh) + ;; Typical situation: some temporary change causes the header to be + ;; incorrect, so EOH comes earlier than intended: the last lines of the + ;; intended headers are now not considered part of the header any more, + ;; so they don't have the multiline property set. When the change is + ;; completed and the header has its correct shape again, the lack of the + ;; multiline property means we won't rehighlight the last lines of + ;; the header. + (if (< (point) start) + nil ;No header within start..limit. + ;; Here we disregard LIMIT so that we may extend the area again. + (set-match-data (list start (point))) + (point)))) + (defvar log-edit-font-lock-keywords - '(("\\`\\(Summary:\\)\\(.*\\)" - (1 font-lock-keyword-face) - (2 font-lock-function-name-face)))) + ;; Copied/inspired by message-font-lock-keywords. + `((log-edit-match-to-eoh + (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp + "\\|\\(.*\\)") + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 (if (assoc (match-string 2) log-edit-headers-alist) + 'log-edit-header + 'log-edit-unknown-header) + nil lax) + (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) + 'log-edit-header) + nil lax) + (4 font-lock-warning-face))))) ;;;###autoload -(defun log-edit (callback &optional setup params buffer &rest ignore) +(defun log-edit (callback &optional setup params buffer mode &rest ignore) "Setup a buffer to enter a log message. -\\<log-edit-mode-map>The buffer will be put in `log-edit-mode'. +\\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode' +if MODE is nil. If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. Mark and point will be set around the entire contents of the buffer so that it is easy to kill the contents of the buffer with \\[kill-region]. @@ -340,8 +386,13 @@ (if buffer (pop-to-buffer buffer)) (when (and log-edit-setup-invert (not (eq setup 'force))) (setq setup (not setup))) - (when setup (erase-buffer)) - (log-edit-mode) + (when setup + (erase-buffer) + (insert "Summary: ") + (save-excursion (insert "\n\n"))) + (if mode + (funcall mode) + (log-edit-mode)) (set (make-local-variable 'log-edit-callback) callback) (if (listp params) (dolist (crt params) @@ -367,7 +418,7 @@ \\{log-edit-mode-map}" (set (make-local-variable 'font-lock-defaults) - '(log-edit-font-lock-keywords t)) + '(log-edit-font-lock-keywords t t)) (make-local-variable 'log-edit-comment-ring-index)) (defun log-edit-hide-buf (&optional buf where) @@ -380,6 +431,17 @@ "Finish editing the log message and commit the files. If you want to abort the commit, simply delete the buffer." (interactive) + ;; Clean up empty headers. + (goto-char (point-min)) + (while (looking-at (concat "^[a-z]*:" log-edit-header-contents-regexp)) + (let ((beg (match-beginning 0))) + (goto-char (match-end 0)) + (if (string-match "\\`[ \n\t]*\\'" (match-string 1)) + (delete-region beg (point))))) + ;; Get rid of leading empty lines. + (goto-char (point-min)) + (when (looking-at "\\([ \t]*\n\\)+") + (delete-region (match-beginning 0) (match-end 0))) ;; Get rid of trailing empty lines (goto-char (point-max)) (skip-syntax-backward " ") @@ -437,12 +499,13 @@ "(Un)Indent the current buffer rigidly to `log-edit-common-indent'." (save-excursion (let ((common (point-max))) - (goto-char (point-min)) + (rfc822-goto-eoh) (while (< (point) (point-max)) (if (not (looking-at "^[ \t]*$")) (setq common (min common (current-indentation)))) (forward-line 1)) - (indent-rigidly (point-min) (point-max) + (rfc822-goto-eoh) + (indent-rigidly (point) (point-max) (- log-edit-common-indent common))))) (defun log-edit-show-diff () @@ -508,6 +571,16 @@ (log-edit-comment-to-change-log))))) (defvar log-edit-changelog-use-first nil) + +(defvar log-edit-rewrite-fixes nil + "Rule to rewrite bug numbers into Fixes: headers. +The value should be of the form (REGEXP . REPLACEMENT) +where REGEXP should match the expression referring to a bug number +in the text, and REPLACEMENT is an expression to pass to `replace-match' +to build the Fixes: header.") +(put 'log-edit-rewrite-fixes 'safe-local-variable + (lambda (v) (and (stringp (car-safe v)) (stringp (cdr v))))) + (defun log-edit-insert-changelog (&optional use-first) "Insert a log message by looking at the ChangeLog. The idea is to write your ChangeLog entries first, and then use this @@ -525,18 +598,38 @@ or if the command is repeated a second time in a row, use the first log entry regardless of user name or time." (interactive "P") - (let ((log-edit-changelog-use-first - (or use-first (eq last-command 'log-edit-insert-changelog)))) - (log-edit-insert-changelog-entries (log-edit-files))) - (log-edit-set-common-indentation) - (goto-char (point-min)) - (when (and log-edit-strip-single-file-name (looking-at "\\*\\s-+")) - (forward-line 1) - (when (not (re-search-forward "^\\*\\s-+" nil t)) - (goto-char (point-min)) - (skip-chars-forward "^():") - (skip-chars-forward ": ") - (delete-region (point-min) (point))))) + (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) + (when (<= (point) eoh) + (goto-char eoh) + (if (looking-at "\n") (forward-char 1)))) + (let ((author + (let ((log-edit-changelog-use-first + (or use-first (eq last-command 'log-edit-insert-changelog)))) + (log-edit-insert-changelog-entries (log-edit-files))))) + (log-edit-set-common-indentation) + ;; Add an Author: field if appropriate. + (when author + (rfc822-goto-eoh) + (insert "Author: " author "\n" (if (looking-at "\n") "" "\n"))) + ;; Add a Fixes: field if applicable. + (when (consp log-edit-rewrite-fixes) + (rfc822-goto-eoh) + (when (re-search-forward (car log-edit-rewrite-fixes) nil t) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (fixes (match-substitute-replacement + (cdr log-edit-rewrite-fixes)))) + (delete-region start end) + (rfc822-goto-eoh) + (insert "Fixes: " fixes "\n" (if (looking-at "\n") "" "\n"))))) + (goto-char (point-min)) + (when (and log-edit-strip-single-file-name (looking-at "\\*\\s-+")) + (forward-line 1) + (when (not (re-search-forward "^\\*\\s-+" nil t)) + (goto-char (point-min)) + (skip-chars-forward "^():") + (skip-chars-forward ": ") + (delete-region (point-min) (point)))))) ;;;; ;;;; functions for getting commit message from ChangeLog a file... @@ -602,6 +695,9 @@ (defvar user-full-name) (defvar user-mail-address) + +(defvar log-edit-author) ;Dynamically scoped. + (defun log-edit-changelog-ours-p () "See if ChangeLog entry at point is for the current user, today. Return non-nil if it is." @@ -616,14 +712,28 @@ (functionp add-log-time-format) (funcall add-log-time-format)) (format-time-string "%Y-%m-%d")))) - (looking-at (if log-edit-changelog-use-first - "[^ \t]" - (regexp-quote (format "%s %s <%s>" time name mail)))))) + (if (null log-edit-changelog-use-first) + (looking-at (regexp-quote (format "%s %s <%s>" time name mail))) + ;; Check the author, to potentially add it as a "Author: " header. + (when (looking-at "[^ \t]") + (when (and (boundp 'log-edit-author) + (not (looking-at (format ".+ .+ <%s>" + (regexp-quote mail)))) + (looking-at ".+ \\(.+ <.+>\\)")) + (let ((author (replace-regexp-in-string " " " " + (match-string 1)))) + (unless (and log-edit-author + (string-match (regexp-quote author) log-edit-author)) + (setq log-edit-author + (if log-edit-author + (concat log-edit-author ", " author) + author))))) + t)))) (defun log-edit-changelog-entries (file) "Return the ChangeLog entries for FILE, and the ChangeLog they came from. The return value looks like this: - (LOGBUFFER (ENTRYSTART . ENTRYEND) ...) + (LOGBUFFER (ENTRYSTART ENTRYEND) ...) where LOGBUFFER is the name of the ChangeLog buffer, and each \(ENTRYSTART . ENTRYEND\) pair is a buffer region." (let ((changelog-file-name @@ -681,34 +791,87 @@ (cons (current-buffer) texts)))))))) -(defun log-edit-changelog-insert-entries (buffer regions) - "Insert those regions in BUFFER specified in REGIONS. -Sort REGIONS front-to-back first." - (let ((regions (sort regions 'car-less-than-car)) - (last)) - (dolist (region regions) - (when (and last (< last (car region))) (newline)) - (setq last (elt region 1)) - (apply 'insert-buffer-substring buffer region)))) +(defun log-edit-changelog-insert-entries (buffer beg end &rest files) + "Insert the text from BUFFER between BEG and END. +Rename relative filenames in the ChangeLog entry as FILES." + (let ((opoint (point)) + (log-name (buffer-file-name buffer)) + (case-fold-search nil) + bound) + (insert-buffer-substring buffer beg end) + (setq bound (point-marker)) + (when log-name + (dolist (f files) + (save-excursion + (goto-char opoint) + (when (re-search-forward + (concat "\\(^\\|[ \t]\\)\\(" + (file-relative-name f (file-name-directory log-name)) + "\\)[, :\n]") + bound t) + (replace-match f t t nil 2))))) + ;; Eliminate tabs at the beginning of the line. + (save-excursion + (goto-char opoint) + (while (re-search-forward "^\\(\t+\\)" bound t) + (replace-match ""))))) (defun log-edit-insert-changelog-entries (files) "Given a list of files FILES, insert the ChangeLog entries for them." - (let ((buffer-entries nil)) - - ;; Add each buffer to buffer-entries, and associate it with the list - ;; of entries we want from that file. + (let ((log-entries nil) + (log-edit-author nil)) + ;; Note that any ChangeLog entry can apply to more than one file. + ;; Here we construct a log-entries list with elements of the form + ;; ((LOGBUFFER ENTRYSTART ENTRYEND) FILE1 FILE2...) (dolist (file files) (let* ((entries (log-edit-changelog-entries file)) - (pair (assq (car entries) buffer-entries))) - (if pair - (setcdr pair (cvs-union (cdr pair) (cdr entries))) - (push entries buffer-entries)))) + (buf (car entries)) + key entry) + (dolist (region (cdr entries)) + (setq key (cons buf region)) + (if (setq entry (assoc key log-entries)) + (setcdr entry (append (cdr entry) (list file))) + (push (list key file) log-entries))))) + ;; Now map over log-entries, and extract the strings. + (dolist (log-entry (nreverse log-entries)) + (apply 'log-edit-changelog-insert-entries + (append (car log-entry) (cdr log-entry))) + (insert "\n")) + log-edit-author)) - ;; Now map over each buffer in buffer-entries, sort the entries for - ;; each buffer, and extract them as strings. - (dolist (buffer-entry buffer-entries) - (log-edit-changelog-insert-entries (car buffer-entry) (cdr buffer-entry)) - (when (cdr buffer-entry) (newline))))) +(defun log-edit-extract-headers (headers comment) + "Extract headers from COMMENT to form command line arguments. +HEADERS should be an alist with elements of the form (HEADER . CMDARG) +associating header names to the corresponding cmdline option name and the +result is then a list of the form (MSG CMDARG1 HDRTEXT1 CMDARG2 HDRTEXT2...). +where MSG is the remaining text from STRING. +If \"Summary\" is not in HEADERS, then the \"Summary\" header is extracted +anyway and put back as the first line of MSG." + (with-temp-buffer + (insert comment) + (rfc822-goto-eoh) + (narrow-to-region (point-min) (point)) + (let ((case-fold-search t) + (summary ()) + (res ())) + (dolist (header (if (assoc "Summary" headers) headers + (cons '("Summary" . t) headers))) + (goto-char (point-min)) + (while (re-search-forward (concat "^" (car header) + ":" log-edit-header-contents-regexp) + nil t) + (if (eq t (cdr header)) + (setq summary (match-string 1)) + (push (match-string 1) res) + (push (or (cdr header) (car header)) res)) + (replace-match "" t t))) + ;; Remove header separator if the header is empty. + (widen) + (goto-char (point-min)) + (when (looking-at "\\([ \t]*\n\\)+") + (delete-region (match-beginning 0) (match-end 0))) + (if summary (insert summary "\n")) + (cons (buffer-string) res)))) (provide 'log-edit)
--- a/lisp/log-view.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/log-view.el Sun Oct 31 23:13:42 2010 -0400 @@ -128,6 +128,7 @@ (easy-mmode-defmap log-view-mode-map '(("z" . kill-this-buffer) ("q" . quit-window) + ("g" . revert-buffer) ("m" . log-view-toggle-mark-entry) ("e" . log-view-modify-change-comment) ("d" . log-view-diff)
--- a/lisp/vc-arch.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-arch.el Sun Oct 31 23:13:42 2010 -0400 @@ -254,8 +254,7 @@ (buffer-substring (point-min) (1- (point-max))))))))) (defun vc-arch-workfile-unchanged-p (file) - "Check if FILE is unchanged by diffing against the master version. -Return non-nil if FILE is unchanged." + "Stub: arch workfiles are always considered to be in a changed state," nil) (defun vc-arch-state (file)
--- a/lisp/vc-bzr.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-bzr.el Sun Oct 31 23:13:42 2010 -0400 @@ -451,11 +451,17 @@ "Unregister FILE from bzr." (vc-bzr-command "remove" nil 0 file "--keep")) +(declare-function log-edit-extract-headers "log-edit" (headers string)) + (defun vc-bzr-checkin (files rev comment) "Check FILE in to bzr with log message COMMENT. REV non-nil gets an error." (if rev (error "Can't check in a specific revision with bzr")) - (vc-bzr-command "commit" nil 0 files "-m" comment)) + (apply 'vc-bzr-command "commit" nil 0 + files (cons "-m" (log-edit-extract-headers '(("Author" . "--author") + ("Date" . "--commit-time") + ("Fixes" . "--fixes")) + comment)))) (defun vc-bzr-find-revision (file rev buffer) "Fetch revision REV of file FILE and put it into BUFFER." @@ -478,7 +484,6 @@ (defvar log-view-font-lock-keywords) (defvar log-view-current-tag-function) (defvar log-view-per-file-logs) -(defvar vc-short-log) (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. @@ -486,13 +491,13 @@ (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-message-re) - (if vc-short-log + (if (eq vc-log-view-type 'short) "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?" "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) ;; log-view-font-lock-keywords is careful to use the buffer-local ;; value of log-view-message-re only since Emacs-23. - (if vc-short-log + (if (eq vc-log-view-type 'short) (append `((,log-view-message-re (1 'log-view-message-face) (2 'change-log-name) @@ -526,6 +531,14 @@ (list vc-bzr-log-switches) vc-bzr-log-switches))))) +(defun vc-bzr-log-incoming (buffer remote-location) + (apply 'vc-bzr-command "missing" buffer 'async nil + (list "--theirs-only" (unless (string= remote-location "") remote-location)))) + +(defun vc-bzr-log-outgoing (buffer remote-location) + (apply 'vc-bzr-command "missing" buffer 'async nil + (list "--mine-only" (unless (string= remote-location "") remote-location)))) + (defun vc-bzr-show-log-entry (revision) "Find entry for patch name REVISION in bzr change log buffer." (goto-char (point-min)) @@ -758,9 +771,11 @@ (define-key map [down-mouse-3] 'vc-bzr-shelve-menu) (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point) - ;; (define-key map "=" 'vc-bzr-shelve-show-at-point) - ;; (define-key map "\C-m" 'vc-bzr-shelve-show-at-point) + (define-key map "=" 'vc-bzr-shelve-show-at-point) + (define-key map "\C-m" 'vc-bzr-shelve-show-at-point) + (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point) (define-key map "P" 'vc-bzr-shelve-apply-at-point) + (define-key map "S" 'vc-bzr-shelve-snapshot) map)) (defvar vc-bzr-shelve-menu-map @@ -768,16 +783,22 @@ (define-key map [de] '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point :help "Delete the current shelf")) + (define-key map [ap] + '(menu-item "Apply and keep shelf" vc-bzr-shelve-apply-and-keep-at-point + :help "Apply the current shelf and keep it")) (define-key map [po] '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point :help "Apply the current shelf and remove it")) - ;; (define-key map [sh] - ;; '(menu-item "Show shelve" vc-bzr-shelve-show-at-point - ;; :help "Show the contents of the current shelve")) + (define-key map [sh] + '(menu-item "Show shelve" vc-bzr-shelve-show-at-point + :help "Show the contents of the current shelve")) map)) (defvar vc-bzr-extra-menu-map (let ((map (make-sparse-keymap))) + (define-key map [bzr-sn] + '(menu-item "Shelve a snapshot" vc-bzr-shelve-snapshot + :help "Shelve the current state of the tree and keep the current state")) (define-key map [bzr-sh] '(menu-item "Shelve..." vc-bzr-shelve :help "Shelve changes")) @@ -864,21 +885,38 @@ (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name) (vc-resynch-buffer root t t)))) -;; (defun vc-bzr-shelve-show (name) -;; "Show the contents of shelve NAME." -;; (interactive "sShelve name: ") -;; (vc-setup-buffer "*vc-bzr-shelve*") -;; ;; FIXME: how can you show the contents of a shelf? -;; (vc-bzr-command "shelve" "*vc-bzr-shelve*" 'async nil name) -;; (set-buffer "*vc-bzr-shelve*") -;; (diff-mode) -;; (setq buffer-read-only t) -;; (pop-to-buffer (current-buffer))) +(defun vc-bzr-shelve-show (name) + "Show the contents of shelve NAME." + (interactive "sShelve name: ") + (vc-setup-buffer "*vc-diff*") + ;; FIXME: how can you show the contents of a shelf? + (vc-bzr-command "unshelve" "*vc-diff*" 'async nil "--preview" name) + (set-buffer "*vc-diff*") + (diff-mode) + (setq buffer-read-only t) + (pop-to-buffer (current-buffer))) (defun vc-bzr-shelve-apply (name) "Apply shelve NAME and remove it afterwards." (interactive "sApply (and remove) shelf: ") - (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name) + (vc-bzr-command "unshelve" nil 0 nil "--apply" name) + (vc-resynch-buffer (vc-bzr-root default-directory) t t)) + +(defun vc-bzr-shelve-apply-and-keep (name) + "Apply shelve NAME and keep it afterwards." + (interactive "sApply (and keep) shelf: ") + (vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep" name) + (vc-resynch-buffer (vc-bzr-root default-directory) t t)) + +(defun vc-bzr-shelve-snapshot () + "Create a stash with the current tree state." + (interactive) + (vc-bzr-command "shelve" nil 0 nil "--all" "-m" + (let ((ct (current-time))) + (concat + (format-time-string "Snapshot on %Y-%m-%d" ct) + (format-time-string " at %H:%M" ct)))) + (vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep") (vc-resynch-buffer (vc-bzr-root default-directory) t t)) (defun vc-bzr-shelve-list () @@ -905,14 +943,18 @@ (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve) (vc-dir-refresh)))) -;; (defun vc-bzr-shelve-show-at-point () -;; (interactive) -;; (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point)))) +(defun vc-bzr-shelve-show-at-point () + (interactive) + (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point)))) (defun vc-bzr-shelve-apply-at-point () (interactive) (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point)))) +(defun vc-bzr-shelve-apply-and-keep-at-point () + (interactive) + (vc-bzr-shelve-apply-and-keep (vc-bzr-shelve-get-at-point (point)))) + (defun vc-bzr-shelve-menu (e) (interactive "e") (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e))) @@ -930,6 +972,19 @@ (setq loglines (buffer-substring-no-properties start (point-max)))))) vc-bzr-revisions)) +(defun vc-bzr-conflicted-files (dir) + (let ((default-directory (vc-bzr-root dir)) + (files ())) + (with-temp-buffer + (vc-bzr-command "status" t 0 default-directory) + (goto-char (point-min)) + (when (re-search-forward "^conflicts:\n" nil t) + (while (looking-at " \\(?:Text conflict in \\(.*\\)\\|.*\\)\n") + (if (match-end 1) + (push (expand-file-name (match-string 1)) files)) + (goto-char (match-end 0))))) + files)) + ;;; Revision completion (eval-and-compile
--- a/lisp/vc-dir.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-dir.el Sun Oct 31 23:13:42 2010 -0400 @@ -188,9 +188,18 @@ (define-key map [diff] '(menu-item "Compare with Base Version" vc-diff :help "Compare file set with the base version")) + (define-key map [logo] + '(menu-item "Show Outgoing Log" vc-log-outgoing + :help "Show a log of changes that will be sent with a push operation")) + (define-key map [logi] + '(menu-item "Show Incoming Log" vc-log-incoming + :help "Show a log of changes that will be received with a pull operation")) (define-key map [log] - '(menu-item "Show history" vc-print-log - :help "List the change log of the current file set in a window")) + '(menu-item "Show history" vc-print-log + :help "List the change log of the current file set in a window")) + (define-key map [rlog] + '(menu-item "Show Top of the Tree History " vc-print-root-log + :help "List the change log for the current tree in a window")) ;; VC commands. (define-key map [sepvccmd] '("--")) (define-key map [update] @@ -263,6 +272,7 @@ (define-key map [mouse-2] 'vc-dir-toggle-mark) (define-key map [follow-link] 'mouse-face) (define-key map "x" 'vc-dir-hide-up-to-date) + (define-key map [?\C-k] 'vc-dir-kill-line) (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired? (define-key map "Q" 'vc-dir-query-replace-regexp) (define-key map (kbd "M-s a C-s") 'vc-dir-isearch) @@ -963,7 +973,8 @@ (propertize "VC backend : " 'face 'font-lock-type-face) (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face) (propertize "Working dir: " 'face 'font-lock-type-face) - (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face) + (propertize (format "%s\n" (abbreviate-file-name dir)) + 'face 'font-lock-variable-name-face) ;; Then the backend specific ones. (vc-call-backend backend 'dir-extra-headers dir) "\n")) @@ -1100,6 +1111,13 @@ (ewoc-delete vc-ewoc crt)) (setq crt prev))))) +(defun vc-dir-kill-line () + "Remove the current line from display." + (interactive) + (let ((crt (ewoc-locate vc-ewoc)) + (inhibit-read-only t)) + (ewoc-delete vc-ewoc crt))) + (defun vc-dir-printer (fileentry) (vc-call-backend vc-dir-backend 'dir-printer fileentry)) @@ -1169,7 +1187,8 @@ nil t nil nil))))) (unless backend (setq backend (vc-responsible-backend dir))) - (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)) + (let (pop-up-windows) ; based on cvs-examine; bug#6204 + (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend))) (if (derived-mode-p 'vc-dir-mode) (vc-dir-refresh) ;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
--- a/lisp/vc-dispatcher.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-dispatcher.el Sun Oct 31 23:13:42 2010 -0400 @@ -141,7 +141,6 @@ (defvar vc-log-operation nil) (defvar vc-log-after-operation-hook nil) (defvar vc-log-fileset) -(defvar vc-log-extra) ;; In a log entry buffer, this is a local variable ;; that points to the buffer for which it was made @@ -458,7 +457,7 @@ (make-variable-buffer-local 'vc-mode-line-hook) (put 'vc-mode-line-hook 'permanent-local t) -(defun vc-resynch-window (file &optional keep noquery) +(defun vc-resynch-window (file &optional keep noquery reset-vc-info) "If FILE is in the current buffer, either revert or unvisit it. The choice between revert (to see expanded keywords) and unvisit depends on KEEP. NOQUERY if non-nil inhibits confirmation for @@ -469,6 +468,8 @@ (and (string= buffer-file-name file) (if keep (when (file-exists-p file) + (when reset-vc-info + (vc-file-clearprops file)) (vc-revert-buffer-internal t noquery) ;; VC operations might toggle the read-only state. In @@ -490,24 +491,24 @@ (declare-function vc-dir-resynch-file "vc-dir" (&optional fname)) (declare-function vc-string-prefix-p "vc" (prefix string)) -(defun vc-resynch-buffers-in-directory (directory &optional keep noquery) +(defun vc-resynch-buffers-in-directory (directory &optional keep noquery reset-vc-info) "Resync all buffers that visit files in DIRECTORY." (dolist (buffer (buffer-list)) (let ((fname (buffer-file-name buffer))) (when (and fname (vc-string-prefix-p directory fname)) (with-current-buffer buffer - (vc-resynch-buffer fname keep noquery)))))) + (vc-resynch-buffer fname keep noquery reset-vc-info)))))) -(defun vc-resynch-buffer (file &optional keep noquery) +(defun vc-resynch-buffer (file &optional keep noquery reset-vc-info) "If FILE is currently visited, resynch its buffer." (if (string= buffer-file-name file) - (vc-resynch-window file keep noquery) + (vc-resynch-window file keep noquery reset-vc-info) (if (file-directory-p file) - (vc-resynch-buffers-in-directory file keep noquery) + (vc-resynch-buffers-in-directory file keep noquery reset-vc-info) (let ((buffer (get-file-buffer file))) (when buffer (with-current-buffer buffer - (vc-resynch-window file keep noquery)))))) + (vc-resynch-window file keep noquery reset-vc-info)))))) ;; Try to avoid unnecessary work, a *vc-dir* buffer is only present ;; if this is true. (when vc-dir-buffers @@ -527,21 +528,26 @@ ;; Set up key bindings for use while editing log messages -(defun vc-log-edit (fileset) +(defun vc-log-edit (fileset mode) "Set up `log-edit' for use on FILE." (setq default-directory (with-current-buffer vc-parent-buffer default-directory)) (log-edit 'vc-finish-logentry nil - `((log-edit-listfun . (lambda () ',fileset)) - (log-edit-diff-function . (lambda () (vc-diff nil))))) + `((log-edit-listfun . (lambda () + ;; FIXME: Should expand the list + ;; for directories. + (mapcar 'file-relative-name + ',fileset))) + (log-edit-diff-function . (lambda () (vc-diff nil)))) + nil + mode) (set (make-local-variable 'vc-log-fileset) fileset) - (make-local-variable 'vc-log-extra) (set-buffer-modified-p nil) (setq buffer-file-name nil)) -(defun vc-start-logentry (files extra comment initial-contents msg logbuf action &optional after-hook) - "Accept a comment for an operation on FILES with extra data EXTRA. +(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook) + "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 INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial @@ -549,8 +555,9 @@ INITIAL-CONTENTS is nil, do action immediately as if the user had entered COMMENT. If COMMENT is t, also do action immediately with an empty comment. Remember the file's buffer in `vc-parent-buffer' -\(current one if no file). AFTER-HOOK specifies the local value -for `vc-log-after-operation-hook'." +\(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'." (let ((parent (if (vc-dispatcher-browsing) ;; If we are called from a directory browser, the parent buffer is @@ -565,12 +572,11 @@ (set (make-local-variable 'vc-parent-buffer) parent) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name vc-parent-buffer))) - (vc-log-edit files) + (vc-log-edit files mode) (make-local-variable 'vc-log-after-operation-hook) (when after-hook (setq vc-log-after-operation-hook after-hook)) (setq vc-log-operation action) - (setq vc-log-extra extra) (when comment (erase-buffer) (when (stringp comment) (insert comment))) @@ -579,7 +585,8 @@ (vc-finish-logentry (eq comment t))))) (declare-function vc-dir-move-to-goal-column "vc-dir" ()) - +;; vc-finish-logentry is typically called from a log-edit buffer (see +;; vc-start-logentry). (defun vc-finish-logentry (&optional nocomment) "Complete the operation implied by the current log entry. Use the contents of the current buffer as a check-in or registration @@ -595,20 +602,21 @@ (or (vc-dispatcher-browsing) (vc-buffer-sync))) (unless vc-log-operation (error "No log operation is pending")) + ;; save the parameters held in buffer-local variables (let ((logbuf (current-buffer)) (log-operation vc-log-operation) + ;; FIXME: When coming from VC-Dir, we should check that the + ;; set of selected files is still equal to vc-log-fileset, + ;; to avoid surprises. (log-fileset vc-log-fileset) - (log-extra vc-log-extra) (log-entry (buffer-string)) - (after-hook vc-log-after-operation-hook) - (tmp-vc-parent-buffer vc-parent-buffer)) + (after-hook vc-log-after-operation-hook)) (pop-to-buffer vc-parent-buffer) ;; OK, do it to it (save-excursion (funcall log-operation log-fileset - log-extra log-entry)) ;; Remove checkin window (after the checkin so that if that fails ;; we don't zap the log buffer and the typing therein). @@ -617,9 +625,11 @@ (delete-windows-on logbuf (selected-frame)) ;; Kill buffer and delete any other dedicated windows/frames. (kill-buffer logbuf)) - (logbuf (pop-to-buffer logbuf) - (bury-buffer) - (pop-to-buffer tmp-vc-parent-buffer))) + (logbuf + (with-selected-window (or (get-buffer-window logbuf 0) + (selected-window)) + (with-current-buffer logbuf + (bury-buffer))))) ;; Now make sure we see the expanded headers (when log-fileset (mapc
--- a/lisp/vc-git.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-git.el Sun Oct 31 23:13:42 2010 -0400 @@ -118,7 +118,7 @@ :version "23.1" :group 'vc) -(defvar git-commits-coding-system 'utf-8 +(defvar vc-git-commits-coding-system 'utf-8 "Default coding system for git commits.") ;;; BACKEND PROPERTIES @@ -171,7 +171,14 @@ (defun vc-git-state (file) "Git-specific version of `vc-state'." - ;; FIXME: This can't set 'ignored yet + ;; FIXME: This can't set 'ignored or 'conflict yet + ;; The 'ignored state could be detected with `git ls-files -i -o + ;; --exclude-standard` It also can't set 'needs-update or + ;; 'needs-merge. The rough equivalent would be that upstream branch + ;; for current branch is in fast-forward state i.e. current branch + ;; is direct ancestor of corresponding upstream branch, and the file + ;; was modified upstream. But we can't check that without a network + ;; operation. (if (not (vc-git-registered file)) 'unregistered (vc-git--call nil "add" "--refresh" "--" (file-relative-name file)) @@ -541,11 +548,16 @@ (defun vc-git-unregister (file) (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) +(declare-function log-edit-extract-headers "log-edit" (headers string)) (defun vc-git-checkin (files rev comment) - (let ((coding-system-for-write git-commits-coding-system)) - (vc-git-command nil 0 files "commit" - "-m" comment "--only" "--"))) + (let ((coding-system-for-write vc-git-commits-coding-system)) + (apply 'vc-git-command nil 0 files + (nconc (list "commit" "-m") + (log-edit-extract-headers '(("Author" . "--author") + ("Date" . "--date")) + comment) + (list "--only" "--"))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects @@ -580,7 +592,7 @@ "Get change log associated with FILES. Note that using SHORTLOG requires at least Git version 1.5.6, for the --graph option." - (let ((coding-system-for-read git-commits-coding-system)) + (let ((coding-system-for-read vc-git-commits-coding-system)) ;; `vc-do-command' creates the buffer, but we need it before running ;; the command. (vc-setup-buffer buffer) @@ -600,25 +612,46 @@ (when start-revision (list start-revision)) '("--"))))))) +(defun vc-git-log-outgoing (buffer remote-location) + (interactive) + (vc-git-command + buffer 0 nil + "log" + "--no-color" "--graph" "--decorate" "--date=short" + "--pretty=tformat:%d%h %ad %s" "--abbrev-commit" + (concat (if (string= remote-location "") + "@{upstream}" + remote-location) + "..HEAD"))) + +(defun vc-git-log-incoming (buffer remote-location) + (interactive) + (vc-git-command nil 0 nil "fetch") + (vc-git-command + buffer 0 nil + "log" + "--no-color" "--graph" "--decorate" "--date=short" + "--pretty=tformat:%d%h %ad %s" "--abbrev-commit" + (concat "HEAD.." (if (string= remote-location "") + "@{upstream}" + remote-location)))) + (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) -;; Dynamically bound. -(defvar vc-short-log) - (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" (require 'add-log) ;; We need the faces add-log. ;; Don't have file markers, so use impossible regexp. (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - (if vc-short-log + (if (not (eq vc-log-view-type 'long)) "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" "^commit *\\([0-9a-z]+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) - (if vc-short-log + (if (not (eq vc-log-view-type 'long)) '( ;; Same as log-view-message-re, except that we don't ;; want the shy group for the tag name. @@ -681,7 +714,8 @@ (with-temp-buffer (vc-git-command t nil nil "for-each-ref" "--format=%(refname)") (goto-char (point-min)) - (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t) + (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$" + nil t) (push (match-string 2) table))) table))
--- a/lisp/vc-hg.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-hg.el Sun Oct 31 23:13:42 2010 -0400 @@ -256,33 +256,33 @@ (with-current-buffer buffer (apply 'vc-hg-command buffer 0 files "log" - (append + (nconc (when start-revision (list (format "-r%s:" start-revision))) (when limit (list "-l" (format "%s" limit))) - (when shortlog '("--style" "compact")) + (when shortlog (list "--style" "compact")) vc-hg-log-switches))))) (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) -(defvar vc-short-log) (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (require 'add-log) ;; we need the add-log faces (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - (if vc-short-log - "^\\([0-9]+\\)\\(?:\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$" + (if (eq vc-log-view-type 'short) + "^\\([0-9]+\\)\\(\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$" "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) - (if vc-short-log + (if (eq vc-log-view-type 'short) (append `((,log-view-message-re (1 'log-view-message-face) - (2 'log-view-message-face) - (3 'change-log-date) - (4 'change-log-name)))) + (2 'highlight nil lax) + (3 'log-view-message-face) + (4 'change-log-date) + (5 'change-log-name)))) (append log-view-font-lock-keywords '( @@ -298,7 +298,8 @@ ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" (1 'change-log-email)) ("^date: \\(.+\\)" (1 'change-log-date)) - ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) + ("^tag: +\\([^ ]+\\)$" (1 'highlight)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) (defun vc-hg-diff (files &optional oldvers newvers buffer) "Get a difference report using hg between two revisions of FILES." @@ -423,10 +424,16 @@ ;; "Unregister FILE from hg." ;; (vc-hg-command nil nil file "remove")) +(declare-function log-edit-extract-headers "log-edit" (headers string)) + (defun vc-hg-checkin (files rev comment) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (vc-hg-command nil 0 files "commit" "-m" comment)) + (apply 'vc-hg-command nil 0 files + (nconc (list "commit" "-m") + (log-edit-extract-headers '(("Author" . "--user") + ("Date" . "--date")) + comment)))) (defun vc-hg-find-revision (file rev buffer) (let ((coding-system-for-read 'binary) @@ -460,8 +467,6 @@ (defvar vc-hg-extra-menu-map (let ((map (make-sparse-keymap))) - (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming)) - (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing)) map)) (defun vc-hg-extra-menu () vc-hg-extra-menu-map) @@ -470,14 +475,6 @@ (defvar log-view-vc-backend) -(define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing" - "Mode for browsing Hg outgoing changes." - (set (make-local-variable 'log-view-vc-backend) 'Hg)) - -(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming" - "Mode for browsing Hg incoming changes." - (set (make-local-variable 'log-view-vc-backend) 'Hg)) - (defstruct (vc-hg-extra-fileinfo (:copier nil) (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name)) @@ -583,33 +580,13 @@ ;; (vc-hg-dir-extra-header "Global id : " "id" "-i") ))) -;; FIXME: this adds another top level menu, instead figure out how to -;; replace the Log-View menu. -(easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map - "Hg-outgoing Display Menu" - `("Hg-outgoing" - ["Push selected" vc-hg-push])) - -(easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map - "Hg-incoming Display Menu" - `("Hg-incoming" - ["Pull selected" vc-hg-pull])) +(defun vc-hg-log-incoming (buffer remote-location) + (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "") + remote-location))) -(defun vc-hg-outgoing () - (interactive) - (let ((bname "*Hg outgoing*") - (vc-short-log nil)) - (vc-hg-command bname 1 nil "outgoing" "-n") - (pop-to-buffer bname) - (vc-hg-outgoing-mode))) - -(defun vc-hg-incoming () - (interactive) - (let ((bname "*Hg incoming*") - (vc-short-log nil)) - (vc-hg-command bname 0 nil "incoming" "-n") - (pop-to-buffer bname) - (vc-hg-incoming-mode))) +(defun vc-hg-log-outgoing (buffer remote-location) + (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") + remote-location))) (declare-function log-view-get-marked "log-view" ()) @@ -618,22 +595,22 @@ (interactive) (let ((marked-list (log-view-get-marked))) (if marked-list - (vc-hg-command - nil 0 nil - (cons "push" + (apply #'vc-hg-command + nil 0 nil + "push" (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) - (error "No log entries selected for push")))) + (mapcar (lambda (arg) (list "-r" arg)) marked-list))) + (error "No log entries selected for push")))) (defun vc-hg-pull () (interactive) (let ((marked-list (log-view-get-marked))) (if marked-list - (vc-hg-command - nil 0 nil - (cons "pull" + (apply #'vc-hg-command + nil 0 nil + "pull" (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) + (mapcar (lambda (arg) (list "-r" arg)) marked-list))) (error "No log entries selected for pull")))) ;;; Internal functions
--- a/lisp/vc-hooks.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-hooks.el Sun Oct 31 23:13:42 2010 -0400 @@ -403,7 +403,7 @@ (defun vc-backend-subdirectory-name (file) - "Return where the master and lock FILEs for the current directory are kept." + "Return where the repository for the current directory is kept." (symbol-name (vc-backend file))) (defun vc-name (file) @@ -471,13 +471,13 @@ USER The current version of the working file is locked by some other USER (a string). - 'needs-update The file has not been edited by the user, but there is + 'needs-update The file has not been edited by the user, but there is a more recent version on the current branch stored - in the master file. + in the repository. 'needs-merge The file has been edited by the user, and there is also a more recent version on the current branch stored in - the master file. This state can only occur if locking + the repository. This state can only occur if locking is not used for the file. 'unlocked-changes The working version of the file is not locked, @@ -556,7 +556,7 @@ unchanged)))) (defun vc-default-workfile-unchanged-p (backend file) - "Check if FILE is unchanged by diffing against the master version. + "Check if FILE is unchanged by diffing against the repository version. Return non-nil if FILE is unchanged." (zerop (condition-case err ;; If the implementation supports it, let the output @@ -818,6 +818,9 @@ \"BACKEND-REV\" if the file is up-to-date \"BACKEND:REV\" if the file is edited (or locked by the calling user) \"BACKEND:LOCKER:REV\" if the file is locked by somebody else + \"BACKEND@REV\" if the file was locally added + \"BACKEND!REV\" if the file contains conflicts or was removed + \"BACKEND?REV\" if the file is under VC, but is missing This function assumes that the file is registered." (let* ((backend-name (symbol-name backend)) @@ -947,6 +950,8 @@ (define-key map "i" 'vc-register) (define-key map "l" 'vc-print-log) (define-key map "L" 'vc-print-root-log) + (define-key map "I" 'vc-log-incoming) + (define-key map "O" 'vc-log-outgoing) (define-key map "m" 'vc-merge) (define-key map "r" 'vc-retrieve-tag) (define-key map "s" 'vc-create-tag) @@ -989,6 +994,12 @@ (define-key map [vc-update-change-log] `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log :help ,(purecopy "Find change log file and add entries from recent version control logs"))) + (define-key map [vc-log-out] + `(menu-item ,(purecopy "Show Outgoing Log") vc-log-outgoing + :help ,(purecopy "Show a log of changes that will be sent with a push operation"))) + (define-key map [vc-log-in] + `(menu-item ,(purecopy "Show Incoming Log") vc-log-incoming + :help ,(purecopy "Show a log of changes that will be received with a pull operation"))) (define-key map [vc-print-log] `(menu-item ,(purecopy "Show History") vc-print-log :help ,(purecopy "List the change log of the current file set in a window")))
--- a/lisp/vc-mtn.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc-mtn.el Sun Oct 31 23:13:42 2010 -0400 @@ -172,8 +172,14 @@ (defun vc-mtn-responsible-p (file) (vc-mtn-root file)) (defun vc-mtn-could-register (file) (vc-mtn-root file)) +(declare-function log-edit-extract-headers "log-edit" (headers string)) + (defun vc-mtn-checkin (files rev comment) - (vc-mtn-command nil 0 files "commit" "-m" comment)) + (apply 'vc-mtn-command nil 0 files + (nconc (list "commit" "-m") + (log-edit-extract-headers '(("Author" . "--author") + ("Date" . "--date")) + comment)))) (defun vc-mtn-find-revision (file rev buffer) (vc-mtn-command buffer 0 file "cat" "-r" rev))
--- a/lisp/vc.el Sun Oct 31 19:30:15 2010 -0700 +++ b/lisp/vc.el Sun Oct 31 23:13:42 2010 -0400 @@ -63,11 +63,18 @@ ;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog') ;; from the commit buffer instead or to set `log-edit-setup-invert'. ;; -;; The vc code maintains some internal state in order to reduce expensive -;; version-control operations to a minimum. Some names are only computed -;; once. If you perform version control operations with the backend while -;; vc's back is turned, or move/rename master files while vc is running, -;; vc may get seriously confused. Don't do these things! +;; When using SCCS, RCS, CVS: be careful not to do repo surgery, or +;; operations like registrations and deletions and renames, outside VC +;; while VC is running. The support for these systems was designed +;; when disks were much slower, and the code maintains a lot of +;; internal state in order to reduce expensive operations to a +;; minimum. Thus, if you mess with the repo while VC's back is turned, +;; VC may get seriously confused. +;; +;; When using Subversion or a later system, anything you do outside VC +;; *through the VCS tools* should safely interlock with VC +;; operations. Under these VC does little state caching, because local +;; operations are assumed to be fast. The dividing line is ;; ;; ADDING SUPPORT FOR OTHER BACKENDS ;; @@ -196,7 +203,7 @@ ;; ;; Return non-nil if FILE is unchanged from the working revision. ;; This function should do a brief comparison of FILE's contents -;; with those of the repository master of the working revision. If +;; with those of the repository copy of the working revision. If ;; the backend does not have such a brief-comparison feature, the ;; default implementation of this function can be used, which ;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff @@ -263,12 +270,10 @@ ;; ;; * checkin (files rev comment) ;; -;; Commit changes in FILES to this backend. If REV is non-nil, that -;; should become the new revision number (not all backends do -;; anything with it). COMMENT is used as a check-in comment. The -;; implementation should pass the value of vc-checkin-switches to -;; the backend command. (Note: in older versions of VC, this -;; command took a single file argument and not a list.) +;; Commit changes in FILES to this backend. REV is a historical artifact +;; and should be ignored. COMMENT is used as a check-in comment. +;; The implementation should pass the value of vc-checkin-switches to +;; the backend command. ;; ;; * find-revision (file rev buffer) ;; @@ -344,6 +349,16 @@ ;; revision. At this point START-REVISION is only required to work ;; in conjunction with LIMIT = 1. ;; +;; * log-outgoing (backend remote-location) +;; +;; Insert in BUFFER the revision log for the changes that will be +;; sent when performing a push operation to REMOTE-LOCATION. +;; +;; * log-incoming (backend remote-location) +;; +;; Insert in BUFFER the revision log for the changes that will be +;; received when performing a pull operation from REMOTE-LOCATION. +;; ;; - log-view-mode () ;; ;; Mode to use for the output of print-log. This defaults to @@ -477,6 +492,12 @@ ;; Return the revision number that follows REV for FILE, or nil if no such ;; revision exists. ;; +;; - log-edit-mode () +;; +;; Turn on the mode used for editing the check in log. This +;; defaults to `log-edit-mode'. If changed, it should use a mode +;; derived from`log-edit-mode'. +;; ;; - check-headers () ;; ;; Return non-nil if the current buffer contains any version headers. @@ -524,6 +545,12 @@ ;; makes it possible to provide menu entries for functionality that ;; is specific to a backend and which does not map to any of the VC ;; generic concepts. +;; +;; - conflicted-files (dir) +;; +;; 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? ;;; Todo: @@ -553,9 +580,6 @@ ;; display the branch name in the mode-line. Replace ;; vc-cvs-sticky-tag with that. ;; -;; - vc-create-tag and vc-retrieve-tag should update the -;; buffers that might be visiting the affected files. -;; ;;;; Internal cleanups: ;; ;; - backends that care about vc-stay-local should try to take it into @@ -746,7 +770,7 @@ "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) "Associate static header string templates with file types. A \%s in the template is replaced with the first string associated with -the file's version control type in `vc-header-alist'." +the file's version control type in `vc-BACKEND-header'." :type '(repeat (cons :format "%v" (regexp :tag "File Type") (string :tag "Header String"))) @@ -767,7 +791,7 @@ (defcustom vc-checkout-carefully (= (user-uid) 0) "Non-nil means be extra-careful in checkout. Verify that the file really is not locked -and that its contents match what the master file says." +and that its contents match what the repository version says." :type 'boolean :group 'vc) (make-obsolete-variable 'vc-checkout-carefully @@ -889,6 +913,16 @@ (nreverse flattened))) (defvar vc-dir-backend) +(defvar log-view-vc-backend) +(defvar diff-vc-backend) + +(defun vc-deduce-backend () + (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + ((derived-mode-p 'log-view-mode) log-view-vc-backend) + ((derived-mode-p 'diff-mode) diff-vc-backend) + ((derived-mode-p 'dired-mode) + (vc-responsible-backend default-directory)) + (vc-mode (vc-backend buffer-file-name)))) (declare-function vc-dir-current-file "vc-dir" ()) (declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) @@ -1030,8 +1064,7 @@ (state (nth 3 vc-fileset)) ;; The backend should check that the checkout-model is consistent ;; among all the `files'. - (model (nth 4 vc-fileset)) - revision) + (model (nth 4 vc-fileset))) ;; Do the right thing (cond @@ -1046,11 +1079,13 @@ (cond (verbose ;; go to a different revision - (setq revision (read-string "Branch, revision, or backend to move to: ")) - (let ((revision-downcase (downcase revision))) + (let* ((revision + (read-string "Branch, revision, or backend to move to: ")) + (revision-downcase (downcase revision))) (if (member revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends)) + (mapcar (lambda (arg) (downcase (symbol-name arg))) + vc-handled-backends)) (let ((vsym (intern-soft revision-downcase))) (dolist (file files) (vc-transfer-file file vsym))) (dolist (file files) @@ -1095,8 +1130,8 @@ (message "No files remain to be committed") (if (not verbose) (vc-checkin ready-for-commit backend) - (setq revision (read-string "New revision or backend: ")) - (let ((revision-downcase (downcase revision))) + (let* ((revision (read-string "New revision or backend: ")) + (revision-downcase (downcase revision))) (if (member revision-downcase (mapcar (lambda (arg) (downcase (symbol-name arg))) @@ -1341,7 +1376,7 @@ (defun vc-checkin (files backend &optional rev comment initial-contents) "Check in FILES. The optional argument REV may be a string specifying the new revision -level (if nil increment the current level). COMMENT is a comment +level (strongly deprecated). 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. @@ -1355,26 +1390,30 @@ (lexical-let ((backend backend)) (vc-start-logentry - files rev comment initial-contents + files comment initial-contents "Enter a change comment." "*VC-log*" - (lambda (files rev comment) - (message "Checking in %s..." (vc-delistify files)) - ;; "This log message intentionally left almost blank". - ;; RCS 5.7 gripes about white-space-only comments too. - (or (and comment (string-match "[^\t\n ]" comment)) - (setq comment "*** empty log message ***")) - (with-vc-properties - files - ;; We used to change buffers to get local value of vc-checkin-switches, - ;; but 'the' local buffer is not a well-defined concept for filesets. - (progn - (vc-call-backend backend 'checkin files rev comment) - (mapc 'vc-delete-automatic-version-backups files)) - `((vc-state . up-to-date) - (vc-checkout-time . ,(nth 5 (file-attributes file))) - (vc-working-revision . nil))) - (message "Checking in %s...done" (vc-delistify files))) + (lambda () + (vc-call-backend backend 'log-edit-mode)) + (lexical-let ((rev rev)) + (lambda (files comment) + (message "Checking in %s..." (vc-delistify files)) + ;; "This log message intentionally left almost blank". + ;; RCS 5.7 gripes about white-space-only comments too. + (or (and comment (string-match "[^\t\n ]" comment)) + (setq comment "*** empty log message ***")) + (with-vc-properties + files + ;; We used to change buffers to get local value of + ;; vc-checkin-switches, but 'the' local buffer is + ;; not a well-defined concept for filesets. + (progn + (vc-call-backend backend 'checkin files rev comment) + (mapc 'vc-delete-automatic-version-backups files)) + `((vc-state . up-to-date) + (vc-checkout-time . ,(nth 5 (file-attributes file))) + (vc-working-revision . nil))) + (message "Checking in %s...done" (vc-delistify files)))) 'vc-checkin-hook))) ;;; Additional entry points for examining version histories @@ -1514,7 +1553,7 @@ (not (string= (vc-working-revision file) "0"))) (push file filtered) ;; This file is added but not yet committed; - ;; there is no master file to diff against. + ;; there is no repository version to diff against. (if (or rev1 rev2) (error "No revisions of %s exist" file) ;; We regard this as "changed". @@ -1533,6 +1572,10 @@ (message "%s" (cdr messages)) nil) (diff-mode) + (set (make-local-variable 'diff-vc-backend) (car vc-fileset)) + (set (make-local-variable 'revert-buffer-function) + `(lambda (ignore-auto noconfirm) + (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose))) ;; Make the *vc-diff* buffer read only, the diff-mode key ;; bindings are nicer for read only buffers. pcl-cvs does the ;; same thing. @@ -1639,18 +1682,20 @@ ;; that's not what we want here, we want the diff for the VC root dir. (call-interactively 'vc-version-diff) (when buffer-file-name (vc-buffer-sync not-urgent)) - (let ((backend - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) - (vc-mode (vc-backend buffer-file-name)))) + (let ((backend (vc-deduce-backend)) rootdir working-revision) (unless backend (error "Buffer is not version controlled")) (setq rootdir (vc-call-backend backend 'root default-directory)) (setq working-revision (vc-working-revision rootdir)) - (vc-diff-internal - t (list backend (list rootdir) working-revision) nil nil - (called-interactively-p 'interactive))))) + ;; VC diff for the root directory produces output that is + ;; relative to it. Bind default-directory to the root directory + ;; here, this way the *vc-diff* buffer is setup correctly, so + ;; relative file names work. + (let ((default-directory rootdir)) + (vc-diff-internal + t (list backend (list rootdir) working-revision) nil nil + (called-interactively-p 'interactive)))))) ;;;###autoload (defun vc-revision-other-window (rev) @@ -1754,17 +1799,19 @@ (defun vc-modify-change-comment (files rev oldcomment) "Edit the comment associated with the given files and revision." - (vc-start-logentry - files rev oldcomment t - "Enter a replacement change comment." - "*VC-log*" - (lambda (files rev comment) - (vc-call-backend - ;; Less of a kluge than it looks like; log-view mode only passes - ;; this function a singleton list. Arguments left in this form in - ;; case the more general operation ever becomes meaningful. - (vc-responsible-backend (car files)) - 'modify-change-comment files rev comment)))) + ;; Less of a kluge than it looks like; log-view mode only passes + ;; this function a singleton list. Arguments left in this form in + ;; case the more general operation ever becomes meaningful. + (let ((backend (vc-responsible-backend (car files)))) + (vc-start-logentry + files oldcomment t + "Enter a replacement change comment." + "*VC-log*" + (lambda () (vc-call-backend backend 'log-edit-mode)) + (lexical-let ((rev rev)) + (lambda (files comment) + (vc-call-backend backend + 'modify-change-comment files rev comment)))))) ;;;###autoload (defun vc-merge () @@ -1825,6 +1872,31 @@ ;;;###autoload (defalias 'vc-resolve-conflicts 'smerge-ediff) +;; TODO: This is OK but maybe we could integrate it better. +;; E.g. it could be run semi-automatically (via a prompt?) when saving a file +;; that was conflicted (i.e. upon mark-resolved). +;; FIXME: should we add an "other-window" version? Or maybe we should +;; hook it inside find-file so it automatically works for +;; find-file-other-window as well. E.g. find-file could use a new +;; `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. +(defun vc-find-conflicted-file () + "Visit the next conflicted file in the current project." + (interactive) + (let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name)) + (vc-responsible-backend default-directory) + (error "No VC backend"))) + (files (vc-call-backend backend + 'conflicted-files default-directory))) + ;; Don't try and visit the current file. + (if (equal (car files) buffer-file-name) (pop files)) + (if (null files) + (message "No more conflicted files") + (find-file (pop files)) + (message "%s more conflicted files after this one" + (if files (length files) "No"))))) + ;; Named-configuration entry points (defun vc-tag-precondition (dir) @@ -1850,13 +1922,22 @@ given, the tag is made as a new branch and the files are checked out in that new branch." (interactive - (list (read-file-name "Directory: " default-directory default-directory t) - (read-string "New tag name: ") - current-prefix-arg)) + (let ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity))) + (list + (if (eq granularity 'repository) + ;; For VC's that do not work at file level, it's pointless + ;; to ask for a directory, branches are created at repository level. + default-directory + (read-file-name "Directory: " default-directory default-directory t)) + (read-string (if current-prefix-arg "New branch name: " "New tag name: ")) + current-prefix-arg))) (message "Making %s... " (if branchp "branch" "tag")) (when (file-directory-p dir) (setq dir (file-name-as-directory dir))) (vc-call-backend (vc-responsible-backend dir) 'create-tag dir name branchp) + (vc-resynch-buffer dir t t t) (message "Making %s... done" (if branchp "branch" "tag"))) ;;;###autoload @@ -1867,8 +1948,16 @@ locked files at or below DIR (but if NAME is empty, locked files are allowed and simply skipped)." (interactive - (list (read-file-name "Directory: " default-directory default-directory t) - (read-string "Tag name to retrieve (default latest revisions): "))) + (let ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity))) + (list + (if (eq granularity 'repository) + ;; For VC's that do not work at file level, it's pointless + ;; to ask for a directory, branches are created at repository level. + default-directory + (read-file-name "Directory: " default-directory default-directory t)) + (read-string "Tag name to retrieve (default latest revisions): ")))) (let ((update (yes-or-no-p "Update any affected buffers? ")) (msg (if (or (not name) (string= name "")) (format "Updating %s... " (abbreviate-file-name dir)) @@ -1877,8 +1966,10 @@ (message "%s" msg) (vc-call-backend (vc-responsible-backend dir) 'retrieve-tag dir name update) + (vc-resynch-buffer dir t t t) (message "%s" (concat msg "done")))) + ;; Miscellaneous other entry points ;; FIXME: this should be a defcustom @@ -1891,9 +1982,31 @@ If it contains `file' then show short logs for files. Not all VC backends support short logs!") -(defvar log-view-vc-backend) (defvar log-view-vc-fileset) +(defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) + (when (and limit (not (eq 'limit-unsupported pl-return)) + (not is-start-revision)) + (goto-char (point-max)) + (lexical-let ((working-revision working-revision) + (limit limit)) + (widget-create 'push-button + :notify (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil (* 2 limit))) + :help-echo "Show the log again, and double the number of log entries shown" + "Show 2X entries") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil nil)) + :help-echo "Show the log again, showing all entries" + "Show unlimited entries")) + (widget-setup))) + (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) ;; Don't switch to the output buffer before running the command, @@ -1901,6 +2014,8 @@ ;; buffer can be accessed by the command. (let ((dir-present nil) (vc-short-log nil) + (buffer-name "*vc-change-log*") + type pl-return) (dolist (file files) (when (file-directory-p file) @@ -1909,44 +2024,78 @@ (not (null (if dir-present (memq 'directory vc-log-short-style) (memq 'file vc-log-short-style))))) + (setq type (if vc-short-log 'short 'long)) + (lexical-let + ((working-revision working-revision) + (backend backend) + (limit limit) + (shortlog vc-short-log) + (files files) + (is-start-revision is-start-revision)) + (vc-log-internal-common + backend buffer-name files type + (lambda (bk buf type-arg files-arg) + (vc-call-backend bk 'print-log files-arg buf + shortlog (when is-start-revision working-revision) limit)) + (lambda (bk files-arg ret) + (vc-print-log-setup-buttons working-revision + is-start-revision limit ret)) + (lambda (bk) + (vc-call-backend bk 'show-log-entry working-revision)) + (lambda (ignore-auto noconfirm) + (vc-print-log-internal backend files working-revision is-start-revision limit)))))) - (setq pl-return (vc-call-backend - backend 'print-log files "*vc-change-log*" - vc-short-log (when is-start-revision working-revision) limit)) - (pop-to-buffer "*vc-change-log*") +(defvar vc-log-view-type nil + "Set this to differentiate the different types of logs.") +(put 'vc-log-view-type 'permanent-local t) + +(defun vc-log-internal-common (backend + buffer-name + files + type + backend-func + setup-buttons-func + goto-location-func + rev-buff-func) + (let (retval) + (with-current-buffer (get-buffer-create buffer-name) + (set (make-local-variable 'vc-log-view-type) type)) + (setq retval (funcall backend-func backend buffer-name type files)) + (pop-to-buffer buffer-name) (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. - (vc-call-backend backend 'log-view-mode)) - (set (make-local-variable 'log-view-vc-backend) backend) - (set (make-local-variable 'log-view-vc-fileset) files) - + (vc-call-backend backend 'log-view-mode) + (set (make-local-variable 'log-view-vc-backend) backend) + (set (make-local-variable 'log-view-vc-fileset) files) + (set (make-local-variable 'revert-buffer-function) + rev-buff-func)) (vc-exec-after `(let ((inhibit-read-only t)) - (when (and ,limit (not ,(eq 'limit-unsupported pl-return)) - (not ,is-start-revision)) - (goto-char (point-max)) - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - ',backend ',files ',working-revision nil (* 2 ,limit))) - :help-echo "Show the log again, and double the number of log entries shown" - "Show 2X entries") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - ',backend ',files ',working-revision nil nil)) - :help-echo "Show the log again, showing all entries" - "Show unlimited entries") - (widget-setup)) - + (funcall ',setup-buttons-func ',backend ',files ',retval) (shrink-window-if-larger-than-buffer) - ;; move point to the log entry for the working revision - (vc-call-backend ',backend 'show-log-entry ',working-revision) + (funcall ',goto-location-func ',backend) (setq vc-sentinel-movepoint (point)) (set-buffer-modified-p nil))))) +(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) + (vc-log-internal-common + backend buffer-name nil type + (lexical-let + ((remote-location remote-location)) + (lambda (bk buf type-arg files) + (vc-call-backend bk type-arg buf remote-location))) + (lambda (bk files-arg ret)) + (lambda (bk) + (goto-char (point-min))) + (lexical-let + ((backend backend) + (remote-location remote-location) + (buffer-name buffer-name) + (type type)) + (lambda (ignore-auto noconfirm) + (vc-incoming-outgoing-internal backend remote-location buffer-name type))))) + ;;;###autoload (defun vc-print-log (&optional working-revision limit) "List the change log of the current fileset in a window. @@ -1995,10 +2144,7 @@ (list lim))) (t (list (when (> vc-log-show-limit 0) vc-log-show-limit))))) - (let ((backend - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) - (vc-mode (vc-backend buffer-file-name)))) + (let ((backend (vc-deduce-backend)) rootdir working-revision) (unless backend (error "Buffer is not version controlled")) @@ -2007,6 +2153,32 @@ (vc-print-log-internal backend (list rootdir) working-revision nil limit))) ;;;###autoload +(defun vc-log-incoming (&optional remote-location) + "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION. +When called interactively with a prefix argument, prompt for REMOTE-LOCATION.." + (interactive + (when current-prefix-arg + (list (read-string "Remote location (empty for default): ")))) + (let ((backend (vc-deduce-backend)) + rootdir working-revision) + (unless backend + (error "Buffer is not version controlled")) + (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming))) + +;;;###autoload +(defun vc-log-outgoing (&optional remote-location) + "Show a 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." + (interactive + (when current-prefix-arg + (list (read-string "Remote location (empty for default): ")))) + (let ((backend (vc-deduce-backend)) + rootdir working-revision) + (unless backend + (error "Buffer is not version controlled")) + (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing))) + +;;;###autoload (defun vc-revert () "Revert working copies of the selected fileset to their repository contents. This asks for confirmation if the buffer contents are not identical @@ -2240,7 +2412,7 @@ (if unmodified-file (copy-file unmodified-file file 'ok-if-already-exists 'keep-date) - (when (y-or-n-p "Get base revision from master? ") + (when (y-or-n-p "Get base revision from repository? ") (vc-revert-file file)))) (vc-call-backend new-backend 'receive-file file rev)) (when modified-file @@ -2327,7 +2499,7 @@ ;;;###autoload (defun vc-rename-file (old new) - "Rename file OLD to NEW, and rename its master file likewise." + "Rename file OLD to NEW in both work area and repository." (interactive "fVC rename file: \nFRename to: ") ;; in CL I would have said (setq new (merge-pathnames new old)) (let ((old-base (file-name-nondirectory old))) @@ -2451,6 +2623,10 @@ (defalias 'vc-default-check-headers 'ignore) +(declare-function log-edit-mode "log-edit" ()) + +(defun vc-default-log-edit-mode (backend) (log-edit-mode)) + (defun vc-default-log-view-mode (backend) (log-view-mode)) (defun vc-default-show-log-entry (backend rev)