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
This commit is contained in:
Paul Mackerras
parent
0fba86b3a9
commit
df3d83b143
209
gitk
209
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user