From: Paul Mackerras Date: Tue, 17 May 2005 23:23:07 +0000 (+0000) Subject: Error popups on error conditions rather than stderr msgs X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=df3d83b143d0e149767acfebc91b2041f44507ef;p=gitk 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 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 "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 "[bind Entry ]; 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 {resizecdetpanes %W %w} pack .ctop -side top -fill both -expand 1 @@ -231,19 +242,20 @@ proc makewindow {} { bindall "allcanvs yview scroll 5 u" bindall <2> "allcanvs scan mark 0 %y" bindall "allcanvs scan dragto 0 %y" - bind . "selnextline -1" - bind . "selnextline 1" - bind . p "selnextline -1" - bind . n "selnextline 1" - bind . "allcanvs yview scroll -1 p" - bind . "allcanvs yview scroll 1 p" - bind . "$ctext yview scroll -1 p" - bind . "$ctext yview scroll -1 p" - bind . "$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 "selnextline -1" + bindall "selnextline 1" + bindall "allcanvs yview scroll -1 p" + bindall "allcanvs yview scroll 1 p" + bindkey "$ctext yview scroll -1 p" + bindkey "$ctext yview scroll -1 p" + bindkey "$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 . doquit bind . dofind bind . findnext @@ -254,23 +266,47 @@ proc makewindow {} { bind . {incrfont -1} bind $cflist <> listboxsel bind . {savestuff %W} + bind . "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 ] + } + 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