# 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
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
}
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
$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
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"
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
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
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
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-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) \
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"
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
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]
}
}
+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 {
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 {$doesmatch} {
lappend matchinglines $l
if {!$didsel && $l > $oldsel} {
- selectline $l
+ findselectline $l
set didsel 1
}
}
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"
+ }
}
}
if {![info exists selectedline]} return
foreach l $matchinglines {
if {$l > $selectedline} {
- selectline $l
+ findselectline $l
return
}
}
set prev $l
}
if {$prev != {}} {
- selectline $prev
+ findselectline $prev
} else {
bell
}
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 {{}} \
$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
projects / git.git / commitdiff