Error popups on error conditions rather than stderr msgs

Stop . bindings firing on find string entry keypresses
Fix geometry saving/restoring a bit
Show the terminal commits
Highlight comment matches in the comment window

1 files changed, 139 insertions, 70 deletions

diff --git a/gitk b/gitk
index 37a97ac..35ae101 100755
--- a/gitk
+++ b/gitk
@@ -7,7 +7,7 @@ exec wish "$0" -- "${1+$@}"
 # and distributed under the terms of the GNU General Public Licence,
 # either version 2, or (at your option) any later version.
 
-# CVS $Revision: 1.13 $
+# CVS $Revision: 1.14 $
 
 proc getcommits {rargs} {
     global commits commfd phase canv mainfont
@@ -32,17 +32,21 @@ proc getcommitline {commfd}  {
     set n [gets $commfd line]
     if {$n < 0} {
 	if {![eof $commfd]} return
+	# this works around what is apparently a bug in Tcl...
+	fconfigure $commfd -blocking 1
 	if {![catch {close $commfd} err]} {
 	    after idle drawgraph
 	    return
 	}
 	if {[string range $err 0 4] == "usage"} {
-	    puts stderr "Error reading commits: bad arguments to git-rev-tree"
-	    puts stderr "Note: arguments to gitk are passed to git-rev-tree"
-	    puts stderr "      to allow selection of commits to be displayed"
+	    set err "\
+Gitk: error reading commits: bad arguments to git-rev-tree.\n\
+(Note: arguments to gitk are passed to git-rev-tree\
+to allow selection of commits to be displayed.)"
 	} else {
-	    puts stderr "Error reading commits: $err"
+	    set err "Error reading commits: $err"
 	}
+	error_popup $err
 	exit 1
     }
 
@@ -83,7 +87,8 @@ proc readcommit {id} {
     set audate {}
     set comname {}
     set comdate {}
-    foreach line [split [exec git-cat-file commit $id] "\n"] {
+    if [catch {set contents [exec git-cat-file commit $id]}] return
+    foreach line [split $contents "\n"] {
 	if {$inhdr} {
 	    if {$line == {}} {
 		set inhdr 0
@@ -118,9 +123,21 @@ proc readcommit {id} {
 			     $comname $comdate $comment]
 }
 
+proc error_popup msg {
+    set w .error
+    toplevel $w
+    wm transient $w .
+    message $w.m -text $msg -justify center -aspect 400
+    pack $w.m -side top -fill x -padx 20 -pady 20
+    button $w.ok -text OK -command "destroy $w"
+    pack $w.ok -side bottom -fill x
+    bind $w <Visibility> "grab $w; focus $w"
+    tkwait window $w
+}
+
 proc makewindow {} {
     global canv canv2 canv3 linespc charspc ctext cflist textfont
-    global sha1entry findtype findloc findstring geometry
+    global sha1entry findtype findloc findstring fstring geometry
 
     menu .bar
     .bar add cascade -label "File" -menu .bar.file
@@ -176,9 +193,11 @@ proc makewindow {} {
     button .ctop.top.bar.findbut -text "Find" -command dofind
     pack .ctop.top.bar.findbut -side left
     set findstring {}
-    entry .ctop.top.bar.findstring -width 30 -font $textfont \
-	-textvariable findstring
-    pack .ctop.top.bar.findstring -side left -expand 1 -fill x
+    set fstring .ctop.top.bar.findstring
+    entry $fstring -width 30 -font $textfont -textvariable findstring
+    # stop the toplevel events from firing on key presses
+    bind $fstring <Key> "[bind Entry <Key>]; break"
+    pack $fstring -side left -expand 1 -fill x
     set findtype Exact
     tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
     set findloc "All fields"
@@ -188,9 +207,6 @@ proc makewindow {} {
     pack .ctop.top.bar.findtype -side right
 
     panedwindow .ctop.cdet -orient horizontal
-    if {[info exists geometry(cdeth)]} {
-	.ctop.cdet conf -height $geometry(cdeth)
-    }
     .ctop add .ctop.cdet
     frame .ctop.cdet.left
     set ctext .ctop.cdet.left.ctext
@@ -201,14 +217,12 @@ proc makewindow {} {
     pack .ctop.cdet.left.sb -side right -fill y
     pack $ctext -side left -fill both -expand 1
     .ctop.cdet add .ctop.cdet.left
-    if {[info exists geometry(detlw)]} {
-	.ctop.cdet.left conf -width $geometry(detlw)
-    }
 
     $ctext tag conf filesep -font [concat $textfont bold]
     $ctext tag conf hunksep -back blue -fore white
     $ctext tag conf d0 -back "#ff8080"
     $ctext tag conf d1 -back green
+    $ctext tag conf found -back yellow
 
     frame .ctop.cdet.right
     set cflist .ctop.cdet.right.cfiles
@@ -218,9 +232,6 @@ proc makewindow {} {
     pack .ctop.cdet.right.sb -side right -fill y
     pack $cflist -side left -fill both -expand 1
     .ctop.cdet add .ctop.cdet.right
-    if {[info exists geometry(detsash)]} {
-	eval .ctop.cdet sash place 0 $geometry(detsash)
-    }
     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 
     pack .ctop -side top -fill both -expand 1
@@ -231,19 +242,20 @@ proc makewindow {} {
     bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
     bindall <2> "allcanvs scan mark 0 %y"
     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
-    bind . <Key-Up> "selnextline -1"
-    bind . <Key-Down> "selnextline 1"
-    bind . p "selnextline -1"
-    bind . n "selnextline 1"
-    bind . <Key-Prior> "allcanvs yview scroll -1 p"
-    bind . <Key-Next> "allcanvs yview scroll 1 p"
-    bind . <Key-Delete> "$ctext yview scroll -1 p"
-    bind . <Key-BackSpace> "$ctext yview scroll -1 p"
-    bind . <Key-space> "$ctext yview scroll 1 p"
-    bind . b "$ctext yview scroll -1 p"
-    bind . d "$ctext yview scroll 18 u"
-    bind . u "$ctext yview scroll -18 u"
-    bind . Q doquit
+    bindall <Key-Up> "selnextline -1"
+    bindall <Key-Down> "selnextline 1"
+    bindall <Key-Prior> "allcanvs yview scroll -1 p"
+    bindall <Key-Next> "allcanvs yview scroll 1 p"
+    bindkey <Key-Delete> "$ctext yview scroll -1 p"
+    bindkey <Key-BackSpace> "$ctext yview scroll -1 p"
+    bindkey <Key-space> "$ctext yview scroll 1 p"
+    bindkey p "selnextline -1"
+    bindkey n "selnextline 1"
+    bindkey b "$ctext yview scroll -1 p"
+    bindkey d "$ctext yview scroll 18 u"
+    bindkey u "$ctext yview scroll -18 u"
+    bindkey / findnext
+    bindkey ? findprev
     bind . <Control-q> doquit
     bind . <Control-f> dofind
     bind . <Control-g> findnext
@@ -254,23 +266,47 @@ proc makewindow {} {
     bind . <Control-KP_Subtract> {incrfont -1}
     bind $cflist <<ListboxSelect>> listboxsel
     bind . <Destroy> {savestuff %W}
+    bind . <Button-1> "click %W"
+}
+
+# when we make a key binding for the toplevel, make sure
+# it doesn't get triggered when that key is pressed in the
+# find string entry widget.
+proc bindkey {ev script} {
+    global fstring
+    bind . $ev $script
+    set escript [bind Entry $ev]
+    if {$escript == {}} {
+	set escript [bind Entry <Key>]
+    }
+    bind $fstring $ev "$escript; break"
+}
+
+# set the focus back to the toplevel for any click outside
+# the find string entry widget
+proc click {w} {
+    global fstring
+    if {$w != $fstring} {
+	focus .
+    }
 }
 
 proc savestuff {w} {
     global canv canv2 canv3 ctext cflist mainfont textfont
     global stuffsaved
     if {$stuffsaved} return
+    if {![winfo viewable .]} return
     catch {
 	set f [open "~/.gitk-new" w]
 	puts $f "set mainfont {$mainfont}"
 	puts $f "set textfont {$textfont}"
 	puts $f "set geometry(width) [winfo width .ctop]"
 	puts $f "set geometry(height) [winfo height .ctop]"
-	puts $f "set geometry(canv1) [winfo width $canv]"
-	puts $f "set geometry(canv2) [winfo width $canv2]"
-	puts $f "set geometry(canv3) [winfo width $canv3]"
-	puts $f "set geometry(canvh) [winfo height $canv]"
-	puts $f "set geometry(cdeth) [winfo height .ctop.cdet]"
+	puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
+	puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
+	puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
+	puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
+	puts $f "set geometry(csash) {[.ctop sash coord 0]}"
 	set wid [expr {([winfo width $ctext] - 8) \
 			   / [font measure $textfont "0"]}]
 	set ht [expr {([winfo height $ctext] - 8) \
@@ -361,13 +397,13 @@ proc about {} {
     toplevel $w
     wm title $w "About gitk"
     message $w.m -text {
-Gitk version 0.91
+Gitk version 0.95
 
 Copyright © 2005 Paul Mackerras
 
 Use and redistribute under the terms of the GNU General Public License
 
-(CVS $Revision: 1.13 $)} \
+(CVS $Revision: 1.14 $)} \
 	    -justify center -aspect 400
     pack $w.m -side top -fill x -padx 20 -pady 20
     button $w.ok -text Close -command "destroy $w"
@@ -459,17 +495,18 @@ proc drawgraph {} {
 
     allcanvs delete all
     set start {}
-    foreach id $commits {
+    foreach id [array names nchildren] {
 	if {$nchildren($id) == 0} {
 	    lappend start $id
 	}
 	set ncleft($id) $nchildren($id)
+	if {![info exists nparents($id)]} {
+	    set nparents($id) 0
+	}
     }
     if {$start == {}} {
-	$canv create text 3 3 -anchor nw -font $mainfont \
-	    -text "ERROR: No starting commits found"
-	set phase {}
-	return
+	error_popup "Gitk: ERROR: No starting commits found"
+	exit 1
     }
 
     set nextcolor 0
@@ -494,14 +531,21 @@ proc drawgraph {} {
 	set id [lindex $todo $level]
 	set lineid($lineno) $id
 	set actualparents {}
-	foreach p $parents($id) {
-	    if {[info exists ncleft($p)]} {
+	if {[info exists parents($id)]} {
+	    foreach p $parents($id) {
 		incr ncleft($p) -1
+		if {![info exists commitinfo($p)]} {
+		    readcommit $p
+		    if {![info exists commitinfo($p)]} continue
+		}
 		lappend actualparents $p
 	    }
 	}
 	if {![info exists commitinfo($id)]} {
 	    readcommit $id
+	    if {![info exists commitinfo($id)]} {
+		set commitinfo($id) {"No commit information available"}
+	    }
 	}
 	set x [expr $canvx0 + $level * $linespc]
 	set y2 [expr $canvy + $linespc]
@@ -671,21 +715,42 @@ proc drawgraph {} {
     }
 }
 
+proc findmatches {f} {
+    global findtype foundstring foundstrlen
+    if {$findtype == "Regexp"} {
+	set matches [regexp -indices -all -inline $foundstring $f]
+    } else {
+	if {$findtype == "IgnCase"} {
+	    set str [string tolower $f]
+	} else {
+	    set str $f
+	}
+	set matches {}
+	set i 0
+	while {[set j [string first $foundstring $str $i]] >= 0} {
+	    lappend matches [list $j [expr $j+$foundstrlen-1]]
+	    set i [expr $j + $foundstrlen]
+	}
+    }
+    return $matches
+}
+
 proc dofind {} {
     global findtype findloc findstring markedmatches commitinfo
     global numcommits lineid linehtag linentag linedtag
     global mainfont namefont canv canv2 canv3 selectedline
-    global matchinglines
+    global matchinglines foundstring foundstrlen
     unmarkmatches
+    focus .
     set matchinglines {}
     set fldtypes {Headline Author Date Committer CDate Comment}
     if {$findtype == "IgnCase"} {
-	set fstr [string tolower $findstring]
+	set foundstring [string tolower $findstring]
     } else {
-	set fstr $findstring
+	set foundstring $findstring
     }
-    set mlen [string length $findstring]
-    if {$mlen == 0} return
+    set foundstrlen [string length $findstring]
+    if {$foundstrlen == 0} return
     if {![info exists selectedline]} {
 	set oldsel -1
     } else {
@@ -700,21 +765,7 @@ proc dofind {} {
 	    if {$findloc != "All fields" && $findloc != $ty} {
 		continue
 	    }
-	    if {$findtype == "Regexp"} {
-		set matches [regexp -indices -all -inline $fstr $f]
-	    } else {
-		if {$findtype == "IgnCase"} {
-		    set str [string tolower $f]
-		} else {
-		    set str $f
-		}
-		set matches {}
-		set i 0
-		while {[set j [string first $fstr $str $i]] >= 0} {
-		    lappend matches [list $j [expr $j+$mlen-1]]
-		    set i [expr $j + $mlen]
-		}
-	    }
+	    set matches [findmatches $f]
 	    if {$matches == {}} continue
 	    set doesmatch 1
 	    if {$ty == "Headline"} {
@@ -728,7 +779,7 @@ proc dofind {} {
 	if {$doesmatch} {
 	    lappend matchinglines $l
 	    if {!$didsel && $l > $oldsel} {
-		selectline $l
+		findselectline $l
 		set didsel 1
 	    }
 	}
@@ -736,7 +787,22 @@ proc dofind {} {
     if {$matchinglines == {}} {
 	bell
     } elseif {!$didsel} {
-	selectline [lindex $matchinglines 0]
+	findselectline [lindex $matchinglines 0]
+    }
+}
+
+proc findselectline {l} {
+    global findloc commentend ctext
+    selectline $l
+    if {$findloc == "All fields" || $findloc == "Comments"} {
+	# highlight the matches in the comments
+	set f [$ctext get 1.0 $commentend]
+	set matches [findmatches $f]
+	foreach match $matches {
+	    set start [lindex $match 0]
+	    set end [expr [lindex $match 1] + 1]
+	    $ctext tag add found "1.0 + $start c" "1.0 + $end c"
+	}
     }
 }
 
@@ -749,7 +815,7 @@ proc findnext {} {
     if {![info exists selectedline]} return
     foreach l $matchinglines {
 	if {$l > $selectedline} {
-	    selectline $l
+	    findselectline $l
 	    return
 	}
     }
@@ -769,7 +835,7 @@ proc findprev {} {
 	set prev $l
     }
     if {$prev != {}} {
-	selectline $prev
+	findselectline $prev
     } else {
 	bell
     }
@@ -818,6 +884,7 @@ proc selectline {l} {
     global lineid linehtag linentag linedtag
     global canvy canvy0 linespc nparents treepending
     global cflist treediffs currentid sha1entry
+    global commentend
     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
     $canv delete secsel
     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
@@ -860,7 +927,9 @@ proc selectline {l} {
     $ctext insert end [lindex $info 5]
     $ctext insert end "\n"
     $ctext tag delete Comments
+    $ctext tag remove found 1.0 end
     $ctext conf -state disabled
+    set commentend [$ctext index "end - 1c"]
 
     $cflist delete 0 end
     set currentid $id