Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
72169e55
Commit
72169e55
authored
Sep 22, 2009
by
Sam Steingold
Browse files
(vc-hg-print-log): Fix shortlog arg passing.
parent
b0459dec
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
154 additions
and
149 deletions
+154
-149
lisp/ChangeLog
lisp/ChangeLog
+4
-0
lisp/vc-hg.el
lisp/vc-hg.el
+150
-149
No files found.
lisp/ChangeLog
View file @
72169e55
2009-09-22 Sam Steingold <sds@gnu.org>
* vc-hg.el (vc-hg-print-log): Fix shortlog arg passing.
2009-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/fill.el: Convert to utf-8 encoding.
...
...
lisp/vc-hg.el
View file @
72169e55
...
...
@@ -127,9 +127,9 @@
"String or list of strings specifying switches for Hg diff under VC.
If nil, use the value of `vc-diff-switches'. If t, use no switches."
:type
'
(
choice
(
const
:tag
"Unspecified"
nil
)
(
const
:tag
"None"
t
)
(
string
:tag
"Argument String"
)
(
repeat
:tag
"Argument List"
:value
(
""
)
string
))
(
const
:tag
"None"
t
)
(
string
:tag
"Argument String"
)
(
repeat
:tag
"Argument List"
:value
(
""
)
string
))
:version
"23.1"
:group
'vc
)
...
...
@@ -160,53 +160,53 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(
let*
((
status
nil
)
(
out
(
with-output-to-string
(
with-current-buffer
standard-output
(
setq
status
(
condition-case
nil
;; Ignore all errors.
(
call-process
"hg"
nil
t
nil
"--cwd"
(
file-name-directory
file
)
"status"
"-A"
(
file-name-nondirectory
file
))
;; Some problem happened. E.g. We can't find an `hg'
;; executable.
(
error
nil
)))))))
(
with-output-to-string
(
with-current-buffer
standard-output
(
setq
status
(
condition-case
nil
;; Ignore all errors.
(
call-process
"hg"
nil
t
nil
"--cwd"
(
file-name-directory
file
)
"status"
"-A"
(
file-name-nondirectory
file
))
;; Some problem happened. E.g. We can't find an `hg'
;; executable.
(
error
nil
)))))))
(
when
(
eq
0
status
)
(
when
(
null
(
string-match
".*: No such file or directory$"
out
))
(
let
((
state
(
aref
out
0
)))
(
cond
((
eq
state
?=
)
'up-to-date
)
((
eq
state
?A
)
'added
)
((
eq
state
?M
)
'edited
)
((
eq
state
?I
)
'ignored
)
((
eq
state
?R
)
'removed
)
((
eq
state
?!
)
'missing
)
((
eq
state
??
)
'unregistered
)
((
eq
state
?C
)
'up-to-date
)
;; Older mercurials use this
(
t
'up-to-date
)))))))
(
when
(
null
(
string-match
".*: No such file or directory$"
out
))
(
let
((
state
(
aref
out
0
)))
(
cond
((
eq
state
?=
)
'up-to-date
)
((
eq
state
?A
)
'added
)
((
eq
state
?M
)
'edited
)
((
eq
state
?I
)
'ignored
)
((
eq
state
?R
)
'removed
)
((
eq
state
?!
)
'missing
)
((
eq
state
??
)
'unregistered
)
((
eq
state
?C
)
'up-to-date
)
;; Older mercurials use this
(
t
'up-to-date
)))))))
(
defun
vc-hg-working-revision
(
file
)
"Hg-specific version of `vc-working-revision'."
(
let*
((
status
nil
)
(
out
(
with-output-to-string
(
with-current-buffer
standard-output
(
setq
status
(
condition-case
nil
;; Ignore all errors.
(
call-process
"hg"
nil
t
nil
"--cwd"
(
file-name-directory
file
)
"log"
"-l1"
(
file-name-nondirectory
file
))
;; Some problem happened. E.g. We can't find an `hg'
;; executable.
(
error
nil
)))))))
(
with-output-to-string
(
with-current-buffer
standard-output
(
setq
status
(
condition-case
nil
;; Ignore all errors.
(
call-process
"hg"
nil
t
nil
"--cwd"
(
file-name-directory
file
)
"log"
"-l1"
(
file-name-nondirectory
file
))
;; Some problem happened. E.g. We can't find an `hg'
;; executable.
(
error
nil
)))))))
(
when
(
eq
0
status
)
(
if
(
string-match
"changeset: *\\([0-9]*\\)"
out
)
(
match-string
1
out
)
"0"
))))
(
match-string
1
out
)
"0"
))))
;;; History functions
...
...
@@ -232,8 +232,9 @@ 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"
(
if
shortlog
'
(
"--style"
"compact"
))
vc-hg-log-switches
))))
(
if
shortlog
(
append
'
(
"--style"
"compact"
)
vc-hg-log-switches
)
vc-hg-log-switches
)))))
(
defvar
log-view-message-re
)
(
defvar
log-view-file-re
)
...
...
@@ -247,52 +248,52 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(
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]+\\)\\) +\\(.*\\)$"
"^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"
))
"^\\([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
(
append
`
((
,
log-view-message-re
(
1
'log-view-message-face
)
(
2
'log-view-message-face
)
(
3
'change-log-date
)
(
4
'change-log-name
))))
(
append
`
((
,
log-view-message-re
(
1
'log-view-message-face
)
(
2
'log-view-message-face
)
(
3
'change-log-date
)
(
4
'change-log-name
))))
(
append
log-view-font-lock-keywords
'
(
;; Handle the case:
;; user: FirstName LastName <foo@bar>
(
"^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(
1
'change-log-name
)
(
2
'change-log-email
))
;; Handle the cases:
;; user: foo@bar
;; and
;; user: foo
(
"^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
)))))))
log-view-font-lock-keywords
'
(
;; Handle the case:
;; user: FirstName LastName <foo@bar>
(
"^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(
1
'change-log-name
)
(
2
'change-log-email
))
;; Handle the cases:
;; user: foo@bar
;; and
;; user: foo
(
"^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
)))))))
(
defun
vc-hg-diff
(
files
&optional
oldvers
newvers
buffer
)
"Get a difference report using hg between two revisions of FILES."
(
let*
((
firstfile
(
car
files
))
(
cwd
(
if
firstfile
(
file-name-directory
firstfile
)
(
expand-file-name
default-directory
)))
(
working
(
and
firstfile
(
vc-working-revision
firstfile
))))
(
cwd
(
if
firstfile
(
file-name-directory
firstfile
)
(
expand-file-name
default-directory
)))
(
working
(
and
firstfile
(
vc-working-revision
firstfile
))))
(
when
(
and
(
equal
oldvers
working
)
(
not
newvers
))
(
setq
oldvers
nil
))
(
when
(
and
(
not
oldvers
)
newvers
)
(
setq
oldvers
working
))
(
apply
#'
vc-hg-command
(
or
buffer
"*vc-diff*"
)
nil
(
mapcar
(
lambda
(
file
)
(
file-relative-name
file
cwd
))
files
)
"--cwd"
cwd
"diff"
(
append
(
vc-switches
'hg
'diff
)
(
when
oldvers
(
if
newvers
(
list
"-r"
oldvers
"-r"
newvers
)
(
list
"-r"
oldvers
)))))))
(
mapcar
(
lambda
(
file
)
(
file-relative-name
file
cwd
))
files
)
"--cwd"
cwd
"diff"
(
append
(
vc-switches
'hg
'diff
)
(
when
oldvers
(
if
newvers
(
list
"-r"
oldvers
"-r"
newvers
)
(
list
"-r"
oldvers
)))))))
(
defun
vc-hg-revision-table
(
files
)
(
let
((
default-directory
(
file-name-directory
(
car
files
))))
...
...
@@ -313,7 +314,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
(
vc-hg-command
buffer
0
file
"annotate"
"-d"
"-n"
(
when
revision
(
concat
"-r"
revision
)))
(
when
revision
(
concat
"-r"
revision
)))
(
with-current-buffer
buffer
(
goto-char
(
point-min
))
(
re-search-forward
"^[ \t]*[0-9]"
)
...
...
@@ -348,12 +349,12 @@ Optional arg REVISION is a revision to annotate from."
(
defun
vc-hg-next-revision
(
file
rev
)
(
let
((
newrev
(
1+
(
string-to-number
rev
)))
(
tip-revision
(
with-temp-buffer
(
vc-hg-command
t
0
nil
"tip"
)
(
goto-char
(
point-min
))
(
re-search-forward
"^changeset:[ \t]*\\([0-9]+\\):"
)
(
string-to-number
(
match-string-no-properties
1
)))))
(
tip-revision
(
with-temp-buffer
(
vc-hg-command
t
0
nil
"tip"
)
(
goto-char
(
point-min
))
(
re-search-forward
"^changeset:[ \t]*\\([0-9]+\\):"
)
(
string-to-number
(
match-string-no-properties
1
)))))
;; We don't want to exceed the maximum possible revision number, ie
;; the tip revision.
(
when
(
<=
newrev
tip-revision
)
...
...
@@ -409,7 +410,7 @@ REV is ignored."
(
let
((
coding-system-for-read
'binary
)
(
coding-system-for-write
'binary
))
(
if
rev
(
vc-hg-command
buffer
0
file
"cat"
"-r"
rev
)
(
vc-hg-command
buffer
0
file
"cat"
"-r"
rev
)
(
vc-hg-command
buffer
0
file
"cat"
))))
;; Modeled after the similar function in vc-bzr.el
...
...
@@ -464,64 +465,64 @@ REV is the revision to check out into WORKFILE."
(
vc-default-dir-printer
'Hg
info
)
(
when
extra
(
insert
(
propertize
(
format
" (%s %s)"
(
case
(
vc-hg-extra-fileinfo->rename-state
extra
)
(
'copied
"copied from"
)
(
'renamed-from
"renamed from"
)
(
'renamed-to
"renamed to"
))
(
vc-hg-extra-fileinfo->extra-name
extra
))
'face
'font-lock-comment-face
)))))
(
format
" (%s %s)"
(
case
(
vc-hg-extra-fileinfo->rename-state
extra
)
(
'copied
"copied from"
)
(
'renamed-from
"renamed from"
)
(
'renamed-to
"renamed to"
))
(
vc-hg-extra-fileinfo->extra-name
extra
))
'face
'font-lock-comment-face
)))))
(
defun
vc-hg-after-dir-status
(
update-function
)
(
let
((
status-char
nil
)
(
file
nil
)
(
translation
'
((
?=
.
up-to-date
)
(
?C
.
up-to-date
)
(
?A
.
added
)
(
?R
.
removed
)
(
?M
.
edited
)
(
?I
.
ignored
)
(
?!
.
missing
)
(
?
.
copy-rename-line
)
(
??
.
unregistered
)))
(
translated
nil
)
(
result
nil
)
(
last-added
nil
)
(
last-line-copy
nil
))
(
file
nil
)
(
translation
'
((
?=
.
up-to-date
)
(
?C
.
up-to-date
)
(
?A
.
added
)
(
?R
.
removed
)
(
?M
.
edited
)
(
?I
.
ignored
)
(
?!
.
missing
)
(
?
.
copy-rename-line
)
(
??
.
unregistered
)))
(
translated
nil
)
(
result
nil
)
(
last-added
nil
)
(
last-line-copy
nil
))
(
goto-char
(
point-min
))
(
while
(
not
(
eobp
))
(
setq
translated
(
cdr
(
assoc
(
char-after
)
translation
)))
(
setq
file
(
buffer-substring-no-properties
(
+
(
point
)
2
)
(
line-end-position
)))
(
cond
((
not
translated
)
(
setq
last-line-copy
nil
))
((
eq
translated
'up-to-date
)
(
setq
last-line-copy
nil
))
((
eq
translated
'copy-rename-line
)
;; For copied files the output looks like this:
;; A COPIED_FILE_NAME
;; ORIGINAL_FILE_NAME
(
setf
(
nth
2
last-added
)
(
vc-hg-create-extra-fileinfo
'copied
file
))
(
setq
last-line-copy
t
))
((
and
last-line-copy
(
eq
translated
'removed
))
;; For renamed files the output looks like this:
;; A NEW_FILE_NAME
;; ORIGINAL_FILE_NAME
;; R ORIGINAL_FILE_NAME
;; We need to adjust the previous entry to not think it is a copy.
(
setf
(
vc-hg-extra-fileinfo->rename-state
(
nth
2
last-added
))
'renamed-from
)
(
push
(
list
file
translated
(
vc-hg-create-extra-fileinfo
'renamed-to
(
nth
0
last-added
)))
result
)
(
setq
last-line-copy
nil
))
(
t
(
setq
last-added
(
list
file
translated
nil
))
(
push
last-added
result
)
(
setq
last-line-copy
nil
)))
(
forward-line
))
(
setq
translated
(
cdr
(
assoc
(
char-after
)
translation
)))
(
setq
file
(
buffer-substring-no-properties
(
+
(
point
)
2
)
(
line-end-position
)))
(
cond
((
not
translated
)
(
setq
last-line-copy
nil
))
((
eq
translated
'up-to-date
)
(
setq
last-line-copy
nil
))
((
eq
translated
'copy-rename-line
)
;; For copied files the output looks like this:
;; A COPIED_FILE_NAME
;; ORIGINAL_FILE_NAME
(
setf
(
nth
2
last-added
)
(
vc-hg-create-extra-fileinfo
'copied
file
))
(
setq
last-line-copy
t
))
((
and
last-line-copy
(
eq
translated
'removed
))
;; For renamed files the output looks like this:
;; A NEW_FILE_NAME
;; ORIGINAL_FILE_NAME
;; R ORIGINAL_FILE_NAME
;; We need to adjust the previous entry to not think it is a copy.
(
setf
(
vc-hg-extra-fileinfo->rename-state
(
nth
2
last-added
))
'renamed-from
)
(
push
(
list
file
translated
(
vc-hg-create-extra-fileinfo
'renamed-to
(
nth
0
last-added
)))
result
)
(
setq
last-line-copy
nil
))
(
t
(
setq
last-added
(
list
file
translated
nil
))
(
push
last-added
result
)
(
setq
last-line-copy
nil
)))
(
forward-line
))
(
funcall
update-function
result
)))
(
defun
vc-hg-dir-status
(
dir
update-function
)
...
...
@@ -587,22 +588,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
'nconc
(
mapcar
(
lambda
(
arg
)
(
list
"-r"
arg
))
marked-list
))))
(
error
"No log entries selected for push"
))))
(
vc-hg-command
nil
0
nil
(
cons
"push"
(
apply
'nconc
(
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
'nconc
(
mapcar
(
lambda
(
arg
)
(
list
"-r"
arg
))
marked-list
))))
(
vc-hg-command
nil
0
nil
(
cons
"pull"
(
apply
'nconc
(
mapcar
(
lambda
(
arg
)
(
list
"-r"
arg
))
marked-list
))))
(
error
"No log entries selected for pull"
))))
;;; Internal functions
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment