Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Backport VC improvements from trunk.

Browse source 
* 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.
This commit is contained in:
Chong Yidong 2010-10-31 23:13:42 -04:00
parent 6aad7ea061
commit 98cfec0d69
14 changed files with 955 additions and 279 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
etc/NEWS
View file

@ -34,6 +34,42 @@ alt/option key by customizing the value for ns-right-alternate-modifier.
** 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
+++

185
lisp/ChangeLog
View file

@ -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,

4
lisp/diff-mode.el
View file

@ -97,6 +97,9 @@ when editing big diffs)."
: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 @@ when editing big diffs)."
;; 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.")

259
lisp/log-edit.el
View file

@ -125,6 +125,7 @@ If SETUP is 'force, this variable has no effect."
: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 @@ when this variable is set to nil.")
(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 @@ automatically."
;;; 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 @@ uses the current buffer."
(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 @@ commands (under C-x v for VC, for example).
\\{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 @@ commands (under C-x v for VC, for example).
"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 @@ If you want to abort the commit, simply delete the buffer."
"(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 @@ can thus take some time."
(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 @@ If the optional prefix arg USE-FIRST is given (via \\[universal-argument]),
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 @@ for more details."
(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 @@ Return non-nil if it is."
(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 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
(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)

1
lisp/log-view.el
View file

@ -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)

3
lisp/vc-arch.el
View file

@ -254,8 +254,7 @@ Only the value `maybe' can be trusted :-(."
(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)

101
lisp/vc-bzr.el
View file

@ -451,11 +451,17 @@ or a superior directory.")
"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 @@ REV non-nil gets an error."
(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 @@ REV non-nil gets an error."
(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 @@ REV non-nil gets an error."
(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 @@ stream. Standard error output is discarded."
(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 @@ stream. Standard error output is discarded."
(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 @@ stream. Standard error output is discarded."
(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 @@ stream. Standard error output is discarded."
(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 @@ stream. Standard error output is discarded."
(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

27
lisp/vc-dir.el
View file

@ -188,9 +188,18 @@ See `run-hooks'."
(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 @@ See `run-hooks'."
(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 @@ specific headers."
(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 @@ outside of VC) and one wants to do some operation on it."
(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 @@ These are the commands available for use in the file status buffer:
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'.

62
lisp/vc-dispatcher.el
View file

@ -141,7 +141,6 @@ preserve the setting."
(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 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'."
(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 @@ editing!"
(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 @@ editing!"
(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 @@ NOT-URGENT means it is ok to continue if the user says not to save."
;; 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 @@ contents of the log entry buffer. If COMMENT is a string and
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 @@ for `vc-log-after-operation-hook'."
(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 @@ for `vc-log-after-operation-hook'."
(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 @@ the buffer contents as a comment."
(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 @@ the buffer contents as a comment."
(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

58
lisp/vc-git.el
View file

@ -118,7 +118,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
: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 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(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 @@ or an empty string if none."
(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 @@ or an empty string if none."
"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 @@ for the --graph option."
(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 @@ or BRANCH^ (where \"^\" can be repeated)."
(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))

89
lisp/vc-hg.el
View file

@ -256,33 +256,33 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(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 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
("^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 @@ COMMENT is ignored."
;; "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 @@ REV is the revision to check out into WORKFILE."
(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 @@ REV is the revision to check out into WORKFILE."
(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 @@ REV is the revision to check out into WORKFILE."
;; (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]))
(defun vc-hg-log-incoming (buffer remote-location)
(vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "")
remote-location)))
(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-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 @@ REV is the revision to check out into WORKFILE."
(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

21
lisp/vc-hooks.el
View file

@ -403,7 +403,7 @@ If the argument is a list, the files must all have the same back end."
(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 @@ For registered files, the value returned is one of:
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 @@ and does not employ any heuristic at all."
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 @@ Format:
\"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 @@ current, and kill the buffer that visits the link."
(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 @@ current, and kill the buffer that visits the link."
(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")))

8
lisp/vc-mtn.el
View file

@ -172,8 +172,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(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))

380
lisp/vc.el
View file

@ -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 @@ See `run-hooks'."
"\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 @@ is sensitive to blank lines."
(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 @@ Within directories, only files already under version control are noticed."
(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 @@ merge in the changes into your working copy."
(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 @@ merge in the changes into your working copy."
(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 @@ merge in the changes into your working copy."
(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 @@ Type \\[vc-next-action] to check in changes.")
(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 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(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 @@ returns t if the buffer had changes, nil otherwise."
(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 @@ returns t if the buffer had changes, nil otherwise."
(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 @@ saving the buffer."
;; 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 @@ The headers are reset to their non-expanded form."
(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 @@ See Info node `Merging'."
;;;###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 @@ the named configuration. If the prefix argument BRANCHP is
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 @@ 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)."
(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 @@ allowed and simply skipped)."
(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 `directory' then if the fileset contains a directory show a short
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 @@ Not all VC backends support short logs!")
;; 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 all VC backends support short logs!")
(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 @@ When called interactively with a prefix argument, prompt for LIMIT."
(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"))
@ -2006,6 +2152,32 @@ When called interactively with a prefix argument, prompt for LIMIT."
(setq working-revision (vc-working-revision rootdir))
(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.
@ -2240,7 +2412,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
(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 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
;;;###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 @@ to provide the `find-revision' operation instead."
(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)