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