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