🌐 AI搜索 & 代理 主页
Google Git
Sign in
chromium / external / github.com / git / git / refs/tags/v0.99.9e / . / gitk
blob: a9d37d9c73e5aae166fc748160df9a5a3ebbad4a [file] [log] [blame]
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
Paul Mackerras9e026d32005-09-27 00:29:41[diff] [blame]3exec wish "$0" -- "$@"
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]4
5# Copyright (C) 2005 Paul Mackerras. All rights reserved.
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
Junio C Hamano73b6a6c2005-07-28 07:28:44[diff] [blame]10proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
16 }
17}
18
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]19proc getcommits {rargs} {
Paul Mackerrase2ede2b2005-06-27 00:37:11[diff] [blame]20 global commits commfd phase canv mainfont env
Paul Mackerras466e4fd2005-08-10 12:50:28[diff] [blame]21 global startmsecs nextupdate ncmupdate
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]22 global ctext maincursor textcursor leftover
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]23
Paul Mackerrase2ede2b2005-06-27 00:37:11[diff] [blame]24 # check that we can find a .git directory somewhere...
Junio C Hamano73b6a6c2005-07-28 07:28:44[diff] [blame]25 set gitdir [gitdir]
Paul Mackerrase2ede2b2005-06-27 00:37:11[diff] [blame]26 if {![file isdirectory $gitdir]} {
27 error_popup "Cannot find the git directory \"$gitdir\"."
28 exit 1
29 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]30 set commits {}
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]31 set phase getcommits
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]32 set startmsecs [clock clicks -milliseconds]
33 set nextupdate [expr $startmsecs + 100]
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]34 set ncmupdate 1
Paul Mackerras2efef4b2005-06-21 00:20:04[diff] [blame]35 if [catch {
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]36 set parse_args [concat --default HEAD $rargs]
Paul Mackerras2efef4b2005-06-21 00:20:04[diff] [blame]37 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
38 }] {
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]39 # if git-rev-parse failed for some reason...
Paul Mackerras2efef4b2005-06-21 00:20:04[diff] [blame]40 if {$rargs == {}} {
41 set rargs HEAD
42 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]43 set parsed_args $rargs
Paul Mackerras2efef4b2005-06-21 00:20:04[diff] [blame]44 }
45 if [catch {
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]46 set commfd [open "|git-rev-list --header --topo-order --parents $parsed_args" r]
Paul Mackerras2efef4b2005-06-21 00:20:04[diff] [blame]47 } err] {
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]48 puts stderr "Error executing git-rev-list: $err"
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]49 exit 1
50 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]51 set leftover {}
Paul Mackerrasd6e81492005-08-07 10:01:24[diff] [blame]52 fconfigure $commfd -blocking 0 -translation lf
Paul Mackerras466e4fd2005-08-10 12:50:28[diff] [blame]53 fileevent $commfd readable [list getcommitlines $commfd]
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]54 $canv delete all
55 $canv create text 3 3 -anchor nw -text "Reading commits..." \
56 -font $mainfont -tags textitems
Paul Mackerrasea13cba2005-06-16 10:54:04[diff] [blame]57 . config -cursor watch
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]58 settextcursor watch
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]59}
60
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]61proc getcommitlines {commfd} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]62 global commits parents cdate children
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]63 global commitlisted phase commitinfo nextupdate
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]64 global stopped redisplaying leftover
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]65
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]66 set stuff [read $commfd]
67 if {$stuff == {}} {
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]68 if {![eof $commfd]} return
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]69 # set it blocking so we wait for the process to terminate
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]70 fconfigure $commfd -blocking 1
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]71 if {![catch {close $commfd} err]} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]72 after idle finishcommits
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]73 return
74 }
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]75 if {[string range $err 0 4] == "usage"} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]76 set err \
77{Gitk: error reading commits: bad arguments to git-rev-list.
78(Note: arguments to gitk are passed to git-rev-list
79to allow selection of commits to be displayed.)}
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]80 } else {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]81 set err "Error reading commits: $err"
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]82 }
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]83 error_popup $err
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]84 exit 1
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]85 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]86 set start 0
87 while 1 {
88 set i [string first "\0" $stuff $start]
89 if {$i < 0} {
Paul Mackerras7e952e72005-06-27 10:04:26[diff] [blame]90 append leftover [string range $stuff $start end]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]91 return
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]92 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]93 set cmit [string range $stuff $start [expr {$i - 1}]]
94 if {$start == 0} {
95 set cmit "$leftover$cmit"
Paul Mackerras7e952e72005-06-27 10:04:26[diff] [blame]96 set leftover {}
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]97 }
98 set start [expr {$i + 1}]
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]99 set j [string first "\n" $cmit]
100 set ok 0
101 if {$j >= 0} {
102 set ids [string range $cmit 0 [expr {$j - 1}]]
103 set ok 1
104 foreach id $ids {
105 if {![regexp {^[0-9a-f]{40}$} $id]} {
106 set ok 0
107 break
108 }
109 }
110 }
111 if {!$ok} {
Paul Mackerras7e952e72005-06-27 10:04:26[diff] [blame]112 set shortcmit $cmit
113 if {[string length $shortcmit] > 80} {
114 set shortcmit "[string range $shortcmit 0 80]..."
115 }
116 error_popup "Can't parse git-rev-list output: {$shortcmit}"
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]117 exit 1
118 }
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]119 set id [lindex $ids 0]
120 set olds [lrange $ids 1 end]
121 set cmit [string range $cmit [expr {$j + 1}] end]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]122 lappend commits $id
123 set commitlisted($id) 1
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]124 parsecommit $id $cmit 1 [lrange $ids 1 end]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]125 drawcommit $id
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]126 if {[clock clicks -milliseconds] >= $nextupdate} {
127 doupdate 1
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]128 }
129 while {$redisplaying} {
130 set redisplaying 0
131 if {$stopped == 1} {
132 set stopped 0
133 set phase "getcommits"
134 foreach id $commits {
135 drawcommit $id
136 if {$stopped} break
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]137 if {[clock clicks -milliseconds] >= $nextupdate} {
138 doupdate 1
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]139 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]140 }
141 }
142 }
143 }
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]144}
145
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]146proc doupdate {reading} {
147 global commfd nextupdate numcommits ncmupdate
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]148
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]149 if {$reading} {
150 fileevent $commfd readable {}
151 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]152 update
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]153 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
154 if {$numcommits < 100} {
155 set ncmupdate [expr {$numcommits + 1}]
156 } elseif {$numcommits < 10000} {
157 set ncmupdate [expr {$numcommits + 10}]
158 } else {
159 set ncmupdate [expr {$numcommits + 100}]
160 }
161 if {$reading} {
162 fileevent $commfd readable [list getcommitlines $commfd]
163 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]164}
165
166proc readcommit {id} {
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]167 if [catch {set contents [exec git-cat-file commit $id]}] return
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]168 parsecommit $id $contents 0 {}
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]169}
170
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]171proc parsecommit {id contents listed olds} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]172 global commitinfo children nchildren parents nparents cdate ncleft
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]173
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]174 set inhdr 1
175 set comment {}
176 set headline {}
177 set auname {}
178 set audate {}
179 set comname {}
180 set comdate {}
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]181 if {![info exists nchildren($id)]} {
182 set children($id) {}
183 set nchildren($id) 0
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]184 set ncleft($id) 0
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]185 }
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]186 set parents($id) $olds
187 set nparents($id) [llength $olds]
188 foreach p $olds {
189 if {![info exists nchildren($p)]} {
190 set children($p) [list $id]
191 set nchildren($p) 1
192 set ncleft($p) 1
193 } elseif {[lsearch -exact $children($p) $id] < 0} {
194 lappend children($p) $id
195 incr nchildren($p)
196 incr ncleft($p)
Paul Mackerras244edd12005-08-17 11:27:55[diff] [blame]197 }
198 }
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]199 foreach line [split $contents "\n"] {
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]200 if {$inhdr} {
201 if {$line == {}} {
202 set inhdr 0
203 } else {
204 set tag [lindex $line 0]
Paul Mackerrase5ea7012005-08-18 10:40:39[diff] [blame]205 if {$tag == "author"} {
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]206 set x [expr {[llength $line] - 2}]
207 set audate [lindex $line $x]
208 set auname [lrange $line 1 [expr {$x - 1}]]
209 } elseif {$tag == "committer"} {
210 set x [expr {[llength $line] - 2}]
211 set comdate [lindex $line $x]
212 set comname [lrange $line 1 [expr {$x - 1}]]
213 }
214 }
215 } else {
216 if {$comment == {}} {
Paul Mackerras806ce092005-06-22 08:15:15[diff] [blame]217 set headline [string trim $line]
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]218 } else {
219 append comment "\n"
220 }
Paul Mackerras806ce092005-06-22 08:15:15[diff] [blame]221 if {!$listed} {
222 # git-rev-list indents the comment by 4 spaces;
223 # if we got this via git-cat-file, add the indentation
224 append comment " "
225 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]226 append comment $line
227 }
228 }
229 if {$audate != {}} {
230 set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
231 }
232 if {$comdate != {}} {
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]233 set cdate($id) $comdate
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]234 set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
235 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]236 set commitinfo($id) [list $headline $auname $audate \
237 $comname $comdate $comment]
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]238}
239
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]240proc readrefs {} {
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]241 global tagids idtags headids idheads tagcontents
242
Junio C Hamano73b6a6c2005-07-28 07:28:44[diff] [blame]243 set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]244 foreach f $tags {
245 catch {
246 set fd [open $f r]
247 set line [read $fd]
248 if {[regexp {^[0-9a-f]{40}} $line id]} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]249 set direct [file tail $f]
250 set tagids($direct) $id
251 lappend idtags($id) $direct
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]252 set tagblob [exec git-cat-file tag $id]
253 set contents [split $tagblob "\n"]
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]254 set obj {}
255 set type {}
256 set tag {}
257 foreach l $contents {
258 if {$l == {}} break
259 switch -- [lindex $l 0] {
260 "object" {set obj [lindex $l 1]}
261 "type" {set type [lindex $l 1]}
262 "tag" {set tag [string range $l 4 end]}
263 }
264 }
265 if {$obj != {} && $type == "commit" && $tag != {}} {
266 set tagids($tag) $obj
267 lappend idtags($obj) $tag
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]268 set tagcontents($tag) $tagblob
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]269 }
270 }
Paul Mackerrasc2f6a022005-06-10 07:54:49[diff] [blame]271 close $fd
272 }
273 }
Junio C Hamano73b6a6c2005-07-28 07:28:44[diff] [blame]274 set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
Paul Mackerrasc2f6a022005-06-10 07:54:49[diff] [blame]275 foreach f $heads {
276 catch {
277 set fd [open $f r]
278 set line [read $fd 40]
279 if {[regexp {^[0-9a-f]{40}} $line id]} {
280 set head [file tail $f]
281 set headids($head) $line
282 lappend idheads($line) $head
283 }
284 close $fd
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]285 }
286 }
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]287 readotherrefs refs {} {tags heads}
288}
289
290proc readotherrefs {base dname excl} {
291 global otherrefids idotherrefs
292
293 set git [gitdir]
294 set files [glob -nocomplain -types f [file join $git $base *]]
295 foreach f $files {
296 catch {
297 set fd [open $f r]
298 set line [read $fd 40]
299 if {[regexp {^[0-9a-f]{40}} $line id]} {
300 set name "$dname[file tail $f]"
301 set otherrefids($name) $id
302 lappend idotherrefs($id) $name
303 }
304 close $fd
305 }
306 }
307 set dirs [glob -nocomplain -types d [file join $git $base *]]
308 foreach d $dirs {
309 set dir [file tail $d]
310 if {[lsearch -exact $excl $dir] >= 0} continue
311 readotherrefs [file join $base $dir] "$dname$dir/" {}
312 }
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]313}
314
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]315proc error_popup msg {
316 set w .error
317 toplevel $w
318 wm transient $w .
319 message $w.m -text $msg -justify center -aspect 400
320 pack $w.m -side top -fill x -padx 20 -pady 20
321 button $w.ok -text OK -command "destroy $w"
322 pack $w.ok -side bottom -fill x
323 bind $w <Visibility> "grab $w; focus $w"
324 tkwait window $w
325}
326
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]327proc makewindow {} {
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]328 global canv canv2 canv3 linespc charspc ctext cflist textfont
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]329 global findtype findtypemenu findloc findstring fstring geometry
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]330 global entries sha1entry sha1string sha1but
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]331 global maincursor textcursor curtextcursor
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]332 global rowctxmenu gaudydiff mergemax
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]333
334 menu .bar
335 .bar add cascade -label "File" -menu .bar.file
336 menu .bar.file
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]337 .bar.file add command -label "Reread references" -command rereadrefs
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]338 .bar.file add command -label "Quit" -command doquit
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]339 menu .bar.help
340 .bar add cascade -label "Help" -menu .bar.help
341 .bar.help add command -label "About gitk" -command about
342 . configure -menu .bar
343
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]344 if {![info exists geometry(canv1)]} {
345 set geometry(canv1) [expr 45 * $charspc]
346 set geometry(canv2) [expr 30 * $charspc]
347 set geometry(canv3) [expr 15 * $charspc]
348 set geometry(canvh) [expr 25 * $linespc + 4]
349 set geometry(ctextw) 80
350 set geometry(ctexth) 30
351 set geometry(cflistw) 30
352 }
Paul Mackerras0327d272005-05-10 00:23:42[diff] [blame]353 panedwindow .ctop -orient vertical
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]354 if {[info exists geometry(width)]} {
355 .ctop conf -width $geometry(width) -height $geometry(height)
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]356 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
357 set geometry(ctexth) [expr {($texth - 8) /
358 [font metrics $textfont -linespace]}]
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]359 }
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]360 frame .ctop.top
361 frame .ctop.top.bar
362 pack .ctop.top.bar -side bottom -fill x
363 set cscroll .ctop.top.csb
364 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
365 pack $cscroll -side right -fill y
366 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
367 pack .ctop.top.clist -side top -fill both -expand 1
368 .ctop add .ctop.top
369 set canv .ctop.top.clist.canv
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]370 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
Paul Mackerrasb5721c72005-05-10 12:08:22[diff] [blame]371 -bg white -bd 0 \
372 -yscrollincr $linespc -yscrollcommand "$cscroll set"
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]373 .ctop.top.clist add $canv
374 set canv2 .ctop.top.clist.canv2
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]375 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
Paul Mackerrasb5721c72005-05-10 12:08:22[diff] [blame]376 -bg white -bd 0 -yscrollincr $linespc
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]377 .ctop.top.clist add $canv2
378 set canv3 .ctop.top.clist.canv3
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]379 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
Paul Mackerrasb5721c72005-05-10 12:08:22[diff] [blame]380 -bg white -bd 0 -yscrollincr $linespc
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]381 .ctop.top.clist add $canv3
Paul Mackerras43bddeb2005-05-15 23:19:18[diff] [blame]382 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]383
384 set sha1entry .ctop.top.bar.sha1
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]385 set entries $sha1entry
386 set sha1but .ctop.top.bar.sha1label
387 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
388 -command gotocommit -width 8
389 $sha1but conf -disabledforeground [$sha1but cget -foreground]
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]390 pack .ctop.top.bar.sha1label -side left
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]391 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
392 trace add variable sha1string write sha1change
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]393 pack $sha1entry -side left -pady 2
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]394
395 image create bitmap bm-left -data {
396 #define left_width 16
397 #define left_height 16
398 static unsigned char left_bits[] = {
399 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
400 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
401 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
402 }
403 image create bitmap bm-right -data {
404 #define right_width 16
405 #define right_height 16
406 static unsigned char right_bits[] = {
407 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
408 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
409 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
410 }
411 button .ctop.top.bar.leftbut -image bm-left -command goback \
412 -state disabled -width 26
413 pack .ctop.top.bar.leftbut -side left -fill y
414 button .ctop.top.bar.rightbut -image bm-right -command goforw \
415 -state disabled -width 26
416 pack .ctop.top.bar.rightbut -side left -fill y
417
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]418 button .ctop.top.bar.findbut -text "Find" -command dofind
419 pack .ctop.top.bar.findbut -side left
420 set findstring {}
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]421 set fstring .ctop.top.bar.findstring
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]422 lappend entries $fstring
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]423 entry $fstring -width 30 -font $textfont -textvariable findstring
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]424 pack $fstring -side left -expand 1 -fill x
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]425 set findtype Exact
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]426 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
427 findtype Exact IgnCase Regexp]
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]428 set findloc "All fields"
429 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]430 Comments Author Committer Files Pickaxe
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]431 pack .ctop.top.bar.findloc -side right
432 pack .ctop.top.bar.findtype -side right
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]433 # for making sure type==Exact whenever loc==Pickaxe
434 trace add variable findloc write findlocchange
Paul Mackerrasb5721c72005-05-10 12:08:22[diff] [blame]435
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]436 panedwindow .ctop.cdet -orient horizontal
437 .ctop add .ctop.cdet
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]438 frame .ctop.cdet.left
439 set ctext .ctop.cdet.left.ctext
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]440 text $ctext -bg white -state disabled -font $textfont \
441 -width $geometry(ctextw) -height $geometry(ctexth) \
Linus Torvaldsb1ba39e2005-08-09 03:04:20[diff] [blame]442 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]443 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
444 pack .ctop.cdet.left.sb -side right -fill y
445 pack $ctext -side left -fill both -expand 1
446 .ctop.cdet add .ctop.cdet.left
447
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]448 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
449 if {$gaudydiff} {
450 $ctext tag conf hunksep -back blue -fore white
451 $ctext tag conf d0 -back "#ff8080"
452 $ctext tag conf d1 -back green
453 } else {
454 $ctext tag conf hunksep -fore blue
455 $ctext tag conf d0 -fore red
456 $ctext tag conf d1 -fore "#00a000"
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]457 $ctext tag conf m0 -fore red
458 $ctext tag conf m1 -fore blue
459 $ctext tag conf m2 -fore green
460 $ctext tag conf m3 -fore purple
461 $ctext tag conf m4 -fore brown
462 $ctext tag conf mmax -fore darkgrey
463 set mergemax 5
464 $ctext tag conf mresult -font [concat $textfont bold]
465 $ctext tag conf msep -font [concat $textfont bold]
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]466 $ctext tag conf found -back yellow
467 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]468
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]469 frame .ctop.cdet.right
470 set cflist .ctop.cdet.right.cfiles
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]471 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]472 -yscrollcommand ".ctop.cdet.right.sb set"
473 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
474 pack .ctop.cdet.right.sb -side right -fill y
475 pack $cflist -side left -fill both -expand 1
476 .ctop.cdet add .ctop.cdet.right
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]477 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]478
Paul Mackerras0327d272005-05-10 00:23:42[diff] [blame]479 pack .ctop -side top -fill both -expand 1
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]480
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]481 bindall <1> {selcanvline %W %x %y}
482 #bindall <B1-Motion> {selcanvline %W %x %y}
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]483 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
484 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
Paul Mackerrasb5721c72005-05-10 12:08:22[diff] [blame]485 bindall <2> "allcanvs scan mark 0 %y"
486 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]487 bind . <Key-Up> "selnextline -1"
488 bind . <Key-Down> "selnextline 1"
Robert Suetterlin6e2dda32005-09-22 00:07:36[diff] [blame]489 bind . <Key-Right> "goforw"
490 bind . <Key-Left> "goback"
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]491 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
492 bind . <Key-Next> "allcanvs yview scroll 1 pages"
493 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
494 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
495 bindkey <Key-space> "$ctext yview scroll 1 pages"
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]496 bindkey p "selnextline -1"
497 bindkey n "selnextline 1"
Robert Suetterlin6e2dda32005-09-22 00:07:36[diff] [blame]498 bindkey z "goback"
499 bindkey x "goforw"
500 bindkey i "selnextline -1"
501 bindkey k "selnextline 1"
502 bindkey j "goback"
503 bindkey l "goforw"
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]504 bindkey b "$ctext yview scroll -1 pages"
505 bindkey d "$ctext yview scroll 18 units"
506 bindkey u "$ctext yview scroll -18 units"
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]507 bindkey / {findnext 1}
508 bindkey <Key-Return> {findnext 0}
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]509 bindkey ? findprev
Paul Mackerras39ad8572005-05-19 12:35:53[diff] [blame]510 bindkey f nextfile
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]511 bind . <Control-q> doquit
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]512 bind . <Control-f> dofind
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]513 bind . <Control-g> {findnext 0}
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]514 bind . <Control-r> findprev
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]515 bind . <Control-equal> {incrfont 1}
516 bind . <Control-KP_Add> {incrfont 1}
517 bind . <Control-minus> {incrfont -1}
518 bind . <Control-KP_Subtract> {incrfont -1}
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]519 bind $cflist <<ListboxSelect>> listboxsel
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]520 bind . <Destroy> {savestuff %W}
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]521 bind . <Button-1> "click %W"
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]522 bind $fstring <Key-Return> dofind
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]523 bind $sha1entry <Key-Return> gotocommit
Paul Mackerrasee3dc722005-06-25 06:37:13[diff] [blame]524 bind $sha1entry <<PasteSelection>> clearsha1
Paul Mackerrasea13cba2005-06-16 10:54:04[diff] [blame]525
526 set maincursor [. cget -cursor]
527 set textcursor [$ctext cget -cursor]
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]528 set curtextcursor $textcursor
Paul Mackerras84ba7342005-06-17 00:12:26[diff] [blame]529
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]530 set rowctxmenu .rowctxmenu
531 menu $rowctxmenu -tearoff 0
532 $rowctxmenu add command -label "Diff this -> selected" \
533 -command {diffvssel 0}
534 $rowctxmenu add command -label "Diff selected -> this" \
535 -command {diffvssel 1}
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]536 $rowctxmenu add command -label "Make patch" -command mkpatch
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]537 $rowctxmenu add command -label "Create tag" -command mktag
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]538 $rowctxmenu add command -label "Write commit to file" -command writecommit
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]539}
540
541# when we make a key binding for the toplevel, make sure
542# it doesn't get triggered when that key is pressed in the
543# find string entry widget.
544proc bindkey {ev script} {
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]545 global entries
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]546 bind . $ev $script
547 set escript [bind Entry $ev]
548 if {$escript == {}} {
549 set escript [bind Entry <Key>]
550 }
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]551 foreach e $entries {
552 bind $e $ev "$escript; break"
553 }
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]554}
555
556# set the focus back to the toplevel for any click outside
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]557# the entry widgets
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]558proc click {w} {
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]559 global entries
560 foreach e $entries {
561 if {$w == $e} return
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]562 }
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]563 focus .
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]564}
565
566proc savestuff {w} {
567 global canv canv2 canv3 ctext cflist mainfont textfont
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]568 global stuffsaved findmergefiles gaudydiff maxgraphpct
Paul Mackerras04c13d32005-08-19 00:22:24[diff] [blame]569 global maxwidth
Paul Mackerras4ef17532005-07-28 03:16:51[diff] [blame]570
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]571 if {$stuffsaved} return
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]572 if {![winfo viewable .]} return
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]573 catch {
574 set f [open "~/.gitk-new" w]
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]575 puts $f [list set mainfont $mainfont]
576 puts $f [list set textfont $textfont]
577 puts $f [list set findmergefiles $findmergefiles]
578 puts $f [list set gaudydiff $gaudydiff]
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]579 puts $f [list set maxgraphpct $maxgraphpct]
Paul Mackerras04c13d32005-08-19 00:22:24[diff] [blame]580 puts $f [list set maxwidth $maxwidth]
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]581 puts $f "set geometry(width) [winfo width .ctop]"
582 puts $f "set geometry(height) [winfo height .ctop]"
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]583 puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
584 puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
585 puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
586 puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]587 set wid [expr {([winfo width $ctext] - 8) \
588 / [font measure $textfont "0"]}]
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]589 puts $f "set geometry(ctextw) $wid"
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]590 set wid [expr {([winfo width $cflist] - 11) \
591 / [font measure [$cflist cget -font] "0"]}]
592 puts $f "set geometry(cflistw) $wid"
593 close $f
594 file rename -force "~/.gitk-new" "~/.gitk"
595 }
596 set stuffsaved 1
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]597}
598
Paul Mackerras43bddeb2005-05-15 23:19:18[diff] [blame]599proc resizeclistpanes {win w} {
600 global oldwidth
601 if [info exists oldwidth($win)] {
602 set s0 [$win sash coord 0]
603 set s1 [$win sash coord 1]
604 if {$w < 60} {
605 set sash0 [expr {int($w/2 - 2)}]
606 set sash1 [expr {int($w*5/6 - 2)}]
607 } else {
608 set factor [expr {1.0 * $w / $oldwidth($win)}]
609 set sash0 [expr {int($factor * [lindex $s0 0])}]
610 set sash1 [expr {int($factor * [lindex $s1 0])}]
611 if {$sash0 < 30} {
612 set sash0 30
613 }
614 if {$sash1 < $sash0 + 20} {
615 set sash1 [expr $sash0 + 20]
616 }
617 if {$sash1 > $w - 10} {
618 set sash1 [expr $w - 10]
619 if {$sash0 > $sash1 - 20} {
620 set sash0 [expr $sash1 - 20]
621 }
622 }
623 }
624 $win sash place 0 $sash0 [lindex $s0 1]
625 $win sash place 1 $sash1 [lindex $s1 1]
626 }
627 set oldwidth($win) $w
628}
629
630proc resizecdetpanes {win w} {
631 global oldwidth
632 if [info exists oldwidth($win)] {
633 set s0 [$win sash coord 0]
634 if {$w < 60} {
635 set sash0 [expr {int($w*3/4 - 2)}]
636 } else {
637 set factor [expr {1.0 * $w / $oldwidth($win)}]
638 set sash0 [expr {int($factor * [lindex $s0 0])}]
639 if {$sash0 < 45} {
640 set sash0 45
641 }
642 if {$sash0 > $w - 15} {
643 set sash0 [expr $w - 15]
644 }
645 }
646 $win sash place 0 $sash0 [lindex $s0 1]
647 }
648 set oldwidth($win) $w
649}
650
Paul Mackerrasb5721c72005-05-10 12:08:22[diff] [blame]651proc allcanvs args {
652 global canv canv2 canv3
653 eval $canv $args
654 eval $canv2 $args
655 eval $canv3 $args
656}
657
658proc bindall {event action} {
659 global canv canv2 canv3
660 bind $canv $event $action
661 bind $canv2 $event $action
662 bind $canv3 $event $action
663}
664
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]665proc about {} {
666 set w .about
667 if {[winfo exists $w]} {
668 raise $w
669 return
670 }
671 toplevel $w
672 wm title $w "About gitk"
673 message $w.m -text {
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]674Gitk version 1.2
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]675
676Copyright © 2005 Paul Mackerras
677
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]678Use and redistribute under the terms of the GNU General Public License} \
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]679 -justify center -aspect 400
680 pack $w.m -side top -fill x -padx 20 -pady 20
681 button $w.ok -text Close -command "destroy $w"
682 pack $w.ok -side bottom
683}
684
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]685proc assigncolor {id} {
686 global commitinfo colormap commcolors colors nextcolor
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]687 global parents nparents children nchildren
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]688 global cornercrossings crossings
689
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]690 if [info exists colormap($id)] return
691 set ncolors [llength $colors]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]692 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]693 set child [lindex $children($id) 0]
694 if {[info exists colormap($child)]
695 && $nparents($child) == 1} {
696 set colormap($id) $colormap($child)
697 return
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]698 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]699 }
700 set badcolors {}
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]701 if {[info exists cornercrossings($id)]} {
702 foreach x $cornercrossings($id) {
703 if {[info exists colormap($x)]
704 && [lsearch -exact $badcolors $colormap($x)] < 0} {
705 lappend badcolors $colormap($x)
706 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]707 }
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]708 if {[llength $badcolors] >= $ncolors} {
709 set badcolors {}
710 }
711 }
712 set origbad $badcolors
713 if {[llength $badcolors] < $ncolors - 1} {
714 if {[info exists crossings($id)]} {
715 foreach x $crossings($id) {
716 if {[info exists colormap($x)]
717 && [lsearch -exact $badcolors $colormap($x)] < 0} {
718 lappend badcolors $colormap($x)
719 }
720 }
721 if {[llength $badcolors] >= $ncolors} {
722 set badcolors $origbad
723 }
724 }
725 set origbad $badcolors
726 }
727 if {[llength $badcolors] < $ncolors - 1} {
728 foreach child $children($id) {
729 if {[info exists colormap($child)]
730 && [lsearch -exact $badcolors $colormap($child)] < 0} {
731 lappend badcolors $colormap($child)
732 }
733 if {[info exists parents($child)]} {
734 foreach p $parents($child) {
735 if {[info exists colormap($p)]
736 && [lsearch -exact $badcolors $colormap($p)] < 0} {
737 lappend badcolors $colormap($p)
738 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]739 }
740 }
741 }
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]742 if {[llength $badcolors] >= $ncolors} {
743 set badcolors $origbad
744 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]745 }
746 for {set i 0} {$i <= $ncolors} {incr i} {
747 set c [lindex $colors $nextcolor]
748 if {[incr nextcolor] >= $ncolors} {
749 set nextcolor 0
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]750 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]751 if {[lsearch -exact $badcolors $c]} break
752 }
753 set colormap($id) $c
754}
755
756proc initgraph {} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]757 global canvy canvy0 lineno numcommits nextcolor linespc
758 global mainline mainlinearrow sidelines
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]759 global nchildren ncleft
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]760 global displist nhyperspace
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]761
762 allcanvs delete all
763 set nextcolor 0
764 set canvy $canvy0
765 set lineno -1
766 set numcommits 0
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]767 catch {unset mainline}
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]768 catch {unset mainlinearrow}
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]769 catch {unset sidelines}
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]770 foreach id [array names nchildren] {
771 set ncleft($id) $nchildren($id)
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]772 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]773 set displist {}
774 set nhyperspace 0
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]775}
776
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]777proc bindline {t id} {
778 global canv
779
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]780 $canv bind $t <Enter> "lineenter %x %y $id"
781 $canv bind $t <Motion> "linemotion %x %y $id"
782 $canv bind $t <Leave> "lineleave $id"
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]783 $canv bind $t <Button-1> "lineclick %x %y $id 1"
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]784}
785
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]786proc drawlines {id xtra} {
787 global mainline mainlinearrow sidelines lthickness colormap canv
788
789 $canv delete lines.$id
790 if {[info exists mainline($id)]} {
791 set t [$canv create line $mainline($id) \
792 -width [expr {($xtra + 1) * $lthickness}] \
793 -fill $colormap($id) -tags lines.$id \
794 -arrow $mainlinearrow($id)]
795 $canv lower $t
796 bindline $t $id
797 }
798 if {[info exists sidelines($id)]} {
799 foreach ls $sidelines($id) {
800 set coords [lindex $ls 0]
801 set thick [lindex $ls 1]
802 set arrow [lindex $ls 2]
803 set t [$canv create line $coords -fill $colormap($id) \
804 -width [expr {($thick + $xtra) * $lthickness}] \
805 -arrow $arrow -tags lines.$id]
806 $canv lower $t
807 bindline $t $id
808 }
809 }
810}
811
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]812# level here is an index in displist
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]813proc drawcommitline {level} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]814 global parents children nparents displist
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]815 global canv canv2 canv3 mainfont namefont canvy linespc
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]816 global lineid linehtag linentag linedtag commitinfo
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]817 global colormap numcommits currentparents dupparents
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]818 global idtags idline idheads idotherrefs
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]819 global lineno lthickness mainline mainlinearrow sidelines
820 global commitlisted rowtextx idpos lastuse displist
821 global oldnlines olddlevel olddisplist
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]822
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]823 incr numcommits
824 incr lineno
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]825 set id [lindex $displist $level]
826 set lastuse($id) $lineno
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]827 set lineid($lineno) $id
828 set idline($id) $lineno
829 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
830 if {![info exists commitinfo($id)]} {
831 readcommit $id
832 if {![info exists commitinfo($id)]} {
833 set commitinfo($id) {"No commit information available"}
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]834 set nparents($id) 0
835 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]836 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]837 assigncolor $id
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]838 set currentparents {}
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]839 set dupparents {}
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]840 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]841 foreach p $parents($id) {
842 if {[lsearch -exact $currentparents $p] < 0} {
843 lappend currentparents $p
844 } else {
845 # remember that this parent was listed twice
846 lappend dupparents $p
847 }
848 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]849 }
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]850 set x [xcoord $level $level $lineno]
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]851 set y1 $canvy
852 set canvy [expr $canvy + $linespc]
853 allcanvs conf -scrollregion \
854 [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]855 if {[info exists mainline($id)]} {
856 lappend mainline($id) $x $y1
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]857 if {$mainlinearrow($id) ne "none"} {
858 set mainline($id) [trimdiagstart $mainline($id)]
859 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]860 }
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]861 drawlines $id 0
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]862 set orad [expr {$linespc / 3}]
863 set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
864 [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
865 -fill $ofill -outline black -width 1]
866 $canv raise $t
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]867 $canv bind $t <1> {selcanvline {} %x %y}
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]868 set xt [xcoord [llength $displist] $level $lineno]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]869 if {[llength $currentparents] > 2} {
870 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]871 }
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]872 set rowtextx($lineno) $xt
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]873 set idpos($id) [list $x $xt $y1]
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]874 if {[info exists idtags($id)] || [info exists idheads($id)]
875 || [info exists idotherrefs($id)]} {
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]876 set xt [drawtags $id $x $xt $y1]
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]877 }
878 set headline [lindex $commitinfo($id) 0]
879 set name [lindex $commitinfo($id) 1]
880 set date [lindex $commitinfo($id) 2]
881 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
882 -text $headline -font $mainfont ]
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]883 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]884 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
885 -text $name -font $namefont]
886 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
887 -text $date -font $mainfont]
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]888
889 set olddlevel $level
890 set olddisplist $displist
891 set oldnlines [llength $displist]
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]892}
893
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]894proc drawtags {id x xt y1} {
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]895 global idtags idheads idotherrefs
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]896 global linespc lthickness
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]897 global canv mainfont idline rowtextx
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]898
899 set marks {}
900 set ntags 0
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]901 set nheads 0
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]902 if {[info exists idtags($id)]} {
903 set marks $idtags($id)
904 set ntags [llength $marks]
905 }
906 if {[info exists idheads($id)]} {
907 set marks [concat $marks $idheads($id)]
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]908 set nheads [llength $idheads($id)]
909 }
910 if {[info exists idotherrefs($id)]} {
911 set marks [concat $marks $idotherrefs($id)]
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]912 }
913 if {$marks eq {}} {
914 return $xt
915 }
916
917 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
918 set yt [expr $y1 - 0.5 * $linespc]
919 set yb [expr $yt + $linespc - 1]
920 set xvals {}
921 set wvals {}
922 foreach tag $marks {
923 set wid [font measure $mainfont $tag]
924 lappend xvals $xt
925 lappend wvals $wid
926 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
927 }
928 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
929 -width $lthickness -fill black -tags tag.$id]
930 $canv lower $t
931 foreach tag $marks x $xvals wid $wvals {
932 set xl [expr $x + $delta]
933 set xr [expr $x + $delta + $wid + $lthickness]
934 if {[incr ntags -1] >= 0} {
935 # draw a tag
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]936 set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
937 $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
938 -width 1 -outline black -fill yellow -tags tag.$id]
939 $canv bind $t <1> [list showtag $tag 1]
940 set rowtextx($idline($id)) [expr {$xr + $linespc}]
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]941 } else {
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]942 # draw a head or other ref
943 if {[incr nheads -1] >= 0} {
944 set col green
945 } else {
946 set col "#ddddff"
947 }
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]948 set xl [expr $xl - $delta/2]
949 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]950 -width 1 -outline black -fill $col -tags tag.$id
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]951 }
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]952 set t [$canv create text $xl $y1 -anchor w -text $tag \
953 -font $mainfont -tags tag.$id]
954 if {$ntags >= 0} {
955 $canv bind $t <1> [list showtag $tag 1]
956 }
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]957 }
958 return $xt
959}
960
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]961proc notecrossings {id lo hi corner} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]962 global olddisplist crossings cornercrossings
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]963
964 for {set i $lo} {[incr i] < $hi} {} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]965 set p [lindex $olddisplist $i]
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]966 if {$p == {}} continue
967 if {$i == $corner} {
968 if {![info exists cornercrossings($id)]
969 || [lsearch -exact $cornercrossings($id) $p] < 0} {
970 lappend cornercrossings($id) $p
971 }
972 if {![info exists cornercrossings($p)]
973 || [lsearch -exact $cornercrossings($p) $id] < 0} {
974 lappend cornercrossings($p) $id
975 }
976 } else {
977 if {![info exists crossings($id)]
978 || [lsearch -exact $crossings($id) $p] < 0} {
979 lappend crossings($id) $p
980 }
981 if {![info exists crossings($p)]
982 || [lsearch -exact $crossings($p) $id] < 0} {
983 lappend crossings($p) $id
984 }
985 }
986 }
987}
988
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]989proc xcoord {i level ln} {
990 global canvx0 xspc1 xspc2
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]991
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]992 set x [expr {$canvx0 + $i * $xspc1($ln)}]
993 if {$i > 0 && $i == $level} {
994 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
995 } elseif {$i > $level} {
996 set x [expr {$x + $xspc2 - $xspc1($ln)}]
997 }
998 return $x
999}
1000
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1001# it seems Tk can't draw arrows on the end of diagonal line segments...
1002proc trimdiagend {line} {
1003 while {[llength $line] > 4} {
1004 set x1 [lindex $line end-3]
1005 set y1 [lindex $line end-2]
1006 set x2 [lindex $line end-1]
1007 set y2 [lindex $line end]
1008 if {($x1 == $x2) != ($y1 == $y2)} break
1009 set line [lreplace $line end-1 end]
1010 }
1011 return $line
1012}
1013
1014proc trimdiagstart {line} {
1015 while {[llength $line] > 4} {
1016 set x1 [lindex $line 0]
1017 set y1 [lindex $line 1]
1018 set x2 [lindex $line 2]
1019 set y2 [lindex $line 3]
1020 if {($x1 == $x2) != ($y1 == $y2)} break
1021 set line [lreplace $line 0 1]
1022 }
1023 return $line
1024}
1025
1026proc drawslants {id needonscreen nohs} {
1027 global canv mainline mainlinearrow sidelines
1028 global canvx0 canvy xspc1 xspc2 lthickness
1029 global currentparents dupparents
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1030 global lthickness linespc canvy colormap lineno geometry
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1031 global maxgraphpct maxwidth
1032 global displist onscreen lastuse
1033 global parents commitlisted
1034 global oldnlines olddlevel olddisplist
1035 global nhyperspace numcommits nnewparents
1036
1037 if {$lineno < 0} {
1038 lappend displist $id
1039 set onscreen($id) 1
1040 return 0
1041 }
1042
1043 set y1 [expr {$canvy - $linespc}]
1044 set y2 $canvy
1045
1046 # work out what we need to get back on screen
1047 set reins {}
1048 if {$onscreen($id) < 0} {
1049 # next to do isn't displayed, better get it on screen...
1050 lappend reins [list $id 0]
1051 }
1052 # make sure all the previous commits's parents are on the screen
1053 foreach p $currentparents {
1054 if {$onscreen($p) < 0} {
1055 lappend reins [list $p 0]
1056 }
1057 }
1058 # bring back anything requested by caller
1059 if {$needonscreen ne {}} {
1060 lappend reins $needonscreen
1061 }
1062
1063 # try the shortcut
1064 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1065 set dlevel $olddlevel
1066 set x [xcoord $dlevel $dlevel $lineno]
1067 set mainline($id) [list $x $y1]
1068 set mainlinearrow($id) none
1069 set lastuse($id) $lineno
1070 set displist [lreplace $displist $dlevel $dlevel $id]
1071 set onscreen($id) 1
1072 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1073 return $dlevel
1074 }
1075
1076 # update displist
1077 set displist [lreplace $displist $olddlevel $olddlevel]
1078 set j $olddlevel
1079 foreach p $currentparents {
1080 set lastuse($p) $lineno
1081 if {$onscreen($p) == 0} {
1082 set displist [linsert $displist $j $p]
1083 set onscreen($p) 1
1084 incr j
1085 }
1086 }
1087 if {$onscreen($id) == 0} {
1088 lappend displist $id
Paul Mackerras022bc2a2005-08-19 00:22:04[diff] [blame]1089 set onscreen($id) 1
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1090 }
1091
1092 # remove the null entry if present
1093 set nullentry [lsearch -exact $displist {}]
1094 if {$nullentry >= 0} {
1095 set displist [lreplace $displist $nullentry $nullentry]
1096 }
1097
1098 # bring back the ones we need now (if we did it earlier
1099 # it would change displist and invalidate olddlevel)
1100 foreach pi $reins {
1101 # test again in case of duplicates in reins
1102 set p [lindex $pi 0]
1103 if {$onscreen($p) < 0} {
1104 set onscreen($p) 1
1105 set lastuse($p) $lineno
1106 set displist [linsert $displist [lindex $pi 1] $p]
1107 incr nhyperspace -1
1108 }
1109 }
1110
1111 set lastuse($id) $lineno
1112
1113 # see if we need to make any lines jump off into hyperspace
1114 set displ [llength $displist]
1115 if {$displ > $maxwidth} {
1116 set ages {}
1117 foreach x $displist {
1118 lappend ages [list $lastuse($x) $x]
1119 }
1120 set ages [lsort -integer -index 0 $ages]
1121 set k 0
1122 while {$displ > $maxwidth} {
1123 set use [lindex $ages $k 0]
1124 set victim [lindex $ages $k 1]
1125 if {$use >= $lineno - 5} break
1126 incr k
1127 if {[lsearch -exact $nohs $victim] >= 0} continue
1128 set i [lsearch -exact $displist $victim]
1129 set displist [lreplace $displist $i $i]
1130 set onscreen($victim) -1
1131 incr nhyperspace
1132 incr displ -1
1133 if {$i < $nullentry} {
1134 incr nullentry -1
1135 }
1136 set x [lindex $mainline($victim) end-1]
1137 lappend mainline($victim) $x $y1
1138 set line [trimdiagend $mainline($victim)]
1139 set arrow "last"
1140 if {$mainlinearrow($victim) ne "none"} {
1141 set line [trimdiagstart $line]
1142 set arrow "both"
1143 }
1144 lappend sidelines($victim) [list $line 1 $arrow]
1145 unset mainline($victim)
1146 }
1147 }
1148
1149 set dlevel [lsearch -exact $displist $id]
1150
1151 # If we are reducing, put in a null entry
1152 if {$displ < $oldnlines} {
1153 # does the next line look like a merge?
1154 # i.e. does it have > 1 new parent?
1155 if {$nnewparents($id) > 1} {
1156 set i [expr {$dlevel + 1}]
1157 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1158 set i $olddlevel
1159 if {$nullentry >= 0 && $nullentry < $i} {
1160 incr i -1
1161 }
1162 } elseif {$nullentry >= 0} {
1163 set i $nullentry
1164 while {$i < $displ
1165 && [lindex $olddisplist $i] == [lindex $displist $i]} {
1166 incr i
1167 }
1168 } else {
1169 set i $olddlevel
1170 if {$dlevel >= $i} {
1171 incr i
1172 }
1173 }
1174 if {$i < $displ} {
1175 set displist [linsert $displist $i {}]
1176 incr displ
1177 if {$dlevel >= $i} {
1178 incr dlevel
1179 }
1180 }
1181 }
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1182
1183 # decide on the line spacing for the next line
1184 set lj [expr {$lineno + 1}]
1185 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1186 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1187 set xspc1($lj) $xspc2
1188 } else {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1189 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1190 if {$xspc1($lj) < $lthickness} {
1191 set xspc1($lj) $lthickness
1192 }
1193 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1194
1195 foreach idi $reins {
1196 set id [lindex $idi 0]
1197 set j [lsearch -exact $displist $id]
1198 set xj [xcoord $j $dlevel $lj]
1199 set mainline($id) [list $xj $y2]
1200 set mainlinearrow($id) first
1201 }
1202
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1203 set i -1
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1204 foreach id $olddisplist {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1205 incr i
1206 if {$id == {}} continue
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1207 if {$onscreen($id) <= 0} continue
1208 set xi [xcoord $i $olddlevel $lineno]
1209 if {$i == $olddlevel} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1210 foreach p $currentparents {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1211 set j [lsearch -exact $displist $p]
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1212 set coords [list $xi $y1]
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1213 set xj [xcoord $j $dlevel $lj]
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1214 if {$xj < $xi - $linespc} {
1215 lappend coords [expr {$xj + $linespc}] $y1
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]1216 notecrossings $p $j $i [expr {$j + 1}]
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1217 } elseif {$xj > $xi + $linespc} {
1218 lappend coords [expr {$xj - $linespc}] $y1
Paul Mackerras6c20ff32005-06-22 09:53:32[diff] [blame]1219 notecrossings $p $i $j [expr {$j - 1}]
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1220 }
1221 if {[lsearch -exact $dupparents $p] >= 0} {
1222 # draw a double-width line to indicate the doubled parent
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1223 lappend coords $xj $y2
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1224 lappend sidelines($p) [list $coords 2 none]
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]1225 if {![info exists mainline($p)]} {
1226 set mainline($p) [list $xj $y2]
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1227 set mainlinearrow($p) none
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1228 }
1229 } else {
1230 # normal case, no parent duplicated
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1231 set yb $y2
1232 set dx [expr {abs($xi - $xj)}]
1233 if {0 && $dx < $linespc} {
1234 set yb [expr {$y1 + $dx}]
1235 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]1236 if {![info exists mainline($p)]} {
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1237 if {$xi != $xj} {
1238 lappend coords $xj $yb
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1239 }
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]1240 set mainline($p) $coords
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1241 set mainlinearrow($p) none
Paul Mackerras84ba7342005-06-17 00:12:26[diff] [blame]1242 } else {
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1243 lappend coords $xj $yb
1244 if {$yb < $y2} {
1245 lappend coords $xj $y2
1246 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1247 lappend sidelines($p) [list $coords 1 none]
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1248 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]1249 }
1250 }
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1251 } else {
1252 set j $i
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1253 if {[lindex $displist $i] != $id} {
1254 set j [lsearch -exact $displist $id]
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1255 }
1256 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
Paul Mackerras022bc2a2005-08-19 00:22:04[diff] [blame]1257 || ($olddlevel < $i && $i < $dlevel)
1258 || ($dlevel < $i && $i < $olddlevel)} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1259 set xj [xcoord $j $dlevel $lj]
Paul Mackerras022bc2a2005-08-19 00:22:04[diff] [blame]1260 lappend mainline($id) $xi $y1 $xj $y2
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]1261 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1262 }
1263 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1264 return $dlevel
1265}
1266
1267# search for x in a list of lists
1268proc llsearch {llist x} {
1269 set i 0
1270 foreach l $llist {
1271 if {$l == $x || [lsearch -exact $l $x] >= 0} {
1272 return $i
1273 }
1274 incr i
1275 }
1276 return -1
1277}
1278
1279proc drawmore {reading} {
1280 global displayorder numcommits ncmupdate nextupdate
1281 global stopped nhyperspace parents commitlisted
1282 global maxwidth onscreen displist currentparents olddlevel
1283
1284 set n [llength $displayorder]
1285 while {$numcommits < $n} {
1286 set id [lindex $displayorder $numcommits]
1287 set ctxend [expr {$numcommits + 10}]
1288 if {!$reading && $ctxend > $n} {
1289 set ctxend $n
1290 }
1291 set dlist {}
1292 if {$numcommits > 0} {
1293 set dlist [lreplace $displist $olddlevel $olddlevel]
1294 set i $olddlevel
1295 foreach p $currentparents {
1296 if {$onscreen($p) == 0} {
1297 set dlist [linsert $dlist $i $p]
1298 incr i
1299 }
1300 }
1301 }
1302 set nohs {}
1303 set reins {}
1304 set isfat [expr {[llength $dlist] > $maxwidth}]
1305 if {$nhyperspace > 0 || $isfat} {
1306 if {$ctxend > $n} break
1307 # work out what to bring back and
1308 # what we want to don't want to send into hyperspace
1309 set room 1
1310 for {set k $numcommits} {$k < $ctxend} {incr k} {
1311 set x [lindex $displayorder $k]
1312 set i [llsearch $dlist $x]
1313 if {$i < 0} {
1314 set i [llength $dlist]
1315 lappend dlist $x
1316 }
1317 if {[lsearch -exact $nohs $x] < 0} {
1318 lappend nohs $x
1319 }
1320 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1321 set reins [list $x $i]
1322 }
1323 set newp {}
1324 if {[info exists commitlisted($x)]} {
1325 set right 0
1326 foreach p $parents($x) {
1327 if {[llsearch $dlist $p] < 0} {
1328 lappend newp $p
1329 if {[lsearch -exact $nohs $p] < 0} {
1330 lappend nohs $p
1331 }
1332 if {$reins eq {} && $onscreen($p) < 0 && $room} {
1333 set reins [list $p [expr {$i + $right}]]
1334 }
1335 }
1336 set right 1
1337 }
1338 }
1339 set l [lindex $dlist $i]
1340 if {[llength $l] == 1} {
1341 set l $newp
1342 } else {
1343 set j [lsearch -exact $l $x]
1344 set l [concat [lreplace $l $j $j] $newp]
1345 }
1346 set dlist [lreplace $dlist $i $i $l]
1347 if {$room && $isfat && [llength $newp] <= 1} {
1348 set room 0
1349 }
1350 }
1351 }
1352
1353 set dlevel [drawslants $id $reins $nohs]
1354 drawcommitline $dlevel
1355 if {[clock clicks -milliseconds] >= $nextupdate
1356 && $numcommits >= $ncmupdate} {
1357 doupdate $reading
1358 if {$stopped} break
1359 }
1360 }
1361}
1362
1363# level here is an index in todo
1364proc updatetodo {level noshortcut} {
1365 global ncleft todo nnewparents
1366 global commitlisted parents onscreen
1367
1368 set id [lindex $todo $level]
1369 set olds {}
1370 if {[info exists commitlisted($id)]} {
1371 foreach p $parents($id) {
1372 if {[lsearch -exact $olds $p] < 0} {
1373 lappend olds $p
1374 }
1375 }
1376 }
1377 if {!$noshortcut && [llength $olds] == 1} {
1378 set p [lindex $olds 0]
1379 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1380 set ncleft($p) 0
1381 set todo [lreplace $todo $level $level $p]
1382 set onscreen($p) 0
1383 set nnewparents($id) 1
1384 return 0
1385 }
1386 }
1387
1388 set todo [lreplace $todo $level $level]
1389 set i $level
1390 set n 0
1391 foreach p $olds {
1392 incr ncleft($p) -1
1393 set k [lsearch -exact $todo $p]
1394 if {$k < 0} {
1395 set todo [linsert $todo $i $p]
1396 set onscreen($p) 0
1397 incr i
1398 incr n
1399 }
1400 }
1401 set nnewparents($id) $n
1402
1403 return 1
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1404}
1405
Paul Mackerras8a0a74a2005-06-27 03:38:29[diff] [blame]1406proc decidenext {{noread 0}} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1407 global ncleft todo
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1408 global datemode cdate
Paul Mackerras8a0a74a2005-06-27 03:38:29[diff] [blame]1409 global commitinfo
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1410
1411 # choose which one to do next time around
1412 set todol [llength $todo]
1413 set level -1
1414 set latest {}
1415 for {set k $todol} {[incr k -1] >= 0} {} {
1416 set p [lindex $todo $k]
1417 if {$ncleft($p) == 0} {
1418 if {$datemode} {
Paul Mackerras8a0a74a2005-06-27 03:38:29[diff] [blame]1419 if {![info exists commitinfo($p)]} {
1420 if {$noread} {
1421 return {}
1422 }
1423 readcommit $p
1424 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1425 if {$latest == {} || $cdate($p) > $latest} {
1426 set level $k
1427 set latest $cdate($p)
1428 }
1429 } else {
1430 set level $k
1431 break
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]1432 }
1433 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]1434 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1435 if {$level < 0} {
1436 if {$todo != {}} {
1437 puts "ERROR: none of the pending commits can be done yet:"
1438 foreach p $todo {
Paul Mackerrasb490a992005-06-22 00:25:38[diff] [blame]1439 puts " $p ($ncleft($p))"
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1440 }
1441 }
1442 return -1
1443 }
1444
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1445 return $level
1446}
1447
1448proc drawcommit {id} {
1449 global phase todo nchildren datemode nextupdate
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1450 global numcommits ncmupdate displayorder todo onscreen
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1451
1452 if {$phase != "incrdraw"} {
1453 set phase incrdraw
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1454 set displayorder {}
1455 set todo {}
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1456 initgraph
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1457 }
1458 if {$nchildren($id) == 0} {
1459 lappend todo $id
1460 set onscreen($id) 0
1461 }
1462 set level [decidenext 1]
1463 if {$level == {} || $id != [lindex $todo $level]} {
1464 return
1465 }
1466 while 1 {
1467 lappend displayorder [lindex $todo $level]
1468 if {[updatetodo $level $datemode]} {
1469 set level [decidenext 1]
1470 if {$level == {}} break
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1471 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1472 set id [lindex $todo $level]
1473 if {![info exists commitlisted($id)]} {
1474 break
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1475 }
1476 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1477 drawmore 1
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1478}
1479
1480proc finishcommits {} {
1481 global phase
Paul Mackerras8a0a74a2005-06-27 03:38:29[diff] [blame]1482 global canv mainfont ctext maincursor textcursor
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1483
1484 if {$phase != "incrdraw"} {
1485 $canv delete all
1486 $canv create text 3 3 -anchor nw -text "No commits selected" \
1487 -font $mainfont -tags textitems
1488 set phase {}
Paul Mackerras8a0a74a2005-06-27 03:38:29[diff] [blame]1489 } else {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1490 drawrest
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1491 }
Paul Mackerrasea13cba2005-06-16 10:54:04[diff] [blame]1492 . config -cursor $maincursor
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]1493 settextcursor $textcursor
1494}
1495
1496# Don't change the text pane cursor if it is currently the hand cursor,
1497# showing that we are over a sha1 ID link.
1498proc settextcursor {c} {
1499 global ctext curtextcursor
1500
1501 if {[$ctext cget -cursor] == $curtextcursor} {
1502 $ctext config -cursor $c
1503 }
1504 set curtextcursor $c
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1505}
1506
1507proc drawgraph {} {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1508 global nextupdate startmsecs ncmupdate
1509 global displayorder onscreen
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1510
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1511 if {$displayorder == {}} return
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1512 set startmsecs [clock clicks -milliseconds]
1513 set nextupdate [expr $startmsecs + 100]
Paul Mackerrasb6645502005-08-10 23:56:23[diff] [blame]1514 set ncmupdate 1
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1515 initgraph
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1516 foreach id $displayorder {
1517 set onscreen($id) 0
1518 }
1519 drawmore 0
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1520}
1521
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1522proc drawrest {} {
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1523 global phase stopped redisplaying selectedline
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1524 global datemode todo displayorder
Paul Mackerras466e4fd2005-08-10 12:50:28[diff] [blame]1525 global numcommits ncmupdate
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]1526 global nextupdate startmsecs
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1527
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1528 set level [decidenext]
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1529 if {$level >= 0} {
1530 set phase drawgraph
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1531 while 1 {
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1532 lappend displayorder [lindex $todo $level]
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1533 set hard [updatetodo $level $datemode]
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1534 if {$hard} {
1535 set level [decidenext]
1536 if {$level < 0} break
Paul Mackerrasa823a912005-06-21 00:01:38[diff] [blame]1537 }
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1538 }
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]1539 drawmore 0
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1540 }
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]1541 set phase {}
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1542 set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
Paul Mackerras84ba7342005-06-17 00:12:26[diff] [blame]1543 #puts "overall $drawmsecs ms for $numcommits commits"
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]1544 if {$redisplaying} {
1545 if {$stopped == 0 && [info exists selectedline]} {
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]1546 selectline $selectedline 0
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]1547 }
1548 if {$stopped == 1} {
1549 set stopped 0
1550 after idle drawgraph
1551 } else {
1552 set redisplaying 0
1553 }
1554 }
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]1555}
1556
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1557proc findmatches {f} {
1558 global findtype foundstring foundstrlen
1559 if {$findtype == "Regexp"} {
1560 set matches [regexp -indices -all -inline $foundstring $f]
1561 } else {
1562 if {$findtype == "IgnCase"} {
1563 set str [string tolower $f]
1564 } else {
1565 set str $f
1566 }
1567 set matches {}
1568 set i 0
1569 while {[set j [string first $foundstring $str $i]] >= 0} {
1570 lappend matches [list $j [expr $j+$foundstrlen-1]]
1571 set i [expr $j + $foundstrlen]
1572 }
1573 }
1574 return $matches
1575}
1576
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1577proc dofind {} {
1578 global findtype findloc findstring markedmatches commitinfo
1579 global numcommits lineid linehtag linentag linedtag
1580 global mainfont namefont canv canv2 canv3 selectedline
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]1581 global matchinglines foundstring foundstrlen
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1582
1583 stopfindproc
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1584 unmarkmatches
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1585 focus .
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1586 set matchinglines {}
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1587 if {$findloc == "Pickaxe"} {
1588 findpatches
1589 return
1590 }
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1591 if {$findtype == "IgnCase"} {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1592 set foundstring [string tolower $findstring]
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1593 } else {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1594 set foundstring $findstring
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1595 }
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1596 set foundstrlen [string length $findstring]
1597 if {$foundstrlen == 0} return
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1598 if {$findloc == "Files"} {
1599 findfiles
1600 return
1601 }
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1602 if {![info exists selectedline]} {
1603 set oldsel -1
1604 } else {
1605 set oldsel $selectedline
1606 }
1607 set didsel 0
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1608 set fldtypes {Headline Author Date Committer CDate Comment}
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1609 for {set l 0} {$l < $numcommits} {incr l} {
1610 set id $lineid($l)
1611 set info $commitinfo($id)
1612 set doesmatch 0
1613 foreach f $info ty $fldtypes {
1614 if {$findloc != "All fields" && $findloc != $ty} {
1615 continue
1616 }
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1617 set matches [findmatches $f]
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1618 if {$matches == {}} continue
1619 set doesmatch 1
1620 if {$ty == "Headline"} {
1621 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1622 } elseif {$ty == "Author"} {
1623 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1624 } elseif {$ty == "Date"} {
1625 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1626 }
1627 }
1628 if {$doesmatch} {
1629 lappend matchinglines $l
1630 if {!$didsel && $l > $oldsel} {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1631 findselectline $l
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1632 set didsel 1
1633 }
1634 }
1635 }
1636 if {$matchinglines == {}} {
1637 bell
1638 } elseif {!$didsel} {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1639 findselectline [lindex $matchinglines 0]
1640 }
1641}
1642
1643proc findselectline {l} {
1644 global findloc commentend ctext
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]1645 selectline $l 1
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1646 if {$findloc == "All fields" || $findloc == "Comments"} {
1647 # highlight the matches in the comments
1648 set f [$ctext get 1.0 $commentend]
1649 set matches [findmatches $f]
1650 foreach match $matches {
1651 set start [lindex $match 0]
1652 set end [expr [lindex $match 1] + 1]
1653 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1654 }
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1655 }
1656}
1657
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1658proc findnext {restart} {
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1659 global matchinglines selectedline
1660 if {![info exists matchinglines]} {
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1661 if {$restart} {
1662 dofind
1663 }
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1664 return
1665 }
1666 if {![info exists selectedline]} return
1667 foreach l $matchinglines {
1668 if {$l > $selectedline} {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1669 findselectline $l
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1670 return
1671 }
1672 }
1673 bell
1674}
1675
1676proc findprev {} {
1677 global matchinglines selectedline
1678 if {![info exists matchinglines]} {
1679 dofind
1680 return
1681 }
1682 if {![info exists selectedline]} return
1683 set prev {}
1684 foreach l $matchinglines {
1685 if {$l >= $selectedline} break
1686 set prev $l
1687 }
1688 if {$prev != {}} {
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]1689 findselectline $prev
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1690 } else {
1691 bell
1692 }
1693}
1694
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1695proc findlocchange {name ix op} {
1696 global findloc findtype findtypemenu
1697 if {$findloc == "Pickaxe"} {
1698 set findtype Exact
1699 set state disabled
1700 } else {
1701 set state normal
1702 }
1703 $findtypemenu entryconf 1 -state $state
1704 $findtypemenu entryconf 2 -state $state
1705}
1706
1707proc stopfindproc {{done 0}} {
1708 global findprocpid findprocfile findids
1709 global ctext findoldcursor phase maincursor textcursor
1710 global findinprogress
1711
1712 catch {unset findids}
1713 if {[info exists findprocpid]} {
1714 if {!$done} {
1715 catch {exec kill $findprocpid}
1716 }
1717 catch {close $findprocfile}
1718 unset findprocpid
1719 }
1720 if {[info exists findinprogress]} {
1721 unset findinprogress
1722 if {$phase != "incrdraw"} {
1723 . config -cursor $maincursor
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]1724 settextcursor $textcursor
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1725 }
1726 }
1727}
1728
1729proc findpatches {} {
1730 global findstring selectedline numcommits
1731 global findprocpid findprocfile
1732 global finddidsel ctext lineid findinprogress
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1733 global findinsertpos
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1734
1735 if {$numcommits == 0} return
1736
1737 # make a list of all the ids to search, starting at the one
1738 # after the selected line (if any)
1739 if {[info exists selectedline]} {
1740 set l $selectedline
1741 } else {
1742 set l -1
1743 }
1744 set inputids {}
1745 for {set i 0} {$i < $numcommits} {incr i} {
1746 if {[incr l] >= $numcommits} {
1747 set l 0
1748 }
1749 append inputids $lineid($l) "\n"
1750 }
1751
1752 if {[catch {
1753 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1754 << $inputids] r]
1755 } err]} {
1756 error_popup "Error starting search process: $err"
1757 return
1758 }
1759
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1760 set findinsertpos end
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1761 set findprocfile $f
1762 set findprocpid [pid $f]
1763 fconfigure $f -blocking 0
1764 fileevent $f readable readfindproc
1765 set finddidsel 0
1766 . config -cursor watch
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]1767 settextcursor watch
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1768 set findinprogress 1
1769}
1770
1771proc readfindproc {} {
1772 global findprocfile finddidsel
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1773 global idline matchinglines findinsertpos
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1774
1775 set n [gets $findprocfile line]
1776 if {$n < 0} {
1777 if {[eof $findprocfile]} {
1778 stopfindproc 1
1779 if {!$finddidsel} {
1780 bell
1781 }
1782 }
1783 return
1784 }
1785 if {![regexp {^[0-9a-f]{40}} $line id]} {
1786 error_popup "Can't parse git-diff-tree output: $line"
1787 stopfindproc
1788 return
1789 }
1790 if {![info exists idline($id)]} {
1791 puts stderr "spurious id: $id"
1792 return
1793 }
1794 set l $idline($id)
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1795 insertmatch $l $id
1796}
1797
1798proc insertmatch {l id} {
1799 global matchinglines findinsertpos finddidsel
1800
1801 if {$findinsertpos == "end"} {
1802 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1803 set matchinglines [linsert $matchinglines 0 $l]
1804 set findinsertpos 1
1805 } else {
1806 lappend matchinglines $l
1807 }
1808 } else {
1809 set matchinglines [linsert $matchinglines $findinsertpos $l]
1810 incr findinsertpos
1811 }
1812 markheadline $l $id
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1813 if {!$finddidsel} {
1814 findselectline $l
1815 set finddidsel 1
1816 }
1817}
1818
1819proc findfiles {} {
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1820 global selectedline numcommits lineid ctext
1821 global ffileline finddidsel parents nparents
1822 global findinprogress findstartline findinsertpos
1823 global treediffs fdiffids fdiffsneeded fdiffpos
1824 global findmergefiles
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1825
1826 if {$numcommits == 0} return
1827
1828 if {[info exists selectedline]} {
1829 set l [expr {$selectedline + 1}]
1830 } else {
1831 set l 0
1832 }
1833 set ffileline $l
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1834 set findstartline $l
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1835 set diffsneeded {}
1836 set fdiffsneeded {}
1837 while 1 {
1838 set id $lineid($l)
1839 if {$findmergefiles || $nparents($id) == 1} {
1840 foreach p $parents($id) {
1841 if {![info exists treediffs([list $id $p])]} {
1842 append diffsneeded "$id $p\n"
1843 lappend fdiffsneeded [list $id $p]
1844 }
1845 }
1846 }
1847 if {[incr l] >= $numcommits} {
1848 set l 0
1849 }
1850 if {$l == $findstartline} break
1851 }
1852
1853 # start off a git-diff-tree process if needed
1854 if {$diffsneeded ne {}} {
1855 if {[catch {
1856 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1857 } err ]} {
1858 error_popup "Error starting search process: $err"
1859 return
1860 }
1861 catch {unset fdiffids}
1862 set fdiffpos 0
1863 fconfigure $df -blocking 0
1864 fileevent $df readable [list readfilediffs $df]
1865 }
1866
1867 set finddidsel 0
1868 set findinsertpos end
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1869 set id $lineid($l)
1870 set p [lindex $parents($id) 0]
1871 . config -cursor watch
Paul Mackerras94a2eed2005-08-07 05:27:57[diff] [blame]1872 settextcursor watch
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1873 set findinprogress 1
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1874 findcont [list $id $p]
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1875 update
1876}
1877
1878proc readfilediffs {df} {
1879 global findids fdiffids fdiffs
1880
1881 set n [gets $df line]
1882 if {$n < 0} {
1883 if {[eof $df]} {
1884 donefilediff
1885 if {[catch {close $df} err]} {
1886 stopfindproc
1887 bell
1888 error_popup "Error in git-diff-tree: $err"
1889 } elseif {[info exists findids]} {
1890 set ids $findids
1891 stopfindproc
1892 bell
1893 error_popup "Couldn't find diffs for {$ids}"
1894 }
1895 }
1896 return
1897 }
1898 if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1899 # start of a new string of diffs
1900 donefilediff
1901 set fdiffids [list $id $p]
1902 set fdiffs {}
1903 } elseif {[string match ":*" $line]} {
1904 lappend fdiffs [lindex $line 5]
1905 }
1906}
1907
1908proc donefilediff {} {
1909 global fdiffids fdiffs treediffs findids
1910 global fdiffsneeded fdiffpos
1911
1912 if {[info exists fdiffids]} {
1913 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1914 && $fdiffpos < [llength $fdiffsneeded]} {
1915 # git-diff-tree doesn't output anything for a commit
1916 # which doesn't change anything
1917 set nullids [lindex $fdiffsneeded $fdiffpos]
1918 set treediffs($nullids) {}
1919 if {[info exists findids] && $nullids eq $findids} {
1920 unset findids
1921 findcont $nullids
1922 }
1923 incr fdiffpos
1924 }
1925 incr fdiffpos
1926
1927 if {![info exists treediffs($fdiffids)]} {
1928 set treediffs($fdiffids) $fdiffs
1929 }
1930 if {[info exists findids] && $fdiffids eq $findids} {
1931 unset findids
1932 findcont $fdiffids
1933 }
1934 }
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1935}
1936
1937proc findcont {ids} {
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]1938 global findids treediffs parents nparents
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1939 global ffileline findstartline finddidsel
1940 global lineid numcommits matchinglines findinprogress
1941 global findmergefiles
1942
1943 set id [lindex $ids 0]
1944 set p [lindex $ids 1]
1945 set pi [lsearch -exact $parents($id) $p]
1946 set l $ffileline
1947 while 1 {
1948 if {$findmergefiles || $nparents($id) == 1} {
1949 if {![info exists treediffs($ids)]} {
1950 set findids $ids
1951 set ffileline $l
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1952 return
1953 }
1954 set doesmatch 0
1955 foreach f $treediffs($ids) {
1956 set x [findmatches $f]
1957 if {$x != {}} {
1958 set doesmatch 1
1959 break
1960 }
1961 }
1962 if {$doesmatch} {
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]1963 insertmatch $l $id
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]1964 set pi $nparents($id)
1965 }
1966 } else {
1967 set pi $nparents($id)
1968 }
1969 if {[incr pi] >= $nparents($id)} {
1970 set pi 0
1971 if {[incr l] >= $numcommits} {
1972 set l 0
1973 }
1974 if {$l == $findstartline} break
1975 set id $lineid($l)
1976 }
1977 set p [lindex $parents($id) $pi]
1978 set ids [list $id $p]
1979 }
1980 stopfindproc
1981 if {!$finddidsel} {
1982 bell
1983 }
1984}
1985
1986# mark a commit as matching by putting a yellow background
1987# behind the headline
1988proc markheadline {l id} {
1989 global canv mainfont linehtag commitinfo
1990
1991 set bbox [$canv bbox $linehtag($l)]
1992 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1993 $canv lower $t
1994}
1995
1996# mark the bits of a headline, author or date that match a find string
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]1997proc markmatches {canv l str tag matches font} {
1998 set bbox [$canv bbox $tag]
1999 set x0 [lindex $bbox 0]
2000 set y0 [lindex $bbox 1]
2001 set y1 [lindex $bbox 3]
2002 foreach match $matches {
2003 set start [lindex $match 0]
2004 set end [lindex $match 1]
2005 if {$start > $end} continue
2006 set xoff [font measure $font [string range $str 0 [expr $start-1]]]
2007 set xlen [font measure $font [string range $str 0 [expr $end]]]
2008 set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
2009 -outline {} -tags matches -fill yellow]
2010 $canv lower $t
2011 }
2012}
2013
2014proc unmarkmatches {} {
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]2015 global matchinglines findids
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]2016 allcanvs delete matches
2017 catch {unset matchinglines}
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]2018 catch {unset findids}
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]2019}
2020
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2021proc selcanvline {w x y} {
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2022 global canv canvy0 ctext linespc
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2023 global lineid linehtag linentag linedtag rowtextx
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2024 set ymax [lindex [$canv cget -scrollregion] 3]
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]2025 if {$ymax == {}} return
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2026 set yfrac [lindex [$canv yview] 0]
2027 set y [expr {$y + $yfrac * $ymax}]
2028 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2029 if {$l < 0} {
2030 set l 0
2031 }
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2032 if {$w eq $canv} {
2033 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2034 }
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]2035 unmarkmatches
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2036 selectline $l 1
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2037}
2038
Linus Torvaldsb1ba39e2005-08-09 03:04:20[diff] [blame]2039proc commit_descriptor {p} {
2040 global commitinfo
2041 set l "..."
2042 if {[info exists commitinfo($p)]} {
2043 set l [lindex $commitinfo($p) 0]
2044 }
2045 return "$p ($l)"
2046}
2047
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]2048# append some text to the ctext widget, and make any SHA1 ID
2049# that we know about be a clickable link.
2050proc appendwithlinks {text} {
2051 global ctext idline linknum
2052
2053 set start [$ctext index "end - 1c"]
2054 $ctext insert end $text
2055 $ctext insert end "\n"
2056 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2057 foreach l $links {
2058 set s [lindex $l 0]
2059 set e [lindex $l 1]
2060 set linkid [string range $text $s $e]
2061 if {![info exists idline($linkid)]} continue
2062 incr e
2063 $ctext tag add link "$start + $s c" "$start + $e c"
2064 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2065 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2066 incr linknum
2067 }
2068 $ctext tag conf link -foreground blue -underline 1
2069 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2070 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2071}
2072
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2073proc selectline {l isnew} {
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2074 global canv canv2 canv3 ctext commitinfo selectedline
2075 global lineid linehtag linentag linedtag
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]2076 global canvy0 linespc parents nparents children
Paul Mackerras14c9dbd2005-07-17 01:53:55[diff] [blame]2077 global cflist currentid sha1entry
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]2078 global commentend idtags idline linknum
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2079
Paul Mackerras84ba7342005-06-17 00:12:26[diff] [blame]2080 $canv delete hover
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]2081 normalline
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2082 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2083 $canv delete secsel
2084 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2085 -tags secsel -fill [$canv cget -selectbackground]]
2086 $canv lower $t
2087 $canv2 delete secsel
2088 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2089 -tags secsel -fill [$canv2 cget -selectbackground]]
2090 $canv2 lower $t
2091 $canv3 delete secsel
2092 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2093 -tags secsel -fill [$canv3 cget -selectbackground]]
2094 $canv3 lower $t
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2095 set y [expr {$canvy0 + $l * $linespc}]
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]2096 set ymax [lindex [$canv cget -scrollregion] 3]
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2097 set ytop [expr {$y - $linespc - 1}]
2098 set ybot [expr {$y + $linespc + 1}]
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2099 set wnow [$canv yview]
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2100 set wtop [expr [lindex $wnow 0] * $ymax]
2101 set wbot [expr [lindex $wnow 1] * $ymax]
2102 set wh [expr {$wbot - $wtop}]
2103 set newtop $wtop
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]2104 if {$ytop < $wtop} {
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2105 if {$ybot < $wtop} {
2106 set newtop [expr {$y - $wh / 2.0}]
2107 } else {
2108 set newtop $ytop
2109 if {$newtop > $wtop - $linespc} {
2110 set newtop [expr {$wtop - $linespc}]
2111 }
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]2112 }
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2113 } elseif {$ybot > $wbot} {
2114 if {$ytop > $wbot} {
2115 set newtop [expr {$y - $wh / 2.0}]
2116 } else {
2117 set newtop [expr {$ybot - $wh}]
2118 if {$newtop < $wtop + $linespc} {
2119 set newtop [expr {$wtop + $linespc}]
2120 }
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]2121 }
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2122 }
2123 if {$newtop != $wtop} {
2124 if {$newtop < 0} {
2125 set newtop 0
2126 }
2127 allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2128 }
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2129
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2130 if {$isnew} {
2131 addtohistory [list selectline $l 0]
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2132 }
2133
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2134 set selectedline $l
2135
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2136 set id $lineid($l)
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]2137 set currentid $id
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]2138 $sha1entry delete 0 end
2139 $sha1entry insert 0 $id
2140 $sha1entry selection from 0
2141 $sha1entry selection to end
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]2142
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2143 $ctext conf -state normal
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2144 $ctext delete 0.0 end
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]2145 set linknum 0
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2146 $ctext mark set fmark.0 0.0
2147 $ctext mark gravity fmark.0 left
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2148 set info $commitinfo($id)
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2149 $ctext insert end "Author: [lindex $info 1] [lindex $info 2]\n"
2150 $ctext insert end "Committer: [lindex $info 3] [lindex $info 4]\n"
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]2151 if {[info exists idtags($id)]} {
2152 $ctext insert end "Tags:"
2153 foreach tag $idtags($id) {
2154 $ctext insert end " $tag"
2155 }
2156 $ctext insert end "\n"
2157 }
Linus Torvalds8b192802005-08-07 20:58:56[diff] [blame]2158
Linus Torvalds8b192802005-08-07 20:58:56[diff] [blame]2159 set comment {}
Linus Torvaldsb1ba39e2005-08-09 03:04:20[diff] [blame]2160 if {[info exists parents($id)]} {
2161 foreach p $parents($id) {
2162 append comment "Parent: [commit_descriptor $p]\n"
Linus Torvalds8b192802005-08-07 20:58:56[diff] [blame]2163 }
Linus Torvaldsb1ba39e2005-08-09 03:04:20[diff] [blame]2164 }
2165 if {[info exists children($id)]} {
2166 foreach c $children($id) {
2167 append comment "Child: [commit_descriptor $c]\n"
2168 }
Linus Torvalds8b192802005-08-07 20:58:56[diff] [blame]2169 }
2170 append comment "\n"
2171 append comment [lindex $info 5]
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2172
2173 # make anything that looks like a SHA1 ID be a clickable link
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]2174 appendwithlinks $comment
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2175
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2176 $ctext tag delete Comments
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]2177 $ctext tag remove found 1.0 end
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2178 $ctext conf -state disabled
Paul Mackerrasdf3d83b2005-05-17 23:23:07[diff] [blame]2179 set commentend [$ctext index "end - 1c"]
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2180
2181 $cflist delete 0 end
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2182 $cflist insert end "Comments"
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2183 if {$nparents($id) == 1} {
2184 startdiff [concat $id $parents($id)]
2185 } elseif {$nparents($id) > 1} {
2186 mergediff $id
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2187 }
2188}
2189
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2190proc selnextline {dir} {
2191 global selectedline
2192 if {![info exists selectedline]} return
2193 set l [expr $selectedline + $dir]
Paul Mackerras98f350e2005-05-15 05:56:51[diff] [blame]2194 unmarkmatches
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2195 selectline $l 1
2196}
2197
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2198proc unselectline {} {
2199 global selectedline
2200
2201 catch {unset selectedline}
2202 allcanvs delete secsel
2203}
2204
2205proc addtohistory {cmd} {
2206 global history historyindex
2207
2208 if {$historyindex > 0
2209 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2210 return
2211 }
2212
2213 if {$historyindex < [llength $history]} {
2214 set history [lreplace $history $historyindex end $cmd]
2215 } else {
2216 lappend history $cmd
2217 }
2218 incr historyindex
2219 if {$historyindex > 1} {
2220 .ctop.top.bar.leftbut conf -state normal
2221 } else {
2222 .ctop.top.bar.leftbut conf -state disabled
2223 }
2224 .ctop.top.bar.rightbut conf -state disabled
2225}
2226
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2227proc goback {} {
2228 global history historyindex
2229
2230 if {$historyindex > 1} {
2231 incr historyindex -1
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2232 set cmd [lindex $history [expr {$historyindex - 1}]]
2233 eval $cmd
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2234 .ctop.top.bar.rightbut conf -state normal
2235 }
2236 if {$historyindex <= 1} {
2237 .ctop.top.bar.leftbut conf -state disabled
2238 }
2239}
2240
2241proc goforw {} {
2242 global history historyindex
2243
2244 if {$historyindex < [llength $history]} {
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2245 set cmd [lindex $history $historyindex]
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2246 incr historyindex
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2247 eval $cmd
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]2248 .ctop.top.bar.leftbut conf -state normal
2249 }
2250 if {$historyindex >= [llength $history]} {
2251 .ctop.top.bar.rightbut conf -state disabled
2252 }
Paul Mackerras5ad588d2005-05-10 01:02:55[diff] [blame]2253}
2254
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2255proc mergediff {id} {
2256 global parents diffmergeid diffmergegca mergefilelist diffpindex
Paul Mackerrase2ed4322005-07-17 07:39:44[diff] [blame]2257
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2258 set diffmergeid $id
2259 set diffpindex -1
2260 set diffmergegca [findgca $parents($id)]
2261 if {[info exists mergefilelist($id)]} {
Paul Mackerras1115fb32005-07-31 11:35:21[diff] [blame]2262 if {$mergefilelist($id) ne {}} {
2263 showmergediff
2264 }
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2265 } else {
2266 contmergediff {}
2267 }
2268}
2269
2270proc findgca {ids} {
2271 set gca {}
2272 foreach id $ids {
2273 if {$gca eq {}} {
2274 set gca $id
2275 } else {
2276 if {[catch {
2277 set gca [exec git-merge-base $gca $id]
2278 } err]} {
2279 return {}
2280 }
2281 }
2282 }
2283 return $gca
2284}
2285
2286proc contmergediff {ids} {
2287 global diffmergeid diffpindex parents nparents diffmergegca
Paul Mackerras1115fb32005-07-31 11:35:21[diff] [blame]2288 global treediffs mergefilelist diffids treepending
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2289
2290 # diff the child against each of the parents, and diff
2291 # each of the parents against the GCA.
2292 while 1 {
2293 if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
2294 set ids [list [lindex $ids 1] $diffmergegca]
2295 } else {
2296 if {[incr diffpindex] >= $nparents($diffmergeid)} break
2297 set p [lindex $parents($diffmergeid) $diffpindex]
2298 set ids [list $diffmergeid $p]
2299 }
2300 if {![info exists treediffs($ids)]} {
2301 set diffids $ids
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2302 if {![info exists treepending]} {
2303 gettreediffs $ids
2304 }
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2305 return
2306 }
2307 }
2308
2309 # If a file in some parent is different from the child and also
2310 # different from the GCA, then it's interesting.
2311 # If we don't have a GCA, then a file is interesting if it is
2312 # different from the child in all the parents.
2313 if {$diffmergegca ne {}} {
2314 set files {}
2315 foreach p $parents($diffmergeid) {
2316 set gcadiffs $treediffs([list $p $diffmergegca])
2317 foreach f $treediffs([list $diffmergeid $p]) {
2318 if {[lsearch -exact $files $f] < 0
2319 && [lsearch -exact $gcadiffs $f] >= 0} {
2320 lappend files $f
2321 }
2322 }
2323 }
2324 set files [lsort $files]
2325 } else {
2326 set p [lindex $parents($diffmergeid) 0]
2327 set files $treediffs([list $diffmergeid $p])
2328 for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2329 set p [lindex $parents($diffmergeid) $i]
2330 set df $treediffs([list $diffmergeid $p])
2331 set nf {}
2332 foreach f $files {
2333 if {[lsearch -exact $df $f] >= 0} {
2334 lappend nf $f
2335 }
2336 }
2337 set files $nf
2338 }
2339 }
2340
2341 set mergefilelist($diffmergeid) $files
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2342 if {$files ne {}} {
2343 showmergediff
2344 }
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2345}
2346
2347proc showmergediff {} {
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2348 global cflist diffmergeid mergefilelist parents
Paul Mackerras1115fb32005-07-31 11:35:21[diff] [blame]2349 global diffopts diffinhunk currentfile currenthunk filelines
2350 global diffblocked groupfilelast mergefds groupfilenum grouphunks
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2351
2352 set files $mergefilelist($diffmergeid)
2353 foreach f $files {
2354 $cflist insert end $f
2355 }
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2356 set env(GIT_DIFF_OPTS) $diffopts
2357 set flist {}
2358 catch {unset currentfile}
2359 catch {unset currenthunk}
2360 catch {unset filelines}
Paul Mackerras1115fb32005-07-31 11:35:21[diff] [blame]2361 catch {unset groupfilenum}
2362 catch {unset grouphunks}
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2363 set groupfilelast -1
2364 foreach p $parents($diffmergeid) {
2365 set cmd [list | git-diff-tree -p $p $diffmergeid]
2366 set cmd [concat $cmd $mergefilelist($diffmergeid)]
2367 if {[catch {set f [open $cmd r]} err]} {
2368 error_popup "Error getting diffs: $err"
2369 foreach f $flist {
2370 catch {close $f}
2371 }
2372 return
2373 }
2374 lappend flist $f
2375 set ids [list $diffmergeid $p]
2376 set mergefds($ids) $f
2377 set diffinhunk($ids) 0
2378 set diffblocked($ids) 0
2379 fconfigure $f -blocking 0
2380 fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2381 }
2382}
2383
2384proc getmergediffline {f ids id} {
2385 global diffmergeid diffinhunk diffoldlines diffnewlines
2386 global currentfile currenthunk
2387 global diffoldstart diffnewstart diffoldlno diffnewlno
2388 global diffblocked mergefilelist
2389 global noldlines nnewlines difflcounts filelines
2390
2391 set n [gets $f line]
2392 if {$n < 0} {
2393 if {![eof $f]} return
2394 }
2395
2396 if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2397 if {$n < 0} {
2398 close $f
2399 }
2400 return
2401 }
2402
2403 if {$diffinhunk($ids) != 0} {
2404 set fi $currentfile($ids)
2405 if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2406 # continuing an existing hunk
2407 set line [string range $line 1 end]
2408 set p [lindex $ids 1]
2409 if {$match eq "-" || $match eq " "} {
2410 set filelines($p,$fi,$diffoldlno($ids)) $line
2411 incr diffoldlno($ids)
2412 }
2413 if {$match eq "+" || $match eq " "} {
2414 set filelines($id,$fi,$diffnewlno($ids)) $line
2415 incr diffnewlno($ids)
2416 }
2417 if {$match eq " "} {
2418 if {$diffinhunk($ids) == 2} {
2419 lappend difflcounts($ids) \
2420 [list $noldlines($ids) $nnewlines($ids)]
2421 set noldlines($ids) 0
2422 set diffinhunk($ids) 1
2423 }
2424 incr noldlines($ids)
2425 } elseif {$match eq "-" || $match eq "+"} {
2426 if {$diffinhunk($ids) == 1} {
2427 lappend difflcounts($ids) [list $noldlines($ids)]
2428 set noldlines($ids) 0
2429 set nnewlines($ids) 0
2430 set diffinhunk($ids) 2
2431 }
2432 if {$match eq "-"} {
2433 incr noldlines($ids)
2434 } else {
2435 incr nnewlines($ids)
2436 }
2437 }
2438 # and if it's \ No newline at end of line, then what?
2439 return
2440 }
2441 # end of a hunk
2442 if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2443 lappend difflcounts($ids) [list $noldlines($ids)]
2444 } elseif {$diffinhunk($ids) == 2
2445 && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2446 lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2447 }
2448 set currenthunk($ids) [list $currentfile($ids) \
2449 $diffoldstart($ids) $diffnewstart($ids) \
2450 $diffoldlno($ids) $diffnewlno($ids) \
2451 $difflcounts($ids)]
2452 set diffinhunk($ids) 0
2453 # -1 = need to block, 0 = unblocked, 1 = is blocked
2454 set diffblocked($ids) -1
2455 processhunks
2456 if {$diffblocked($ids) == -1} {
2457 fileevent $f readable {}
2458 set diffblocked($ids) 1
2459 }
2460 }
2461
2462 if {$n < 0} {
2463 # eof
2464 if {!$diffblocked($ids)} {
2465 close $f
2466 set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2467 set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2468 processhunks
2469 }
2470 } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2471 # start of a new file
2472 set currentfile($ids) \
2473 [lsearch -exact $mergefilelist($diffmergeid) $fname]
2474 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2475 $line match f1l f1c f2l f2c rest]} {
2476 if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2477 # start of a new hunk
2478 if {$f1l == 0 && $f1c == 0} {
2479 set f1l 1
2480 }
2481 if {$f2l == 0 && $f2c == 0} {
2482 set f2l 1
2483 }
2484 set diffinhunk($ids) 1
2485 set diffoldstart($ids) $f1l
2486 set diffnewstart($ids) $f2l
2487 set diffoldlno($ids) $f1l
2488 set diffnewlno($ids) $f2l
2489 set difflcounts($ids) {}
2490 set noldlines($ids) 0
2491 set nnewlines($ids) 0
2492 }
2493 }
2494}
2495
2496proc processhunks {} {
2497 global diffmergeid parents nparents currenthunk
2498 global mergefilelist diffblocked mergefds
2499 global grouphunks grouplinestart grouplineend groupfilenum
2500
2501 set nfiles [llength $mergefilelist($diffmergeid)]
2502 while 1 {
2503 set fi $nfiles
2504 set lno 0
2505 # look for the earliest hunk
2506 foreach p $parents($diffmergeid) {
2507 set ids [list $diffmergeid $p]
2508 if {![info exists currenthunk($ids)]} return
2509 set i [lindex $currenthunk($ids) 0]
2510 set l [lindex $currenthunk($ids) 2]
2511 if {$i < $fi || ($i == $fi && $l < $lno)} {
2512 set fi $i
2513 set lno $l
2514 set pi $p
2515 }
2516 }
2517
2518 if {$fi < $nfiles} {
2519 set ids [list $diffmergeid $pi]
2520 set hunk $currenthunk($ids)
2521 unset currenthunk($ids)
2522 if {$diffblocked($ids) > 0} {
2523 fileevent $mergefds($ids) readable \
2524 [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2525 }
2526 set diffblocked($ids) 0
2527
2528 if {[info exists groupfilenum] && $groupfilenum == $fi
2529 && $lno <= $grouplineend} {
2530 # add this hunk to the pending group
2531 lappend grouphunks($pi) $hunk
2532 set endln [lindex $hunk 4]
2533 if {$endln > $grouplineend} {
2534 set grouplineend $endln
2535 }
2536 continue
2537 }
2538 }
2539
2540 # succeeding stuff doesn't belong in this group, so
2541 # process the group now
2542 if {[info exists groupfilenum]} {
2543 processgroup
2544 unset groupfilenum
2545 unset grouphunks
2546 }
2547
2548 if {$fi >= $nfiles} break
2549
2550 # start a new group
2551 set groupfilenum $fi
2552 set grouphunks($pi) [list $hunk]
2553 set grouplinestart $lno
2554 set grouplineend [lindex $hunk 4]
2555 }
2556}
2557
2558proc processgroup {} {
2559 global groupfilelast groupfilenum difffilestart
2560 global mergefilelist diffmergeid ctext filelines
2561 global parents diffmergeid diffoffset
2562 global grouphunks grouplinestart grouplineend nparents
2563 global mergemax
2564
2565 $ctext conf -state normal
2566 set id $diffmergeid
2567 set f $groupfilenum
2568 if {$groupfilelast != $f} {
2569 $ctext insert end "\n"
2570 set here [$ctext index "end - 1c"]
2571 set difffilestart($f) $here
2572 set mark fmark.[expr {$f + 1}]
2573 $ctext mark set $mark $here
2574 $ctext mark gravity $mark left
2575 set header [lindex $mergefilelist($id) $f]
2576 set l [expr {(78 - [string length $header]) / 2}]
2577 set pad [string range "----------------------------------------" 1 $l]
2578 $ctext insert end "$pad $header $pad\n" filesep
2579 set groupfilelast $f
2580 foreach p $parents($id) {
2581 set diffoffset($p) 0
2582 }
2583 }
2584
2585 $ctext insert end "@@" msep
2586 set nlines [expr {$grouplineend - $grouplinestart}]
2587 set events {}
2588 set pnum 0
2589 foreach p $parents($id) {
2590 set startline [expr {$grouplinestart + $diffoffset($p)}]
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2591 set ol $startline
2592 set nl $grouplinestart
2593 if {[info exists grouphunks($p)]} {
2594 foreach h $grouphunks($p) {
2595 set l [lindex $h 2]
2596 if {$nl < $l} {
2597 for {} {$nl < $l} {incr nl} {
2598 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2599 incr ol
2600 }
2601 }
2602 foreach chunk [lindex $h 5] {
2603 if {[llength $chunk] == 2} {
2604 set olc [lindex $chunk 0]
2605 set nlc [lindex $chunk 1]
2606 set nnl [expr {$nl + $nlc}]
2607 lappend events [list $nl $nnl $pnum $olc $nlc]
2608 incr ol $olc
2609 set nl $nnl
2610 } else {
2611 incr ol [lindex $chunk 0]
2612 incr nl [lindex $chunk 0]
2613 }
2614 }
2615 }
2616 }
2617 if {$nl < $grouplineend} {
2618 for {} {$nl < $grouplineend} {incr nl} {
2619 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2620 incr ol
2621 }
2622 }
2623 set nlines [expr {$ol - $startline}]
2624 $ctext insert end " -$startline,$nlines" msep
2625 incr pnum
2626 }
2627
2628 set nlines [expr {$grouplineend - $grouplinestart}]
2629 $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2630
2631 set events [lsort -integer -index 0 $events]
2632 set nevents [llength $events]
2633 set nmerge $nparents($diffmergeid)
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2634 set l $grouplinestart
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2635 for {set i 0} {$i < $nevents} {set i $j} {
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2636 set nl [lindex $events $i 0]
2637 while {$l < $nl} {
2638 $ctext insert end " $filelines($id,$f,$l)\n"
2639 incr l
2640 }
2641 set e [lindex $events $i]
2642 set enl [lindex $e 1]
2643 set j $i
2644 set active {}
2645 while 1 {
2646 set pnum [lindex $e 2]
2647 set olc [lindex $e 3]
2648 set nlc [lindex $e 4]
2649 if {![info exists delta($pnum)]} {
2650 set delta($pnum) [expr {$olc - $nlc}]
2651 lappend active $pnum
2652 } else {
2653 incr delta($pnum) [expr {$olc - $nlc}]
2654 }
2655 if {[incr j] >= $nevents} break
2656 set e [lindex $events $j]
2657 if {[lindex $e 0] >= $enl} break
2658 if {[lindex $e 1] > $enl} {
2659 set enl [lindex $e 1]
2660 }
2661 }
2662 set nlc [expr {$enl - $l}]
2663 set ncol mresult
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2664 set bestpn -1
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2665 if {[llength $active] == $nmerge - 1} {
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2666 # no diff for one of the parents, i.e. it's identical
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2667 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2668 if {![info exists delta($pnum)]} {
2669 if {$pnum < $mergemax} {
2670 lappend ncol m$pnum
2671 } else {
2672 lappend ncol mmax
2673 }
2674 break
2675 }
2676 }
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2677 } elseif {[llength $active] == $nmerge} {
2678 # all parents are different, see if one is very similar
2679 set bestsim 30
2680 for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2681 set sim [similarity $pnum $l $nlc $f \
2682 [lrange $events $i [expr {$j-1}]]]
2683 if {$sim > $bestsim} {
2684 set bestsim $sim
2685 set bestpn $pnum
2686 }
2687 }
2688 if {$bestpn >= 0} {
2689 lappend ncol m$bestpn
2690 }
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2691 }
2692 set pnum -1
2693 foreach p $parents($id) {
2694 incr pnum
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2695 if {![info exists delta($pnum)] || $pnum == $bestpn} continue
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2696 set olc [expr {$nlc + $delta($pnum)}]
2697 set ol [expr {$l + $diffoffset($p)}]
2698 incr diffoffset($p) $delta($pnum)
2699 unset delta($pnum)
2700 for {} {$olc > 0} {incr olc -1} {
2701 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2702 incr ol
2703 }
2704 }
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2705 set endl [expr {$l + $nlc}]
2706 if {$bestpn >= 0} {
2707 # show this pretty much as a normal diff
2708 set p [lindex $parents($id) $bestpn]
2709 set ol [expr {$l + $diffoffset($p)}]
2710 incr diffoffset($p) $delta($bestpn)
2711 unset delta($bestpn)
2712 for {set k $i} {$k < $j} {incr k} {
2713 set e [lindex $events $k]
2714 if {[lindex $e 2] != $bestpn} continue
2715 set nl [lindex $e 0]
2716 set ol [expr {$ol + $nl - $l}]
2717 for {} {$l < $nl} {incr l} {
2718 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2719 }
2720 set c [lindex $e 3]
2721 for {} {$c > 0} {incr c -1} {
2722 $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2723 incr ol
2724 }
2725 set nl [lindex $e 1]
2726 for {} {$l < $nl} {incr l} {
2727 $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2728 }
2729 }
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2730 }
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2731 for {} {$l < $endl} {incr l} {
2732 $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2733 }
Paul Mackerras9d2a52e2005-07-28 03:15:47[diff] [blame]2734 }
2735 while {$l < $grouplineend} {
2736 $ctext insert end " $filelines($id,$f,$l)\n"
2737 incr l
2738 }
2739 $ctext conf -state disabled
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2740}
2741
Paul Mackerrasc8a4acb2005-07-29 14:23:03[diff] [blame]2742proc similarity {pnum l nlc f events} {
2743 global diffmergeid parents diffoffset filelines
2744
2745 set id $diffmergeid
2746 set p [lindex $parents($id) $pnum]
2747 set ol [expr {$l + $diffoffset($p)}]
2748 set endl [expr {$l + $nlc}]
2749 set same 0
2750 set diff 0
2751 foreach e $events {
2752 if {[lindex $e 2] != $pnum} continue
2753 set nl [lindex $e 0]
2754 set ol [expr {$ol + $nl - $l}]
2755 for {} {$l < $nl} {incr l} {
2756 incr same [string length $filelines($id,$f,$l)]
2757 incr same
2758 }
2759 set oc [lindex $e 3]
2760 for {} {$oc > 0} {incr oc -1} {
2761 incr diff [string length $filelines($p,$f,$ol)]
2762 incr diff
2763 incr ol
2764 }
2765 set nl [lindex $e 1]
2766 for {} {$l < $nl} {incr l} {
2767 incr diff [string length $filelines($id,$f,$l)]
2768 incr diff
2769 }
2770 }
2771 for {} {$l < $endl} {incr l} {
2772 incr same [string length $filelines($id,$f,$l)]
2773 incr same
2774 }
2775 if {$same == 0} {
2776 return 0
2777 }
2778 return [expr {200 * $same / (2 * $same + $diff)}]
2779}
2780
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2781proc startdiff {ids} {
2782 global treediffs diffids treepending diffmergeid
2783
2784 set diffids $ids
2785 catch {unset diffmergeid}
2786 if {![info exists treediffs($ids)]} {
2787 if {![info exists treepending]} {
2788 gettreediffs $ids
2789 }
2790 } else {
2791 addtocflist $ids
2792 }
2793}
2794
2795proc addtocflist {ids} {
2796 global treediffs cflist
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2797 foreach f $treediffs($ids) {
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2798 $cflist insert end $f
2799 }
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2800 getblobdiffs $ids
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2801}
2802
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2803proc gettreediffs {ids} {
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2804 global treediff parents treepending
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2805 set treepending $ids
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2806 set treediff {}
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2807 set id [lindex $ids 0]
2808 set p [lindex $ids 1]
Linus Torvalds8b7e5d72005-10-25 20:01:42[diff] [blame]2809 if [catch {set gdtf [open "|git-diff-tree -r $id" r]}] return
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2810 fconfigure $gdtf -blocking 0
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2811 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2812}
2813
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2814proc gettreediffline {gdtf ids} {
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2815 global treediff treediffs treepending diffids diffmergeid
2816
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2817 set n [gets $gdtf line]
2818 if {$n < 0} {
2819 if {![eof $gdtf]} return
2820 close $gdtf
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2821 set treediffs($ids) $treediff
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2822 unset treepending
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2823 if {$ids != $diffids} {
2824 gettreediffs $diffids
2825 } else {
2826 if {[info exists diffmergeid]} {
2827 contmergediff $ids
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]2828 } else {
2829 addtocflist $ids
2830 }
2831 }
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2832 return
2833 }
Paul Mackerrasd4e95cb2005-06-01 00:02:13[diff] [blame]2834 set file [lindex $line 5]
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2835 lappend treediff $file
Paul Mackerrasd2610d12005-05-11 00:45:38[diff] [blame]2836}
2837
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2838proc getblobdiffs {ids} {
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2839 global diffopts blobdifffd diffids env curdifftag curtagstart
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2840 global difffilestart nextupdate diffinhdr treediffs
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2841
2842 set id [lindex $ids 0]
2843 set p [lindex $ids 1]
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2844 set env(GIT_DIFF_OPTS) $diffopts
Linus Torvalds8b7e5d72005-10-25 20:01:42[diff] [blame]2845 set cmd [list | git-diff-tree -r -p -C $id]
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2846 if {[catch {set bdf [open $cmd r]} err]} {
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2847 puts "error getting diffs: $err"
2848 return
2849 }
Paul Mackerras4f2c2642005-07-17 15:11:44[diff] [blame]2850 set diffinhdr 0
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2851 fconfigure $bdf -blocking 0
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2852 set blobdifffd($ids) $bdf
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2853 set curdifftag Comments
2854 set curtagstart 0.0
Paul Mackerras3c461ff2005-07-20 13:13:46[diff] [blame]2855 catch {unset difffilestart}
2856 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2857 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2858}
2859
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2860proc getblobdiffline {bdf ids} {
Paul Mackerras4f2c2642005-07-17 15:11:44[diff] [blame]2861 global diffids blobdifffd ctext curdifftag curtagstart
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2862 global diffnexthead diffnextnote difffilestart
2863 global nextupdate diffinhdr treediffs
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]2864 global gaudydiff
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2865
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2866 set n [gets $bdf line]
2867 if {$n < 0} {
2868 if {[eof $bdf]} {
2869 close $bdf
Paul Mackerrase2ed4322005-07-17 07:39:44[diff] [blame]2870 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2871 $ctext tag add $curdifftag $curtagstart end
2872 }
2873 }
2874 return
2875 }
Paul Mackerrase2ed4322005-07-17 07:39:44[diff] [blame]2876 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2877 return
2878 }
2879 $ctext conf -state normal
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2880 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2881 # start of a new file
2882 $ctext insert end "\n"
2883 $ctext tag add $curdifftag $curtagstart end
2884 set curtagstart [$ctext index "end - 1c"]
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2885 set header $newname
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2886 set here [$ctext index "end - 1c"]
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2887 set i [lsearch -exact $treediffs($diffids) $fname]
2888 if {$i >= 0} {
2889 set difffilestart($i) $here
2890 incr i
2891 $ctext mark set fmark.$i $here
2892 $ctext mark gravity fmark.$i left
2893 }
2894 if {$newname != $fname} {
2895 set i [lsearch -exact $treediffs($diffids) $newname]
2896 if {$i >= 0} {
2897 set difffilestart($i) $here
2898 incr i
2899 $ctext mark set fmark.$i $here
2900 $ctext mark gravity fmark.$i left
2901 }
2902 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2903 set curdifftag "f:$fname"
2904 $ctext tag delete $curdifftag
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2905 set l [expr {(78 - [string length $header]) / 2}]
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2906 set pad [string range "----------------------------------------" 1 $l]
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2907 $ctext insert end "$pad $header $pad\n" filesep
Paul Mackerras4f2c2642005-07-17 15:11:44[diff] [blame]2908 set diffinhdr 1
2909 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2910 set diffinhdr 0
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2911 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2912 $line match f1l f1c f2l f2c rest]} {
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]2913 if {$gaudydiff} {
2914 $ctext insert end "\t" hunksep
2915 $ctext insert end " $f1l " d0 " $f2l " d1
2916 $ctext insert end " $rest \n" hunksep
2917 } else {
2918 $ctext insert end "$line\n" hunksep
2919 }
Paul Mackerras4f2c2642005-07-17 15:11:44[diff] [blame]2920 set diffinhdr 0
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2921 } else {
2922 set x [string range $line 0 0]
2923 if {$x == "-" || $x == "+"} {
2924 set tag [expr {$x == "+"}]
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]2925 if {$gaudydiff} {
2926 set line [string range $line 1 end]
2927 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2928 $ctext insert end "$line\n" d$tag
2929 } elseif {$x == " "} {
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]2930 if {$gaudydiff} {
2931 set line [string range $line 1 end]
2932 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2933 $ctext insert end "$line\n"
Paul Mackerras4f2c2642005-07-17 15:11:44[diff] [blame]2934 } elseif {$diffinhdr || $x == "\\"} {
Paul Mackerras58422152005-05-19 10:56:42[diff] [blame]2935 # e.g. "\ No newline at end of file"
2936 $ctext insert end "$line\n" filesep
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2937 } else {
2938 # Something else we don't recognize
2939 if {$curdifftag != "Comments"} {
2940 $ctext insert end "\n"
2941 $ctext tag add $curdifftag $curtagstart end
2942 set curtagstart [$ctext index "end - 1c"]
2943 set curdifftag Comments
2944 }
2945 $ctext insert end "$line\n" filesep
2946 }
2947 }
2948 $ctext conf -state disabled
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2949 if {[clock clicks -milliseconds] >= $nextupdate} {
2950 incr nextupdate 100
2951 fileevent $bdf readable {}
2952 update
2953 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2954 }
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2955}
2956
Paul Mackerras39ad8572005-05-19 12:35:53[diff] [blame]2957proc nextfile {} {
2958 global difffilestart ctext
2959 set here [$ctext index @0,0]
2960 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2961 if {[$ctext compare $difffilestart($i) > $here]} {
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2962 if {![info exists pos]
2963 || [$ctext compare $difffilestart($i) < $pos]} {
2964 set pos $difffilestart($i)
2965 }
Paul Mackerras39ad8572005-05-19 12:35:53[diff] [blame]2966 }
2967 }
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2968 if {[info exists pos]} {
2969 $ctext yview $pos
2970 }
Paul Mackerras39ad8572005-05-19 12:35:53[diff] [blame]2971}
2972
Paul Mackerrase5c2d852005-05-11 23:44:54[diff] [blame]2973proc listboxsel {} {
Paul Mackerras7eab2932005-07-20 16:25:54[diff] [blame]2974 global ctext cflist currentid
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]2975 if {![info exists currentid]} return
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]2976 set sel [lsort [$cflist curselection]]
2977 if {$sel eq {}} return
2978 set first [lindex $sel 0]
2979 catch {$ctext yview fmark.$first}
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2980}
2981
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]2982proc setcoords {} {
2983 global linespc charspc canvx0 canvy0 mainfont
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]2984 global xspc1 xspc2 lthickness
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]2985
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]2986 set linespc [font metrics $mainfont -linespace]
2987 set charspc [font measure $mainfont "m"]
2988 set canvy0 [expr 3 + 0.5 * $linespc]
2989 set canvx0 [expr 3 + 0.5 * $linespc]
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]2990 set lthickness [expr {int($linespc / 9) + 1}]
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]2991 set xspc1(0) $linespc
2992 set xspc2 $linespc
Paul Mackerras9a40c502005-05-12 23:46:16[diff] [blame]2993}
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]2994
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]2995proc redisplay {} {
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]2996 global stopped redisplaying phase
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]2997 if {$stopped > 1} return
2998 if {$phase == "getcommits"} return
2999 set redisplaying 1
Paul Mackerras9ccbdfb2005-06-16 00:27:23[diff] [blame]3000 if {$phase == "drawgraph" || $phase == "incrdraw"} {
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3001 set stopped 1
3002 } else {
3003 drawgraph
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]3004 }
3005}
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3006
3007proc incrfont {inc} {
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3008 global mainfont namefont textfont ctext canv phase
Paul Mackerrascfb45632005-05-31 12:14:42[diff] [blame]3009 global stopped entries
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3010 unmarkmatches
3011 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3012 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3013 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3014 setcoords
3015 $ctext conf -font $textfont
3016 $ctext tag conf filesep -font [concat $textfont bold]
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3017 foreach e $entries {
3018 $e conf -font $mainfont
3019 }
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3020 if {$phase == "getcommits"} {
3021 $canv itemconf textitems -font $mainfont
3022 }
3023 redisplay
Paul Mackerras1db95b02005-05-09 04:08:39[diff] [blame]3024}
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3025
Paul Mackerrasee3dc722005-06-25 06:37:13[diff] [blame]3026proc clearsha1 {} {
3027 global sha1entry sha1string
3028 if {[string length $sha1string] == 40} {
3029 $sha1entry delete 0 end
3030 }
3031}
3032
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3033proc sha1change {n1 n2 op} {
3034 global sha1string currentid sha1but
3035 if {$sha1string == {}
3036 || ([info exists currentid] && $sha1string == $currentid)} {
3037 set state disabled
3038 } else {
3039 set state normal
3040 }
3041 if {[$sha1but cget -state] == $state} return
3042 if {$state == "normal"} {
3043 $sha1but conf -state normal -relief raised -text "Goto: "
3044 } else {
3045 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3046 }
3047}
3048
3049proc gotocommit {} {
3050 global sha1string currentid idline tagids
Paul Mackerrasf3b8b3c2005-07-18 16:16:35[diff] [blame]3051 global lineid numcommits
3052
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3053 if {$sha1string == {}
3054 || ([info exists currentid] && $sha1string == $currentid)} return
3055 if {[info exists tagids($sha1string)]} {
3056 set id $tagids($sha1string)
3057 } else {
3058 set id [string tolower $sha1string]
Paul Mackerrasf3b8b3c2005-07-18 16:16:35[diff] [blame]3059 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3060 set matches {}
3061 for {set l 0} {$l < $numcommits} {incr l} {
3062 if {[string match $id* $lineid($l)]} {
3063 lappend matches $lineid($l)
3064 }
3065 }
3066 if {$matches ne {}} {
3067 if {[llength $matches] > 1} {
3068 error_popup "Short SHA1 id $id is ambiguous"
3069 return
3070 }
3071 set id [lindex $matches 0]
3072 }
3073 }
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3074 }
3075 if {[info exists idline($id)]} {
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]3076 selectline $idline($id) 1
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3077 return
3078 }
Paul Mackerrasf3b8b3c2005-07-18 16:16:35[diff] [blame]3079 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3080 set type "SHA1 id"
3081 } else {
3082 set type "Tag"
3083 }
3084 error_popup "$type $sha1string is not known"
3085}
3086
Paul Mackerras84ba7342005-06-17 00:12:26[diff] [blame]3087proc lineenter {x y id} {
3088 global hoverx hovery hoverid hovertimer
3089 global commitinfo canv
3090
3091 if {![info exists commitinfo($id)]} return
3092 set hoverx $x
3093 set hovery $y
3094 set hoverid $id
3095 if {[info exists hovertimer]} {
3096 after cancel $hovertimer
3097 }
3098 set hovertimer [after 500 linehover]
3099 $canv delete hover
3100}
3101
3102proc linemotion {x y id} {
3103 global hoverx hovery hoverid hovertimer
3104
3105 if {[info exists hoverid] && $id == $hoverid} {
3106 set hoverx $x
3107 set hovery $y
3108 if {[info exists hovertimer]} {
3109 after cancel $hovertimer
3110 }
3111 set hovertimer [after 500 linehover]
3112 }
3113}
3114
3115proc lineleave {id} {
3116 global hoverid hovertimer canv
3117
3118 if {[info exists hoverid] && $id == $hoverid} {
3119 $canv delete hover
3120 if {[info exists hovertimer]} {
3121 after cancel $hovertimer
3122 unset hovertimer
3123 }
3124 unset hoverid
3125 }
3126}
3127
3128proc linehover {} {
3129 global hoverx hovery hoverid hovertimer
3130 global canv linespc lthickness
3131 global commitinfo mainfont
3132
3133 set text [lindex $commitinfo($hoverid) 0]
3134 set ymax [lindex [$canv cget -scrollregion] 3]
3135 if {$ymax == {}} return
3136 set yfrac [lindex [$canv yview] 0]
3137 set x [expr {$hoverx + 2 * $linespc}]
3138 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3139 set x0 [expr {$x - 2 * $lthickness}]
3140 set y0 [expr {$y - 2 * $lthickness}]
3141 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3142 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3143 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3144 -fill \#ffff80 -outline black -width 1 -tags hover]
3145 $canv raise $t
3146 set t [$canv create text $x $y -anchor nw -text $text -tags hover]
3147 $canv raise $t
3148}
3149
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]3150proc clickisonarrow {id y} {
3151 global mainline mainlinearrow sidelines lthickness
3152
3153 set thresh [expr {2 * $lthickness + 6}]
3154 if {[info exists mainline($id)]} {
3155 if {$mainlinearrow($id) ne "none"} {
3156 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3157 return "up"
3158 }
3159 }
3160 }
3161 if {[info exists sidelines($id)]} {
3162 foreach ls $sidelines($id) {
3163 set coords [lindex $ls 0]
3164 set arrow [lindex $ls 2]
3165 if {$arrow eq "first" || $arrow eq "both"} {
3166 if {abs([lindex $coords 1] - $y) < $thresh} {
3167 return "up"
3168 }
3169 }
3170 if {$arrow eq "last" || $arrow eq "both"} {
3171 if {abs([lindex $coords end] - $y) < $thresh} {
3172 return "down"
3173 }
3174 }
3175 }
3176 }
3177 return {}
3178}
3179
3180proc arrowjump {id dirn y} {
3181 global mainline sidelines canv
3182
3183 set yt {}
3184 if {$dirn eq "down"} {
3185 if {[info exists mainline($id)]} {
3186 set y1 [lindex $mainline($id) 1]
3187 if {$y1 > $y} {
3188 set yt $y1
3189 }
3190 }
3191 if {[info exists sidelines($id)]} {
3192 foreach ls $sidelines($id) {
3193 set y1 [lindex $ls 0 1]
3194 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3195 set yt $y1
3196 }
3197 }
3198 }
3199 } else {
3200 if {[info exists sidelines($id)]} {
3201 foreach ls $sidelines($id) {
3202 set y1 [lindex $ls 0 end]
3203 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3204 set yt $y1
3205 }
3206 }
3207 }
3208 }
3209 if {$yt eq {}} return
3210 set ymax [lindex [$canv cget -scrollregion] 3]
3211 if {$ymax eq {} || $ymax <= 0} return
3212 set view [$canv yview]
3213 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3214 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3215 if {$yfrac < 0} {
3216 set yfrac 0
3217 }
3218 $canv yview moveto $yfrac
3219}
3220
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3221proc lineclick {x y id isnew} {
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]3222 global ctext commitinfo children cflist canv thickerline
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3223
3224 unmarkmatches
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3225 unselectline
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]3226 normalline
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3227 $canv delete hover
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]3228 # draw this line thicker than normal
3229 drawlines $id 1
3230 set thickerline $id
3231 if {$isnew} {
3232 set ymax [lindex [$canv cget -scrollregion] 3]
3233 if {$ymax eq {}} return
3234 set yfrac [lindex [$canv yview] 0]
3235 set y [expr {$y + $yfrac * $ymax}]
3236 }
3237 set dirn [clickisonarrow $id $y]
3238 if {$dirn ne {}} {
3239 arrowjump $id $dirn $y
3240 return
3241 }
3242
3243 if {$isnew} {
3244 addtohistory [list lineclick $x $y $id 0]
3245 }
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3246 # fill the details pane with info about this line
3247 $ctext conf -state normal
3248 $ctext delete 0.0 end
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3249 $ctext tag conf link -foreground blue -underline 1
3250 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3251 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3252 $ctext insert end "Parent:\t"
3253 $ctext insert end $id [list link link0]
3254 $ctext tag bind link0 <1> [list selbyid $id]
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3255 set info $commitinfo($id)
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3256 $ctext insert end "\n\t[lindex $info 0]\n"
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3257 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3258 $ctext insert end "\tDate:\t[lindex $info 2]\n"
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3259 if {[info exists children($id)]} {
3260 $ctext insert end "\nChildren:"
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3261 set i 0
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3262 foreach child $children($id) {
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3263 incr i
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3264 set info $commitinfo($child)
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3265 $ctext insert end "\n\t"
3266 $ctext insert end $child [list link link$i]
3267 $ctext tag bind link$i <1> [list selbyid $child]
3268 $ctext insert end "\n\t[lindex $info 0]"
3269 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3270 $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3271 }
3272 }
3273 $ctext conf -state disabled
3274
3275 $cflist delete 0 end
3276}
3277
Paul Mackerras9843c302005-08-30 00:57:11[diff] [blame]3278proc normalline {} {
3279 global thickerline
3280 if {[info exists thickerline]} {
3281 drawlines $thickerline 0
3282 unset thickerline
3283 }
3284}
3285
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3286proc selbyid {id} {
3287 global idline
3288 if {[info exists idline($id)]} {
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]3289 selectline $idline($id) 1
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3290 }
3291}
3292
3293proc mstime {} {
3294 global startmstime
3295 if {![info exists startmstime]} {
3296 set startmstime [clock clicks -milliseconds]
3297 }
3298 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3299}
3300
3301proc rowmenu {x y id} {
3302 global rowctxmenu idline selectedline rowmenuid
3303
3304 if {![info exists selectedline] || $idline($id) eq $selectedline} {
3305 set state disabled
3306 } else {
3307 set state normal
3308 }
3309 $rowctxmenu entryconfigure 0 -state $state
3310 $rowctxmenu entryconfigure 1 -state $state
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3311 $rowctxmenu entryconfigure 2 -state $state
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3312 set rowmenuid $id
3313 tk_popup $rowctxmenu $x $y
3314}
3315
3316proc diffvssel {dirn} {
3317 global rowmenuid selectedline lineid
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3318
3319 if {![info exists selectedline]} return
3320 if {$dirn} {
3321 set oldid $lineid($selectedline)
3322 set newid $rowmenuid
3323 } else {
3324 set oldid $rowmenuid
3325 set newid $lineid($selectedline)
3326 }
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3327 addtohistory [list doseldiff $oldid $newid]
3328 doseldiff $oldid $newid
3329}
3330
3331proc doseldiff {oldid newid} {
3332 global ctext cflist
3333 global commitinfo
3334
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3335 $ctext conf -state normal
3336 $ctext delete 0.0 end
3337 $ctext mark set fmark.0 0.0
3338 $ctext mark gravity fmark.0 left
3339 $cflist delete 0 end
3340 $cflist insert end "Top"
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3341 $ctext insert end "From "
3342 $ctext tag conf link -foreground blue -underline 1
3343 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3344 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3345 $ctext tag bind link0 <1> [list selbyid $oldid]
3346 $ctext insert end $oldid [list link link0]
3347 $ctext insert end "\n "
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3348 $ctext insert end [lindex $commitinfo($oldid) 0]
Paul Mackerrasfa4da7b2005-08-07 23:47:22[diff] [blame]3349 $ctext insert end "\n\nTo "
3350 $ctext tag bind link1 <1> [list selbyid $newid]
3351 $ctext insert end $newid [list link link1]
3352 $ctext insert end "\n "
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3353 $ctext insert end [lindex $commitinfo($newid) 0]
3354 $ctext insert end "\n"
3355 $ctext conf -state disabled
3356 $ctext tag delete Comments
3357 $ctext tag remove found 1.0 end
Paul Mackerras1115fb32005-07-31 11:35:21[diff] [blame]3358 startdiff [list $newid $oldid]
Paul Mackerrasc8dfbcf2005-06-25 05:39:21[diff] [blame]3359}
3360
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3361proc mkpatch {} {
3362 global rowmenuid currentid commitinfo patchtop patchnum
3363
3364 if {![info exists currentid]} return
3365 set oldid $currentid
3366 set oldhead [lindex $commitinfo($oldid) 0]
3367 set newid $rowmenuid
3368 set newhead [lindex $commitinfo($newid) 0]
3369 set top .patch
3370 set patchtop $top
3371 catch {destroy $top}
3372 toplevel $top
3373 label $top.title -text "Generate patch"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3374 grid $top.title - -pady 10
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3375 label $top.from -text "From:"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3376 entry $top.fromsha1 -width 40 -relief flat
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3377 $top.fromsha1 insert 0 $oldid
3378 $top.fromsha1 conf -state readonly
3379 grid $top.from $top.fromsha1 -sticky w
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3380 entry $top.fromhead -width 60 -relief flat
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3381 $top.fromhead insert 0 $oldhead
3382 $top.fromhead conf -state readonly
3383 grid x $top.fromhead -sticky w
3384 label $top.to -text "To:"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3385 entry $top.tosha1 -width 40 -relief flat
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3386 $top.tosha1 insert 0 $newid
3387 $top.tosha1 conf -state readonly
3388 grid $top.to $top.tosha1 -sticky w
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3389 entry $top.tohead -width 60 -relief flat
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3390 $top.tohead insert 0 $newhead
3391 $top.tohead conf -state readonly
3392 grid x $top.tohead -sticky w
3393 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3394 grid $top.rev x -pady 10
3395 label $top.flab -text "Output file:"
3396 entry $top.fname -width 60
3397 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3398 incr patchnum
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3399 grid $top.flab $top.fname -sticky w
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3400 frame $top.buts
3401 button $top.buts.gen -text "Generate" -command mkpatchgo
3402 button $top.buts.can -text "Cancel" -command mkpatchcan
3403 grid $top.buts.gen $top.buts.can
3404 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3405 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3406 grid $top.buts - -pady 10 -sticky ew
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3407 focus $top.fname
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3408}
3409
3410proc mkpatchrev {} {
3411 global patchtop
3412
3413 set oldid [$patchtop.fromsha1 get]
3414 set oldhead [$patchtop.fromhead get]
3415 set newid [$patchtop.tosha1 get]
3416 set newhead [$patchtop.tohead get]
3417 foreach e [list fromsha1 fromhead tosha1 tohead] \
3418 v [list $newid $newhead $oldid $oldhead] {
3419 $patchtop.$e conf -state normal
3420 $patchtop.$e delete 0 end
3421 $patchtop.$e insert 0 $v
3422 $patchtop.$e conf -state readonly
3423 }
3424}
3425
3426proc mkpatchgo {} {
3427 global patchtop
3428
3429 set oldid [$patchtop.fromsha1 get]
3430 set newid [$patchtop.tosha1 get]
3431 set fname [$patchtop.fname get]
3432 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3433 error_popup "Error creating patch: $err"
3434 }
3435 catch {destroy $patchtop}
3436 unset patchtop
3437}
3438
3439proc mkpatchcan {} {
3440 global patchtop
3441
3442 catch {destroy $patchtop}
3443 unset patchtop
3444}
3445
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3446proc mktag {} {
3447 global rowmenuid mktagtop commitinfo
3448
3449 set top .maketag
3450 set mktagtop $top
3451 catch {destroy $top}
3452 toplevel $top
3453 label $top.title -text "Create tag"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3454 grid $top.title - -pady 10
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3455 label $top.id -text "ID:"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3456 entry $top.sha1 -width 40 -relief flat
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3457 $top.sha1 insert 0 $rowmenuid
3458 $top.sha1 conf -state readonly
3459 grid $top.id $top.sha1 -sticky w
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3460 entry $top.head -width 60 -relief flat
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3461 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3462 $top.head conf -state readonly
3463 grid x $top.head -sticky w
3464 label $top.tlab -text "Tag name:"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3465 entry $top.tag -width 60
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3466 grid $top.tlab $top.tag -sticky w
3467 frame $top.buts
3468 button $top.buts.gen -text "Create" -command mktaggo
3469 button $top.buts.can -text "Cancel" -command mktagcan
3470 grid $top.buts.gen $top.buts.can
3471 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3472 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3473 grid $top.buts - -pady 10 -sticky ew
3474 focus $top.tag
3475}
3476
3477proc domktag {} {
3478 global mktagtop env tagids idtags
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3479
3480 set id [$mktagtop.sha1 get]
3481 set tag [$mktagtop.tag get]
3482 if {$tag == {}} {
3483 error_popup "No tag name specified"
3484 return
3485 }
3486 if {[info exists tagids($tag)]} {
3487 error_popup "Tag \"$tag\" already exists"
3488 return
3489 }
3490 if {[catch {
Junio C Hamano73b6a6c2005-07-28 07:28:44[diff] [blame]3491 set dir [gitdir]
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3492 set fname [file join $dir "refs/tags" $tag]
3493 set f [open $fname w]
3494 puts $f $id
3495 close $f
3496 } err]} {
3497 error_popup "Error creating tag: $err"
3498 return
3499 }
3500
3501 set tagids($tag) $id
3502 lappend idtags($id) $tag
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]3503 redrawtags $id
3504}
3505
3506proc redrawtags {id} {
3507 global canv linehtag idline idpos selectedline
3508
3509 if {![info exists idline($id)]} return
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3510 $canv delete tag.$id
3511 set xt [eval drawtags $id $idpos($id)]
3512 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3513 if {[info exists selectedline] && $selectedline == $idline($id)} {
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]3514 selectline $selectedline 0
Paul Mackerrasbdbfbe32005-06-27 12:56:40[diff] [blame]3515 }
3516}
3517
3518proc mktagcan {} {
3519 global mktagtop
3520
3521 catch {destroy $mktagtop}
3522 unset mktagtop
3523}
3524
3525proc mktaggo {} {
3526 domktag
3527 mktagcan
3528}
3529
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3530proc writecommit {} {
3531 global rowmenuid wrcomtop commitinfo wrcomcmd
3532
3533 set top .writecommit
3534 set wrcomtop $top
3535 catch {destroy $top}
3536 toplevel $top
3537 label $top.title -text "Write commit to file"
3538 grid $top.title - -pady 10
3539 label $top.id -text "ID:"
3540 entry $top.sha1 -width 40 -relief flat
3541 $top.sha1 insert 0 $rowmenuid
3542 $top.sha1 conf -state readonly
3543 grid $top.id $top.sha1 -sticky w
3544 entry $top.head -width 60 -relief flat
3545 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3546 $top.head conf -state readonly
3547 grid x $top.head -sticky w
3548 label $top.clab -text "Command:"
3549 entry $top.cmd -width 60 -textvariable wrcomcmd
3550 grid $top.clab $top.cmd -sticky w -pady 10
3551 label $top.flab -text "Output file:"
3552 entry $top.fname -width 60
3553 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3554 grid $top.flab $top.fname -sticky w
3555 frame $top.buts
3556 button $top.buts.gen -text "Write" -command wrcomgo
3557 button $top.buts.can -text "Cancel" -command wrcomcan
3558 grid $top.buts.gen $top.buts.can
3559 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3560 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3561 grid $top.buts - -pady 10 -sticky ew
3562 focus $top.fname
3563}
3564
3565proc wrcomgo {} {
3566 global wrcomtop
3567
3568 set id [$wrcomtop.sha1 get]
3569 set cmd "echo $id | [$wrcomtop.cmd get]"
3570 set fname [$wrcomtop.fname get]
3571 if {[catch {exec sh -c $cmd >$fname &} err]} {
3572 error_popup "Error writing commit: $err"
3573 }
3574 catch {destroy $wrcomtop}
3575 unset wrcomtop
3576}
3577
3578proc wrcomcan {} {
3579 global wrcomtop
3580
3581 catch {destroy $wrcomtop}
3582 unset wrcomtop
3583}
3584
Paul Mackerrasf1d83ba2005-08-19 12:14:28[diff] [blame]3585proc listrefs {id} {
3586 global idtags idheads idotherrefs
3587
3588 set x {}
3589 if {[info exists idtags($id)]} {
3590 set x $idtags($id)
3591 }
3592 set y {}
3593 if {[info exists idheads($id)]} {
3594 set y $idheads($id)
3595 }
3596 set z {}
3597 if {[info exists idotherrefs($id)]} {
3598 set z $idotherrefs($id)
3599 }
3600 return [list $x $y $z]
3601}
3602
3603proc rereadrefs {} {
3604 global idtags idheads idotherrefs
3605 global tagids headids otherrefids
3606
3607 set refids [concat [array names idtags] \
3608 [array names idheads] [array names idotherrefs]]
3609 foreach id $refids {
3610 if {![info exists ref($id)]} {
3611 set ref($id) [listrefs $id]
3612 }
3613 }
3614 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
3615 catch {unset $v}
3616 }
3617 readrefs
3618 set refids [lsort -unique [concat $refids [array names idtags] \
3619 [array names idheads] [array names idotherrefs]]]
3620 foreach id $refids {
3621 set v [listrefs $id]
3622 if {![info exists ref($id)] || $ref($id) != $v} {
3623 redrawtags $id
3624 }
3625 }
3626}
3627
Paul Mackerras106288c2005-08-19 13:11:39[diff] [blame]3628proc showtag {tag isnew} {
3629 global ctext cflist tagcontents tagids linknum
3630
3631 if {$isnew} {
3632 addtohistory [list showtag $tag 0]
3633 }
3634 $ctext conf -state normal
3635 $ctext delete 0.0 end
3636 set linknum 0
3637 if {[info exists tagcontents($tag)]} {
3638 set text $tagcontents($tag)
3639 } else {
3640 set text "Tag: $tag\nId: $tagids($tag)"
3641 }
3642 appendwithlinks $text
3643 $ctext conf -state disabled
3644 $cflist delete 0 end
3645}
3646
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3647proc doquit {} {
3648 global stopped
3649 set stopped 100
3650 destroy .
3651}
3652
3653# defaults...
3654set datemode 0
3655set boldnames 0
3656set diffopts "-U 5 -p"
Paul Mackerras4a2139f2005-06-28 23:47:48[diff] [blame]3657set wrcomcmd "git-diff-tree --stdin -p --pretty"
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3658
3659set mainfont {Helvetica 9}
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3660set textfont {Courier 9}
Paul Mackerrasb74fd572005-07-16 11:46:13[diff] [blame]3661set findmergefiles 0
Paul Mackerrasf0654862005-07-18 18:29:03[diff] [blame]3662set gaudydiff 0
Paul Mackerras8d858d12005-08-04 23:52:16[diff] [blame]3663set maxgraphpct 50
Paul Mackerrasf6075eb2005-08-17 23:30:10[diff] [blame]3664set maxwidth 16
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3665
3666set colors {green red blue magenta darkgrey brown orange}
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3667
3668catch {source ~/.gitk}
3669
Paul Mackerras17386062005-05-18 22:51:00[diff] [blame]3670set namefont $mainfont
3671if {$boldnames} {
3672 lappend namefont bold
3673}
3674
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3675set revtreeargs {}
3676foreach arg $argv {
3677 switch -regexp -- $arg {
3678 "^$" { }
3679 "^-b" { set boldnames 1 }
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3680 "^-d" { set datemode 1 }
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3681 default {
3682 lappend revtreeargs $arg
3683 }
3684 }
3685}
3686
Paul Mackerrasd6982062005-08-06 12:06:06[diff] [blame]3687set history {}
3688set historyindex 0
3689
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3690set stopped 0
3691set redisplaying 0
Paul Mackerras0fba86b2005-05-16 23:54:58[diff] [blame]3692set stuffsaved 0
Paul Mackerras74daedb2005-06-27 09:27:32[diff] [blame]3693set patchnum 0
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3694setcoords
3695makewindow
Paul Mackerras887fe3c2005-05-21 07:35:37[diff] [blame]3696readrefs
Paul Mackerras1d10f362005-05-15 12:55:47[diff] [blame]3697getcommits $revtreeargs