From df3d83b143d0e149767acfebc91b2041f44507ef Mon Sep 17 00:00:00 2001
From: Paul Mackerras <paulus@samba.org>
Date: Tue, 17 May 2005 23:23:07 +0000
Subject: [PATCH] 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
---
gitk | 209 +++++++++++++++++++++++++++++++++++++++--------------------
1 file changed, 139 insertions(+), 70 deletions(-)
diff --git a/gitk b/gitk
index 37a97acc12d..35ae1018b6b 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