[PATCH 0/7] gitk: UI enhancements

[PATCH 0/7] gitk: UI enhancements

[Alexander Gavrilov]

This is a set of patches that enhance the UI in various ways.
They should be applied in order, and after the previous 4 patches
that deal with encodings. The previous set of patches is
apparently not applied yet, but I feel that I should not hold
these back any longer.

If Robin Rosenberg's series gets accepted first, I'll rebase
and resend the patches.


Alexander Gavrilov (7):
      gitk: Enhance UI popup and accelerator handling.
      gitk: Allow forcing branch creation if it already exists.
      gitk: Allow starting gui blame for a specific line.
      gitk: Fix file list context menu for merge commits.
      gitk: Make cherry-pick call git-citool on conflicts.
      gitk: Implement a user-friendly Edit View dialog.
      gitk: Explicitly position popup windows.

 gitk |  550 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------
 1 files changed, 471 insertions(+), 79 deletions(-)

[PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Alexander Gavrilov]

- Popups are supposed to be marked transient, otherwise
  the WM creates them in strange places. Besides, at
  least under kwin, transients are automatically kept
  above their parent.
- Accelerators for menu items should be listed directly
  on the items, to make them more discoverable.
- Some more accelerators are added, e.g. F4 for Edit View.
- Finally, dialogs can now be accepted or dismissed using
  the Return and Escape keys.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |   96 ++++++++++++++++++++++++++++++++++++++++++++++++++----------------
 1 files changed, 73 insertions(+), 23 deletions(-)

diff --git a/gitk b/gitk
index e6c2a17..a4ef736 100755
--- a/gitk
+++ b/gitk
@@ -1710,22 +1710,24 @@ proc show_error {w top msg} {
     pack $w.ok -side bottom -fill x
     bind $top <Visibility> "grab $top; focus $top"
     bind $top <Key-Return> "destroy $top"
+    bind $top <Key-space>  "destroy $top"
+    bind $top <Key-Escape> "destroy $top"
     tkwait window $top
 }
 
-proc error_popup msg {
+proc error_popup {msg {owner .}} {
     set w .error
     toplevel $w
-    wm transient $w .
+    wm transient $w $owner
     show_error $w $w $msg
 }
 
-proc confirm_popup msg {
+proc confirm_popup {msg {owner .}} {
     global confirm_ok
     set confirm_ok 0
     set w .confirm
     toplevel $w
-    wm transient $w .
+    wm transient $w $owner
     message $w.m -text $msg -justify center -aspect 400
     pack $w.m -side top -fill x -padx 20 -pady 20
     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
@@ -1733,6 +1735,9 @@ proc confirm_popup msg {
     button $w.cancel -text [mc Cancel] -command "destroy $w"
     pack $w.cancel -side right -fill x
     bind $w <Visibility> "grab $w; focus $w"
+    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
+    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
+    bind $w <Key-Escape> "destroy $w"
     tkwait window $w
     return $confirm_ok
 }
@@ -1767,22 +1772,28 @@ proc makewindow {} {
     global rprogitem rprogcoord rownumsel numcommits
     global have_tk85
 
+    if {[tk windowingsystem] eq {aqua}} {
+	set M1T Cmd
+    } else {
+	set M1T Ctrl
+    }
+
     menu .bar
     .bar add cascade -label [mc "File"] -menu .bar.file
     menu .bar.file
-    .bar.file add command -label [mc "Update"] -command updatecommits
-    .bar.file add command -label [mc "Reload"] -command reloadcommits
+    .bar.file add command -label [mc "Update"] -accelerator F5 -command updatecommits
+    .bar.file add command -label [mc "Reload"] -accelerator $M1T-F5 -command reloadcommits
     .bar.file add command -label [mc "Reread references"] -command rereadrefs
-    .bar.file add command -label [mc "List references"] -command showrefs
-    .bar.file add command -label [mc "Quit"] -command doquit
+    .bar.file add command -label [mc "List references"] -accelerator F2 -command showrefs
+    .bar.file add command -label [mc "Quit"] -accelerator $M1T-Q -command doquit
     menu .bar.edit
     .bar add cascade -label [mc "Edit"] -menu .bar.edit
     .bar.edit add command -label [mc "Preferences"] -command doprefs
 
     menu .bar.view
     .bar add cascade -label [mc "View"] -menu .bar.view
-    .bar.view add command -label [mc "New view..."] -command {newview 0}
-    .bar.view add command -label [mc "Edit view..."] -command editview \
+    .bar.view add command -label [mc "New view..."] -accelerator Shift-F4 -command {newview 0}
+    .bar.view add command -label [mc "Edit view..."] -accelerator F4 -command editview \
 	-state disabled
     .bar.view add command -label [mc "Delete view"] -command delview -state disabled
     .bar.view add separator
@@ -2146,7 +2157,12 @@ proc makewindow {} {
     bindkey <Key-Return> {dofind 1 1}
     bindkey ? {dofind -1 1}
     bindkey f nextfile
-    bindkey <F5> updatecommits
+    bind . <F5> updatecommits
+    bind . <$M1B-F5> reloadcommits
+    bind . <F2> showrefs
+    bind . <Shift-F4> {newview 0}
+    catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
+    bind . <F4> edit_or_newview
     bind . <$M1B-q> doquit
     bind . <$M1B-f> {dofind 1 1}
     bind . <$M1B-g> {dofind 1 0}
@@ -2456,6 +2472,7 @@ proc about {} {
     }
     toplevel $w
     wm title $w [mc "About gitk"]
+    wm transient $w .
     message $w.m -text [mc "
 Gitk - a commit viewer for git
 
@@ -2484,10 +2501,10 @@ proc keys {} {
     }
     toplevel $w
     wm title $w [mc "Gitk key bindings"]
+    wm transient $w .
     message $w.m -text "
 [mc "Gitk key bindings:"]
 
-[mc "<%s-Q>		Quit" $M1T]
 [mc "<Home>		Move to first commit"]
 [mc "<End>		Move to last commit"]
 [mc "<Up>, p, i	Move up one commit"]
@@ -2521,11 +2538,11 @@ proc keys {} {
 [mc "<%s-plus>	Increase font size" $M1T]
 [mc "<%s-KP->	Decrease font size" $M1T]
 [mc "<%s-minus>	Decrease font size" $M1T]
-[mc "<F5>		Update"]
 " \
 	    -justify left -bg white -border 2 -relief groove
     pack $w.m -side top -fill both -padx 2 -pady 2
     button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+    bind $w <Key-Escape> [list destroy $w]
     pack $w.ok -side bottom
     bind $w <Visibility> "focus $w.ok"
     bind $w <Key-Escape> "destroy $w"
@@ -3171,6 +3188,16 @@ proc newview {ishighlight} {
     vieweditor $top $nextviewnum [mc "Gitk view definition"]
 }
 
+proc edit_or_newview {} {
+    global curview
+
+    if {$curview > 0} {
+	editview
+    } else {
+	newview 0
+    }
+}
+
 proc editview {} {
     global curview
     global viewname viewperm newviewname newviewperm
@@ -3193,6 +3220,7 @@ proc vieweditor {top n title} {
 
     toplevel $top
     wm title $top $title
+    wm transient $top .
     label $top.nl -text [mc "Name"]
     entry $top.name -width 20 -textvariable newviewname($n)
     grid $top.nl $top.name -sticky w -pady 5
@@ -3229,6 +3257,7 @@ proc vieweditor {top n title} {
     frame $top.buts
     button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
     button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
+    bind $top <Escape> [list destroy $top]
     grid $top.buts.ok $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
@@ -3261,9 +3290,7 @@ proc newviewok {top n} {
     if {[catch {
 	set newargs [shellsplit $newviewargs($n)]
     } err]} {
-	error_popup "[mc "Error in commit selection arguments:"] $err"
-	wm raise $top
-	focus $top
+	error_popup "[mc "Error in commit selection arguments:"] $err" $top
 	return
     }
     set files {}
@@ -7367,6 +7394,7 @@ proc mkpatch {} {
     set patchtop $top
     catch {destroy $top}
     toplevel $top
+    wm transient $top .
     label $top.title -text [mc "Generate patch"]
     grid $top.title - -pady 10
     label $top.from -text [mc "From:"]
@@ -7397,6 +7425,8 @@ proc mkpatch {} {
     frame $top.buts
     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
+    bind $top <Key-Return> mkpatchgo
+    bind $top <Key-Escape> mkpatchcan
     grid $top.buts.gen $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
@@ -7431,7 +7461,7 @@ proc mkpatchgo {} {
     set cmd [lrange $cmd 1 end]
     lappend cmd >$fname &
     if {[catch {eval exec $cmd} err]} {
-	error_popup "[mc "Error creating patch:"] $err"
+	error_popup "[mc "Error creating patch:"] $err" $patchtop
     }
     catch {destroy $patchtop}
     unset patchtop
@@ -7451,6 +7481,7 @@ proc mktag {} {
     set mktagtop $top
     catch {destroy $top}
     toplevel $top
+    wm transient $top .
     label $top.title -text [mc "Create tag"]
     grid $top.title - -pady 10
     label $top.id -text [mc "ID:"]
@@ -7468,6 +7499,8 @@ proc mktag {} {
     frame $top.buts
     button $top.buts.gen -text [mc "Create"] -command mktaggo
     button $top.buts.can -text [mc "Cancel"] -command mktagcan
+    bind $top <Key-Return> mktaggo
+    bind $top <Key-Escape> mktagcan
     grid $top.buts.gen $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
@@ -7481,17 +7514,17 @@ proc domktag {} {
     set id [$mktagtop.sha1 get]
     set tag [$mktagtop.tag get]
     if {$tag == {}} {
-	error_popup [mc "No tag name specified"]
+	error_popup [mc "No tag name specified"] $mktagtop
 	return
     }
     if {[info exists tagids($tag)]} {
-	error_popup [mc "Tag \"%s\" already exists" $tag]
+	error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
 	return
     }
     if {[catch {
 	exec git tag $tag $id
     } err]} {
-	error_popup "[mc "Error creating tag:"] $err"
+	error_popup "[mc "Error creating tag:"] $err" $mktagtop
 	return
     }
 
@@ -7501,6 +7534,7 @@ proc domktag {} {
     addedtag $id
     dispneartags 0
     run refill_reflist
+    return 1
 }
 
 proc redrawtags {id} {
@@ -7539,7 +7573,7 @@ proc mktagcan {} {
 }
 
 proc mktaggo {} {
-    domktag
+    if {![domktag]} return
     mktagcan
 }
 
@@ -7550,6 +7584,7 @@ proc writecommit {} {
     set wrcomtop $top
     catch {destroy $top}
     toplevel $top
+    wm transient $top .
     label $top.title -text [mc "Write commit to file"]
     grid $top.title - -pady 10
     label $top.id -text [mc "ID:"]
@@ -7571,6 +7606,8 @@ proc writecommit {} {
     frame $top.buts
     button $top.buts.gen -text [mc "Write"] -command wrcomgo
     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
+    bind $top <Key-Return> wrcomgo
+    bind $top <Key-Escape> wrcomcan
     grid $top.buts.gen $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
@@ -7585,7 +7622,7 @@ proc wrcomgo {} {
     set cmd "echo $id | [$wrcomtop.cmd get]"
     set fname [$wrcomtop.fname get]
     if {[catch {exec sh -c $cmd >$fname &} err]} {
-	error_popup "[mc "Error writing commit:"] $err"
+	error_popup "[mc "Error writing commit:"] $err" $wrcomtop
     }
     catch {destroy $wrcomtop}
     unset wrcomtop
@@ -7604,6 +7641,7 @@ proc mkbranch {} {
     set top .makebranch
     catch {destroy $top}
     toplevel $top
+    wm transient $top .
     label $top.title -text [mc "Create new branch"]
     grid $top.title - -pady 10
     label $top.id -text [mc "ID:"]
@@ -7617,6 +7655,8 @@ proc mkbranch {} {
     frame $top.buts
     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
+    bind $top <Key-Return> [list mkbrgo $top]
+    bind $top <Key-Escape> "catch {destroy $top}"
     grid $top.buts.go $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
@@ -7630,7 +7670,7 @@ proc mkbrgo {top} {
     set name [$top.name get]
     set id [$top.sha1 get]
     if {$name eq {}} {
-	error_popup [mc "Please specify a name for the new branch"]
+	error_popup [mc "Please specify a name for the new branch"] $top
 	return
     }
     catch {destroy $top}
@@ -7723,6 +7763,7 @@ proc resethead {} {
     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
     pack $w.ok -side left -fill x -padx 20 -pady 20
     button $w.cancel -text [mc Cancel] -command "destroy $w"
+    bind $w <Key-Escape> [list destroy $w]
     pack $w.cancel -side right -fill x -padx 20 -pady 20
     bind $w <Visibility> "grab $w; focus $w"
     tkwait window $w
@@ -7879,6 +7920,7 @@ proc showrefs {} {
     }
     toplevel $top
     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
+    wm transient $top .
     text $top.list -background $bgcolor -foreground $fgcolor \
 	-selectbackground $selectbgcolor -font mainfont \
 	-xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
@@ -7900,6 +7942,7 @@ proc showrefs {} {
     pack $top.f.l -side left
     grid $top.f - -sticky ew -pady 2
     button $top.close -command [list destroy $top] -text [mc "Close"]
+    bind $top <Key-Escape> [list destroy $top]
     grid $top.close -
     grid columnconfigure $top 0 -weight 1
     grid rowconfigure $top 0 -weight 1
@@ -9205,6 +9248,7 @@ proc mkfontdisp {font top which} {
 
 proc choosefont {font which} {
     global fontparam fontlist fonttop fontattr
+    global prefstop
 
     set fontparam(which) $which
     set fontparam(font) $font
@@ -9218,6 +9262,7 @@ proc choosefont {font which} {
 	font create sample
 	eval font config sample [font actual $font]
 	toplevel $top
+	wm transient $top $prefstop
 	wm title $top [mc "Gitk font chooser"]
 	label $top.l -textvariable fontparam(which)
 	pack $top.l -side top
@@ -9251,6 +9296,8 @@ proc choosefont {font which} {
 	frame $top.buts
 	button $top.buts.ok -text [mc "OK"] -command fontok -default active
 	button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
+	bind $top <Key-Return> fontok
+	bind $top <Key-Escape> fontcan
 	grid $top.buts.ok $top.buts.can
 	grid columnconfigure $top.buts 0 -weight 1 -uniform a
 	grid columnconfigure $top.buts 1 -weight 1 -uniform a
@@ -9332,6 +9379,7 @@ proc doprefs {} {
     }
     toplevel $top
     wm title $top [mc "Gitk preferences"]
+    wm transient $top .
     label $top.ldisp -text [mc "Commit list display options"]
     grid $top.ldisp - -sticky w -pady 10
     label $top.spacer -text " "
@@ -9419,6 +9467,8 @@ proc doprefs {} {
     frame $top.buts
     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
+    bind $top <Key-Return> prefsok
+    bind $top <Key-Escape> prefscan
     grid $top.buts.ok $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
-- 
1.6.0.20.g6148bc

[PATCH 2/7] gitk: Allow forcing branch creation if it already exists.

[Alexander Gavrilov]

If gitk knows that the branch the user tries to create exists,
it should ask whether it should overwrite it. This way the user
can either decide to choose a new name, or move the head while
preserving the reflog.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |   28 +++++++++++++++++++++++-----
 1 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/gitk b/gitk
index a4ef736..96ca965 100755
--- a/gitk
+++ b/gitk
@@ -7669,24 +7669,42 @@ proc mkbrgo {top} {
 
     set name [$top.name get]
     set id [$top.sha1 get]
+    set cmdargs [list]
+    set old_id {}
     if {$name eq {}} {
 	error_popup [mc "Please specify a name for the new branch"] $top
 	return
     }
+    if {[info exists headids($name)]} {
+	if {![confirm_popup [mc \
+		"Branch '%s' already exists. Overwrite?" $name] $top]} {
+	    return
+	}
+	set old_id $headids($name)
+	lappend cmdargs -f
+    }
     catch {destroy $top}
+    lappend cmdargs $name $id
     nowbusy newbranch
     update
     if {[catch {
-	exec git branch $name $id
+	eval exec git branch $cmdargs
     } err]} {
 	notbusy newbranch
 	error_popup $err
     } else {
-	set headids($name) $id
-	lappend idheads($id) $name
-	addedhead $id $name
 	notbusy newbranch
-	redrawtags $id
+	if {$old_id ne {}} {
+	    movehead $id $name
+	    movedhead $id $name
+	    redrawtags $old_id
+	    redrawtags $id
+	} else {
+	    set headids($name) $id
+	    lappend idheads($id) $name
+	    addedhead $id $name
+	    redrawtags $id
+	}
 	dispneartags 0
 	run refill_reflist
     }
-- 
1.6.0.20.g6148bc

[PATCH 3/7] gitk: Allow starting gui blame for a specific line.

[Alexander Gavrilov]

Adds a context menu item to the diff viewer pane that
calls blame, focusing it on the clicked line. In case
of combined diffs, it also automatically deduces which
parent is to be blamed.

The context menu itself is added by this patch. It is
possible to populate it with commands from the flist
menu.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |  135 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 133 insertions(+), 2 deletions(-)

diff --git a/gitk b/gitk
index 96ca965..3c77909 100755
--- a/gitk
+++ b/gitk
@@ -2184,6 +2184,7 @@ proc makewindow {} {
     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
     global ctxbut
     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
+    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
 
     set maincursor [. cget -cursor]
     set textcursor [$ctext cget -cursor]
@@ -2233,6 +2234,12 @@ proc makewindow {} {
         -command {external_diff}
     $flist_menu add command -label [mc "Blame parent commit"] \
         -command {external_blame 1}
+
+    global diff_menu
+    set diff_menu .diffctxmenu
+    menu $diff_menu -tearoff 0
+    $diff_menu add command -label [mc "Blame parent commit"] \
+        -command {external_blame_diff}
 }
 
 # Windows sends all mouse wheel events to the current focused window, not
@@ -2935,6 +2942,34 @@ proc pop_flist_menu {w X Y x y} {
     tk_popup $flist_menu $X $Y
 }
 
+proc find_ctext_fileinfo {line} {
+    global ctext_file_names ctext_file_lines
+
+    set ok [bsearch $ctext_file_lines $line]
+    set tline [lindex $ctext_file_lines $ok]
+
+    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
+        return {}
+    } else {
+        return [list [lindex $ctext_file_names $ok] $tline]
+    }
+}
+
+proc pop_diff_menu {w X Y x y} {
+    global ctext diff_menu flist_menu_file
+    global diff_menu_txtpos diff_menu_line
+    global diff_menu_filebase
+
+    stopfinding
+    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
+    set diff_menu_line [lindex $diff_menu_txtpos 0]
+    set f [find_ctext_fileinfo $diff_menu_line]
+    if {$f eq {}} return
+    set flist_menu_file [lindex $f 0]
+    set diff_menu_filebase [lindex $f 1]
+    tk_popup $diff_menu $X $Y
+}
+
 proc flist_hl {only} {
     global flist_menu_file findstring gdttype
 
@@ -3041,7 +3076,84 @@ proc external_diff {} {
     }
 }
 
-proc external_blame {parent_idx} {
+proc find_hunk_blamespec {base line} {
+    global ctext
+
+    # Find and parse the hunk header
+    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
+    if {$s_lix eq {}} return
+
+    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
+    if {![regexp {^@@@?(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
+	    s_line old_specs osz osz1 new_line nsz]} {
+	return
+    }
+
+    # base lines for the parents
+    set old_lines [list]
+    foreach old_spec [lrange [split $old_specs " "] 1 end] {
+	if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
+	        old_spec old_line osz]} {
+	    return
+	}
+	lappend old_lines $old_line
+    }
+
+    # Now scan the lines to determine offset within the hunk
+    set parent {}
+    set dline 0
+    set s_lno [lindex [split $s_lix "."] 0]
+
+    for {set i $line} {$i > $s_lno} {incr i -1} {
+	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
+	if {$parent eq {}} {
+	    # find first preceeding line that belongs to some parent
+	    for {set j 0} {$j < [llength $old_lines]} {incr j} {
+		set code [string index $c_line $j]
+		if {$code ne {-} && $code ne { }} continue
+		if {$code eq { } && $parent ne {}} continue
+		set parent $j
+		if {$code eq {-}} break
+	    }
+	}
+	if {$parent ne {}} {
+	    # then count other lines that belong to it
+	    set code [string index $c_line $parent]
+	    if {$code ne {+}} {
+		incr dline
+	    }
+	}
+    }
+
+    if {$parent eq {}} { set parent 0 }
+    incr dline [lindex $old_lines $parent]
+    incr parent
+    return [list $parent $dline]
+}
+
+proc external_blame_diff {} {
+    global currentid diffmergeid cmitmode
+    global diff_menu_txtpos diff_menu_line
+    global diff_menu_filebase flist_menu_file
+
+    if {$cmitmode eq "tree"} {
+	set parent_idx 1
+	set line [expr {$diff_menu_line - $diff_menu_filebase - 1}]
+    } else {
+	set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
+	if {$hinfo ne {}} {
+	    set parent_idx [lindex $hinfo 0]
+	    set line [lindex $hinfo 1]
+	} else {
+	    set parent_idx 1
+	    set line 0
+	}
+    }
+
+    external_blame $parent_idx $line
+}
+
+proc external_blame {parent_idx {line {}}} {
     global flist_menu_file
     global nullid nullid2
     global parentlist selectedline currentid
@@ -3057,7 +3169,12 @@ proc external_blame {parent_idx} {
 	return
     }
 
-    if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
+    set cmdline [list git gui blame]
+    if {$line ne {} && $line > 1} {
+	lappend cmdline "--line=$line"
+    }
+    lappend cmdline $base_commit $flist_menu_file
+    if {[catch {eval exec $cmdline &} err]} {
 	error_popup "[mc "git gui blame: command failed:"] $err"
     }
 }
@@ -6305,6 +6422,7 @@ proc gettreeline {gtf id} {
 
 proc showfile {f} {
     global treefilelist treeidlist diffids nullid nullid2
+    global ctext_file_names ctext_file_lines
     global ctext commentend
 
     set i [lsearch -exact $treefilelist($diffids) $f]
@@ -6328,6 +6446,8 @@ proc showfile {f} {
     filerun $bf [list getblobline $bf $diffids]
     $ctext config -state normal
     clear_ctext $commentend
+    lappend ctext_file_names $f
+    lappend ctext_file_lines [lindex [split $commentend "."] 0]
     $ctext insert end "\n"
     $ctext insert end "$f\n" filesep
     $ctext config -state disabled
@@ -6387,6 +6507,7 @@ proc mergediff {id} {
 proc getmergediffline {mdf id np} {
     global diffmergeid ctext cflist mergemax
     global difffilestart mdifffd
+    global ctext_file_names ctext_file_lines
     global diffencoding
 
     $ctext conf -state normal
@@ -6404,6 +6525,8 @@ proc getmergediffline {mdf id np} {
 	    set here [$ctext index "end - 1c"]
 	    lappend difffilestart $here
 	    add_flist [list $fname]
+	    lappend ctext_file_names $fname
+	    lappend ctext_file_lines [lindex [split $here "."] 0]
 	    set diffencoding [get_cached_encoding $fname]
 	    set l [expr {(78 - [string length $fname]) / 2}]
 	    set pad [string range "----------------------------------------" 1 $l]
@@ -6661,11 +6784,13 @@ proc setinlist {var i val} {
 
 proc makediffhdr {fname ids} {
     global ctext curdiffstart treediffs
+    global ctext_file_names
 
     set i [lsearch -exact $treediffs($ids) $fname]
     if {$i >= 0} {
 	setinlist difffilestart $i $curdiffstart
     }
+    set ctext_file_names [lreplace $ctext_file_names end end $fname]
     set l [expr {(78 - [string length $fname]) / 2}]
     set pad [string range "----------------------------------------" 1 $l]
     $ctext insert $curdiffstart "$pad $fname $pad" filesep
@@ -6674,6 +6799,7 @@ proc makediffhdr {fname ids} {
 proc getblobdiffline {bdf ids} {
     global diffids blobdifffd ctext curdiffstart
     global diffnexthead diffnextnote difffilestart
+    global ctext_file_names ctext_file_lines
     global diffinhdr treediffs
     global diffencoding
 
@@ -6691,6 +6817,8 @@ proc getblobdiffline {bdf ids} {
 	    # start of a new file
 	    $ctext insert end "\n"
 	    set curdiffstart [$ctext index "end - 1c"]
+	    lappend ctext_file_names ""
+	    lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
 	    $ctext insert end "\n" filesep
 	    # If the name hasn't changed the length will be odd,
 	    # the middle char will be a space, and the two bits either
@@ -6827,6 +6955,7 @@ proc nextfile {} {
 
 proc clear_ctext {{first 1.0}} {
     global ctext smarktop smarkbot
+    global ctext_file_names ctext_file_lines
     global pendinglinks
 
     set l [lindex [split $first .] 0]
@@ -6840,6 +6969,8 @@ proc clear_ctext {{first 1.0}} {
     if {$first eq "1.0"} {
 	catch {unset pendinglinks}
     }
+    set ctext_file_names {}
+    set ctext_file_lines {}
 }
 
 proc settabs {{firstab {}}} {
-- 
1.6.0.20.g6148bc

[PATCH 4/7] gitk: Fix file list context menu for merge commits.

[Alexander Gavrilov]

Currently it displays an ugly error box, because the
treediffs array is not filled for such commits. This
is clearly unacceptable.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |    6 ++++--
 1 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/gitk b/gitk
index 3c77909..cfaf7a1 100755
--- a/gitk
+++ b/gitk
@@ -6479,7 +6479,7 @@ proc getblobline {bf id} {
 
 proc mergediff {id} {
     global diffmergeid mdifffd
-    global diffids
+    global diffids treediffs
     global parents
     global diffcontext
     global diffencoding
@@ -6487,6 +6487,7 @@ proc mergediff {id} {
 
     set diffmergeid $id
     set diffids $id
+    set treediffs($id) [list ]
     # this doesn't seem to actually affect anything...
     set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
     if {$limitdiffs && $vfilelimit($curview) ne {}} {
@@ -6506,7 +6507,7 @@ proc mergediff {id} {
 
 proc getmergediffline {mdf id np} {
     global diffmergeid ctext cflist mergemax
-    global difffilestart mdifffd
+    global difffilestart mdifffd treediffs
     global ctext_file_names ctext_file_lines
     global diffencoding
 
@@ -6524,6 +6525,7 @@ proc getmergediffline {mdf id np} {
 	    $ctext insert end "\n"
 	    set here [$ctext index "end - 1c"]
 	    lappend difffilestart $here
+	    lappend treediffs($id) $fname
 	    add_flist [list $fname]
 	    lappend ctext_file_names $fname
 	    lappend ctext_file_lines [lindex [split $here "."] 0]
-- 
1.6.0.20.g6148bc

[PATCH 5/7] gitk: Make cherry-pick call git-citool on conflicts.

[Alexander Gavrilov]

Now that git-gui has facilities to help users resolve
conflicts, it makes sense to launch it from other gui
tools when they happen.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |   59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 58 insertions(+), 1 deletions(-)

diff --git a/gitk b/gitk
index cfaf7a1..e84e109 100755
--- a/gitk
+++ b/gitk
@@ -7843,6 +7843,53 @@ proc mkbrgo {top} {
     }
 }
 
+proc exec_citool {args {baseid {}}} {
+    global commitinfo env
+
+    if {[info exists env(GIT_AUTHOR_NAME)]} {
+	set old_name $env(GIT_AUTHOR_NAME)
+    }
+    if {[info exists env(GIT_AUTHOR_EMAIL)]} {
+	set old_email $env(GIT_AUTHOR_EMAIL)
+    }
+    if {[info exists env(GIT_AUTHOR_DATE)]} {
+	set old_date $env(GIT_AUTHOR_DATE)
+    }
+
+    if {$baseid ne {}} {
+	if {![info exists commitinfo($baseid)]} {
+	    getcommit $baseid
+	}
+	set author [lindex $commitinfo($baseid) 1]
+	set date [lindex $commitinfo($baseid) 2]
+	if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
+	            $author author name email]
+	    && $date ne {}} {
+	    set env(GIT_AUTHOR_NAME) $name
+	    set env(GIT_AUTHOR_EMAIL) $email
+	    set env(GIT_AUTHOR_DATE) $date
+	}
+    }
+
+    eval exec git citool $args &
+
+    if {[info exists old_name]} {
+	set env(GIT_AUTHOR_NAME) $old_name
+    } else {
+	unset env(GIT_AUTHOR_NAME)
+    }
+    if {[info exists old_email]} {
+	set env(GIT_AUTHOR_EMAIL) $old_email
+    } else {
+	unset env(GIT_AUTHOR_EMAIL)
+    }
+    if {[info exists old_date]} {
+	set env(GIT_AUTHOR_DATE) $old_date
+    } else {
+	unset env(GIT_AUTHOR_DATE)
+    }
+}
+
 proc cherrypick {} {
     global rowmenuid curview
     global mainhead mainheadid
@@ -7861,7 +7908,17 @@ proc cherrypick {} {
     # no error occurs, and exec takes that as an indication of error...
     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
 	notbusy cherrypick
-	error_popup $err
+	if {[regexp -line \
+	    {Entry '(.*)' would be overwritten by merge} $err msg fname]} {
+	    error_popup [mc "Cherry-pick failed: file '%s' had local modifications.
+Your working directory is in an inconsistent state." $fname]
+	} elseif {[regexp -line {^CONFLICT \(.*\):} $err msg]} {
+	    # Force citool to read MERGE_MSG
+	    file delete [file join [gitdir] "GITGUI_MSG"]
+	    exec_citool [list] $rowmenuid
+	} else {
+	    error_popup $err
+	}
 	return
     }
     set newhead [exec git rev-parse HEAD]
-- 
1.6.0.20.g6148bc

[PATCH 6/7] gitk: Implement a user-friendly Edit View dialog.

[Alexander Gavrilov]

Originally gitk required the user to specify all limiting
options manually in the same field with the list of commits.
It is extremely unfriendly for new users, who may not know
which options can be used, or, indeed, that it is possible
to specify them at all.

This patch modifies the dialog to present the most useful
options as individual fields. Note that options that may
be useful to an extent, but produce broken view, are
deliberately not included.

It is still possible to specify options in the commit list
field, but when the dialog is reopened, they will be extracted
into their own separate fields.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |  207 ++++++++++++++++++++++++++++++++++++++++++++++++++++--------------
 1 files changed, 163 insertions(+), 44 deletions(-)

diff --git a/gitk b/gitk
index e84e109..c7dd487 100755
--- a/gitk
+++ b/gitk
@@ -3289,8 +3289,8 @@ proc shellsplit {str} {
 # Code to implement multiple views
 
 proc newview {ishighlight} {
-    global nextviewnum newviewname newviewperm newishighlight
-    global newviewargs revtreeargs viewargscmd newviewargscmd curview
+    global nextviewnum newviewname newishighlight
+    global revtreeargs viewargscmd newviewopts curview
 
     set newishighlight $ishighlight
     set top .gitkview
@@ -3299,9 +3299,9 @@ proc newview {ishighlight} {
 	return
     }
     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
-    set newviewperm($nextviewnum) 0
-    set newviewargs($nextviewnum) [shellarglist $revtreeargs]
-    set newviewargscmd($nextviewnum) $viewargscmd($curview)
+    set newviewopts($nextviewnum,perm) 0
+    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
+    decode_view_opts $nextviewnum $revtreeargs
     vieweditor $top $nextviewnum [mc "Gitk view definition"]
 }
 
@@ -3315,53 +3315,167 @@ proc edit_or_newview {} {
     }
 }
 
+set known_view_options {
+    {perm    b    . {}               {mc "Remember this view"}}
+    {args    t50= + {}               {mc "Commits to include (arguments to git log):"}}
+    {all     b    * "--all"          {mc "Use all refs"}}
+    {dorder  b    . {"--date-order" "-d"}      {mc "Strictly sort by date"}}
+    {lright  b    . "--left-right"   {mc "Mark branch sides"}}
+    {since   t15  + {"--since=*" "--after=*"}  {mc "Since date:"}}
+    {until   t15  . {"--until=*" "--before=*"} {mc "Until date:"}}
+    {limit   t10  + "--max-count=*"  {mc "Max count:"}}
+    {skip    t10  . "--skip=*"       {mc "Skip:"}}
+    {first   b    . "--first-parent" {mc "Limit to first parent"}}
+    {cmd     t50= + {}               {mc "Command to generate more commits to include:"}}
+    }
+
+proc encode_view_opts {n} {
+    global known_view_options newviewopts
+
+    set rargs [list]
+    foreach opt $known_view_options {
+	set patterns [lindex $opt 3]
+	if {$patterns eq {}} continue
+	set pattern [lindex $patterns 0]
+
+	set val $newviewopts($n,[lindex $opt 0])
+	
+	if {[lindex $opt 1] eq "b"} {
+	    if {$val} {
+		lappend rargs $pattern
+	    }
+	} else {
+	    set val [string trim $val]
+	    if {$val ne {}} {
+		set pfix [string range $pattern 0 end-1]
+		lappend rargs $pfix$val
+	    }
+	}
+    }
+    return [concat $rargs [shellsplit $newviewopts($n,args)]]
+}
+
+proc decode_view_opts {n view_args} {
+    global known_view_options newviewopts
+
+    foreach opt $known_view_options {
+	if {[lindex $opt 1] eq "b"} {
+	    set val 0
+	} else {
+	    set val {}
+	}
+	set newviewopts($n,[lindex $opt 0]) $val
+    }
+    set oargs [list]
+    foreach arg $view_args {
+	if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
+	    && ![info exists found(limit)]} {
+	    set newviewopts($n,limit) $cnt
+	    set found(limit) 1
+	    continue
+	}
+	catch { unset val }
+	foreach opt $known_view_options {
+	    set id [lindex $opt 0]
+	    if {[info exists found($id)]} continue
+	    foreach pattern [lindex $opt 3] {
+		if {![string match $pattern $arg]} continue
+		if {[lindex $opt 1] ne "b"} {
+		    set size [string length $pattern]
+		    set val [string range $arg [expr {$size-1}] end]
+		} else {
+		    set val 1
+		}
+		set newviewopts($n,$id) $val
+		set found($id) 1
+		break
+	    }
+	    if {[info exists val]} break
+	}
+	if {[info exists val]} continue
+	lappend oargs $arg
+    }
+    set newviewopts($n,args) [shellarglist $oargs]
+}
+
 proc editview {} {
     global curview
-    global viewname viewperm newviewname newviewperm
-    global viewargs newviewargs viewargscmd newviewargscmd
+    global viewname viewperm newviewname newviewopts
+    global viewargs viewargscmd
 
     set top .gitkvedit-$curview
     if {[winfo exists $top]} {
 	raise $top
 	return
     }
-    set newviewname($curview) $viewname($curview)
-    set newviewperm($curview) $viewperm($curview)
-    set newviewargs($curview) [shellarglist $viewargs($curview)]
-    set newviewargscmd($curview) $viewargscmd($curview)
+    set newviewname($curview)      $viewname($curview)
+    set newviewopts($curview,perm) $viewperm($curview)
+    set newviewopts($curview,cmd)  $viewargscmd($curview)
+    decode_view_opts $curview $viewargs($curview)
     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
 }
 
 proc vieweditor {top n title} {
-    global newviewname newviewperm viewfiles bgcolor
+    global newviewname newviewopts viewfiles bgcolor
+    global known_view_options
 
     toplevel $top
     wm title $top $title
     wm transient $top .
+
+    # View name
+    frame $top.nfr
     label $top.nl -text [mc "Name"]
     entry $top.name -width 20 -textvariable newviewname($n)
-    grid $top.nl $top.name -sticky w -pady 5
-    checkbutton $top.perm -text [mc "Remember this view"] \
-	-variable newviewperm($n)
-    grid $top.perm - -pady 5 -sticky w
-    message $top.al -aspect 1000 \
-	-text [mc "Commits to include (arguments to git log):"]
-    grid $top.al - -sticky w -pady 5
-    entry $top.args -width 50 -textvariable newviewargs($n) \
-	-background $bgcolor
-    grid $top.args - -sticky ew -padx 5
-
-    message $top.ac -aspect 1000 \
-	-text [mc "Command to generate more commits to include:"]
-    grid $top.ac - -sticky w -pady 5
-    entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \
-	-background white
-    grid $top.argscmd - -sticky ew -padx 5
-
-    message $top.l -aspect 1000 \
+    pack $top.nfr -in $top -fill x -pady 5 -padx 3
+    pack $top.nl -in $top.nfr -side left -padx {0 30}
+    pack $top.name -in $top.nfr -side left
+
+    # View options
+    set cframe $top.nfr
+    set cexpand 0
+    set cnt 0
+    foreach opt $known_view_options {
+	set id [lindex $opt 0]
+	set type [lindex $opt 1]
+	set flags [lindex $opt 2]
+	set title [eval [lindex $opt 4]]
+	set lxpad 0
+
+	if {$flags eq "+" || $flags eq "*"} {
+	    set cframe $top.fr$cnt
+	    incr cnt
+	    frame $cframe
+	    pack $cframe -in $top -fill x -pady 3 -padx 3
+	    set cexpand [expr {$flags eq "*"}]
+	} else {
+	    set lxpad 5
+	}
+
+	if {$type eq "b"} {
+	    checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
+	    pack $cframe.c_$id -in $cframe -side left \
+		-padx [list $lxpad 0] -expand $cexpand -anchor w
+	} elseif {[regexp {^t(\d+)$} $type type sz]} {
+	    message $cframe.l_$id -aspect 1500 -text $title
+	    entry $cframe.e_$id -width $sz -background $bgcolor \
+		-textvariable newviewopts($n,$id)
+	    pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
+	    pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
+	} elseif {[regexp {^t(\d+)=$} $type type sz]} {
+	    message $cframe.l_$id -aspect 1500 -text $title
+	    entry $cframe.e_$id -width $sz -background $bgcolor \
+		-textvariable newviewopts($n,$id)
+	    pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
+	    pack $cframe.e_$id -in $cframe -side top -fill x
+	}
+    }
+
+    # Path list
+    message $top.l -aspect 1500 \
 	-text [mc "Enter files and directories to include, one per line:"]
-    grid $top.l - -sticky w
-    text $top.t -width 40 -height 10 -background $bgcolor -font uifont
+    pack $top.l -in $top -side top -pady [list 7 0] -anchor w -padx 3
+    text $top.t -width 40 -height 5 -background $bgcolor -font uifont
     if {[info exists viewfiles($n)]} {
 	foreach f $viewfiles($n) {
 	    $top.t insert end $f
@@ -3370,15 +3484,19 @@ proc vieweditor {top n title} {
 	$top.t delete {end - 1c} end
 	$top.t mark set insert 0.0
     }
-    grid $top.t - -sticky ew -padx 5
+    pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
     frame $top.buts
     button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
+    button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
     button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
+    bind $top <Control-Return> [list newviewok $top $n]
+    bind $top <F5> [list newviewok $top $n 1]
     bind $top <Escape> [list destroy $top]
-    grid $top.buts.ok $top.buts.can
+    grid $top.buts.ok $top.buts.apply $top.buts.can
     grid columnconfigure $top.buts 0 -weight 1 -uniform a
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
-    grid $top.buts - -pady 10 -sticky ew
+    grid columnconfigure $top.buts 2 -weight 1 -uniform a
+    pack $top.buts -in $top -side top -fill x
     focus $top.t
 }
 
@@ -3399,13 +3517,13 @@ proc allviewmenus {n op args} {
     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
 }
 
-proc newviewok {top n} {
+proc newviewok {top n {apply 0}} {
     global nextviewnum newviewperm newviewname newishighlight
     global viewname viewfiles viewperm selectedview curview
-    global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu
+    global viewargs viewargscmd newviewopts viewhlmenu
 
     if {[catch {
-	set newargs [shellsplit $newviewargs($n)]
+	set newargs [encode_view_opts $n]
     } err]} {
 	error_popup "[mc "Error in commit selection arguments:"] $err" $top
 	return
@@ -3421,10 +3539,10 @@ proc newviewok {top n} {
 	# creating a new view
 	incr nextviewnum
 	set viewname($n) $newviewname($n)
-	set viewperm($n) $newviewperm($n)
+	set viewperm($n) $newviewopts($n,perm)
 	set viewfiles($n) $files
 	set viewargs($n) $newargs
-	set viewargscmd($n) $newviewargscmd($n)
+	set viewargscmd($n) $newviewopts($n,cmd)
 	addviewmenu $n
 	if {!$newishighlight} {
 	    run showview $n
@@ -3433,7 +3551,7 @@ proc newviewok {top n} {
 	}
     } else {
 	# editing an existing view
-	set viewperm($n) $newviewperm($n)
+	set viewperm($n) $newviewopts($n,perm)
 	if {$newviewname($n) ne $viewname($n)} {
 	    set viewname($n) $newviewname($n)
 	    doviewmenu .bar.view 5 [list showview $n] \
@@ -3442,15 +3560,16 @@ proc newviewok {top n} {
 		# entryconf [list -label $viewname($n) -value $viewname($n)]
 	}
 	if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
-		$newviewargscmd($n) ne $viewargscmd($n)} {
+		$newviewopts($n,cmd) ne $viewargscmd($n)} {
 	    set viewfiles($n) $files
 	    set viewargs($n) $newargs
-	    set viewargscmd($n) $newviewargscmd($n)
+	    set viewargscmd($n) $newviewopts($n,cmd)
 	    if {$curview == $n} {
 		run reloadcommits
 	    }
 	}
     }
+    if {$apply} return
     catch {destroy $top}
 }
 
-- 
1.6.0.20.g6148bc

[PATCH 7/7] gitk: Explicitly position popup windows.

[Alexander Gavrilov]

For some reason, on Windows all transient windows are placed
in the upper left corner of the screen. Thus, it is necessary
to explicitly position the windows using the tk::PlaceWindow
function.

Reference list and the Edit View dialog are positioned under
the mouse cursor, thus allowing the user to create them in a
convenient place using keyboard shortcuts, and providing a
sane position when opened through the menu.

Other popups are centered on the main window.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |   19 +++++++++++++++++--
 1 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/gitk b/gitk
index c7dd487..9e580a6 100755
--- a/gitk
+++ b/gitk
@@ -1703,7 +1703,7 @@ proc removehead {id name} {
     unset headids($name)
 }
 
-proc show_error {w top msg} {
+proc show_error {w top msg {owner {}}} {
     message $w.m -text $msg -justify center -aspect 400
     pack $w.m -side top -fill x -padx 20 -pady 20
     button $w.ok -text [mc OK] -command "destroy $top"
@@ -1712,6 +1712,9 @@ proc show_error {w top msg} {
     bind $top <Key-Return> "destroy $top"
     bind $top <Key-space>  "destroy $top"
     bind $top <Key-Escape> "destroy $top"
+    if {$owner ne {}} {
+	tk::PlaceWindow $top widget $owner
+    }
     tkwait window $top
 }
 
@@ -1719,7 +1722,7 @@ proc error_popup {msg {owner .}} {
     set w .error
     toplevel $w
     wm transient $w $owner
-    show_error $w $w $msg
+    show_error $w $w $msg $owner
 }
 
 proc confirm_popup {msg {owner .}} {
@@ -1738,6 +1741,7 @@ proc confirm_popup {msg {owner .}} {
     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
     bind $w <Key-Escape> "destroy $w"
+    tk::PlaceWindow $w widget $owner
     tkwait window $w
     return $confirm_ok
 }
@@ -2493,6 +2497,7 @@ Use and redistribute under the terms of the GNU General Public License"] \
     bind $w <Visibility> "focus $w.ok"
     bind $w <Key-Escape> "destroy $w"
     bind $w <Key-Return> "destroy $w"
+    tk::PlaceWindow $w widget .
 }
 
 proc keys {} {
@@ -2554,6 +2559,7 @@ proc keys {} {
     bind $w <Visibility> "focus $w.ok"
     bind $w <Key-Escape> "destroy $w"
     bind $w <Key-Return> "destroy $w"
+    tk::PlaceWindow $w widget .
 }
 
 # Procedures for manipulating the file list window at the
@@ -3497,6 +3503,7 @@ proc vieweditor {top n title} {
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
     grid columnconfigure $top.buts 2 -weight 1 -uniform a
     pack $top.buts -in $top -side top -fill x
+    tk::PlaceWindow $top pointer .
     focus $top.t
 }
 
@@ -7684,6 +7691,7 @@ proc mkpatch {} {
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
     grid $top.buts - -pady 10 -sticky ew
     focus $top.fname
+    tk::PlaceWindow $top widget .
 }
 
 proc mkpatchrev {} {
@@ -7758,6 +7766,7 @@ proc mktag {} {
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
     grid $top.buts - -pady 10 -sticky ew
     focus $top.tag
+    tk::PlaceWindow $top widget .
 }
 
 proc domktag {} {
@@ -7865,6 +7874,7 @@ proc writecommit {} {
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
     grid $top.buts - -pady 10 -sticky ew
     focus $top.fname
+    tk::PlaceWindow $top widget .
 }
 
 proc wrcomgo {} {
@@ -7914,6 +7924,7 @@ proc mkbranch {} {
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
     grid $top.buts - -pady 10 -sticky ew
     focus $top.name
+    tk::PlaceWindow $top widget .
 }
 
 proc mkbrgo {top} {
@@ -8093,6 +8104,7 @@ proc resethead {} {
     bind $w <Key-Escape> [list destroy $w]
     pack $w.cancel -side right -fill x -padx 20 -pady 20
     bind $w <Visibility> "grab $w; focus $w"
+    tk::PlaceWindow $w widget .
     tkwait window $w
     if {!$confirm_ok} return
     if {[catch {set fd [open \
@@ -8278,6 +8290,7 @@ proc showrefs {} {
     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
     set reflist {}
     refill_reflist
+    tk::PlaceWindow $top pointer .
 }
 
 proc sel_reflist {w x y} {
@@ -9630,6 +9643,7 @@ proc choosefont {font which} {
 	grid columnconfigure $top.buts 1 -weight 1 -uniform a
 	pack $top.buts -side bottom -fill x
 	trace add variable fontparam write chg_fontparam
+	tk::PlaceWindow $top widget $prefstop
     } else {
 	raise $top
 	$top.c itemconf text -text $which
@@ -9801,6 +9815,7 @@ proc doprefs {} {
     grid columnconfigure $top.buts 1 -weight 1 -uniform a
     grid $top.buts - - -pady 10 -sticky ew
     bind $top <Visibility> "focus $top.buts.ok"
+    tk::PlaceWindow $top widget .
 }
 
 proc choose_extdiff {} {
-- 
1.6.0.20.g6148bc

Re: [PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Paul Mackerras]

Alexander Gavrilov writes:

> - Popups are supposed to be marked transient, otherwise
>   the WM creates them in strange places. Besides, at
>   least under kwin, transients are automatically kept
>   above their parent.
> - Accelerators for menu items should be listed directly
>   on the items, to make them more discoverable.
> - Some more accelerators are added, e.g. F4 for Edit View.
> - Finally, dialogs can now be accepted or dismissed using
>   the Return and Escape keys.

Thanks for the patch series; a few specific comments follow.

> +    catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }

What is this key, or why is this line needed?

> @@ -2484,10 +2501,10 @@ proc keys {} {
>      }
>      toplevel $w
>      wm title $w [mc "Gitk key bindings"]
> +    wm transient $w .
>      message $w.m -text "
>  [mc "Gitk key bindings:"]
>  
> -[mc "<%s-Q>		Quit" $M1T]
>  [mc "<Home>		Move to first commit"]
>  [mc "<End>		Move to last commit"]
>  [mc "<Up>, p, i	Move up one commit"]
> @@ -2521,11 +2538,11 @@ proc keys {} {
>  [mc "<%s-plus>	Increase font size" $M1T]
>  [mc "<%s-KP->	Decrease font size" $M1T]
>  [mc "<%s-minus>	Decrease font size" $M1T]
> -[mc "<F5>		Update"]

I think it is useful to have the accelerator keys listed in the key
binding help.

> @@ -7501,6 +7534,7 @@ proc domktag {} {
>      addedtag $id
>      dispneartags 0
>      run refill_reflist
> +    return 1
>  }
>  
>  proc redrawtags {id} {
> @@ -7539,7 +7573,7 @@ proc mktagcan {} {
>  }
>  
>  proc mktaggo {} {
> -    domktag
> +    if {![domktag]} return

You need to change the error returns in domktag to say "return 0",
otherwise this will give a "can't use empty string as operand of "!""
Tcl error.

Paul.

Re: [PATCH 5/7] gitk: Make cherry-pick call git-citool on conflicts.

[Paul Mackerras]

Alexander Gavrilov writes:

> Now that git-gui has facilities to help users resolve
> conflicts, it makes sense to launch it from other gui
> tools when they happen.

Nice idea...

> +proc exec_citool {args {baseid {}}} {

I'm a little nervous about you having a parameter called "args", since
that specific name has a special meaning in Tcl; it's how Tcl handles
variable-length argument lists.

> +    global commitinfo env
> +
> +    if {[info exists env(GIT_AUTHOR_NAME)]} {
> +	set old_name $env(GIT_AUTHOR_NAME)
> +    }
> +    if {[info exists env(GIT_AUTHOR_EMAIL)]} {
> +	set old_email $env(GIT_AUTHOR_EMAIL)
> +    }
> +    if {[info exists env(GIT_AUTHOR_DATE)]} {
> +	set old_date $env(GIT_AUTHOR_DATE)
> +    }
> +
> +    if {$baseid ne {}} {
> +	if {![info exists commitinfo($baseid)]} {
> +	    getcommit $baseid
> +	}
> +	set author [lindex $commitinfo($baseid) 1]
> +	set date [lindex $commitinfo($baseid) 2]
> +	if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
> +	            $author author name email]
> +	    && $date ne {}} {
> +	    set env(GIT_AUTHOR_NAME) $name
> +	    set env(GIT_AUTHOR_EMAIL) $email
> +	    set env(GIT_AUTHOR_DATE) $date
> +	}
> +    }
> +
> +    eval exec git citool $args &

If we can assume the existence of a shell (which we do elsewhere), we
can perhaps do this more simply by putting the environment variable
settings in the command before the command name.  It's a pity that git
citool won't take the author name/email/date as command-line arguments
or from a file, since it ends up being pretty verbose doing it the way
you have.

> @@ -7861,7 +7908,17 @@ proc cherrypick {} {
>      # no error occurs, and exec takes that as an indication of error...
>      if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
>  	notbusy cherrypick
> -	error_popup $err
> +	if {[regexp -line \
> +	    {Entry '(.*)' would be overwritten by merge} $err msg fname]} {
> +	    error_popup [mc "Cherry-pick failed: file '%s' had local modifications.
> +Your working directory is in an inconsistent state." $fname]

That message seems a bit too scary.  It's not inconsistent, it's just
got local modifications.  If I remember correctly, in this situation
git cherry-pick will back out all the changes it did and leave the
working directory as it was before.

> +	} elseif {[regexp -line {^CONFLICT \(.*\):} $err msg]} {
> +	    # Force citool to read MERGE_MSG
> +	    file delete [file join [gitdir] "GITGUI_MSG"]
> +	    exec_citool [list] $rowmenuid

[list] as an idiom for the empty list is a little unusual (here and
elsewhere in your patches); {} would be more usual.

Paul.

Re: [PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Alexander Gavrilov]

On Thu, Oct 9, 2008 at 4:27 AM, Paul Mackerras <paulus@samba.org> wrote:
>> +    catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
>
> What is this key, or why is this line needed?

It is a workaround for an apparent bug in interaction between Tk and
XKB on some systems.
XKB configuration files bind those symbols to Ctrl-Alt-F*
combinations, but Tk's keyboard
handiling code sees them when Shift-F* is pressed. I'll be glad to
find a better fix, but that's
all I could do for now.

The catch wrapper is there to avoid erroring out if that keysym does not exist.

>> @@ -2484,10 +2501,10 @@ proc keys {} {
>>
>> -[mc "<%s-Q>          Quit" $M1T]
>>  [mc "<Home>          Move to first commit"]
>>  [mc "<End>           Move to last commit"]
>>  [mc "<Up>, p, i      Move up one commit"]
>> @@ -2521,11 +2538,11 @@ proc keys {} {
>>  [mc "<%s-plus>       Increase font size" $M1T]
>>  [mc "<%s-KP->        Decrease font size" $M1T]
>>  [mc "<%s-minus>      Decrease font size" $M1T]
>> -[mc "<F5>            Update"]
>
> I think it is useful to have the accelerator keys listed in the key
> binding help.

I don't insist on this part of the patch, it just seemed to be redundant now.

>> @@ -7501,6 +7534,7 @@ proc domktag {} {
>>      addedtag $id
>>      dispneartags 0
>>      run refill_reflist
>> +    return 1
>>  }
>>
>>  proc redrawtags {id} {
>> @@ -7539,7 +7573,7 @@ proc mktagcan {} {
>>  }
>>
>>  proc mktaggo {} {
>> -    domktag
>> +    if {![domktag]} return
>
> You need to change the error returns in domktag to say "return 0",
> otherwise this will give a "can't use empty string as operand of "!""
> Tcl error.

I did not know this. I'm not that familiar with Tcl...

Alexander

Re: [PATCH 5/7] gitk: Make cherry-pick call git-citool on conflicts.

[Alexander Gavrilov]

On Thu, Oct 9, 2008 at 11:42 AM, Paul Mackerras <paulus@samba.org> wrote:
>> +proc exec_citool {args {baseid {}}} {
>
> I'm a little nervous about you having a parameter called "args", since
> that specific name has a special meaning in Tcl; it's how Tcl handles
> variable-length argument lists.

Yes, I'd better change that. Probably it works only because that name is
special only as the last parameter.

> If we can assume the existence of a shell (which we do elsewhere), we
> can perhaps do this more simply by putting the environment variable
> settings in the command before the command name.  It's a pity that git
> citool won't take the author name/email/date as command-line arguments
> or from a file, since it ends up being pretty verbose doing it the way
> you have.

If I understand correctly, using a shell would require composing the
command as a string, which itself requires quoting the author name & email,
and other argument strings. I did not feel confident enough to do that, so
chose a dumb but safe solution.

>> @@ -7861,7 +7908,17 @@ proc cherrypick {} {
>>      # no error occurs, and exec takes that as an indication of error...
>>      if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
>>       notbusy cherrypick
>> -     error_popup $err
>> +     if {[regexp -line \
>> +         {Entry '(.*)' would be overwritten by merge} $err msg fname]} {
>> +         error_popup [mc "Cherry-pick failed: file '%s' had local modifications.
>> +Your working directory is in an inconsistent state." $fname]
>
> That message seems a bit too scary.  It's not inconsistent, it's just
> got local modifications.  If I remember correctly, in this situation
> git cherry-pick will back out all the changes it did and leave the
> working directory as it was before.

Yes, I'll have to reword it.

> [list] as an idiom for the empty list is a little unusual (here and
> elsewhere in your patches); {} would be more usual.

I'm more used to languages where lists and strings are very different types...
Even in perl you have to use [] for an empty list ref, and '' for an
empty string.

Alexander

Re: [PATCH 5/7] gitk: Make cherry-pick call git-citool on conflicts.

[Paul Mackerras]

Alexander Gavrilov writes:

> If I understand correctly, using a shell would require composing the
> command as a string, which itself requires quoting the author name & email,
> and other argument strings. I did not feel confident enough to do that, so
> chose a dumb but safe solution.

You're right.  I think we should do it basically the way you suggest,
but the saving/restoring of the environment can be done a bit more
concisely like this:

proc exec_citool {args {baseid {}}} {
    global commitinfo env

    set save_env [array get env GIT_AUTHOR_*]

    if {$baseid ne {}} {
	# as before ...
    }

    eval exec git citool $args &

    catch {array unset env GIT_AUTHOR_*}
    array set env $save_env
}

> I'm more used to languages where lists and strings are very different types...
> Even in perl you have to use [] for an empty list ref, and '' for an
> empty string.

In Tcl, everything is a string. :)

Paul.

Re: [PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Paul Mackerras]

Alexander Gavrilov writes:

> On Thu, Oct 9, 2008 at 4:27 AM, Paul Mackerras <paulus@samba.org> wrote:
> >> +    catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
> >
> > What is this key, or why is this line needed?
> 
> It is a workaround for an apparent bug in interaction between Tk and
> XKB on some systems.
> XKB configuration files bind those symbols to Ctrl-Alt-F*
> combinations, but Tk's keyboard
> handiling code sees them when Shift-F* is pressed. I'll be glad to
> find a better fix, but that's
> all I could do for now.

OK, that information should go in the patch description.

> > You need to change the error returns in domktag to say "return 0",
> > otherwise this will give a "can't use empty string as operand of "!""
> > Tcl error.
> 
> I did not know this. I'm not that familiar with Tcl...

Then I am amazed at how much you have been able to accomplish...

There's a lot of information available in the Tcl/Tk man pages.  On
Debian or Ubuntu, you need the tcl8.5-doc and tk8.5-doc packages
installed.  Then you can do e.g. "man 3tcl Tcl" to get a summary of
the Tcl language syntax, etc.

BTW, I haven't forgotten about your encoding support patches.  The
last month has been occupied with travelling for Kernel Summit and the
Linux Plumbers Conference, followed by a vacation, and then catching
up with work that has piled up, so I haven't had much time to spare
for gitk hacking.

Paul.

Re: [PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Paul Mackerras]

Alexander Gavrilov writes:

> - Popups are supposed to be marked transient, otherwise
>   the WM creates them in strange places. Besides, at
>   least under kwin, transients are automatically kept
>   above their parent.

I agree with most of the places where you add wm transient commands,
but in the case of the list of references (showrefs), I think of that
as a long-lived window that one would normally place beside the main
window.  (In fact, it should be a pane in the main window, but I
couldn't think of a place for it.  Maybe I should split the
bottom-right pane in two.)

So I don't think the wm transient in showrefs is what we want.
Comments?

Paul.

Re: [PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Alexander Gavrilov]

On Fri, Oct 17, 2008 at 1:55 AM, Paul Mackerras <paulus@samba.org> wrote:
> Alexander Gavrilov writes:
>> - Popups are supposed to be marked transient, otherwise
>>   the WM creates them in strange places. Besides, at
>>   least under kwin, transients are automatically kept
>>   above their parent.
>
> I agree with most of the places where you add wm transient commands,
> but in the case of the list of references (showrefs), I think of that
> as a long-lived window that one would normally place beside the main
> window.  (In fact, it should be a pane in the main window, but I
> couldn't think of a place for it.  Maybe I should split the
> bottom-right pane in two.)
>
> So I don't think the wm transient in showrefs is what we want.
> Comments?

On the other hand, wm transient makes it always stay on top of the
main window. If the main window is maximized, it is useful.

Btw, gitk probably should not save its geometry if the window is
maximized, because when it is started again the window is too large.

Alexander

Re: [PATCH 1/7] gitk: Enhance UI popup and accelerator handling.

[Paul Mackerras]

Alexander Gavrilov writes:

> - Popups are supposed to be marked transient, otherwise
>   the WM creates them in strange places. Besides, at
>   least under kwin, transients are automatically kept
>   above their parent.
> - Accelerators for menu items should be listed directly
>   on the items, to make them more discoverable.
> - Some more accelerators are added, e.g. F4 for Edit View.
> - Finally, dialogs can now be accepted or dismissed using
>   the Return and Escape keys.

Could you rebase this and split it into 3 patches, one each for the
transient popups, accelerators, and return/escape key bindings?

Thanks,
Paul.

Re: [PATCH 2/7] gitk: Allow forcing branch creation if it already exists.

[Paul Mackerras]

Alexander Gavrilov writes:

> If gitk knows that the branch the user tries to create exists,
> it should ask whether it should overwrite it. This way the user
> can either decide to choose a new name, or move the head while
> preserving the reflog.

Applied, thanks.

Paul.

Re: [PATCH 4/7] gitk: Fix file list context menu for merge commits.

[Paul Mackerras]

Alexander Gavrilov writes:

> Currently it displays an ugly error box, because the
> treediffs array is not filled for such commits. This
> is clearly unacceptable.

Applied, thanks, with a better patch description, one that actually
described the remedial action. :)

Paul.

Re: [PATCH 7/7] gitk: Explicitly position popup windows.

[Paul Mackerras]

Alexander Gavrilov writes:

> For some reason, on Windows all transient windows are placed
> in the upper left corner of the screen. Thus, it is necessary
> to explicitly position the windows using the tk::PlaceWindow
> function.

Hmmm, this is not part of the official Tk API as far as I can see, and
having to call tk::PlaceWindow on every window we create is a bit
gross.  What exactly does it do, and what effect will this change have
on Linux?  Are you sure there isn't some other way to fix the problem?

Paul.

Re: [PATCH 7/7] gitk: Explicitly position popup windows.

[Alexander Gavrilov]

On Tue, Oct 21, 2008 at 3:41 PM, Paul Mackerras <paulus@samba.org> wrote:
> Alexander Gavrilov writes:
>
>> For some reason, on Windows all transient windows are placed
>> in the upper left corner of the screen. Thus, it is necessary
>> to explicitly position the windows using the tk::PlaceWindow
>> function.
>
> Hmmm, this is not part of the official Tk API as far as I can see, and
> having to call tk::PlaceWindow on every window we create is a bit
> gross.  What exactly does it do, and what effect will this change have
> on Linux?  Are you sure there isn't some other way to fix the problem?

It is just a convenient helper function that can explicitly compute
and set the window position in a number of ways. It is used in Tk's
dialog implementations. If you don't like using an unofficial
function, I can pull out the relevant ~8 lines of code as a separate
function in gitk.


http://objectmix.com/tcl/390381-tile-dialog-boxes-not-transient-parent-under-windows.html
http://wiki.tcl.tk/1254

Alexander

Re: [PATCH 3/7] gitk: Allow starting gui blame for a specific line.

[Paul Mackerras]

Alexander Gavrilov writes:

> Adds a context menu item to the diff viewer pane that
> calls blame, focusing it on the clicked line. In case
> of combined diffs, it also automatically deduces which
> parent is to be blamed.

I have some comments on this one, but I haven't finished reviewing it
completely, so I may have more... :)

> +proc find_hunk_blamespec {base line} {
> +    global ctext
> +
> +    # Find and parse the hunk header
> +    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
> +    if {$s_lix eq {}} return
> +
> +    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
> +    if {![regexp {^@@@?(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \

In fact there can be many @ characters at the beginning of the line;
the number of parents plus one, in fact.  See commit
c465a76af658b443075d6efee1c3131257643020 in the kernel tree for an
example.  I suggest starting with ^@@@* rather than ^@@@?.

> +    # Now scan the lines to determine offset within the hunk
> +    set parent {}
> +    set dline 0
> +    set s_lno [lindex [split $s_lix "."] 0]
> +
> +    for {set i $line} {$i > $s_lno} {incr i -1} {
> +	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
> +	if {$parent eq {}} {
> +	    # find first preceeding line that belongs to some parent
> +	    for {set j 0} {$j < [llength $old_lines]} {incr j} {
> +		set code [string index $c_line $j]
> +		if {$code ne {-} && $code ne { }} continue
> +		if {$code eq { } && $parent ne {}} continue
> +		set parent $j
> +		if {$code eq {-}} break
> +	    }
> +	}

This part worries me a bit.  If the user clicks on a line where all
the $code values are "+" then I think we should blame the current
commit.  Either that, or we disable the context menu item before
posting it if the user clicks on a line that starts with all "+"
characters (as many "+" as there are parents).

BTW, writing "-" rather than {-} in expressions is more idiomatic.

Paul.

Re: [PATCH 3/7] gitk: Allow starting gui blame for a specific line.

[Alexander Gavrilov]

On Thursday 23 October 2008 15:58:58 Paul Mackerras wrote:
> > +    # Now scan the lines to determine offset within the hunk
> > +    set parent {}
> > +    set dline 0
> > +    set s_lno [lindex [split $s_lix "."] 0]
> > +
> > +    for {set i $line} {$i > $s_lno} {incr i -1} {
> > +	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
> > +	if {$parent eq {}} {
> > +	    # find first preceeding line that belongs to some parent
> > +	    for {set j 0} {$j < [llength $old_lines]} {incr j} {
> > +		set code [string index $c_line $j]
> > +		if {$code ne {-} && $code ne { }} continue
> > +		if {$code eq { } && $parent ne {}} continue
> > +		set parent $j
> > +		if {$code eq {-}} break
> > +	    }
> > +	}
> 
> This part worries me a bit.  If the user clicks on a line where all
> the $code values are "+" then I think we should blame the current
> commit.  Either that, or we disable the context menu item before
> posting it if the user clicks on a line that starts with all "+"
> characters (as many "+" as there are parents).

Good point. How about this variant? I renamed the menu item, and
changed the code to blame the current commit if:

- The display is in the tree mode, or
- The line is added relative to all parents, or
- Diff analysis failed

I also fixed a bug in processing of deleted lines in combined diffs,
and made the parent selection code more readable (hopefully).

--- >8 ---
From: Alexander Gavrilov <angavrilov@gmail.com>
Subject: [PATCH] gitk: Allow starting gui blame for a specific line.

Adds a context menu item to the diff viewer pane that
calls blame, focusing it on the clicked line. In case
of combined diffs, it also automatically deduces which
parent is to be blamed. Lines added by the diff are
blamed on the current commit itself.

The context menu itself is added by this patch. It is
possible to populate it with commands from the flist
menu.

Signed-off-by: Alexander Gavrilov <angavrilov@gmail.com>
---
 gitk |  148 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 146 insertions(+), 2 deletions(-)

diff --git a/gitk b/gitk
index f6a3e10..6fbd6bb 100755
--- a/gitk
+++ b/gitk
@@ -2249,6 +2249,7 @@ proc makewindow {} {
     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
     global ctxbut
     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
+    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
 
     set maincursor [. cget -cursor]
     set textcursor [$ctext cget -cursor]
@@ -2291,6 +2292,13 @@ proc makewindow {} {
 	{mc "Blame parent commit" command {external_blame 1}}
     }
     $flist_menu configure -tearoff 0
+
+    global diff_menu
+    set diff_menu .diffctxmenu
+    makemenu $diff_menu {
+	{mc "Blame this line" command {external_blame_diff}}
+    }
+    $diff_menu configure -tearoff 0
 }
 
 # Windows sends all mouse wheel events to the current focused window, not
@@ -2993,6 +3001,34 @@ proc pop_flist_menu {w X Y x y} {
     tk_popup $flist_menu $X $Y
 }
 
+proc find_ctext_fileinfo {line} {
+    global ctext_file_names ctext_file_lines
+
+    set ok [bsearch $ctext_file_lines $line]
+    set tline [lindex $ctext_file_lines $ok]
+
+    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
+        return {}
+    } else {
+        return [list [lindex $ctext_file_names $ok] $tline]
+    }
+}
+
+proc pop_diff_menu {w X Y x y} {
+    global ctext diff_menu flist_menu_file
+    global diff_menu_txtpos diff_menu_line
+    global diff_menu_filebase
+
+    stopfinding
+    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
+    set diff_menu_line [lindex $diff_menu_txtpos 0]
+    set f [find_ctext_fileinfo $diff_menu_line]
+    if {$f eq {}} return
+    set flist_menu_file [lindex $f 0]
+    set diff_menu_filebase [lindex $f 1]
+    tk_popup $diff_menu $X $Y
+}
+
 proc flist_hl {only} {
     global flist_menu_file findstring gdttype
 
@@ -3099,7 +3135,96 @@ proc external_diff {} {
     }
 }
 
-proc external_blame {parent_idx} {
+proc find_hunk_blamespec {base line} {
+    global ctext
+
+    # Find and parse the hunk header
+    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
+    if {$s_lix eq {}} return
+
+    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
+    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
+	    s_line old_specs osz osz1 new_line nsz]} {
+	return
+    }
+
+    # base lines for the parents
+    set base_lines [list $new_line]
+    foreach old_spec [lrange [split $old_specs " "] 1 end] {
+	if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
+	        old_spec old_line osz]} {
+	    return
+	}
+	lappend base_lines $old_line
+    }
+
+    # Now scan the lines to determine offset within the hunk
+    set parent {}
+    set dline 0
+    set s_lno [lindex [split $s_lix "."] 0]
+
+    for {set i $line} {$i > $s_lno} {incr i -1} {
+	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
+	# Determine if the line is removed
+	set chunk [string range $c_line 0 [llength $base_lines]-2]
+	set removed_idx [string first "-" $chunk]
+	# Choose a parent index
+	if {$parent eq {}} {
+	    if {$removed_idx >= 0} {
+		set parent $removed_idx
+		incr parent
+	    } else {
+		set unchanged_idx [string first " " $chunk]
+		if {$unchanged_idx >= 0} {
+		    set parent $unchanged_idx
+		    incr parent
+		} else {
+		    # blame the current commit
+		    set parent 0
+		}
+	    }
+	}
+	# then count other lines that belong to it
+	if {$parent > 0} {
+	    set code [string index $c_line $parent-1]
+	    if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
+		incr dline
+	    }
+	} else {
+	    if {$removed_idx < 0} {
+		incr dline
+	    }
+	}
+    }
+
+    if {$parent eq {}} { set parent 0 }
+    incr dline [lindex $base_lines $parent]
+    return [list $parent $dline]
+}
+
+proc external_blame_diff {} {
+    global currentid diffmergeid cmitmode
+    global diff_menu_txtpos diff_menu_line
+    global diff_menu_filebase flist_menu_file
+
+    if {$cmitmode eq "tree"} {
+	set parent_idx 0
+	set line [expr {$diff_menu_line - $diff_menu_filebase - 1}]
+    } else {
+	set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
+	if {$hinfo ne {}} {
+	    set parent_idx [lindex $hinfo 0]
+	    set line [lindex $hinfo 1]
+	} else {
+	    set parent_idx 0
+	    set line 0
+	}
+    }
+
+    external_blame $parent_idx $line
+}
+
+proc external_blame {parent_idx {line {}}} {
     global flist_menu_file
     global nullid nullid2
     global parentlist selectedline currentid
@@ -3115,7 +3240,12 @@ proc external_blame {parent_idx} {
 	return
     }
 
-    if {[catch {exec git gui blame $base_commit $flist_menu_file &} err]} {
+    set cmdline [list git gui blame]
+    if {$line ne {} && $line > 1} {
+	lappend cmdline "--line=$line"
+    }
+    lappend cmdline $base_commit $flist_menu_file
+    if {[catch {eval exec $cmdline &} err]} {
 	error_popup "[mc "git gui blame: command failed:"] $err"
     }
 }
@@ -6364,6 +6494,7 @@ proc gettreeline {gtf id} {
 
 proc showfile {f} {
     global treefilelist treeidlist diffids nullid nullid2
+    global ctext_file_names ctext_file_lines
     global ctext commentend
 
     set i [lsearch -exact $treefilelist($diffids) $f]
@@ -6387,6 +6518,8 @@ proc showfile {f} {
     filerun $bf [list getblobline $bf $diffids]
     $ctext config -state normal
     clear_ctext $commentend
+    lappend ctext_file_names $f
+    lappend ctext_file_lines [lindex [split $commentend "."] 0]
     $ctext insert end "\n"
     $ctext insert end "$f\n" filesep
     $ctext config -state disabled
@@ -6447,6 +6580,7 @@ proc mergediff {id} {
 proc getmergediffline {mdf id np} {
     global diffmergeid ctext cflist mergemax
     global difffilestart mdifffd treediffs
+    global ctext_file_names ctext_file_lines
     global diffencoding
 
     $ctext conf -state normal
@@ -6465,6 +6599,8 @@ proc getmergediffline {mdf id np} {
 	    lappend difffilestart $here
 	    lappend treediffs($id) $fname
 	    add_flist [list $fname]
+	    lappend ctext_file_names $fname
+	    lappend ctext_file_lines [lindex [split $here "."] 0]
 	    set diffencoding [get_path_encoding $fname]
 	    set l [expr {(78 - [string length $fname]) / 2}]
 	    set pad [string range "----------------------------------------" 1 $l]
@@ -6733,11 +6869,13 @@ proc setinlist {var i val} {
 
 proc makediffhdr {fname ids} {
     global ctext curdiffstart treediffs
+    global ctext_file_names
 
     set i [lsearch -exact $treediffs($ids) $fname]
     if {$i >= 0} {
 	setinlist difffilestart $i $curdiffstart
     }
+    set ctext_file_names [lreplace $ctext_file_names end end $fname]
     set l [expr {(78 - [string length $fname]) / 2}]
     set pad [string range "----------------------------------------" 1 $l]
     $ctext insert $curdiffstart "$pad $fname $pad" filesep
@@ -6746,6 +6884,7 @@ proc makediffhdr {fname ids} {
 proc getblobdiffline {bdf ids} {
     global diffids blobdifffd ctext curdiffstart
     global diffnexthead diffnextnote difffilestart
+    global ctext_file_names ctext_file_lines
     global diffinhdr treediffs
     global diffencoding
 
@@ -6763,6 +6902,8 @@ proc getblobdiffline {bdf ids} {
 	    # start of a new file
 	    $ctext insert end "\n"
 	    set curdiffstart [$ctext index "end - 1c"]
+	    lappend ctext_file_names ""
+	    lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
 	    $ctext insert end "\n" filesep
 	    # If the name hasn't changed the length will be odd,
 	    # the middle char will be a space, and the two bits either
@@ -6899,6 +7040,7 @@ proc nextfile {} {
 
 proc clear_ctext {{first 1.0}} {
     global ctext smarktop smarkbot
+    global ctext_file_names ctext_file_lines
     global pendinglinks
 
     set l [lindex [split $first .] 0]
@@ -6912,6 +7054,8 @@ proc clear_ctext {{first 1.0}} {
     if {$first eq "1.0"} {
 	catch {unset pendinglinks}
     }
+    set ctext_file_names {}
+    set ctext_file_lines {}
 }
 
 proc settabs {{firstab {}}} {
-- 
1.6.0.20.g6148bc

Re: [PATCH 3/7] gitk: Allow starting gui blame for a specific line.

[Paul Mackerras]

Alexander Gavrilov writes:

> Good point. How about this variant? I renamed the menu item, and
> changed the code to blame the current commit if:

Sounds good, just a couple of minor nits...

> +    # Now scan the lines to determine offset within the hunk
> +    set parent {}
> +    set dline 0
> +    set s_lno [lindex [split $s_lix "."] 0]
> +
> +    for {set i $line} {$i > $s_lno} {incr i -1} {
> +	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
> +	# Determine if the line is removed
> +	set chunk [string range $c_line 0 [llength $base_lines]-2]

You need an [expr]:

set chunk [string range $c_line 0 [expr {[llength $base_lines] - 2}]]

> +	set removed_idx [string first "-" $chunk]
> +	# Choose a parent index
> +	if {$parent eq {}} {
> +	    if {$removed_idx >= 0} {
> +		set parent $removed_idx
> +		incr parent
> +	    } else {
> +		set unchanged_idx [string first " " $chunk]
> +		if {$unchanged_idx >= 0} {
> +		    set parent $unchanged_idx
> +		    incr parent
> +		} else {
> +		    # blame the current commit
> +		    set parent 0
> +		}
> +	    }
> +	}

I like this better than the previous version, but it would turn out a
bit simpler if you use parent = -1 to indicate that we're blaming the
current commit, and then increment it right at the end.

> +	# then count other lines that belong to it
> +	if {$parent > 0} {
> +	    set code [string index $c_line $parent-1]

Once again you need an [expr].

Apart from those things, it looks good.  If you like I will fix those
things and commit it.

Paul.

Re: [PATCH 3/7] gitk: Allow starting gui blame for a specific line.

[Alexander Gavrilov]

On Saturday 25 October 2008 15:57:23 Paul Mackerras wrote:
> > +    # Now scan the lines to determine offset within the hunk
> > +    set parent {}
> > +    set dline 0
> > +    set s_lno [lindex [split $s_lix "."] 0]
> > +
> > +    for {set i $line} {$i > $s_lno} {incr i -1} {
> > +	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
> > +	# Determine if the line is removed
> > +	set chunk [string range $c_line 0 [llength $base_lines]-2]
> 
> You need an [expr]:
> 
> set chunk [string range $c_line 0 [expr {[llength $base_lines] - 2}]]

Ugh. I guess I'll have to install docs from Tcl 8.4...
 
> > +	set removed_idx [string first "-" $chunk]
> > +	# Choose a parent index
> > +	if {$parent eq {}} {
> > +	    if {$removed_idx >= 0} {
> > +		set parent $removed_idx
> > +		incr parent
> > +	    } else {
> > +		set unchanged_idx [string first " " $chunk]
> > +		if {$unchanged_idx >= 0} {
> > +		    set parent $unchanged_idx
> > +		    incr parent
> > +		} else {
> > +		    # blame the current commit
> > +		    set parent 0
> > +		}
> > +	    }
> > +	}
> 
> I like this better than the previous version, but it would turn out a
> bit simpler if you use parent = -1 to indicate that we're blaming the
> current commit, and then increment it right at the end.

Yes, it's probably better to apply the following fixup.

Alexander


diff --git a/gitk b/gitk
index 6fbd6bb..68f07c2 100755
--- a/gitk
+++ b/gitk
@@ -3160,33 +3160,32 @@ proc find_hunk_blamespec {base line} {
 
     # Now scan the lines to determine offset within the hunk
     set parent {}
+    set max_parent [expr {[llength $base_lines]-2}]
     set dline 0
     set s_lno [lindex [split $s_lix "."] 0]
 
     for {set i $line} {$i > $s_lno} {incr i -1} {
 	set c_line [$ctext get $i.0 "$i.0 + 1 lines"]
 	# Determine if the line is removed
-	set chunk [string range $c_line 0 [llength $base_lines]-2]
+	set chunk [string range $c_line 0 $max_parent]
 	set removed_idx [string first "-" $chunk]
 	# Choose a parent index
 	if {$parent eq {}} {
 	    if {$removed_idx >= 0} {
 		set parent $removed_idx
-		incr parent
 	    } else {
 		set unchanged_idx [string first " " $chunk]
 		if {$unchanged_idx >= 0} {
 		    set parent $unchanged_idx
-		    incr parent
 		} else {
 		    # blame the current commit
-		    set parent 0
+		    set parent -1
 		}
 	    }
 	}
 	# then count other lines that belong to it
-	if {$parent > 0} {
-	    set code [string index $c_line $parent-1]
+	if {$parent >= 0} {
+	    set code [string index $c_line $parent]
 	    if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
 		incr dline
 	    }
@@ -3197,7 +3196,8 @@ proc find_hunk_blamespec {base line} {
 	}
     }
 
-    if {$parent eq {}} { set parent 0 }
+    if {$parent eq {}} { set parent -1 }
+    incr parent
     incr dline [lindex $base_lines $parent]
     return [list $parent $dline]
 }

Re: [PATCH 3/7] gitk: Allow starting gui blame for a specific line.

[Paul Mackerras]

Alexander Gavrilov writes:

> Ugh. I guess I'll have to install docs from Tcl 8.4...

Yes, although I strongly encourage people to move to 8.5, I haven't
made it a requirement (yet :).

Paul.