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

diff --git a/gitk b/gitk
index 37a97acc12df008eed58a26fad8fce41f765ebdf..35ae1018b6b77646ee87e2bc9ed955ad6baea65c 100755 (executable)
--- 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