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.
 
 # 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
 
 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
     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"} {
        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 {
        } else {

-           puts stderr "Error reading commits: $err"
+           set err "Error reading commits: $err"

        }
        }

+       error_popup $err

        exit 1
     }
 
        exit 1
     }
 


@@ -83,7 +87,8 @@ proc readcommit {id} {
     set audate {}
     set comname {}
     set comdate {}
     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
        if {$inhdr} {
            if {$line == {}} {
                set inhdr 0


@@ -118,9 +123,21 @@ proc readcommit {id} {
                             $comname $comdate $comment]
 }
 
                             $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
 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
 
     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 {}
     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"
     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
     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
     .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
     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 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
 
     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
     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
     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"
     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
     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 . <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
 }
 
 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]"
     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) \
        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 {
     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
 
 
 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"
            -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 {}
 
     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 {$nchildren($id) == 0} {
            lappend start $id
        }
        set ncleft($id) $nchildren($id)

+       if {![info exists nparents($id)]} {
+           set nparents($id) 0
+       }

     }
     if {$start == {}} {
     }
     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
     }
 
     set nextcolor 0


@@ -494,14 +531,21 @@ proc drawgraph {} {
        set id [lindex $todo $level]
        set lineid($lineno) $id
        set actualparents {}
        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
                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
                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]
        }
        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
 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
     unmarkmatches

+    focus .

     set matchinglines {}
     set fldtypes {Headline Author Date Committer CDate Comment}
     if {$findtype == "IgnCase"} {
     set matchinglines {}
     set fldtypes {Headline Author Date Committer CDate Comment}
     if {$findtype == "IgnCase"} {

-       set fstr [string tolower $findstring]
+       set foundstring [string tolower $findstring]

     } else {
     } 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 {
     if {![info exists selectedline]} {
        set oldsel -1
     } else {


@@ -700,21 +765,7 @@ proc dofind {} {
            if {$findloc != "All fields" && $findloc != $ty} {
                continue
            }
            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"} {
            if {$matches == {}} continue
            set doesmatch 1
            if {$ty == "Headline"} {


@@ -728,7 +779,7 @@ proc dofind {} {
        if {$doesmatch} {
            lappend matchinglines $l
            if {!$didsel && $l > $oldsel} {
        if {$doesmatch} {
            lappend matchinglines $l
            if {!$didsel && $l > $oldsel} {

-               selectline $l
+               findselectline $l

                set didsel 1
            }
        }
                set didsel 1
            }
        }


@@ -736,7 +787,22 @@ proc dofind {} {
     if {$matchinglines == {}} {
        bell
     } elseif {!$didsel} {
     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} {
     if {![info exists selectedline]} return
     foreach l $matchinglines {
        if {$l > $selectedline} {

-           selectline $l
+           findselectline $l

            return
        }
     }
            return
        }
     }


@@ -769,7 +835,7 @@ proc findprev {} {
        set prev $l
     }
     if {$prev != {}} {
        set prev $l
     }
     if {$prev != {}} {

-       selectline $prev
+       findselectline $prev

     } else {
        bell
     }
     } 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 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 {{}} \
     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 insert end [lindex $info 5]
     $ctext insert end "\n"
     $ctext tag delete Comments

+    $ctext tag remove found 1.0 end

     $ctext conf -state disabled
     $ctext conf -state disabled

+    set commentend [$ctext index "end - 1c"]

 
     $cflist delete 0 end
     set currentid $id
 
     $cflist delete 0 end
     set currentid $id