return 1
}
-proc _visualize {w} {
- set revs {}
+proc _refs {w list} {
+ set r {}
foreach i [$w.source.l curselection] {
- lappend revs [$w.source.l get $i]
+ lappend r [lindex [lindex $list $i] 0]
}
+ return $r
+}
+
+proc _visualize {w list} {
+ set revs [_refs $w $list]
if {$revs eq {}} return
lappend revs --not HEAD
do_gitk $revs
}
-proc _start {w} {
+proc _start {w list} {
global HEAD ui_status_value current_branch
set cmd [list git merge]
- set names {}
- set revcnt 0
- foreach i [$w.source.l curselection] {
- set b [$w.source.l get $i]
- lappend cmd $b
- lappend names $b
- incr revcnt
- }
+ set names [_refs $w $list]
+ set revcnt [llength $names]
+ append cmd { } $names
if {$revcnt == 0} {
return
set msg "Merging $current_branch, [join $names {, }]"
set ui_status_value "$msg..."
set cons [console::new "Merge" $msg]
- console::exec $cons $cmd [namespace code [list _finish $revcnt]]
+ console::exec $cons $cmd \
+ [namespace code [list _finish $revcnt $cons]]
bind $w <Destroy> {}
destroy $w
}
proc dialog {} {
global current_branch
+ global M1B
if {![_can_merge]} return
+ set fmt {list %(objectname) %(*objectname) %(refname) %(subject)}
+ set cmd [list git for-each-ref --tcl --format=$fmt]
+ lappend cmd refs/heads
+ lappend cmd refs/remotes
+ lappend cmd refs/tags
+ set fr_fd [open "| $cmd" r]
+ fconfigure $fr_fd -translation binary
+ while {[gets $fr_fd line] > 0} {
+ set line [eval $line]
+ set ref [lindex $line 2]
+ regsub ^refs/(heads|remotes|tags)/ $ref {} ref
+ set subj($ref) [lindex $line 3]
+ lappend sha1([lindex $line 0]) $ref
+ if {[lindex $line 1] ne {}} {
+ lappend sha1([lindex $line 1]) $ref
+ }
+ }
+ close $fr_fd
+
+ set to_show {}
+ set fr_fd [open "| git rev-list --all --not HEAD"]
+ while {[gets $fr_fd line] > 0} {
+ if {[catch {set ref $sha1($line)}]} continue
+ foreach n $ref {
+ lappend to_show [list $n $line]
+ }
+ }
+ close $fr_fd
+ set to_show [lsort -unique $to_show]
+
set w .merge_setup
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
+ set _visualize [namespace code [list _visualize $w $to_show]]
+ set _start [namespace code [list _start $w $to_show]]
+
label $w.header \
-text "Merge Into $current_branch" \
-font font_uibold
pack $w.header -side top -fill x
frame $w.buttons
- button $w.buttons.visualize -text Visualize \
- -command [namespace code [list _visualize $w]]
+ button $w.buttons.visualize -text Visualize -command $_visualize
pack $w.buttons.visualize -side left
- button $w.buttons.create -text Merge \
- -command [namespace code [list _start $w]]
+ button $w.buttons.create -text Merge -command $_start
pack $w.buttons.create -side right
- button $w.buttons.cancel -text {Cancel} \
- -command [list destroy $w]
+ button $w.buttons.cancel -text {Cancel} -command [list destroy $w]
pack $w.buttons.cancel -side right -padx 5
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
listbox $w.source.l \
-height 10 \
-width 70 \
+ -font font_diff \
-selectmode extended \
-yscrollcommand [list $w.source.sby set]
scrollbar $w.source.sby -command [list $w.source.l yview]
pack $w.source.l -side left -fill both -expand 1
pack $w.source -fill both -expand 1 -pady 5 -padx 5
- set cmd [list git for-each-ref]
- lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
- lappend cmd refs/heads
- lappend cmd refs/remotes
- lappend cmd refs/tags
- set fr_fd [open "| $cmd" r]
- fconfigure $fr_fd -translation binary
- while {[gets $fr_fd line] > 0} {
- set line [split $line { }]
- set sha1([lindex $line 0]) [lindex $line 2]
- set sha1([lindex $line 1]) [lindex $line 2]
- }
- close $fr_fd
-
- set to_show {}
- set fr_fd [open "| git rev-list --all --not HEAD"]
- while {[gets $fr_fd line] > 0} {
- if {[catch {set ref $sha1($line)}]} continue
- regsub ^refs/(heads|remotes|tags)/ $ref {} ref
- lappend to_show $ref
+ foreach ref $to_show {
+ set n [lindex $ref 0]
+ if {[string length $n] > 20} {
+ set n "[string range $n 0 16]..."
+ }
+ $w.source.l insert end [format {%s %-20s %s} \
+ [string range [lindex $ref 1] 0 5] \
+ $n \
+ $subj([lindex $ref 0])]
}
- close $fr_fd
- foreach ref [lsort -unique $to_show] {
- $w.source.l insert end $ref
- }
+ bind $w.source.l <Key-K> [list event generate %W <Shift-Key-Up>]
+ bind $w.source.l <Key-J> [list event generate %W <Shift-Key-Down>]
+ bind $w.source.l <Key-k> [list event generate %W <Key-Up>]
+ bind $w.source.l <Key-j> [list event generate %W <Key-Down>]
+ bind $w.source.l <Key-h> [list event generate %W <Key-Left>]
+ bind $w.source.l <Key-l> [list event generate %W <Key-Right>]
+ bind $w.source.l <Key-v> $_visualize
- bind $w <Visibility> "grab $w"
+ bind $w <$M1B-Key-Return> $_start
+ bind $w <Visibility> "grab $w; focus $w.source.l"
bind $w <Key-Escape> "unlock_index;destroy $w"
bind $w <Destroy> unlock_index
wm title $w "[appname] ([reponame]): Merge"