« back to all changes in this revision
Viewing changes to gitk
- browse files at revision 13
- compare with another revision
- download diff
- download tarball
- view history from revision 13
- Committer: Package Import Robot
- Author(s): LaMont Jones
- Date: 2007-11-29 07:28:44 UTC
- mfrom: (8.1.2 dapper-backports)
- Revision ID: package-import@ubuntu.com-20071129072844-umsb7y3140yhxkth
Tags: 1:1.5.3.6-1.1~dapper1
* backport to dapper et al.
- debian/rules changes to support source:Upstream-Version for old dpkg.
- allow asciidoc (>7.0.2-3)
- debian/rules changes to support source:Upstream-Version for old dpkg.
- allow asciidoc (>7.0.2-3)
- files added:
- .mailmap
- RelNotes
- contrib/blameview
- contrib/continuous
- contrib/examples
- contrib/fast-import
- contrib/hg-to-git
- contrib/hooks
- contrib/p4import
- contrib/patches
- contrib/stats
- contrib/workdir
- git-gui
- git-gui/lib
- t/t3900
- t/t5515
- t/t7004
- t/t7500
- t/t9110
- t/t9111
- t/t9115
- files removed:
- Documentation/git-applymbox.txt
- contrib/colordiff
- files modified:
- .gitignore
added
removed
gitk
12
12
if {[info exists env(GIT_DIR)]} {
13
13
return $env(GIT_DIR)
14
14
} else {
15
return ".git"
16
}
17
}
18
15
return [exec git rev-parse --git-dir]
16
}
17
}
18
19
# A simple scheduler for compute-intensive stuff.
20
# The aim is to make sure that event handlers for GUI actions can
21
# run at least every 50-100 ms. Unfortunately fileevent handlers are
22
# run before X event handlers, so reading from a fast source can
23
# make the GUI completely unresponsive.
24
proc run args {
25
global isonrunq runq
26
27
set script $args
28
if {[info exists isonrunq($script)]} return
29
if {$runq eq {}} {
30
after idle dorunq
31
}
32
lappend runq [list {} $script]
33
set isonrunq($script) 1
34
}
35
36
proc filerun {fd script} {
37
fileevent $fd readable [list filereadable $fd $script]
38
}
39
40
proc filereadable {fd script} {
41
global runq
42
43
fileevent $fd readable {}
44
if {$runq eq {}} {
45
after idle dorunq
46
}
47
lappend runq [list $fd $script]
48
}
49
50
proc dorunq {} {
51
global isonrunq runq
52
53
set tstart [clock clicks -milliseconds]
54
set t0 $tstart
55
while {$runq ne {}} {
56
set fd [lindex $runq 0 0]
57
set script [lindex $runq 0 1]
58
set repeat [eval $script]
59
set t1 [clock clicks -milliseconds]
60
set t [expr {$t1 - $t0}]
61
set runq [lrange $runq 1 end]
62
if {$repeat ne {} && $repeat} {
63
if {$fd eq {} || $repeat == 2} {
64
# script returns 1 if it wants to be readded
65
# file readers return 2 if they could do more straight away
66
lappend runq [list $fd $script]
67
} else {
68
fileevent $fd readable [list filereadable $fd $script]
69
}
70
} elseif {$fd eq {}} {
71
unset isonrunq($script)
72
}
73
set t0 $t1
74
if {$t1 - $tstart >= 80} break
75
}
76
if {$runq ne {}} {
77
after idle dorunq
78
}
79
}
80
81
# Start off a git rev-list process and arrange to read its output
19
82
proc start_rev_list {view} {
20
global startmsecs nextupdate
83
global startmsecs
21
84
global commfd leftover tclencoding datemode
22
85
global viewargs viewfiles commitidx
86
global lookingforhead showlocalchanges
23
87
24
88
set startmsecs [clock clicks -milliseconds]
25
set nextupdate [expr {$startmsecs + 100}]
26
89
set commitidx($view) 0
27
set args $viewargs($view)
28
if {$viewfiles($view) ne {}} {
29
set args [concat $args "--" $viewfiles($view)]
30
}
31
90
set order "--topo-order"
32
91
if {$datemode} {
33
92
set order "--date-order"
34
93
}
35
94
if {[catch {
36
set fd [open [concat | git rev-list --header $order \
37
--parents --boundary --default HEAD $args] r]
95
set fd [open [concat | git log -z --pretty=raw $order --parents \
96
--boundary $viewargs($view) "--" $viewfiles($view)] r]
38
97
} err]} {
39
puts stderr "Error executing git rev-list: $err"
98
error_popup "Error executing git rev-list: $err"
40
99
exit 1
41
100
}
42
101
set commfd($view) $fd
43
102
set leftover($view) {}
44
fconfigure $fd -blocking 0 -translation lf
103
set lookingforhead $showlocalchanges
104
fconfigure $fd -blocking 0 -translation lf -eofchar {}
45
105
if {$tclencoding != {}} {
46
106
fconfigure $fd -encoding $tclencoding
47
107
}
48
fileevent $fd readable [list getcommitlines $fd $view]
108
filerun $fd [list getcommitlines $fd $view]
49
109
nowbusy $view
50
110
}
51
111
72
132
}
73
133
74
134
proc getcommitlines {fd view} {
75
global commitlisted nextupdate
135
global commitlisted
76
136
global leftover commfd
77
137
global displayorder commitidx commitrow commitdata
78
global parentlist childlist children curview hlview
79
global vparentlist vchildlist vdisporder vcmitlisted
138
global parentlist children curview hlview
139
global vparentlist vdisporder vcmitlisted
80
140
81
141
set stuff [read $fd 500000]
142
# git log doesn't terminate the last commit with a null...
143
if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
144
set stuff "\0"
145
}
82
146
if {$stuff == {}} {
83
if {![eof $fd]} return
147
if {![eof $fd]} {
148
return 1
149
}
84
150
global viewname
85
151
unset commfd($view)
86
152
notbusy $view
105
171
error_popup $err
106
172
}
107
173
if {$view == $curview} {
108
after idle finishcommits
174
run chewcommits $view
109
175
}
110
return
176
return 0
111
177
}
112
178
set start 0
113
179
set gotsome 0
128
194
set j [string first "\n" $cmit]
129
195
set ok 0
130
196
set listed 1
131
if {$j >= 0} {
132
set ids [string range $cmit 0 [expr {$j - 1}]]
133
if {[string range $ids 0 0] == "-"} {
134
set listed 0
197
if {$j >= 0 && [string match "commit *" $cmit]} {
198
set ids [string range $cmit 7 [expr {$j - 1}]]
199
if {[string match {[-<>]*} $ids]} {
200
switch -- [string index $ids 0] {
201
"-" {set listed 0}
202
"<" {set listed 2}
203
">" {set listed 3}
204
}
135
205
set ids [string range $ids 1 end]
136
206
}
137
207
set ok 1
147
217
if {[string length $shortcmit] > 80} {
148
218
set shortcmit "[string range $shortcmit 0 80]..."
149
219
}
150
error_popup "Can't parse git rev-list output: {$shortcmit}"
220
error_popup "Can't parse git log output: {$shortcmit}"
151
221
exit 1
152
222
}
153
223
set id [lindex $ids 0]
171
241
incr commitidx($view)
172
242
if {$view == $curview} {
173
243
lappend parentlist $olds
174
lappend childlist $children($view,$id)
175
244
lappend displayorder $id
176
245
lappend commitlisted $listed
177
246
} else {
178
247
lappend vparentlist($view) $olds
179
lappend vchildlist($view) $children($view,$id)
180
248
lappend vdisporder($view) $id
181
249
lappend vcmitlisted($view) $listed
182
250
}
183
251
set gotsome 1
184
252
}
185
253
if {$gotsome} {
186
if {$view == $curview} {
187
while {[layoutmore $nextupdate]} doupdate
188
} elseif {[info exists hlview] && $view == $hlview} {
189
vhighlightmore
254
run chewcommits $view
255
}
256
return 2
257
}
258
259
proc chewcommits {view} {
260
global curview hlview commfd
261
global selectedline pending_select
262
263
set more 0
264
if {$view == $curview} {
265
set allread [expr {![info exists commfd($view)]}]
266
set tlimit [expr {[clock clicks -milliseconds] + 50}]
267
set more [layoutmore $tlimit $allread]
268
if {$allread && !$more} {
269
global displayorder commitidx phase
270
global numcommits startmsecs
271
272
if {[info exists pending_select]} {
273
set row [first_real_row]
274
selectline $row 1
275
}
276
if {$commitidx($curview) > 0} {
277
#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
278
#puts "overall $ms ms for $numcommits commits"
279
} else {
280
show_status "No commits selected"
281
}
282
notbusy layout
283
set phase {}
190
284
}
191
285
}
192
if {[clock clicks -milliseconds] >= $nextupdate} {
193
doupdate
194
}
195
}
196
197
proc doupdate {} {
198
global commfd nextupdate numcommits
199
200
foreach v [array names commfd] {
201
fileevent $commfd($v) readable {}
202
}
203
update
204
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
205
foreach v [array names commfd] {
206
set fd $commfd($v)
207
fileevent $fd readable [list getcommitlines $fd $v]
208
}
286
if {[info exists hlview] && $view == $hlview} {
287
vhighlightmore
288
}
289
return $more
209
290
}
210
291
211
292
proc readcommit {id} {
215
296
216
297
proc updatecommits {} {
217
298
global viewdata curview phase displayorder
218
global children commitrow selectedline thickerline
299
global children commitrow selectedline thickerline showneartags
219
300
220
301
if {$phase ne {}} {
221
302
stop_rev_list
230
311
catch {unset selectedline}
231
312
catch {unset thickerline}
232
313
catch {unset viewdata($n)}
233
discardallcommits
234
314
readrefs
315
changedrefs
316
if {$showneartags} {
317
getallcommits
318
}
235
319
showview $n
236
320
}
237
321
263
347
}
264
348
}
265
349
set headline {}
266
# take the first line of the comment as the headline
267
set i [string first "\n" $comment]
268
if {$i >= 0} {
269
set headline [string trim [string range $comment 0 $i]]
270
} else {
271
set headline $comment
350
# take the first non-blank line of the comment as the headline
351
set headline [string trimleft $comment]
352
set i [string first "\n" $headline]
353
if {$i >= 0} {
354
set headline [string range $headline 0 $i]
355
}
356
set headline [string trimright $headline]
357
set i [string first "\r" $headline]
358
if {$i >= 0} {
359
set headline [string trimright [string range $headline 0 $i]]
272
360
}
273
361
if {!$listed} {
274
362
# git rev-list indents the comment by 4 spaces;
303
391
}
304
392
305
393
proc readrefs {} {
306
global tagids idtags headids idheads tagcontents
307
global otherrefids idotherrefs mainhead
394
global tagids idtags headids idheads tagobjid
395
global otherrefids idotherrefs mainhead mainheadid
308
396
309
397
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
310
398
catch {unset $v}
311
399
}
312
set refd [open [list | git ls-remote [gitdir]] r]
313
while {0 <= [set n [gets $refd line]]} {
314
if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
315
match id path]} {
316
continue
317
}
318
if {[regexp {^remotes/.*/HEAD$} $path match]} {
319
continue
320
}
321
if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
322
set type others
323
set name $path
324
}
325
if {[regexp {^remotes/} $path match]} {
326
set type heads
327
}
328
if {$type == "tags"} {
400
set refd [open [list | git show-ref -d] r]
401
while {[gets $refd line] >= 0} {
402
if {[string index $line 40] ne " "} continue
403
set id [string range $line 0 39]
404
set ref [string range $line 41 end]
405
if {![string match "refs/*" $ref]} continue
406
set name [string range $ref 5 end]
407
if {[string match "remotes/*" $name]} {
408
if {![string match "*/HEAD" $name]} {
409
set headids($name) $id
410
lappend idheads($id) $name
411
}
412
} elseif {[string match "heads/*" $name]} {
413
set name [string range $name 6 end]
414
set headids($name) $id
415
lappend idheads($id) $name
416
} elseif {[string match "tags/*" $name]} {
417
# this lets refs/tags/foo^{} overwrite refs/tags/foo,
418
# which is what we want since the former is the commit ID
419
set name [string range $name 5 end]
420
if {[string match "*^{}" $name]} {
421
set name [string range $name 0 end-3]
422
} else {
423
set tagobjid($name) $id
424
}
329
425
set tagids($name) $id
330
426
lappend idtags($id) $name
331
set obj {}
332
set type {}
333
set tag {}
334
catch {
335
set commit [exec git rev-parse "$id^0"]
336
if {$commit != $id} {
337
set tagids($name) $commit
338
lappend idtags($commit) $name
339
}
340
}
341
catch {
342
set tagcontents($name) [exec git cat-file tag $id]
343
}
344
} elseif { $type == "heads" } {
345
set headids($name) $id
346
lappend idheads($id) $name
347
427
} else {
348
428
set otherrefids($name) $id
349
429
lappend idotherrefs($id) $name
350
430
}
351
431
}
352
close $refd
432
catch {close $refd}
353
433
set mainhead {}
434
set mainheadid {}
354
435
catch {
355
436
set thehead [exec git symbolic-ref HEAD]
356
437
if {[string match "refs/heads/*" $thehead]} {
357
438
set mainhead [string range $thehead 11 end]
358
}
359
}
439
if {[info exists headids($mainhead)]} {
440
set mainheadid $headids($mainhead)
441
}
442
}
443
}
444
}
445
446
# skip over fake commits
447
proc first_real_row {} {
448
global nullid nullid2 displayorder numcommits
449
450
for {set row 0} {$row < $numcommits} {incr row} {
451
set id [lindex $displayorder $row]
452
if {$id ne $nullid && $id ne $nullid2} {
453
break
454
}
455
}
456
return $row
457
}
458
459
# update things for a head moved to a child of its previous location
460
proc movehead {id name} {
461
global headids idheads
462
463
removehead $headids($name) $name
464
set headids($name) $id
465
lappend idheads($id) $name
466
}
467
468
# update things when a head has been removed
469
proc removehead {id name} {
470
global headids idheads
471
472
if {$idheads($id) eq $name} {
473
unset idheads($id)
474
} else {
475
set i [lsearch -exact $idheads($id) $name]
476
if {$i >= 0} {
477
set idheads($id) [lreplace $idheads($id) $i $i]
478
}
479
}
480
unset headids($name)
360
481
}
361
482
362
483
proc show_error {w top msg} {
395
516
396
517
proc makewindow {} {
397
518
global canv canv2 canv3 linespc charspc ctext cflist
398
global textfont mainfont uifont
519
global textfont mainfont uifont tabstop
399
520
global findtype findtypemenu findloc findstring fstring geometry
400
521
global entries sha1entry sha1string sha1but
522
global diffcontextstring diffcontext
401
523
global maincursor textcursor curtextcursor
402
global rowctxmenu mergemax wrapcomment
524
global rowctxmenu fakerowmenu mergemax wrapcomment
403
525
global highlight_files gdttype
404
526
global searchstring sstring
405
global bgcolor fgcolor bglist fglist diffcolors
527
global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
406
528
global headctxmenu
407
529
408
530
menu .bar
411
533
menu .bar.file
412
534
.bar.file add command -label "Update" -command updatecommits
413
535
.bar.file add command -label "Reread references" -command rereadrefs
536
.bar.file add command -label "List references" -command showrefs
414
537
.bar.file add command -label "Quit" -command doquit
415
538
.bar.file configure -font $uifont
416
539
menu .bar.edit
427
550
.bar.view add separator
428
551
.bar.view add radiobutton -label "All files" -command {showview 0} \
429
552
-variable selectedview -value 0
430
553
431
554
menu .bar.help
432
555
.bar add cascade -label "Help" -menu .bar.help
433
556
.bar.help add command -label "About gitk" -command about
435
558
.bar.help configure -font $uifont
436
559
. configure -menu .bar
437
560
438
if {![info exists geometry(canv1)]} {
439
set geometry(canv1) [expr {45 * $charspc}]
440
set geometry(canv2) [expr {30 * $charspc}]
441
set geometry(canv3) [expr {15 * $charspc}]
442
set geometry(canvh) [expr {25 * $linespc + 4}]
443
set geometry(ctextw) 80
444
set geometry(ctexth) 30
445
set geometry(cflistw) 30
446
}
561
# the gui has upper and lower half, parts of a paned window.
447
562
panedwindow .ctop -orient vertical
448
if {[info exists geometry(width)]} {
449
.ctop conf -width $geometry(width) -height $geometry(height)
450
set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
451
set geometry(ctexth) [expr {($texth - 8) /
452
[font metrics $textfont -linespace]}]
563
564
# possibly use assumed geometry
565
if {![info exists geometry(pwsash0)]} {
566
set geometry(topheight) [expr {15 * $linespc}]
567
set geometry(topwidth) [expr {80 * $charspc}]
568
set geometry(botheight) [expr {15 * $linespc}]
569
set geometry(botwidth) [expr {50 * $charspc}]
570
set geometry(pwsash0) "[expr {40 * $charspc}] 2"
571
set geometry(pwsash1) "[expr {60 * $charspc}] 2"
453
572
}
454
frame .ctop.top
455
frame .ctop.top.bar
456
frame .ctop.top.lbar
457
pack .ctop.top.lbar -side bottom -fill x
458
pack .ctop.top.bar -side bottom -fill x
459
set cscroll .ctop.top.csb
573
574
# the upper half will have a paned window, a scroll bar to the right, and some stuff below
575
frame .tf -height $geometry(topheight) -width $geometry(topwidth)
576
frame .tf.histframe
577
panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
578
579
# create three canvases
580
set cscroll .tf.histframe.csb
581
set canv .tf.histframe.pwclist.canv
582
canvas $canv \
583
-selectbackground $selectbgcolor \
584
-background $bgcolor -bd 0 \
585
-yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
586
.tf.histframe.pwclist add $canv
587
set canv2 .tf.histframe.pwclist.canv2
588
canvas $canv2 \
589
-selectbackground $selectbgcolor \
590
-background $bgcolor -bd 0 -yscrollincr $linespc
591
.tf.histframe.pwclist add $canv2
592
set canv3 .tf.histframe.pwclist.canv3
593
canvas $canv3 \
594
-selectbackground $selectbgcolor \
595
-background $bgcolor -bd 0 -yscrollincr $linespc
596
.tf.histframe.pwclist add $canv3
597
eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
598
eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
599
600
# a scroll bar to rule them
460
601
scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
461
602
pack $cscroll -side right -fill y
462
panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
463
pack .ctop.top.clist -side top -fill both -expand 1
464
.ctop add .ctop.top
465
set canv .ctop.top.clist.canv
466
canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
467
-background $bgcolor -bd 0 \
468
-yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
469
.ctop.top.clist add $canv
470
set canv2 .ctop.top.clist.canv2
471
canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
472
-background $bgcolor -bd 0 -yscrollincr $linespc
473
.ctop.top.clist add $canv2
474
set canv3 .ctop.top.clist.canv3
475
canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
476
-background $bgcolor -bd 0 -yscrollincr $linespc
477
.ctop.top.clist add $canv3
478
bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
603
bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
479
604
lappend bglist $canv $canv2 $canv3
480
481
set sha1entry .ctop.top.bar.sha1
605
pack .tf.histframe.pwclist -fill both -expand 1 -side left
606
607
# we have two button bars at bottom of top frame. Bar 1
608
frame .tf.bar
609
frame .tf.lbar -height 15
610
611
set sha1entry .tf.bar.sha1
482
612
set entries $sha1entry
483
set sha1but .ctop.top.bar.sha1label
613
set sha1but .tf.bar.sha1label
484
614
button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
485
615
-command gotocommit -width 8 -font $uifont
486
616
$sha1but conf -disabledforeground [$sha1but cget -foreground]
487
pack .ctop.top.bar.sha1label -side left
617
pack .tf.bar.sha1label -side left
488
618
entry $sha1entry -width 40 -font $textfont -textvariable sha1string
489
619
trace add variable sha1string write sha1change
490
620
pack $sha1entry -side left -pady 2
505
635
0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
506
636
0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
507
637
}
508
button .ctop.top.bar.leftbut -image bm-left -command goback \
509
-state disabled -width 26
510
pack .ctop.top.bar.leftbut -side left -fill y
511
button .ctop.top.bar.rightbut -image bm-right -command goforw \
512
-state disabled -width 26
513
pack .ctop.top.bar.rightbut -side left -fill y
638
button .tf.bar.leftbut -image bm-left -command goback \
639
-state disabled -width 26
640
pack .tf.bar.leftbut -side left -fill y
641
button .tf.bar.rightbut -image bm-right -command goforw \
642
-state disabled -width 26
643
pack .tf.bar.rightbut -side left -fill y
514
644
515
button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
516
pack .ctop.top.bar.findbut -side left
645
button .tf.bar.findbut -text "Find" -command dofind -font $uifont
646
pack .tf.bar.findbut -side left
517
647
set findstring {}
518
set fstring .ctop.top.bar.findstring
648
set fstring .tf.bar.findstring
519
649
lappend entries $fstring
520
650
entry $fstring -width 30 -font $textfont -textvariable findstring
521
651
trace add variable findstring write find_change
522
pack $fstring -side left -expand 1 -fill x
652
pack $fstring -side left -expand 1 -fill x -in .tf.bar
523
653
set findtype Exact
524
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
525
findtype Exact IgnCase Regexp]
654
set findtypemenu [tk_optionMenu .tf.bar.findtype \
655
findtype Exact IgnCase Regexp]
526
656
trace add variable findtype write find_change
527
.ctop.top.bar.findtype configure -font $uifont
528
.ctop.top.bar.findtype.menu configure -font $uifont
657
.tf.bar.findtype configure -font $uifont
658
.tf.bar.findtype.menu configure -font $uifont
529
659
set findloc "All fields"
530
tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
660
tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
531
661
Comments Author Committer
532
662
trace add variable findloc write find_change
533
.ctop.top.bar.findloc configure -font $uifont
534
.ctop.top.bar.findloc.menu configure -font $uifont
535
pack .ctop.top.bar.findloc -side right
536
pack .ctop.top.bar.findtype -side right
663
.tf.bar.findloc configure -font $uifont
664
.tf.bar.findloc.menu configure -font $uifont
665
pack .tf.bar.findloc -side right
666
pack .tf.bar.findtype -side right
537
667
538
label .ctop.top.lbar.flabel -text "Highlight: Commits " \
539
-font $uifont
540
pack .ctop.top.lbar.flabel -side left -fill y
668
# build up the bottom bar of upper window
669
label .tf.lbar.flabel -text "Highlight: Commits " \
670
-font $uifont
671
pack .tf.lbar.flabel -side left -fill y
541
672
set gdttype "touching paths:"
542
set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
543
"adding/removing string:"]
673
set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
674
"adding/removing string:"]
544
675
trace add variable gdttype write hfiles_change
545
676
$gm conf -font $uifont
546
.ctop.top.lbar.gdttype conf -font $uifont
547
pack .ctop.top.lbar.gdttype -side left -fill y
548
entry .ctop.top.lbar.fent -width 25 -font $textfont \
677
.tf.lbar.gdttype conf -font $uifont
678
pack .tf.lbar.gdttype -side left -fill y
679
entry .tf.lbar.fent -width 25 -font $textfont \
549
680
-textvariable highlight_files
550
681
trace add variable highlight_files write hfiles_change
551
lappend entries .ctop.top.lbar.fent
552
pack .ctop.top.lbar.fent -side left -fill x -expand 1
553
label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
554
pack .ctop.top.lbar.vlabel -side left -fill y
682
lappend entries .tf.lbar.fent
683
pack .tf.lbar.fent -side left -fill x -expand 1
684
label .tf.lbar.vlabel -text " OR in view" -font $uifont
685
pack .tf.lbar.vlabel -side left -fill y
555
686
global viewhlmenu selectedhlview
556
set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
557
$viewhlmenu entryconf 0 -command delvhighlight
687
set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
688
$viewhlmenu entryconf None -command delvhighlight
558
689
$viewhlmenu conf -font $uifont
559
.ctop.top.lbar.vhl conf -font $uifont
560
pack .ctop.top.lbar.vhl -side left -fill y
561
label .ctop.top.lbar.rlabel -text " OR " -font $uifont
562
pack .ctop.top.lbar.rlabel -side left -fill y
690
.tf.lbar.vhl conf -font $uifont
691
pack .tf.lbar.vhl -side left -fill y
692
label .tf.lbar.rlabel -text " OR " -font $uifont
693
pack .tf.lbar.rlabel -side left -fill y
563
694
global highlight_related
564
set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
565
"Descendent" "Not descendent" "Ancestor" "Not ancestor"]
695
set m [tk_optionMenu .tf.lbar.relm highlight_related None \
696
"Descendent" "Not descendent" "Ancestor" "Not ancestor"]
566
697
$m conf -font $uifont
567
.ctop.top.lbar.relm conf -font $uifont
698
.tf.lbar.relm conf -font $uifont
568
699
trace add variable highlight_related write vrel_change
569
pack .ctop.top.lbar.relm -side left -fill y
570
571
panedwindow .ctop.cdet -orient horizontal
572
.ctop add .ctop.cdet
573
frame .ctop.cdet.left
574
frame .ctop.cdet.left.bot
575
pack .ctop.cdet.left.bot -side bottom -fill x
576
button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
700
pack .tf.lbar.relm -side left -fill y
701
702
# Finish putting the upper half of the viewer together
703
pack .tf.lbar -in .tf -side bottom -fill x
704
pack .tf.bar -in .tf -side bottom -fill x
705
pack .tf.histframe -fill both -side top -expand 1
706
.ctop add .tf
707
.ctop paneconfigure .tf -height $geometry(topheight)
708
.ctop paneconfigure .tf -width $geometry(topwidth)
709
710
# now build up the bottom
711
panedwindow .pwbottom -orient horizontal
712
713
# lower left, a text box over search bar, scroll bar to the right
714
# if we know window height, then that will set the lower text height, otherwise
715
# we set lower text height which will drive window height
716
if {[info exists geometry(main)]} {
717
frame .bleft -width $geometry(botwidth)
718
} else {
719
frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
720
}
721
frame .bleft.top
722
frame .bleft.mid
723
724
button .bleft.top.search -text "Search" -command dosearch \
577
725
-font $uifont
578
pack .ctop.cdet.left.bot.search -side left -padx 5
579
set sstring .ctop.cdet.left.bot.sstring
726
pack .bleft.top.search -side left -padx 5
727
set sstring .bleft.top.sstring
580
728
entry $sstring -width 20 -font $textfont -textvariable searchstring
581
729
lappend entries $sstring
582
730
trace add variable searchstring write incrsearch
583
731
pack $sstring -side left -expand 1 -fill x
584
set ctext .ctop.cdet.left.ctext
732
radiobutton .bleft.mid.diff -text "Diff" \
733
-command changediffdisp -variable diffelide -value {0 0}
734
radiobutton .bleft.mid.old -text "Old version" \
735
-command changediffdisp -variable diffelide -value {0 1}
736
radiobutton .bleft.mid.new -text "New version" \
737
-command changediffdisp -variable diffelide -value {1 0}
738
label .bleft.mid.labeldiffcontext -text " Lines of context: " \
739
-font $uifont
740
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
741
spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
742
-from 1 -increment 1 -to 10000000 \
743
-validate all -validatecommand "diffcontextvalidate %P" \
744
-textvariable diffcontextstring
745
.bleft.mid.diffcontext set $diffcontext
746
trace add variable diffcontextstring write diffcontextchange
747
lappend entries .bleft.mid.diffcontext
748
pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
749
set ctext .bleft.ctext
585
750
text $ctext -background $bgcolor -foreground $fgcolor \
751
-tabs "[expr {$tabstop * $charspc}]" \
586
752
-state disabled -font $textfont \
587
-width $geometry(ctextw) -height $geometry(ctexth) \
588
753
-yscrollcommand scrolltext -wrap none
589
scrollbar .ctop.cdet.left.sb -command "$ctext yview"
590
pack .ctop.cdet.left.sb -side right -fill y
754
scrollbar .bleft.sb -command "$ctext yview"
755
pack .bleft.top -side top -fill x
756
pack .bleft.mid -side top -fill x
757
pack .bleft.sb -side right -fill y
591
758
pack $ctext -side left -fill both -expand 1
592
.ctop.cdet add .ctop.cdet.left
593
759
lappend bglist $ctext
594
760
lappend fglist $ctext
595
761
620
786
$ctext tag conf msep -font [concat $textfont bold]
621
787
$ctext tag conf found -back yellow
622
788
623
frame .ctop.cdet.right
624
frame .ctop.cdet.right.mode
625
radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
789
.pwbottom add .bleft
790
.pwbottom paneconfigure .bleft -width $geometry(botwidth)
791
792
# lower right
793
frame .bright
794
frame .bright.mode
795
radiobutton .bright.mode.patch -text "Patch" \
626
796
-command reselectline -variable cmitmode -value "patch"
627
radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
797
.bright.mode.patch configure -font $uifont
798
radiobutton .bright.mode.tree -text "Tree" \
628
799
-command reselectline -variable cmitmode -value "tree"
629
grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
630
pack .ctop.cdet.right.mode -side top -fill x
631
set cflist .ctop.cdet.right.cfiles
800
.bright.mode.tree configure -font $uifont
801
grid .bright.mode.patch .bright.mode.tree -sticky ew
802
pack .bright.mode -side top -fill x
803
set cflist .bright.cfiles
632
804
set indent [font measure $mainfont "nn"]
633
text $cflist -width $geometry(cflistw) \
805
text $cflist \
806
-selectbackground $selectbgcolor \
634
807
-background $bgcolor -foreground $fgcolor \
635
808
-font $mainfont \
636
809
-tabs [list $indent [expr {2 * $indent}]] \
637
-yscrollcommand ".ctop.cdet.right.sb set" \
810
-yscrollcommand ".bright.sb set" \
638
811
-cursor [. cget -cursor] \
639
812
-spacing1 1 -spacing3 1
640
813
lappend bglist $cflist
641
814
lappend fglist $cflist
642
scrollbar .ctop.cdet.right.sb -command "$cflist yview"
643
pack .ctop.cdet.right.sb -side right -fill y
815
scrollbar .bright.sb -command "$cflist yview"
816
pack .bright.sb -side right -fill y
644
817
pack $cflist -side left -fill both -expand 1
645
818
$cflist tag configure highlight \
646
819
-background [$cflist cget -selectbackground]
647
820
$cflist tag configure bold -font [concat $mainfont bold]
648
.ctop.cdet add .ctop.cdet.right
649
bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
650
651
pack .ctop -side top -fill both -expand 1
652
821
822
.pwbottom add .bright
823
.ctop add .pwbottom
824
825
# restore window position if known
826
if {[info exists geometry(main)]} {
827
wm geometry . "$geometry(main)"
828
}
829
830
if {[tk windowingsystem] eq {aqua}} {
831
set M1B M1
832
} else {
833
set M1B Control
834
}
835
836
bind .pwbottom <Configure> {resizecdetpanes %W %w}
837
pack .ctop -fill both -expand 1
653
838
bindall <1> {selcanvline %W %x %y}
654
839
#bindall <B1-Motion> {selcanvline %W %x %y}
655
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
656
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
840
if {[tk windowingsystem] == "win32"} {
841
bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
842
bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
843
} else {
844
bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
845
bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
846
}
657
847
bindall <2> "canvscan mark %W %x %y"
658
848
bindall <B2-Motion> "canvscan dragto %W %x %y"
659
849
bindkey <Home> selfirstline
666
856
bindkey <Key-Left> "goback"
667
857
bind . <Key-Prior> "selnextpage -1"
668
858
bind . <Key-Next> "selnextpage 1"
669
bind . <Control-Home> "allcanvs yview moveto 0.0"
670
bind . <Control-End> "allcanvs yview moveto 1.0"
671
bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
672
bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
673
bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
674
bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
859
bind . <$M1B-Home> "allcanvs yview moveto 0.0"
860
bind . <$M1B-End> "allcanvs yview moveto 1.0"
861
bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
862
bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
863
bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
864
bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
675
865
bindkey <Key-Delete> "$ctext yview scroll -1 pages"
676
866
bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
677
867
bindkey <Key-space> "$ctext yview scroll 1 pages"
690
880
bindkey <Key-Return> {findnext 0}
691
881
bindkey ? findprev
692
882
bindkey f nextfile
693
bind . <Control-q> doquit
694
bind . <Control-f> dofind
695
bind . <Control-g> {findnext 0}
696
bind . <Control-r> dosearchback
697
bind . <Control-s> dosearch
698
bind . <Control-equal> {incrfont 1}
699
bind . <Control-KP_Add> {incrfont 1}
700
bind . <Control-minus> {incrfont -1}
701
bind . <Control-KP_Subtract> {incrfont -1}
702
bind . <Destroy> {savestuff %W}
883
bindkey <F5> updatecommits
884
bind . <$M1B-q> doquit
885
bind . <$M1B-f> dofind
886
bind . <$M1B-g> {findnext 0}
887
bind . <$M1B-r> dosearchback
888
bind . <$M1B-s> dosearch
889
bind . <$M1B-equal> {incrfont 1}
890
bind . <$M1B-KP_Add> {incrfont 1}
891
bind . <$M1B-minus> {incrfont -1}
892
bind . <$M1B-KP_Subtract> {incrfont -1}
893
wm protocol . WM_DELETE_WINDOW doquit
703
894
bind . <Button-1> "click %W"
704
895
bind $fstring <Key-Return> dofind
705
896
bind $sha1entry <Key-Return> gotocommit
707
898
bind $cflist <1> {sel_flist %W %x %y; break}
708
899
bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
709
900
bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
901
bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
710
902
711
903
set maincursor [. cget -cursor]
712
904
set textcursor [$ctext cget -cursor]
724
916
$rowctxmenu add command -label "Create new branch" -command mkbranch
725
917
$rowctxmenu add command -label "Cherry-pick this commit" \
726
918
-command cherrypick
919
$rowctxmenu add command -label "Reset HEAD branch to here" \
920
-command resethead
921
922
set fakerowmenu .fakerowmenu
923
menu $fakerowmenu -tearoff 0
924
$fakerowmenu add command -label "Diff this -> selected" \
925
-command {diffvssel 0}
926
$fakerowmenu add command -label "Diff selected -> this" \
927
-command {diffvssel 1}
928
$fakerowmenu add command -label "Make patch" -command mkpatch
929
# $fakerowmenu add command -label "Commit" -command {mkcommit 0}
930
# $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
931
# $fakerowmenu add command -label "Revert local changes" -command revertlocal
727
932
728
933
set headctxmenu .headctxmenu
729
934
menu $headctxmenu -tearoff 0
731
936
-command cobranch
732
937
$headctxmenu add command -label "Remove this branch" \
733
938
-command rmbranch
939
940
global flist_menu
941
set flist_menu .flistctxmenu
942
menu $flist_menu -tearoff 0
943
$flist_menu add command -label "Highlight this too" \
944
-command {flist_hl 0}
945
$flist_menu add command -label "Highlight this only" \
946
-command {flist_hl 1}
947
}
948
949
# Windows sends all mouse wheel events to the current focused window, not
950
# the one where the mouse hovers, so bind those events here and redirect
951
# to the correct window
952
proc windows_mousewheel_redirector {W X Y D} {
953
global canv canv2 canv3
954
set w [winfo containing -displayof $W $X $Y]
955
if {$w ne ""} {
956
set u [expr {$D < 0 ? 5 : -5}]
957
if {$w == $canv || $w == $canv2 || $w == $canv3} {
958
allcanvs yview scroll $u units
959
} else {
960
catch {
961
$w yview scroll $u units
962
}
963
}
964
}
734
965
}
735
966
736
967
# mouse-2 makes all windows scan vertically, but only the one
770
1001
# set the focus back to the toplevel for any click outside
771
1002
# the entry widgets
772
1003
proc click {w} {
773
global entries
774
foreach e $entries {
1004
global ctext entries
1005
foreach e [concat $entries $ctext] {
775
1006
if {$w == $e} return
776
1007
}
777
1008
focus .
778
1009
}
779
1010
780
1011
proc savestuff {w} {
781
global canv canv2 canv3 ctext cflist mainfont textfont uifont
1012
global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
782
1013
global stuffsaved findmergefiles maxgraphpct
783
global maxwidth showneartags
1014
global maxwidth showneartags showlocalchanges
784
1015
global viewname viewfiles viewargs viewperm nextviewnum
785
global cmitmode wrapcomment
786
global colors bgcolor fgcolor diffcolors
1016
global cmitmode wrapcomment datetimeformat
1017
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
787
1018
788
1019
if {$stuffsaved} return
789
1020
if {![winfo viewable .]} return
792
1023
puts $f [list set mainfont $mainfont]
793
1024
puts $f [list set textfont $textfont]
794
1025
puts $f [list set uifont $uifont]
1026
puts $f [list set tabstop $tabstop]
795
1027
puts $f [list set findmergefiles $findmergefiles]
796
1028
puts $f [list set maxgraphpct $maxgraphpct]
797
1029
puts $f [list set maxwidth $maxwidth]
798
1030
puts $f [list set cmitmode $cmitmode]
799
1031
puts $f [list set wrapcomment $wrapcomment]
800
1032
puts $f [list set showneartags $showneartags]
1033
puts $f [list set showlocalchanges $showlocalchanges]
1034
puts $f [list set datetimeformat $datetimeformat]
801
1035
puts $f [list set bgcolor $bgcolor]
802
1036
puts $f [list set fgcolor $fgcolor]
803
1037
puts $f [list set colors $colors]
804
1038
puts $f [list set diffcolors $diffcolors]
805
puts $f "set geometry(width) [winfo width .ctop]"
806
puts $f "set geometry(height) [winfo height .ctop]"
807
puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
808
puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
809
puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
810
puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
811
set wid [expr {([winfo width $ctext] - 8) \
812
/ [font measure $textfont "0"]}]
813
puts $f "set geometry(ctextw) $wid"
814
set wid [expr {([winfo width $cflist] - 11) \
815
/ [font measure [$cflist cget -font] "0"]}]
816
puts $f "set geometry(cflistw) $wid"
1039
puts $f [list set diffcontext $diffcontext]
1040
puts $f [list set selectbgcolor $selectbgcolor]
1041
1042
puts $f "set geometry(main) [wm geometry .]"
1043
puts $f "set geometry(topwidth) [winfo width .tf]"
1044
puts $f "set geometry(topheight) [winfo height .tf]"
1045
puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1046
puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1047
puts $f "set geometry(botwidth) [winfo width .bleft]"
1048
puts $f "set geometry(botheight) [winfo height .bleft]"
1049
817
1050
puts -nonewline $f "set permviews {"
818
1051
for {set v 0} {$v < $nextviewnum} {incr v} {
819
1052
if {$viewperm($v)} {
894
1127
}
895
1128
896
1129
proc about {} {
1130
global uifont
897
1131
set w .about
898
1132
if {[winfo exists $w]} {
899
1133
raise $w
907
1141
Copyright � 2005-2006 Paul Mackerras
908
1142
909
1143
Use and redistribute under the terms of the GNU General Public License} \
910
-justify center -aspect 400
911
pack $w.m -side top -fill x -padx 20 -pady 20
912
button $w.ok -text Close -command "destroy $w"
1144
-justify center -aspect 400 -border 2 -bg white -relief groove
1145
pack $w.m -side top -fill x -padx 2 -pady 2
1146
$w.m configure -font $uifont
1147
button $w.ok -text Close -command "destroy $w" -default active
913
1148
pack $w.ok -side bottom
1149
$w.ok configure -font $uifont
1150
bind $w <Visibility> "focus $w.ok"
1151
bind $w <Key-Escape> "destroy $w"
1152
bind $w <Key-Return> "destroy $w"
914
1153
}
915
1154
916
1155
proc keys {} {
1156
global uifont
917
1157
set w .keys
918
1158
if {[winfo exists $w]} {
919
1159
raise $w
920
1160
return
921
1161
}
1162
if {[tk windowingsystem] eq {aqua}} {
1163
set M1T Cmd
1164
} else {
1165
set M1T Ctrl
1166
}
922
1167
toplevel $w
923
1168
wm title $w "Gitk key bindings"
924
message $w.m -text {
1169
message $w.m -text "
925
1170
Gitk key bindings:
926
1171
927
<Ctrl-Q> Quit
1172
<$M1T-Q> Quit
928
1173
<Home> Move to first commit
929
1174
<End> Move to last commit
930
1175
<Up>, p, i Move up one commit
933
1178
<Right>, x, l Go forward in history list
934
1179
<PageUp> Move up one page in commit list
935
1180
<PageDown> Move down one page in commit list
936
<Ctrl-Home> Scroll to top of commit list
937
<Ctrl-End> Scroll to bottom of commit list
938
<Ctrl-Up> Scroll commit list up one line
939
<Ctrl-Down> Scroll commit list down one line
940
<Ctrl-PageUp> Scroll commit list up one page
941
<Ctrl-PageDown> Scroll commit list down one page
1181
<$M1T-Home> Scroll to top of commit list
1182
<$M1T-End> Scroll to bottom of commit list
1183
<$M1T-Up> Scroll commit list up one line
1184
<$M1T-Down> Scroll commit list down one line
1185
<$M1T-PageUp> Scroll commit list up one page
1186
<$M1T-PageDown> Scroll commit list down one page
942
1187
<Shift-Up> Move to previous highlighted line
943
1188
<Shift-Down> Move to next highlighted line
944
1189
<Delete>, b Scroll diff view up one page
946
1191
<Space> Scroll diff view down one page
947
1192
u Scroll diff view up 18 lines
948
1193
d Scroll diff view down 18 lines
949
<Ctrl-F> Find
950
<Ctrl-G> Move to next find hit
1194
<$M1T-F> Find
1195
<$M1T-G> Move to next find hit
951
1196
<Return> Move to next find hit
952
1197
/ Move to next find hit, or redo find
953
1198
? Move to previous find hit
954
1199
f Scroll diff view to next file
955
<Ctrl-S> Search for next hit in diff view
956
<Ctrl-R> Search for previous hit in diff view
957
<Ctrl-KP+> Increase font size
958
<Ctrl-plus> Increase font size
959
<Ctrl-KP-> Decrease font size
960
<Ctrl-minus> Decrease font size
961
} \
962
-justify left -bg white -border 2 -relief sunken
963
pack $w.m -side top -fill both
964
button $w.ok -text Close -command "destroy $w"
1200
<$M1T-S> Search for next hit in diff view
1201
<$M1T-R> Search for previous hit in diff view
1202
<$M1T-KP+> Increase font size
1203
<$M1T-plus> Increase font size
1204
<$M1T-KP-> Decrease font size
1205
<$M1T-minus> Decrease font size
1206
<F5> Update
1207
" \
1208
-justify left -bg white -border 2 -relief groove
1209
pack $w.m -side top -fill both -padx 2 -pady 2
1210
$w.m configure -font $uifont
1211
button $w.ok -text Close -command "destroy $w" -default active
965
1212
pack $w.ok -side bottom
1213
$w.ok configure -font $uifont
1214
bind $w <Visibility> "focus $w.ok"
1215
bind $w <Key-Escape> "destroy $w"
1216
bind $w <Key-Return> "destroy $w"
966
1217
}
967
1218
968
1219
# Procedures for manipulating the file list window at the
1041
1292
set treeheight($prefix) $ht
1042
1293
incr ht [lindex $htstack end]
1043
1294
set htstack [lreplace $htstack end end]
1295
set prefixend [lindex $prefendstack end]
1296
set prefendstack [lreplace $prefendstack end end]
1297
set prefix [string range $prefix 0 $prefixend]
1044
1298
}
1045
1299
$w conf -state disabled
1046
1300
}
1213
1467
0x00, 0x00};
1214
1468
}
1215
1469
1470
image create bitmap reficon-T -background black -foreground yellow -data {
1471
#define tagicon_width 13
1472
#define tagicon_height 9
1473
static unsigned char tagicon_bits[] = {
1474
0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1475
0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1476
} -maskdata {
1477
#define tagicon-mask_width 13
1478
#define tagicon-mask_height 9
1479
static unsigned char tagicon-mask_bits[] = {
1480
0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1481
0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1482
}
1483
set rectdata {
1484
#define headicon_width 13
1485
#define headicon_height 9
1486
static unsigned char headicon_bits[] = {
1487
0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1488
0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1489
}
1490
set rectmask {
1491
#define headicon-mask_width 13
1492
#define headicon-mask_height 9
1493
static unsigned char headicon-mask_bits[] = {
1494
0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1495
0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1496
}
1497
image create bitmap reficon-H -background black -foreground green \
1498
-data $rectdata -maskdata $rectmask
1499
image create bitmap reficon-o -background black -foreground "#ddddff" \
1500
-data $rectdata -maskdata $rectmask
1501
1216
1502
proc init_flist {first} {
1217
1503
global cflist cflist_top selectedline difffilestart
1218
1504
1293
1579
}
1294
1580
}
1295
1581
1582
proc pop_flist_menu {w X Y x y} {
1583
global ctext cflist cmitmode flist_menu flist_menu_file
1584
global treediffs diffids
1585
1586
set l [lindex [split [$w index "@$x,$y"] "."] 0]
1587
if {$l <= 1} return
1588
if {$cmitmode eq "tree"} {
1589
set e [linetoelt $l]
1590
if {[string index $e end] eq "/"} return
1591
} else {
1592
set e [lindex $treediffs($diffids) [expr {$l-2}]]
1593
}
1594
set flist_menu_file $e
1595
tk_popup $flist_menu $X $Y
1596
}
1597
1598
proc flist_hl {only} {
1599
global flist_menu_file highlight_files
1600
1601
set x [shellquote $flist_menu_file]
1602
if {$only || $highlight_files eq {}} {
1603
set highlight_files $x
1604
} else {
1605
append highlight_files " " $x
1606
}
1607
}
1608
1296
1609
# Functions for adding and removing shell-type quoting
1297
1610
1298
1611
proc shellquote {str} {
1402
1715
set newviewname($nextviewnum) "View $nextviewnum"
1403
1716
set newviewperm($nextviewnum) 0
1404
1717
set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1405
vieweditor $top $nextviewnum "Gitk view definition"
1718
vieweditor $top $nextviewnum "Gitk view definition"
1406
1719
}
1407
1720
1408
1721
proc editview {} {
1428
1741
toplevel $top
1429
1742
wm title $top $title
1430
1743
label $top.nl -text "Name" -font $uifont
1431
entry $top.name -width 20 -textvariable newviewname($n)
1744
entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1432
1745
grid $top.nl $top.name -sticky w -pady 5
1433
checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1746
checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1747
-font $uifont
1434
1748
grid $top.perm - -pady 5 -sticky w
1435
1749
message $top.al -aspect 1000 -font $uifont \
1436
1750
-text "Commits to include (arguments to git rev-list):"
1437
1751
grid $top.al - -sticky w -pady 5
1438
1752
entry $top.args -width 50 -textvariable newviewargs($n) \
1439
-background white
1753
-background white -font $uifont
1440
1754
grid $top.args - -sticky ew -padx 5
1441
1755
message $top.l -aspect 1000 -font $uifont \
1442
1756
-text "Enter files and directories to include, one per line:"
1443
1757
grid $top.l - -sticky w
1444
text $top.t -width 40 -height 10 -background white
1758
text $top.t -width 40 -height 10 -background white -font $uifont
1445
1759
if {[info exists viewfiles($n)]} {
1446
1760
foreach f $viewfiles($n) {
1447
1761
$top.t insert end $f
1452
1766
}
1453
1767
grid $top.t - -sticky ew -padx 5
1454
1768
frame $top.buts
1455
button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1456
button $top.buts.can -text "Cancel" -command [list destroy $top]
1769
button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1770
-font $uifont
1771
button $top.buts.can -text "Cancel" -command [list destroy $top] \
1772
-font $uifont
1457
1773
grid $top.buts.ok $top.buts.can
1458
1774
grid columnconfigure $top.buts 0 -weight 1 -uniform a
1459
1775
grid columnconfigure $top.buts 1 -weight 1 -uniform a
1474
1790
proc allviewmenus {n op args} {
1475
1791
global viewhlmenu
1476
1792
1477
doviewmenu .bar.view 7 [list showview $n] $op $args
1793
doviewmenu .bar.view 5 [list showview $n] $op $args
1478
1794
doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1479
1795
}
1480
1796
1507
1823
set viewargs($n) $newargs
1508
1824
addviewmenu $n
1509
1825
if {!$newishighlight} {
1510
after idle showview $n
1826
run showview $n
1511
1827
} else {
1512
after idle addvhighlight $n
1828
run addvhighlight $n
1513
1829
}
1514
1830
} else {
1515
1831
# editing an existing view
1516
1832
set viewperm($n) $newviewperm($n)
1517
1833
if {$newviewname($n) ne $viewname($n)} {
1518
1834
set viewname($n) $newviewname($n)
1519
doviewmenu .bar.view 7 [list showview $n] \
1835
doviewmenu .bar.view 5 [list showview $n] \
1520
1836
entryconf [list -label $viewname($n)]
1521
1837
doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1522
1838
entryconf [list -label $viewname($n) -value $viewname($n)]
1525
1841
set viewfiles($n) $files
1526
1842
set viewargs($n) $newargs
1527
1843
if {$curview == $n} {
1528
after idle updatecommits
1844
run updatecommits
1529
1845
}
1530
1846
}
1531
1847
}
1576
1892
1577
1893
proc showview {n} {
1578
1894
global curview viewdata viewfiles
1579
global displayorder parentlist childlist rowidlist rowoffsets
1895
global displayorder parentlist rowidlist rowoffsets
1580
1896
global colormap rowtextx commitrow nextcolor canvxmax
1581
global numcommits rowrangelist commitlisted idrowranges
1897
global numcommits rowrangelist commitlisted idrowranges rowchk
1582
1898
global selectedline currentid canv canvy0
1583
global matchinglines treediffs
1899
global treediffs
1584
1900
global pending_select phase
1585
global commitidx rowlaidout rowoptim linesegends
1586
global commfd nextupdate
1587
global selectedview
1588
global vparentlist vchildlist vdisporder vcmitlisted
1901
global commitidx rowlaidout rowoptim
1902
global commfd
1903
global selectedview selectfirst
1904
global vparentlist vdisporder vcmitlisted
1589
1905
global hlview selectedhlview
1590
1906
1591
1907
if {$n == $curview} return
1602
1918
} else {
1603
1919
set yscreen [expr {($ybot - $ytop) / 2}]
1604
1920
}
1921
} elseif {[info exists pending_select]} {
1922
set selid $pending_select
1923
unset pending_select
1605
1924
}
1606
1925
unselectline
1607
1926
normalline
1608
stopfindproc
1609
1927
if {$curview >= 0} {
1610
1928
set vparentlist($curview) $parentlist
1611
set vchildlist($curview) $childlist
1612
1929
set vdisporder($curview) $displayorder
1613
1930
set vcmitlisted($curview) $commitlisted
1614
1931
if {$phase ne {}} {
1615
1932
set viewdata($curview) \
1616
1933
[list $phase $rowidlist $rowoffsets $rowrangelist \
1617
1934
[flatten idrowranges] [flatten idinlist] \
1618
$rowlaidout $rowoptim $numcommits $linesegends]
1935
$rowlaidout $rowoptim $numcommits]
1619
1936
} elseif {![info exists viewdata($curview)]
1620
1937
|| [lindex $viewdata($curview) 0] ne {}} {
1621
1938
set viewdata($curview) \
1622
1939
[list {} $rowidlist $rowoffsets $rowrangelist]
1623
1940
}
1624
1941
}
1625
catch {unset matchinglines}
1626
1942
catch {unset treediffs}
1627
1943
clear_display
1628
1944
if {[info exists hlview] && $hlview == $n} {
1632
1948
1633
1949
set curview $n
1634
1950
set selectedview $n
1635
.bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1636
.bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1951
.bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1952
.bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1637
1953
1638
1954
if {![info exists viewdata($n)]} {
1639
set pending_select $selid
1955
if {$selid ne {}} {
1956
set pending_select $selid
1957
}
1640
1958
getcommits
1641
1959
return
1642
1960
}
1645
1963
set phase [lindex $v 0]
1646
1964
set displayorder $vdisporder($n)
1647
1965
set parentlist $vparentlist($n)
1648
set childlist $vchildlist($n)
1649
1966
set commitlisted $vcmitlisted($n)
1650
1967
set rowidlist [lindex $v 1]
1651
1968
set rowoffsets [lindex $v 2]
1659
1976
set rowlaidout [lindex $v 6]
1660
1977
set rowoptim [lindex $v 7]
1661
1978
set numcommits [lindex $v 8]
1662
set linesegends [lindex $v 9]
1979
catch {unset rowchk}
1663
1980
}
1664
1981
1665
1982
catch {unset colormap}
1670
1987
set row 0
1671
1988
setcanvscroll
1672
1989
set yf 0
1673
set row 0
1990
set row {}
1991
set selectfirst 0
1674
1992
if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1675
1993
set row $commitrow($n,$selid)
1676
1994
# try to get the selected row in the same position on the screen
1683
2001
}
1684
2002
allcanvs yview moveto $yf
1685
2003
drawvisible
1686
selectline $row 0
2004
if {$row ne {}} {
2005
selectline $row 0
2006
} elseif {$selid ne {}} {
2007
set pending_select $selid
2008
} else {
2009
set row [first_real_row]
2010
if {$row < $numcommits} {
2011
selectline $row 0
2012
} else {
2013
set selectfirst 1
2014
}
2015
}
1687
2016
if {$phase ne {}} {
1688
2017
if {$phase eq "getcommits"} {
1689
2018
show_status "Reading commits..."
1690
2019
}
1691
if {[info exists commfd($n)]} {
1692
layoutmore {}
1693
} else {
1694
finishcommits
1695
}
2020
run chewcommits $n
1696
2021
} elseif {$numcommits == 0} {
1697
2022
show_status "No commits selected"
1698
2023
}
2024
run refill_reflist
1699
2025
}
1700
2026
1701
2027
# Stuff relating to the highlighting facility
1770
2096
if {$n != $curview && ![info exists viewdata($n)]} {
1771
2097
set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1772
2098
set vparentlist($n) {}
1773
set vchildlist($n) {}
1774
2099
set vdisporder($n) {}
1775
2100
set vcmitlisted($n) {}
1776
2101
start_rev_list $n
1877
2202
} else {
1878
2203
set gdtargs [list "-S$highlight_files"]
1879
2204
}
1880
set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
2205
set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
1881
2206
set filehighlight [open $cmd r+]
1882
2207
fconfigure $filehighlight -blocking 0
1883
fileevent $filehighlight readable readfhighlight
2208
filerun $filehighlight readfhighlight
1884
2209
set fhl_list {}
1885
2210
drawvisible
1886
2211
flushhighlights
1908
2233
global filehighlight fhighlights commitrow curview mainfont iddrawn
1909
2234
global fhl_list
1910
2235
1911
while {[gets $filehighlight line] >= 0} {
2236
if {![info exists filehighlight]} {
2237
return 0
2238
}
2239
set nr 0
2240
while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
1912
2241
set line [string trim $line]
1913
2242
set i [lsearch -exact $fhl_list $line]
1914
2243
if {$i < 0} continue
1929
2258
}
1930
2259
if {[eof $filehighlight]} {
1931
2260
# strange...
1932
puts "oops, git-diff-tree died"
2261
puts "oops, git diff-tree died"
1933
2262
catch {close $filehighlight}
1934
2263
unset filehighlight
2264
return 0
1935
2265
}
1936
2266
next_hlcont
2267
return 1
1937
2268
}
1938
2269
1939
2270
proc find_change {name ix op} {
1947
2278
set boldnamerows {}
1948
2279
catch {unset nhighlights}
1949
2280
unbolden
2281
unmarkmatches
1950
2282
if {$findtype ne "Regexp"} {
1951
2283
set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1952
2284
$findstring]
1955
2287
drawvisible
1956
2288
}
1957
2289
2290
proc doesmatch {f} {
2291
global findtype findstring findpattern
2292
2293
if {$findtype eq "Regexp"} {
2294
return [regexp $findstring $f]
2295
} elseif {$findtype eq "IgnCase"} {
2296
return [string match -nocase $findpattern $f]
2297
} else {
2298
return [string match $findpattern $f]
2299
}
2300
}
2301
1958
2302
proc askfindhighlight {row id} {
1959
2303
global nhighlights commitinfo iddrawn mainfont
1960
global findstring findtype findloc findpattern
2304
global findloc
2305
global markingmatches
1961
2306
1962
2307
if {![info exists commitinfo($id)]} {
1963
2308
getcommit $id
1966
2311
set isbold 0
1967
2312
set fldtypes {Headline Author Date Committer CDate Comments}
1968
2313
foreach f $info ty $fldtypes {
1969
if {$findloc ne "All fields" && $findloc ne $ty} {
1970
continue
1971
}
1972
if {$findtype eq "Regexp"} {
1973
set doesmatch [regexp $findstring $f]
1974
} elseif {$findtype eq "IgnCase"} {
1975
set doesmatch [string match -nocase $findpattern $f]
1976
} else {
1977
set doesmatch [string match $findpattern $f]
1978
}
1979
if {$doesmatch} {
2314
if {($findloc eq "All fields" || $findloc eq $ty) &&
2315
[doesmatch $f]} {
1980
2316
if {$ty eq "Author"} {
1981
2317
set isbold 2
1982
} else {
1983
set isbold 1
2318
break
1984
2319
}
2320
set isbold 1
1985
2321
}
1986
2322
}
1987
if {[info exists iddrawn($id)]} {
1988
if {$isbold && ![ishighlighted $row]} {
1989
bolden $row [concat $mainfont bold]
2323
if {$isbold && [info exists iddrawn($id)]} {
2324
set f [concat $mainfont bold]
2325
if {![ishighlighted $row]} {
2326
bolden $row $f
2327
if {$isbold > 1} {
2328
bolden_name $row $f
2329
}
1990
2330
}
1991
if {$isbold >= 2} {
1992
bolden_name $row [concat $mainfont bold]
2331
if {$markingmatches} {
2332
markrowmatches $row $id
1993
2333
}
1994
2334
}
1995
2335
set nhighlights($row) $isbold
1996
2336
}
1997
2337
2338
proc markrowmatches {row id} {
2339
global canv canv2 linehtag linentag commitinfo findloc
2340
2341
set headline [lindex $commitinfo($id) 0]
2342
set author [lindex $commitinfo($id) 1]
2343
$canv delete match$row
2344
$canv2 delete match$row
2345
if {$findloc eq "All fields" || $findloc eq "Headline"} {
2346
set m [findmatches $headline]
2347
if {$m ne {}} {
2348
markmatches $canv $row $headline $linehtag($row) $m \
2349
[$canv itemcget $linehtag($row) -font] $row
2350
}
2351
}
2352
if {$findloc eq "All fields" || $findloc eq "Author"} {
2353
set m [findmatches $author]
2354
if {$m ne {}} {
2355
markmatches $canv2 $row $author $linentag($row) $m \
2356
[$canv2 itemcget $linentag($row) -font] $row
2357
}
2358
}
2359
}
2360
1998
2361
proc vrel_change {name ix op} {
1999
2362
global highlight_related
2000
2363
2001
2364
rhighlight_none
2002
2365
if {$highlight_related ne "None"} {
2003
after idle drawvisible
2366
run drawvisible
2004
2367
}
2005
2368
}
2006
2369
2015
2378
set anc_todo [list $a]
2016
2379
if {$highlight_related ne "None"} {
2017
2380
rhighlight_none
2018
after idle drawvisible
2381
run drawvisible
2019
2382
}
2020
2383
}
2021
2384
2233
2596
}
2234
2597
2235
2598
proc usedinrange {id l1 l2} {
2236
global children commitrow childlist curview
2599
global children commitrow curview
2237
2600
2238
2601
if {[info exists commitrow($curview,$id)]} {
2239
2602
set r $commitrow($curview,$id)
2240
2603
if {$l1 <= $r && $r <= $l2} {
2241
2604
return [expr {$r - $l1 + 1}]
2242
2605
}
2243
set kids [lindex $childlist $r]
2244
} else {
2245
set kids $children($curview,$id)
2246
2606
}
2607
set kids $children($curview,$id)
2247
2608
foreach c $kids {
2248
2609
set r $commitrow($curview,$c)
2249
2610
if {$l1 <= $r && $r <= $l2} {
2286
2647
}
2287
2648
2288
2649
proc makeuparrow {oid x y z} {
2289
global rowidlist rowoffsets uparrowlen idrowranges
2650
global rowidlist rowoffsets uparrowlen idrowranges displayorder
2290
2651
2291
2652
for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2292
2653
incr y -1
2309
2670
}
2310
2671
set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2311
2672
lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2312
lappend idrowranges($oid) $y
2673
lappend idrowranges($oid) [lindex $displayorder $y]
2313
2674
}
2314
2675
2315
2676
proc initlayout {} {
2318
2679
global idinlist rowchk rowrangelist idrowranges
2319
2680
global numcommits canvxmax canv
2320
2681
global nextcolor
2321
global parentlist childlist children
2682
global parentlist
2322
2683
global colormap rowtextx
2323
global linesegends
2684
global selectfirst
2324
2685
2325
2686
set numcommits 0
2326
2687
set displayorder {}
2327
2688
set commitlisted {}
2328
2689
set parentlist {}
2329
set childlist {}
2330
2690
set rowrangelist {}
2331
2691
set nextcolor 0
2332
2692
set rowidlist {{}}
2339
2699
catch {unset colormap}
2340
2700
catch {unset rowtextx}
2341
2701
catch {unset idrowranges}
2342
set linesegends {}
2702
set selectfirst 1
2343
2703
}
2344
2704
2345
2705
proc setcanvscroll {} {
2370
2730
return [list $r0 $r1]
2371
2731
}
2372
2732
2373
proc layoutmore {tmax} {
2733
proc layoutmore {tmax allread} {
2374
2734
global rowlaidout rowoptim commitidx numcommits optim_delay
2375
global uparrowlen curview
2735
global uparrowlen curview rowidlist idinlist
2376
2736
2737
set showlast 0
2738
set showdelay $optim_delay
2739
set optdelay [expr {$uparrowlen + 1}]
2377
2740
while {1} {
2378
if {$rowoptim - $optim_delay > $numcommits} {
2379
showstuff [expr {$rowoptim - $optim_delay}]
2380
} elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2381
set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2741
if {$rowoptim - $showdelay > $numcommits} {
2742
showstuff [expr {$rowoptim - $showdelay}] $showlast
2743
} elseif {$rowlaidout - $optdelay > $rowoptim} {
2744
set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2382
2745
if {$nr > 100} {
2383
2746
set nr 100
2384
2747
}
2392
2755
set nr 150
2393
2756
}
2394
2757
set row $rowlaidout
2395
set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2758
set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2396
2759
if {$rowlaidout == $row} {
2397
2760
return 0
2398
2761
}
2762
} elseif {$allread} {
2763
set optdelay 0
2764
set nrows $commitidx($curview)
2765
if {[lindex $rowidlist $nrows] ne {} ||
2766
[array names idinlist] ne {}} {
2767
layouttail
2768
set rowlaidout $commitidx($curview)
2769
} elseif {$rowoptim == $nrows} {
2770
set showdelay 0
2771
set showlast 1
2772
if {$numcommits == $nrows} {
2773
return 0
2774
}
2775
}
2399
2776
} else {
2400
2777
return 0
2401
2778
}
2405
2782
}
2406
2783
}
2407
2784
2408
proc showstuff {canshow} {
2409
global numcommits commitrow pending_select selectedline
2410
global linesegends idrowranges idrangedrawn curview
2785
proc showstuff {canshow last} {
2786
global numcommits commitrow pending_select selectedline curview
2787
global lookingforhead mainheadid displayorder selectfirst
2788
global lastscrollset commitinterest
2411
2789
2412
2790
if {$numcommits == 0} {
2413
2791
global phase
2414
2792
set phase "incrdraw"
2415
2793
allcanvs delete all
2416
2794
}
2417
set row $numcommits
2795
for {set l $numcommits} {$l < $canshow} {incr l} {
2796
set id [lindex $displayorder $l]
2797
if {[info exists commitinterest($id)]} {
2798
foreach script $commitinterest($id) {
2799
eval [string map [list "%I" $id] $script]
2800
}
2801
unset commitinterest($id)
2802
}
2803
}
2804
set r0 $numcommits
2805
set prev $numcommits
2418
2806
set numcommits $canshow
2419
setcanvscroll
2807
set t [clock clicks -milliseconds]
2808
if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2809
set lastscrollset $t
2810
setcanvscroll
2811
}
2420
2812
set rows [visiblerows]
2421
set r0 [lindex $rows 0]
2422
2813
set r1 [lindex $rows 1]
2423
set selrow -1
2424
for {set r $row} {$r < $canshow} {incr r} {
2425
foreach id [lindex $linesegends [expr {$r+1}]] {
2426
set i -1
2427
foreach {s e} [rowranges $id] {
2428
incr i
2429
if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2430
&& ![info exists idrangedrawn($id,$i)]} {
2431
drawlineseg $id $i
2432
set idrangedrawn($id,$i) 1
2433
}
2434
}
2435
}
2436
}
2437
if {$canshow > $r1} {
2438
set canshow $r1
2439
}
2440
while {$row < $canshow} {
2441
drawcmitrow $row
2442
incr row
2814
if {$r1 >= $canshow} {
2815
set r1 [expr {$canshow - 1}]
2816
}
2817
if {$r0 <= $r1} {
2818
drawcommits $r0 $r1
2443
2819
}
2444
2820
if {[info exists pending_select] &&
2445
2821
[info exists commitrow($curview,$pending_select)] &&
2446
2822
$commitrow($curview,$pending_select) < $numcommits} {
2447
2823
selectline $commitrow($curview,$pending_select) 1
2448
2824
}
2449
if {![info exists selectedline] && ![info exists pending_select]} {
2450
selectline 0 1
2451
}
2825
if {$selectfirst} {
2826
if {[info exists selectedline] || [info exists pending_select]} {
2827
set selectfirst 0
2828
} else {
2829
set l [first_real_row]
2830
selectline $l 1
2831
set selectfirst 0
2832
}
2833
}
2834
if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2835
&& ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2836
set lookingforhead 0
2837
dodiffindex
2838
}
2839
}
2840
2841
proc doshowlocalchanges {} {
2842
global lookingforhead curview mainheadid phase commitrow
2843
2844
if {[info exists commitrow($curview,$mainheadid)] &&
2845
($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2846
dodiffindex
2847
} elseif {$phase ne {}} {
2848
set lookingforhead 1
2849
}
2850
}
2851
2852
proc dohidelocalchanges {} {
2853
global lookingforhead localfrow localirow lserial
2854
2855
set lookingforhead 0
2856
if {$localfrow >= 0} {
2857
removerow $localfrow
2858
set localfrow -1
2859
if {$localirow > 0} {
2860
incr localirow -1
2861
}
2862
}
2863
if {$localirow >= 0} {
2864
removerow $localirow
2865
set localirow -1
2866
}
2867
incr lserial
2868
}
2869
2870
# spawn off a process to do git diff-index --cached HEAD
2871
proc dodiffindex {} {
2872
global localirow localfrow lserial
2873
2874
incr lserial
2875
set localfrow -1
2876
set localirow -1
2877
set fd [open "|git diff-index --cached HEAD" r]
2878
fconfigure $fd -blocking 0
2879
filerun $fd [list readdiffindex $fd $lserial]
2880
}
2881
2882
proc readdiffindex {fd serial} {
2883
global localirow commitrow mainheadid nullid2 curview
2884
global commitinfo commitdata lserial
2885
2886
set isdiff 1
2887
if {[gets $fd line] < 0} {
2888
if {![eof $fd]} {
2889
return 1
2890
}
2891
set isdiff 0
2892
}
2893
# we only need to see one line and we don't really care what it says...
2894
close $fd
2895
2896
# now see if there are any local changes not checked in to the index
2897
if {$serial == $lserial} {
2898
set fd [open "|git diff-files" r]
2899
fconfigure $fd -blocking 0
2900
filerun $fd [list readdifffiles $fd $serial]
2901
}
2902
2903
if {$isdiff && $serial == $lserial && $localirow == -1} {
2904
# add the line for the changes in the index to the graph
2905
set localirow $commitrow($curview,$mainheadid)
2906
set hl "Local changes checked in to index but not committed"
2907
set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
2908
set commitdata($nullid2) "\n $hl\n"
2909
insertrow $localirow $nullid2
2910
}
2911
return 0
2912
}
2913
2914
proc readdifffiles {fd serial} {
2915
global localirow localfrow commitrow mainheadid nullid curview
2916
global commitinfo commitdata lserial
2917
2918
set isdiff 1
2919
if {[gets $fd line] < 0} {
2920
if {![eof $fd]} {
2921
return 1
2922
}
2923
set isdiff 0
2924
}
2925
# we only need to see one line and we don't really care what it says...
2926
close $fd
2927
2928
if {$isdiff && $serial == $lserial && $localfrow == -1} {
2929
# add the line for the local diff to the graph
2930
if {$localirow >= 0} {
2931
set localfrow $localirow
2932
incr localirow
2933
} else {
2934
set localfrow $commitrow($curview,$mainheadid)
2935
}
2936
set hl "Local uncommitted changes, not checked in to index"
2937
set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
2938
set commitdata($nullid) "\n $hl\n"
2939
insertrow $localfrow $nullid
2940
}
2941
return 0
2452
2942
}
2453
2943
2454
2944
proc layoutrows {row endrow last} {
2455
2945
global rowidlist rowoffsets displayorder
2456
2946
global uparrowlen downarrowlen maxwidth mingaplen
2457
global childlist parentlist
2458
global idrowranges linesegends
2947
global children parentlist
2948
global idrowranges
2459
2949
global commitidx curview
2460
2950
global idinlist rowchk rowrangelist
2461
2951
2463
2953
set offs [lindex $rowoffsets $row]
2464
2954
while {$row < $endrow} {
2465
2955
set id [lindex $displayorder $row]
2466
set oldolds {}
2467
set newolds {}
2956
set nev [expr {[llength $idlist] - $maxwidth + 1}]
2468
2957
foreach p [lindex $parentlist $row] {
2469
if {![info exists idinlist($p)]} {
2470
lappend newolds $p
2471
} elseif {!$idinlist($p)} {
2472
lappend oldolds $p
2958
if {![info exists idinlist($p)] || !$idinlist($p)} {
2959
incr nev
2473
2960
}
2474
2961
}
2475
set lse {}
2476
set nev [expr {[llength $idlist] + [llength $newolds]
2477
+ [llength $oldolds] - $maxwidth + 1}]
2478
2962
if {$nev > 0} {
2479
2963
if {!$last &&
2480
2964
$row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2489
2973
set offs [incrange $offs $x 1]
2490
2974
set idinlist($i) 0
2491
2975
set rm1 [expr {$row - 1}]
2492
lappend lse $i
2493
lappend idrowranges($i) $rm1
2976
lappend idrowranges($i) [lindex $displayorder $rm1]
2494
2977
if {[incr nev -1] <= 0} break
2495
2978
continue
2496
2979
}
2497
set rowchk($id) [expr {$row + $r}]
2980
set rowchk($i) [expr {$row + $r}]
2498
2981
}
2499
2982
}
2500
2983
lset rowidlist $row $idlist
2501
2984
lset rowoffsets $row $offs
2502
2985
}
2503
lappend linesegends $lse
2986
set oldolds {}
2987
set newolds {}
2988
foreach p [lindex $parentlist $row] {
2989
if {![info exists idinlist($p)]} {
2990
lappend newolds $p
2991
} elseif {!$idinlist($p)} {
2992
lappend oldolds $p
2993
}
2994
set idinlist($p) 1
2995
}
2504
2996
set col [lsearch -exact $idlist $id]
2505
2997
if {$col < 0} {
2506
2998
set col [llength $idlist]
2507
2999
lappend idlist $id
2508
3000
lset rowidlist $row $idlist
2509
3001
set z {}
2510
if {[lindex $childlist $row] ne {}} {
3002
if {$children($curview,$id) ne {}} {
2511
3003
set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2512
3004
unset idinlist($id)
2513
3005
}
2522
3014
set ranges {}
2523
3015
if {[info exists idrowranges($id)]} {
2524
3016
set ranges $idrowranges($id)
2525
lappend ranges $row
3017
lappend ranges $id
2526
3018
unset idrowranges($id)
2527
3019
}
2528
3020
lappend rowrangelist $ranges
2546
3038
lset offs $col {}
2547
3039
}
2548
3040
foreach i $newolds {
2549
set idinlist($i) 1
2550
set idrowranges($i) $row
3041
set idrowranges($i) $id
2551
3042
}
2552
3043
incr col $l
2553
3044
foreach oid $oldolds {
2554
set idinlist($oid) 1
2555
3045
set idlist [linsert $idlist $col $oid]
2556
3046
set offs [linsert $offs $col $o]
2557
3047
makeuparrow $oid $col $row $o
2566
3056
proc addextraid {id row} {
2567
3057
global displayorder commitrow commitinfo
2568
3058
global commitidx commitlisted
2569
global parentlist childlist children curview
3059
global parentlist children curview
2570
3060
2571
3061
incr commitidx($curview)
2572
3062
lappend displayorder $id
2580
3070
if {![info exists children($curview,$id)]} {
2581
3071
set children($curview,$id) {}
2582
3072
}
2583
lappend childlist $children($curview,$id)
2584
3073
}
2585
3074
2586
3075
proc layouttail {} {
2593
3082
set col [expr {[llength $idlist] - 1}]
2594
3083
set id [lindex $idlist $col]
2595
3084
addextraid $id $row
2596
unset idinlist($id)
2597
lappend idrowranges($id) $row
3085
catch {unset idinlist($id)}
3086
lappend idrowranges($id) $id
2598
3087
lappend rowrangelist $idrowranges($id)
2599
3088
unset idrowranges($id)
2600
3089
incr row
2605
3094
}
2606
3095
2607
3096
foreach id [array names idinlist] {
3097
unset idinlist($id)
2608
3098
addextraid $id $row
2609
3099
lset rowidlist $row [list $id]
2610
3100
lset rowoffsets $row 0
2611
3101
makeuparrow $id 0 $row 0
2612
lappend idrowranges($id) $row
3102
lappend idrowranges($id) $id
2613
3103
lappend rowrangelist $idrowranges($id)
2614
3104
unset idrowranges($id)
2615
3105
incr row
2628
3118
}
2629
3119
2630
3120
proc optimize_rows {row col endrow} {
2631
global rowidlist rowoffsets idrowranges displayorder
3121
global rowidlist rowoffsets displayorder
2632
3122
2633
3123
for {} {$row < $endrow} {incr row} {
2634
3124
set idlist [lindex $rowidlist $row]
2652
3142
set isarrow 1
2653
3143
}
2654
3144
}
3145
# Looking at lines from this row to the previous row,
3146
# make them go straight up if they end in an arrow on
3147
# the previous row; otherwise make them go straight up
3148
# or at 45 degrees.
2655
3149
if {$z < -1 || ($z < 0 && $isarrow)} {
3150
# Line currently goes left too much;
3151
# insert pads in the previous row, then optimize it
2656
3152
set npad [expr {-1 - $z + $isarrow}]
2657
3153
set offs [incrange $offs $col $npad]
2658
3154
insert_pad $y0 $x0 $npad
2663
3159
set x0 [expr {$col + $z}]
2664
3160
set z0 [lindex $rowoffsets $y0 $x0]
2665
3161
} elseif {$z > 1 || ($z > 0 && $isarrow)} {
3162
# Line currently goes right too much;
3163
# insert pads in this line and adjust the next's rowoffsets
2666
3164
set npad [expr {$z - 1 + $isarrow}]
2667
3165
set y1 [expr {$row + 1}]
2668
3166
set offs2 [lindex $rowoffsets $y1]
2693
3191
set z0 [expr {$xc - $x0}]
2694
3192
}
2695
3193
}
3194
# avoid lines jigging left then immediately right
2696
3195
if {$z0 ne {} && $z < 0 && $z0 > 0} {
2697
3196
insert_pad $y0 $x0 1
2698
3197
set offs [incrange $offs $col 1]
2701
3200
}
2702
3201
if {!$haspad} {
2703
3202
set o {}
3203
# Find the first column that doesn't have a line going right
2704
3204
for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2705
3205
set o [lindex $offs $col]
2706
3206
if {$o eq {}} {
2719
3219
}
2720
3220
if {$o eq {} || $o <= 0} break
2721
3221
}
3222
# Insert a pad at that column as long as it has a line and
3223
# isn't the last column, and adjust the next row' offsets
2722
3224
if {$o ne {} && [incr col] < [llength $idlist]} {
2723
3225
set y1 [expr {$row + 1}]
2724
3226
set offs2 [lindex $rowoffsets $y1]
2772
3274
} elseif {[info exists idrowranges($id)]} {
2773
3275
set ranges $idrowranges($id)
2774
3276
}
2775
return $ranges
2776
}
2777
2778
proc drawlineseg {id i} {
2779
global rowoffsets rowidlist
2780
global displayorder
2781
global canv colormap linespc
2782
global numcommits commitrow curview
2783
2784
set ranges [rowranges $id]
2785
set downarrow 1
2786
if {[info exists commitrow($curview,$id)]
2787
&& $commitrow($curview,$id) < $numcommits} {
2788
set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2789
} else {
2790
set downarrow 1
2791
}
2792
set startrow [lindex $ranges [expr {2 * $i}]]
2793
set row [lindex $ranges [expr {2 * $i + 1}]]
2794
if {$startrow == $row} return
2795
assigncolor $id
2796
set coords {}
2797
set col [lsearch -exact [lindex $rowidlist $row] $id]
2798
if {$col < 0} {
2799
puts "oops: drawline: id $id not on row $row"
2800
return
2801
}
2802
set lasto {}
2803
set ns 0
3277
set linenos {}
3278
foreach rid $ranges {
3279
lappend linenos $commitrow($curview,$rid)
3280
}
3281
if {$linenos ne {}} {
3282
lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3283
}
3284
return $linenos
3285
}
3286
3287
# work around tk8.4 refusal to draw arrows on diagonal segments
3288
proc adjarrowhigh {coords} {
3289
global linespc
3290
3291
set x0 [lindex $coords 0]
3292
set x1 [lindex $coords 2]
3293
if {$x0 != $x1} {
3294
set y0 [lindex $coords 1]
3295
set y1 [lindex $coords 3]
3296
if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3297
# we have a nearby vertical segment, just trim off the diag bit
3298
set coords [lrange $coords 2 end]
3299
} else {
3300
set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3301
set xi [expr {$x0 - $slope * $linespc / 2}]
3302
set yi [expr {$y0 - $linespc / 2}]
3303
set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3304
}
3305
}
3306
return $coords
3307
}
3308
3309
proc drawlineseg {id row endrow arrowlow} {
3310
global rowidlist displayorder iddrawn linesegs
3311
global canv colormap linespc curview maxlinelen
3312
3313
set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3314
set le [expr {$row + 1}]
3315
set arrowhigh 1
2804
3316
while {1} {
2805
set o [lindex $rowoffsets $row $col]
2806
if {$o eq {}} break
2807
if {$o ne $lasto} {
2808
# changing direction
2809
set x [xc $row $col]
2810
set y [yc $row]
2811
lappend coords $x $y
2812
set lasto $o
2813
}
2814
incr col $o
2815
incr row -1
2816
}
2817
set x [xc $row $col]
2818
set y [yc $row]
2819
lappend coords $x $y
2820
if {$i == 0} {
2821
# draw the link to the first child as part of this line
2822
incr row -1
2823
set child [lindex $displayorder $row]
2824
set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2825
if {$ccol >= 0} {
2826
set x [xc $row $ccol]
2827
set y [yc $row]
2828
if {$ccol < $col - 1} {
2829
lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2830
} elseif {$ccol > $col + 1} {
2831
lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2832
}
2833
lappend coords $x $y
2834
}
2835
}
2836
if {[llength $coords] < 4} return
2837
if {$downarrow} {
2838
# This line has an arrow at the lower end: check if the arrow is
2839
# on a diagonal segment, and if so, work around the Tk 8.4
2840
# refusal to draw arrows on diagonal lines.
2841
set x0 [lindex $coords 0]
2842
set x1 [lindex $coords 2]
2843
if {$x0 != $x1} {
2844
set y0 [lindex $coords 1]
2845
set y1 [lindex $coords 3]
2846
if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2847
# we have a nearby vertical segment, just trim off the diag bit
2848
set coords [lrange $coords 2 end]
2849
} else {
2850
set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2851
set xi [expr {$x0 - $slope * $linespc / 2}]
2852
set yi [expr {$y0 - $linespc / 2}]
2853
set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2854
}
2855
}
2856
}
2857
set arrow [expr {2 * ($i > 0) + $downarrow}]
2858
set arrow [lindex {none first last both} $arrow]
2859
set t [$canv create line $coords -width [linewidth $id] \
2860
-fill $colormap($id) -tags lines.$id -arrow $arrow]
2861
$canv lower $t
2862
bindline $t $id
3317
set c [lsearch -exact [lindex $rowidlist $le] $id]
3318
if {$c < 0} {
3319
incr le -1
3320
break
3321
}
3322
lappend cols $c
3323
set x [lindex $displayorder $le]
3324
if {$x eq $id} {
3325
set arrowhigh 0
3326
break
3327
}
3328
if {[info exists iddrawn($x)] || $le == $endrow} {
3329
set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3330
if {$c >= 0} {
3331
lappend cols $c
3332
set arrowhigh 0
3333
}
3334
break
3335
}
3336
incr le
3337
}
3338
if {$le <= $row} {
3339
return $row
3340
}
3341
3342
set lines {}
3343
set i 0
3344
set joinhigh 0
3345
if {[info exists linesegs($id)]} {
3346
set lines $linesegs($id)
3347
foreach li $lines {
3348
set r0 [lindex $li 0]
3349
if {$r0 > $row} {
3350
if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3351
set joinhigh 1
3352
}
3353
break
3354
}
3355
incr i
3356
}
3357
}
3358
set joinlow 0
3359
if {$i > 0} {
3360
set li [lindex $lines [expr {$i-1}]]
3361
set r1 [lindex $li 1]
3362
if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3363
set joinlow 1
3364
}
3365
}
3366
3367
set x [lindex $cols [expr {$le - $row}]]
3368
set xp [lindex $cols [expr {$le - 1 - $row}]]
3369
set dir [expr {$xp - $x}]
3370
if {$joinhigh} {
3371
set ith [lindex $lines $i 2]
3372
set coords [$canv coords $ith]
3373
set ah [$canv itemcget $ith -arrow]
3374
set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3375
set x2 [lindex $cols [expr {$le + 1 - $row}]]
3376
if {$x2 ne {} && $x - $x2 == $dir} {
3377
set coords [lrange $coords 0 end-2]
3378
}
3379
} else {
3380
set coords [list [xc $le $x] [yc $le]]
3381
}
3382
if {$joinlow} {
3383
set itl [lindex $lines [expr {$i-1}] 2]
3384
set al [$canv itemcget $itl -arrow]
3385
set arrowlow [expr {$al eq "last" || $al eq "both"}]
3386
} elseif {$arrowlow &&
3387
[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3388
set arrowlow 0
3389
}
3390
set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3391
for {set y $le} {[incr y -1] > $row} {} {
3392
set x $xp
3393
set xp [lindex $cols [expr {$y - 1 - $row}]]
3394
set ndir [expr {$xp - $x}]
3395
if {$dir != $ndir || $xp < 0} {
3396
lappend coords [xc $y $x] [yc $y]
3397
}
3398
set dir $ndir
3399
}
3400
if {!$joinlow} {
3401
if {$xp < 0} {
3402
# join parent line to first child
3403
set ch [lindex $displayorder $row]
3404
set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3405
if {$xc < 0} {
3406
puts "oops: drawlineseg: child $ch not on row $row"
3407
} else {
3408
if {$xc < $x - 1} {
3409
lappend coords [xc $row [expr {$x-1}]] [yc $row]
3410
} elseif {$xc > $x + 1} {
3411
lappend coords [xc $row [expr {$x+1}]] [yc $row]
3412
}
3413
set x $xc
3414
}
3415
lappend coords [xc $row $x] [yc $row]
3416
} else {
3417
set xn [xc $row $xp]
3418
set yn [yc $row]
3419
# work around tk8.4 refusal to draw arrows on diagonal segments
3420
if {$arrowlow && $xn != [lindex $coords end-1]} {
3421
if {[llength $coords] < 4 ||
3422
[lindex $coords end-3] != [lindex $coords end-1] ||
3423
[lindex $coords end] - $yn > 2 * $linespc} {
3424
set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3425
set yo [yc [expr {$row + 0.5}]]
3426
lappend coords $xn $yo $xn $yn
3427
}
3428
} else {
3429
lappend coords $xn $yn
3430
}
3431
}
3432
if {!$joinhigh} {
3433
if {$arrowhigh} {
3434
set coords [adjarrowhigh $coords]
3435
}
3436
assigncolor $id
3437
set t [$canv create line $coords -width [linewidth $id] \
3438
-fill $colormap($id) -tags lines.$id -arrow $arrow]
3439
$canv lower $t
3440
bindline $t $id
3441
set lines [linsert $lines $i [list $row $le $t]]
3442
} else {
3443
$canv coords $ith $coords
3444
if {$arrow ne $ah} {
3445
$canv itemconf $ith -arrow $arrow
3446
}
3447
lset lines $i 0 $row
3448
}
3449
} else {
3450
set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3451
set ndir [expr {$xo - $xp}]
3452
set clow [$canv coords $itl]
3453
if {$dir == $ndir} {
3454
set clow [lrange $clow 2 end]
3455
}
3456
set coords [concat $coords $clow]
3457
if {!$joinhigh} {
3458
lset lines [expr {$i-1}] 1 $le
3459
if {$arrowhigh} {
3460
set coords [adjarrowhigh $coords]
3461
}
3462
} else {
3463
# coalesce two pieces
3464
$canv delete $ith
3465
set b [lindex $lines [expr {$i-1}] 0]
3466
set e [lindex $lines $i 1]
3467
set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3468
}
3469
$canv coords $itl $coords
3470
if {$arrow ne $al} {
3471
$canv itemconf $itl -arrow $arrow
3472
}
3473
}
3474
3475
set linesegs($id) $lines
3476
return $le
2863
3477
}
2864
3478
2865
proc drawparentlinks {id row col olds} {
2866
global rowidlist canv colormap
3479
proc drawparentlinks {id row} {
3480
global rowidlist canv colormap curview parentlist
3481
global idpos
2867
3482
3483
set rowids [lindex $rowidlist $row]
3484
set col [lsearch -exact $rowids $id]
3485
if {$col < 0} return
3486
set olds [lindex $parentlist $row]
2868
3487
set row2 [expr {$row + 1}]
2869
3488
set x [xc $row $col]
2870
3489
set y [yc $row]
2882
3501
if {$x2 > $rmx} {
2883
3502
set rmx $x2
2884
3503
}
2885
set ranges [rowranges $p]
2886
if {$ranges ne {} && $row2 == [lindex $ranges 0]
2887
&& $row2 < [lindex $ranges 1]} {
3504
if {[lsearch -exact $rowids $p] < 0} {
2888
3505
# drawlineseg will do this one for us
2889
3506
continue
2890
3507
}
2902
3519
$canv lower $t
2903
3520
bindline $t $p
2904
3521
}
2905
return $rmx
3522
if {$rmx > [lindex $idpos($id) 1]} {
3523
lset idpos($id) 1 $rmx
3524
redrawtags $id
3525
}
2906
3526
}
2907
3527
2908
3528
proc drawlines {id} {
2909
global colormap canv
2910
global idrangedrawn
2911
global children iddrawn commitrow rowidlist curview
3529
global canv
2912
3530
2913
$canv delete lines.$id
2914
set nr [expr {[llength [rowranges $id]] / 2}]
2915
for {set i 0} {$i < $nr} {incr i} {
2916
if {[info exists idrangedrawn($id,$i)]} {
2917
drawlineseg $id $i
2918
}
2919
}
2920
foreach child $children($curview,$id) {
2921
if {[info exists iddrawn($child)]} {
2922
set row $commitrow($curview,$child)
2923
set col [lsearch -exact [lindex $rowidlist $row] $child]
2924
if {$col >= 0} {
2925
drawparentlinks $child $row $col [list $id]
2926
}
2927
}
2928
}
3531
$canv itemconf lines.$id -width [linewidth $id]
2929
3532
}
2930
3533
2931
proc drawcmittext {id row col rmx} {
2932
global linespc canv canv2 canv3 canvy0 fgcolor
2933
global commitlisted commitinfo rowidlist
3534
proc drawcmittext {id row col} {
3535
global linespc canv canv2 canv3 canvy0 fgcolor curview
3536
global commitlisted commitinfo rowidlist parentlist
2934
3537
global rowtextx idpos idtags idheads idotherrefs
2935
3538
global linehtag linentag linedtag
2936
global mainfont canvxmax boldrows boldnamerows fgcolor
3539
global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
2937
3540
2938
set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
3541
# listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3542
set listed [lindex $commitlisted $row]
3543
if {$id eq $nullid} {
3544
set ofill red
3545
} elseif {$id eq $nullid2} {
3546
set ofill green
3547
} else {
3548
set ofill [expr {$listed != 0? "blue": "white"}]
3549
}
2939
3550
set x [xc $row $col]
2940
3551
set y [yc $row]
2941
3552
set orad [expr {$linespc / 3}]
2942
set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2943
[expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2944
-fill $ofill -outline $fgcolor -width 1 -tags circle]
3553
if {$listed <= 1} {
3554
set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3555
[expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3556
-fill $ofill -outline $fgcolor -width 1 -tags circle]
3557
} elseif {$listed == 2} {
3558
# triangle pointing left for left-side commits
3559
set t [$canv create polygon \
3560
[expr {$x - $orad}] $y \
3561
[expr {$x + $orad - 1}] [expr {$y - $orad}] \
3562
[expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3563
-fill $ofill -outline $fgcolor -width 1 -tags circle]
3564
} else {
3565
# triangle pointing right for right-side commits
3566
set t [$canv create polygon \
3567
[expr {$x + $orad - 1}] $y \
3568
[expr {$x - $orad}] [expr {$y - $orad}] \
3569
[expr {$x - $orad}] [expr {$y + $orad - 1}] \
3570
-fill $ofill -outline $fgcolor -width 1 -tags circle]
3571
}
2945
3572
$canv raise $t
2946
3573
$canv bind $t <1> {selcanvline {} %x %y}
2947
set xt [xc $row [llength [lindex $rowidlist $row]]]
2948
if {$xt < $rmx} {
2949
set xt $rmx
3574
set rmx [llength [lindex $rowidlist $row]]
3575
set olds [lindex $parentlist $row]
3576
if {$olds ne {}} {
3577
set nextids [lindex $rowidlist [expr {$row + 1}]]
3578
foreach p $olds {
3579
set i [lsearch -exact $nextids $p]
3580
if {$i > $rmx} {
3581
set rmx $i
3582
}
3583
}
2950
3584
}
3585
set xt [xc $row $rmx]
2951
3586
set rowtextx($row) $xt
2952
3587
set idpos($id) [list $x $xt $y]
2953
3588
if {[info exists idtags($id)] || [info exists idheads($id)]
2985
3620
2986
3621
proc drawcmitrow {row} {
2987
3622
global displayorder rowidlist
2988
global idrangedrawn iddrawn
3623
global iddrawn markingmatches
2989
3624
global commitinfo parentlist numcommits
2990
3625
global filehighlight fhighlights findstring nhighlights
2991
3626
global hlview vhighlights
2992
3627
global highlight_related rhighlights
2993
3628
2994
3629
if {$row >= $numcommits} return
2995
foreach id [lindex $rowidlist $row] {
2996
if {$id eq {}} continue
2997
set i -1
2998
foreach {s e} [rowranges $id] {
2999
incr i
3000
if {$row < $s} continue
3001
if {$e eq {}} break
3002
if {$row <= $e} {
3003
if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3004
drawlineseg $id $i
3005
set idrangedrawn($id,$i) 1
3006
}
3007
break
3008
}
3009
}
3010
}
3011
3630
3012
3631
set id [lindex $displayorder $row]
3013
3632
if {[info exists hlview] && ![info exists vhighlights($row)]} {
3022
3641
if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3023
3642
askrelhighlight $row $id
3024
3643
}
3025
if {[info exists iddrawn($id)]} return
3026
set col [lsearch -exact [lindex $rowidlist $row] $id]
3027
if {$col < 0} {
3028
puts "oops, row $row id $id not in list"
3029
return
3030
}
3031
if {![info exists commitinfo($id)]} {
3032
getcommit $id
3033
}
3034
assigncolor $id
3035
set olds [lindex $parentlist $row]
3036
if {$olds ne {}} {
3037
set rmx [drawparentlinks $id $row $col $olds]
3038
} else {
3039
set rmx 0
3040
}
3041
drawcmittext $id $row $col $rmx
3042
set iddrawn($id) 1
3644
if {![info exists iddrawn($id)]} {
3645
set col [lsearch -exact [lindex $rowidlist $row] $id]
3646
if {$col < 0} {
3647
puts "oops, row $row id $id not in list"
3648
return
3649
}
3650
if {![info exists commitinfo($id)]} {
3651
getcommit $id
3652
}
3653
assigncolor $id
3654
drawcmittext $id $row $col
3655
set iddrawn($id) 1
3656
}
3657
if {$markingmatches} {
3658
markrowmatches $row $id
3659
}
3660
}
3661
3662
proc drawcommits {row {endrow {}}} {
3663
global numcommits iddrawn displayorder curview
3664
global parentlist rowidlist
3665
3666
if {$row < 0} {
3667
set row 0
3668
}
3669
if {$endrow eq {}} {
3670
set endrow $row
3671
}
3672
if {$endrow >= $numcommits} {
3673
set endrow [expr {$numcommits - 1}]
3674
}
3675
3676
# make the lines join to already-drawn rows either side
3677
set r [expr {$row - 1}]
3678
if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3679
set r $row
3680
}
3681
set er [expr {$endrow + 1}]
3682
if {$er >= $numcommits ||
3683
![info exists iddrawn([lindex $displayorder $er])]} {
3684
set er $endrow
3685
}
3686
for {} {$r <= $er} {incr r} {
3687
set id [lindex $displayorder $r]
3688
set wasdrawn [info exists iddrawn($id)]
3689
drawcmitrow $r
3690
if {$r == $er} break
3691
set nextid [lindex $displayorder [expr {$r + 1}]]
3692
if {$wasdrawn && [info exists iddrawn($nextid)]} {
3693
catch {unset prevlines}
3694
continue
3695
}
3696
drawparentlinks $id $r
3697
3698
if {[info exists lineends($r)]} {
3699
foreach lid $lineends($r) {
3700
unset prevlines($lid)
3701
}
3702
}
3703
set rowids [lindex $rowidlist $r]
3704
foreach lid $rowids {
3705
if {$lid eq {}} continue
3706
if {$lid eq $id} {
3707
# see if this is the first child of any of its parents
3708
foreach p [lindex $parentlist $r] {
3709
if {[lsearch -exact $rowids $p] < 0} {
3710
# make this line extend up to the child
3711
set le [drawlineseg $p $r $er 0]
3712
lappend lineends($le) $p
3713
set prevlines($p) 1
3714
}
3715
}
3716
} elseif {![info exists prevlines($lid)]} {
3717
set le [drawlineseg $lid $r $er 1]
3718
lappend lineends($le) $lid
3719
set prevlines($lid) 1
3720
}
3721
}
3722
}
3043
3723
}
3044
3724
3045
3725
proc drawfrac {f0 f1} {
3046
global numcommits canv
3047
global linespc
3726
global canv linespc
3048
3727
3049
3728
set ymax [lindex [$canv cget -scrollregion] 3]
3050
3729
if {$ymax eq {} || $ymax == 0} return
3051
3730
set y0 [expr {int($f0 * $ymax)}]
3052
3731
set row [expr {int(($y0 - 3) / $linespc) - 1}]
3053
if {$row < 0} {
3054
set row 0
3055
}
3056
3732
set y1 [expr {int($f1 * $ymax)}]
3057
3733
set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3058
if {$endrow >= $numcommits} {
3059
set endrow [expr {$numcommits - 1}]
3060
}
3061
for {} {$row <= $endrow} {incr row} {
3062
drawcmitrow $row
3063
}
3734
drawcommits $row $endrow
3064
3735
}
3065
3736
3066
3737
proc drawvisible {} {
3069
3740
}
3070
3741
3071
3742
proc clear_display {} {
3072
global iddrawn idrangedrawn
3743
global iddrawn linesegs
3073
3744
global vhighlights fhighlights nhighlights rhighlights
3074
3745
3075
3746
allcanvs delete all
3076
3747
catch {unset iddrawn}
3077
catch {unset idrangedrawn}
3748
catch {unset linesegs}
3078
3749
catch {unset vhighlights}
3079
3750
catch {unset fhighlights}
3080
3751
catch {unset nhighlights}
3301
3972
-tags text -fill $fgcolor
3302
3973
}
3303
3974
3304
proc finishcommits {} {
3305
global commitidx phase curview
3306
global pending_select
3307
3308
if {$commitidx($curview) > 0} {
3309
drawrest
3310
} else {
3311
show_status "No commits selected"
3312
}
3313
set phase {}
3314
catch {unset pending_select}
3315
}
3316
3317
3975
# Insert a new commit as the child of the commit on row $row.
3318
3976
# The new commit will be displayed on row $row and the commits
3319
3977
# on that row and below will move down one row.
3320
3978
proc insertrow {row newcmit} {
3321
global displayorder parentlist childlist commitlisted
3979
global displayorder parentlist commitlisted children
3322
3980
global commitrow curview rowidlist rowoffsets numcommits
3323
global rowrangelist idrowranges rowlaidout rowoptim numcommits
3324
global linesegends selectedline
3981
global rowrangelist rowlaidout rowoptim numcommits
3982
global selectedline rowchk commitidx
3325
3983
3326
3984
if {$row >= $numcommits} {
3327
3985
puts "oops, inserting new row $row but only have $numcommits rows"
3330
3988
set p [lindex $displayorder $row]
3331
3989
set displayorder [linsert $displayorder $row $newcmit]
3332
3990
set parentlist [linsert $parentlist $row $p]
3333
set kids [lindex $childlist $row]
3991
set kids $children($curview,$p)
3334
3992
lappend kids $newcmit
3335
lset childlist $row $kids
3336
set childlist [linsert $childlist $row {}]
3993
set children($curview,$p) $kids
3994
set children($curview,$newcmit) {}
3337
3995
set commitlisted [linsert $commitlisted $row 1]
3338
3996
set l [llength $displayorder]
3339
3997
for {set r $row} {$r < $l} {incr r} {
3340
3998
set id [lindex $displayorder $r]
3341
3999
set commitrow($curview,$id) $r
3342
4000
}
4001
incr commitidx($curview)
3343
4002
3344
4003
set idlist [lindex $rowidlist $row]
3345
4004
set offs [lindex $rowoffsets $row]
3364
4023
set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3365
4024
3366
4025
set rowrangelist [linsert $rowrangelist $row {}]
3367
set l [llength $rowrangelist]
3368
for {set r 0} {$r < $l} {incr r} {
3369
set ranges [lindex $rowrangelist $r]
3370
if {$ranges ne {} && [lindex $ranges end] >= $row} {
3371
set newranges {}
3372
foreach x $ranges {
3373
if {$x >= $row} {
3374
lappend newranges [expr {$x + 1}]
3375
} else {
3376
lappend newranges $x
3377
}
3378
}
3379
lset rowrangelist $r $newranges
3380
}
3381
}
3382
4026
if {[llength $kids] > 1} {
3383
4027
set rp1 [expr {$row + 1}]
3384
4028
set ranges [lindex $rowrangelist $rp1]
3385
4029
if {$ranges eq {}} {
3386
set ranges [list $row $rp1]
3387
} elseif {[lindex $ranges end-1] == $rp1} {
3388
lset ranges end-1 $row
4030
set ranges [list $newcmit $p]
4031
} elseif {[lindex $ranges end-1] eq $p} {
4032
lset ranges end-1 $newcmit
3389
4033
}
3390
4034
lset rowrangelist $rp1 $ranges
3391
4035
}
3392
foreach id [array names idrowranges] {
3393
set ranges $idrowranges($id)
3394
if {$ranges ne {} && [lindex $ranges end] >= $row} {
3395
set newranges {}
3396
foreach x $ranges {
3397
if {$x >= $row} {
3398
lappend newranges [expr {$x + 1}]
3399
} else {
3400
lappend newranges $x
3401
}
3402
}
3403
set idrowranges($id) $newranges
3404
}
3405
}
3406
4036
3407
set linesegends [linsert $linesegends $row {}]
4037
catch {unset rowchk}
3408
4038
3409
4039
incr rowlaidout
3410
4040
incr rowoptim
3416
4046
redisplay
3417
4047
}
3418
4048
4049
# Remove a commit that was inserted with insertrow on row $row.
4050
proc removerow {row} {
4051
global displayorder parentlist commitlisted children
4052
global commitrow curview rowidlist rowoffsets numcommits
4053
global rowrangelist idrowranges rowlaidout rowoptim numcommits
4054
global linesegends selectedline rowchk commitidx
4055
4056
if {$row >= $numcommits} {
4057
puts "oops, removing row $row but only have $numcommits rows"
4058
return
4059
}
4060
set rp1 [expr {$row + 1}]
4061
set id [lindex $displayorder $row]
4062
set p [lindex $parentlist $row]
4063
set displayorder [lreplace $displayorder $row $row]
4064
set parentlist [lreplace $parentlist $row $row]
4065
set commitlisted [lreplace $commitlisted $row $row]
4066
set kids $children($curview,$p)
4067
set i [lsearch -exact $kids $id]
4068
if {$i >= 0} {
4069
set kids [lreplace $kids $i $i]
4070
set children($curview,$p) $kids
4071
}
4072
set l [llength $displayorder]
4073
for {set r $row} {$r < $l} {incr r} {
4074
set id [lindex $displayorder $r]
4075
set commitrow($curview,$id) $r
4076
}
4077
incr commitidx($curview) -1
4078
4079
set rowidlist [lreplace $rowidlist $row $row]
4080
set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
4081
if {$kids ne {}} {
4082
set offs [lindex $rowoffsets $row]
4083
set offs [lreplace $offs end end]
4084
lset rowoffsets $row $offs
4085
}
4086
4087
set rowrangelist [lreplace $rowrangelist $row $row]
4088
if {[llength $kids] > 0} {
4089
set ranges [lindex $rowrangelist $row]
4090
if {[lindex $ranges end-1] eq $id} {
4091
set ranges [lreplace $ranges end-1 end]
4092
lset rowrangelist $row $ranges
4093
}
4094
}
4095
4096
catch {unset rowchk}
4097
4098
incr rowlaidout -1
4099
incr rowoptim -1
4100
incr numcommits -1
4101
4102
if {[info exists selectedline] && $selectedline > $row} {
4103
incr selectedline -1
4104
}
4105
redisplay
4106
}
4107
3419
4108
# Don't change the text pane cursor if it is currently the hand cursor,
3420
4109
# showing that we are over a sha1 ID link.
3421
4110
proc settextcursor {c} {
3447
4136
}
3448
4137
}
3449
4138
3450
proc drawrest {} {
3451
global startmsecs
3452
global rowlaidout commitidx curview
3453
global pending_select
3454
3455
set row $rowlaidout
3456
layoutrows $rowlaidout $commitidx($curview) 1
3457
layouttail
3458
optimize_rows $row 0 $commitidx($curview)
3459
showstuff $commitidx($curview)
3460
if {[info exists pending_select]} {
3461
selectline 0 1
3462
}
3463
3464
set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3465
#global numcommits
3466
#puts "overall $drawmsecs ms for $numcommits commits"
3467
}
3468
3469
4139
proc findmatches {f} {
3470
global findtype foundstring foundstrlen
4140
global findtype findstring
3471
4141
if {$findtype == "Regexp"} {
3472
set matches [regexp -indices -all -inline $foundstring $f]
4142
set matches [regexp -indices -all -inline $findstring $f]
3473
4143
} else {
4144
set fs $findstring
3474
4145
if {$findtype == "IgnCase"} {
3475
set str [string tolower $f]
3476
} else {
3477
set str $f
4146
set f [string tolower $f]
4147
set fs [string tolower $fs]
3478
4148
}
3479
4149
set matches {}
3480
4150
set i 0
3481
while {[set j [string first $foundstring $str $i]] >= 0} {
3482
lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3483
set i [expr {$j + $foundstrlen}]
4151
set l [string length $fs]
4152
while {[set j [string first $fs $f $i]] >= 0} {
4153
lappend matches [list $j [expr {$j+$l-1}]]
4154
set i [expr {$j + $l}]
3484
4155
}
3485
4156
}
3486
4157
return $matches
3487
4158
}
3488
4159
3489
proc dofind {} {
3490
global findtype findloc findstring markedmatches commitinfo
3491
global numcommits displayorder linehtag linentag linedtag
3492
global mainfont canv canv2 canv3 selectedline
3493
global matchinglines foundstring foundstrlen matchstring
3494
global commitdata
4160
proc dofind {{rev 0}} {
4161
global findstring findstartline findcurline selectedline numcommits
3495
4162
3496
stopfindproc
3497
4163
unmarkmatches
3498
4164
cancel_next_highlight
3499
4165
focus .
3500
set matchinglines {}
3501
if {$findtype == "IgnCase"} {
3502
set foundstring [string tolower $findstring]
3503
} else {
3504
set foundstring $findstring
3505
}
3506
set foundstrlen [string length $findstring]
3507
if {$foundstrlen == 0} return
3508
regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3509
set matchstring "*$matchstring*"
4166
if {$findstring eq {} || $numcommits == 0} return
3510
4167
if {![info exists selectedline]} {
3511
set oldsel -1
3512
} else {
3513
set oldsel $selectedline
3514
}
3515
set didsel 0
3516
set fldtypes {Headline Author Date Committer CDate Comments}
3517
set l -1
3518
foreach id $displayorder {
3519
set d $commitdata($id)
3520
incr l
3521
if {$findtype == "Regexp"} {
3522
set doesmatch [regexp $foundstring $d]
3523
} elseif {$findtype == "IgnCase"} {
3524
set doesmatch [string match -nocase $matchstring $d]
4168
set findstartline [lindex [visiblerows] $rev]
4169
} else {
4170
set findstartline $selectedline
4171
}
4172
set findcurline $findstartline
4173
nowbusy finding
4174
if {!$rev} {
4175
run findmore
4176
} else {
4177
if {$findcurline == 0} {
4178
set findcurline $numcommits
4179
}
4180
incr findcurline -1
4181
run findmorerev
4182
}
4183
}
4184
4185
proc findnext {restart} {
4186
global findcurline
4187
if {![info exists findcurline]} {
4188
if {$restart} {
4189
dofind
3525
4190
} else {
3526
set doesmatch [string match $matchstring $d]
3527
}
3528
if {!$doesmatch} continue
3529
if {![info exists commitinfo($id)]} {
3530
getcommit $id
3531
}
3532
set info $commitinfo($id)
3533
set doesmatch 0
3534
foreach f $info ty $fldtypes {
3535
if {$findloc != "All fields" && $findloc != $ty} {
3536
continue
3537
}
3538
set matches [findmatches $f]
3539
if {$matches == {}} continue
3540
set doesmatch 1
3541
if {$ty == "Headline"} {
3542
drawcmitrow $l
3543
markmatches $canv $l $f $linehtag($l) $matches $mainfont
3544
} elseif {$ty == "Author"} {
3545
drawcmitrow $l
3546
markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3547
} elseif {$ty == "Date"} {
3548
drawcmitrow $l
3549
markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3550
}
3551
}
3552
if {$doesmatch} {
3553
lappend matchinglines $l
3554
if {!$didsel && $l > $oldsel} {
3555
findselectline $l
3556
set didsel 1
3557
}
3558
}
3559
}
3560
if {$matchinglines == {}} {
3561
bell
3562
} elseif {!$didsel} {
3563
findselectline [lindex $matchinglines 0]
3564
}
4191
bell
4192
}
4193
} else {
4194
run findmore
4195
nowbusy finding
4196
}
4197
}
4198
4199
proc findprev {} {
4200
global findcurline
4201
if {![info exists findcurline]} {
4202
dofind 1
4203
} else {
4204
run findmorerev
4205
nowbusy finding
4206
}
4207
}
4208
4209
proc findmore {} {
4210
global commitdata commitinfo numcommits findstring findpattern findloc
4211
global findstartline findcurline displayorder
4212
4213
set fldtypes {Headline Author Date Committer CDate Comments}
4214
set l [expr {$findcurline + 1}]
4215
if {$l >= $numcommits} {
4216
set l 0
4217
}
4218
if {$l <= $findstartline} {
4219
set lim [expr {$findstartline + 1}]
4220
} else {
4221
set lim $numcommits
4222
}
4223
if {$lim - $l > 500} {
4224
set lim [expr {$l + 500}]
4225
}
4226
set last 0
4227
for {} {$l < $lim} {incr l} {
4228
set id [lindex $displayorder $l]
4229
# shouldn't happen unless git log doesn't give all the commits...
4230
if {![info exists commitdata($id)]} continue
4231
if {![doesmatch $commitdata($id)]} continue
4232
if {![info exists commitinfo($id)]} {
4233
getcommit $id
4234
}
4235
set info $commitinfo($id)
4236
foreach f $info ty $fldtypes {
4237
if {($findloc eq "All fields" || $findloc eq $ty) &&
4238
[doesmatch $f]} {
4239
findselectline $l
4240
notbusy finding
4241
return 0
4242
}
4243
}
4244
}
4245
if {$l == $findstartline + 1} {
4246
bell
4247
unset findcurline
4248
notbusy finding
4249
return 0
4250
}
4251
set findcurline [expr {$l - 1}]
4252
return 1
4253
}
4254
4255
proc findmorerev {} {
4256
global commitdata commitinfo numcommits findstring findpattern findloc
4257
global findstartline findcurline displayorder
4258
4259
set fldtypes {Headline Author Date Committer CDate Comments}
4260
set l $findcurline
4261
if {$l == 0} {
4262
set l $numcommits
4263
}
4264
incr l -1
4265
if {$l >= $findstartline} {
4266
set lim [expr {$findstartline - 1}]
4267
} else {
4268
set lim -1
4269
}
4270
if {$l - $lim > 500} {
4271
set lim [expr {$l - 500}]
4272
}
4273
set last 0
4274
for {} {$l > $lim} {incr l -1} {
4275
set id [lindex $displayorder $l]
4276
if {![doesmatch $commitdata($id)]} continue
4277
if {![info exists commitinfo($id)]} {
4278
getcommit $id
4279
}
4280
set info $commitinfo($id)
4281
foreach f $info ty $fldtypes {
4282
if {($findloc eq "All fields" || $findloc eq $ty) &&
4283
[doesmatch $f]} {
4284
findselectline $l
4285
notbusy finding
4286
return 0
4287
}
4288
}
4289
}
4290
if {$l == -1} {
4291
bell
4292
unset findcurline
4293
notbusy finding
4294
return 0
4295
}
4296
set findcurline [expr {$l + 1}]
4297
return 1
3565
4298
}
3566
4299
3567
4300
proc findselectline {l} {
3568
global findloc commentend ctext
4301
global findloc commentend ctext findcurline markingmatches
4302
4303
set markingmatches 1
4304
set findcurline $l
3569
4305
selectline $l 1
3570
4306
if {$findloc == "All fields" || $findloc == "Comments"} {
3571
4307
# highlight the matches in the comments
3577
4313
$ctext tag add found "1.0 + $start c" "1.0 + $end c"
3578
4314
}
3579
4315
}
3580
}
3581
3582
proc findnext {restart} {
3583
global matchinglines selectedline
3584
if {![info exists matchinglines]} {
3585
if {$restart} {
3586
dofind
3587
}
3588
return
3589
}
3590
if {![info exists selectedline]} return
3591
foreach l $matchinglines {
3592
if {$l > $selectedline} {
3593
findselectline $l
3594
return
3595
}
3596
}
3597
bell
3598
}
3599
3600
proc findprev {} {
3601
global matchinglines selectedline
3602
if {![info exists matchinglines]} {
3603
dofind
3604
return
3605
}
3606
if {![info exists selectedline]} return
3607
set prev {}
3608
foreach l $matchinglines {
3609
if {$l >= $selectedline} break
3610
set prev $l
3611
}
3612
if {$prev != {}} {
3613
findselectline $prev
3614
} else {
3615
bell
3616
}
3617
}
3618
3619
proc stopfindproc {{done 0}} {
3620
global findprocpid findprocfile findids
3621
global ctext findoldcursor phase maincursor textcursor
3622
global findinprogress
3623
3624
catch {unset findids}
3625
if {[info exists findprocpid]} {
3626
if {!$done} {
3627
catch {exec kill $findprocpid}
3628
}
3629
catch {close $findprocfile}
3630
unset findprocpid
3631
}
3632
catch {unset findinprogress}
3633
notbusy find
3634
}
3635
3636
# mark a commit as matching by putting a yellow background
3637
# behind the headline
3638
proc markheadline {l id} {
3639
global canv mainfont linehtag
3640
3641
drawcmitrow $l
3642
set bbox [$canv bbox $linehtag($l)]
3643
set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3644
$canv lower $t
3645
}
3646
3647
# mark the bits of a headline, author or date that match a find string
3648
proc markmatches {canv l str tag matches font} {
4316
drawvisible
4317
}
4318
4319
# mark the bits of a headline or author that match a find string
4320
proc markmatches {canv l str tag matches font row} {
4321
global selectedline
4322
3649
4323
set bbox [$canv bbox $tag]
3650
4324
set x0 [lindex $bbox 0]
3651
4325
set y0 [lindex $bbox 1]
3658
4332
set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3659
4333
set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3660
4334
[expr {$x0+$xlen+2}] $y1 \
3661
-outline {} -tags matches -fill yellow]
4335
-outline {} -tags [list match$l matches] -fill yellow]
3662
4336
$canv lower $t
4337
if {[info exists selectedline] && $row == $selectedline} {
4338
$canv raise $t secsel
4339
}
3663
4340
}
3664
4341
}
3665
4342
3666
4343
proc unmarkmatches {} {
3667
global matchinglines findids
4344
global findids markingmatches findcurline
4345
3668
4346
allcanvs delete matches
3669
catch {unset matchinglines}
3670
4347
catch {unset findids}
4348
set markingmatches 0
4349
catch {unset findcurline}
3671
4350
}
3672
4351
3673
4352
proc selcanvline {w x y} {
3743
4422
3744
4423
# add a list of tag or branch names at position pos
3745
4424
# returns the number of names inserted
3746
proc appendrefs {pos tags var} {
3747
global ctext commitrow linknum curview $var
4425
proc appendrefs {pos ids var} {
4426
global ctext commitrow linknum curview $var maxrefs
3748
4427
3749
4428
if {[catch {$ctext index $pos}]} {
3750
4429
return 0
3751
4430
}
3752
set tags [lsort $tags]
3753
set sep {}
3754
foreach tag $tags {
3755
set id [set $var\($tag\)]
3756
set lk link$linknum
3757
incr linknum
3758
$ctext insert $pos $sep
3759
$ctext insert $pos $tag $lk
3760
$ctext tag conf $lk -foreground blue
3761
if {[info exists commitrow($curview,$id)]} {
3762
$ctext tag bind $lk <1> \
3763
[list selectline $commitrow($curview,$id) 1]
3764
$ctext tag conf $lk -underline 1
3765
$ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3766
$ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3767
}
3768
set sep ", "
3769
}
4431
$ctext conf -state normal
4432
$ctext delete $pos "$pos lineend"
4433
set tags {}
4434
foreach id $ids {
4435
foreach tag [set $var\($id\)] {
4436
lappend tags [list $tag $id]
4437
}
4438
}
4439
if {[llength $tags] > $maxrefs} {
4440
$ctext insert $pos "many ([llength $tags])"
4441
} else {
4442
set tags [lsort -index 0 -decreasing $tags]
4443
set sep {}
4444
foreach ti $tags {
4445
set id [lindex $ti 1]
4446
set lk link$linknum
4447
incr linknum
4448
$ctext tag delete $lk
4449
$ctext insert $pos $sep
4450
$ctext insert $pos [lindex $ti 0] $lk
4451
if {[info exists commitrow($curview,$id)]} {
4452
$ctext tag conf $lk -foreground blue
4453
$ctext tag bind $lk <1> \
4454
[list selectline $commitrow($curview,$id) 1]
4455
$ctext tag conf $lk -underline 1
4456
$ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4457
$ctext tag bind $lk <Leave> \
4458
{ %W configure -cursor $curtextcursor }
4459
}
4460
set sep ", "
4461
}
4462
}
4463
$ctext conf -state disabled
3770
4464
return [llength $tags]
3771
4465
}
3772
4466
3773
proc taglist {ids} {
3774
global idtags
3775
3776
set tags {}
3777
foreach id $ids {
3778
foreach tag $idtags($id) {
3779
lappend tags $tag
3780
}
3781
}
3782
return $tags
3783
}
3784
3785
4467
# called when we have finished computing the nearby tags
3786
proc dispneartags {} {
3787
global selectedline currentid ctext anc_tags desc_tags showneartags
3788
global desc_heads
3789
3790
if {![info exists selectedline] || !$showneartags} return
3791
set id $currentid
3792
$ctext conf -state normal
3793
if {[info exists desc_heads($id)]} {
3794
if {[appendrefs branch $desc_heads($id) headids] > 1} {
3795
$ctext insert "branch -2c" "es"
3796
}
3797
}
3798
if {[info exists anc_tags($id)]} {
3799
appendrefs follows [taglist $anc_tags($id)] tagids
3800
}
3801
if {[info exists desc_tags($id)]} {
3802
appendrefs precedes [taglist $desc_tags($id)] tagids
3803
}
3804
$ctext conf -state disabled
4468
proc dispneartags {delay} {
4469
global selectedline currentid showneartags tagphase
4470
4471
if {![info exists selectedline] || !$showneartags} return
4472
after cancel dispnexttag
4473
if {$delay} {
4474
after 200 dispnexttag
4475
set tagphase -1
4476
} else {
4477
after idle dispnexttag
4478
set tagphase 0
4479
}
4480
}
4481
4482
proc dispnexttag {} {
4483
global selectedline currentid showneartags tagphase ctext
4484
4485
if {![info exists selectedline] || !$showneartags} return
4486
switch -- $tagphase {
4487
0 {
4488
set dtags [desctags $currentid]
4489
if {$dtags ne {}} {
4490
appendrefs precedes $dtags idtags
4491
}
4492
}
4493
1 {
4494
set atags [anctags $currentid]
4495
if {$atags ne {}} {
4496
appendrefs follows $atags idtags
4497
}
4498
}
4499
2 {
4500
set dheads [descheads $currentid]
4501
if {$dheads ne {}} {
4502
if {[appendrefs branch $dheads idheads] > 1
4503
&& [$ctext get "branch -3c"] eq "h"} {
4504
# turn "Branch" into "Branches"
4505
$ctext conf -state normal
4506
$ctext insert "branch -2c" "es"
4507
$ctext conf -state disabled
4508
}
4509
}
4510
}
4511
}
4512
if {[incr tagphase] <= 2} {
4513
after idle dispnexttag
4514
}
3805
4515
}
3806
4516
3807
4517
proc selectline {l isnew} {
3808
4518
global canv canv2 canv3 ctext commitinfo selectedline
3809
4519
global displayorder linehtag linentag linedtag
3810
global canvy0 linespc parentlist childlist
4520
global canvy0 linespc parentlist children curview
3811
4521
global currentid sha1entry
3812
4522
global commentend idtags linknum
3813
4523
global mergemax numcommits pending_select
3814
global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
4524
global cmitmode showneartags allcommits
3815
4525
3816
4526
catch {unset pending_select}
3817
4527
$canv delete hover
3818
4528
normalline
3819
4529
cancel_next_highlight
4530
unsel_reflist
3820
4531
if {$l < 0 || $l >= $numcommits} return
3821
4532
set y [expr {$canvy0 + $l * $linespc}]
3822
4533
set ymax [lindex [$canv cget -scrollregion] 3]
3897
4608
}
3898
4609
$ctext insert end "\n"
3899
4610
}
3900
4611
3901
4612
set headers {}
3902
4613
set olds [lindex $parentlist $l]
3903
4614
if {[llength $olds] > 1} {
3918
4629
}
3919
4630
}
3920
4631
3921
foreach c [lindex $childlist $l] {
4632
foreach c $children($curview,$id) {
3922
4633
append headers "Child: [commit_descriptor $c]"
3923
4634
}
3924
4635
3931
4642
$ctext insert end "Branch: "
3932
4643
$ctext mark set branch "end -1c"
3933
4644
$ctext mark gravity branch left
3934
if {[info exists desc_heads($id)]} {
3935
if {[appendrefs branch $desc_heads($id) headids] > 1} {
3936
# turn "Branch" into "Branches"
3937
$ctext insert "branch -2c" "es"
3938
}
3939
}
3940
4645
$ctext insert end "\nFollows: "
3941
4646
$ctext mark set follows "end -1c"
3942
4647
$ctext mark gravity follows left
3943
if {[info exists anc_tags($id)]} {
3944
appendrefs follows [taglist $anc_tags($id)] tagids
3945
}
3946
4648
$ctext insert end "\nPrecedes: "
3947
4649
$ctext mark set precedes "end -1c"
3948
4650
$ctext mark gravity precedes left
3949
if {[info exists desc_tags($id)]} {
3950
appendrefs precedes [taglist $desc_tags($id)] tagids
3951
}
3952
4651
$ctext insert end "\n"
4652
dispneartags 1
3953
4653
}
3954
4654
$ctext insert end "\n"
3955
appendwithlinks [lindex $info 5] {comment}
4655
set comment [lindex $info 5]
4656
if {[string first "\r" $comment] >= 0} {
4657
set comment [string map {"\r" "\n "} $comment]
4658
}
4659
appendwithlinks $comment {comment}
3956
4660
3957
$ctext tag delete Comments
3958
4661
$ctext tag remove found 1.0 end
3959
4662
$ctext conf -state disabled
3960
4663
set commentend [$ctext index "end - 1c"]
3983
4686
3984
4687
proc selnextline {dir} {
3985
4688
global selectedline
4689
focus .
3986
4690
if {![info exists selectedline]} return
3987
4691
set l [expr {$selectedline + $dir}]
3988
4692
unmarkmatches
4006
4710
set l [expr $numcommits - 1]
4007
4711
}
4008
4712
unmarkmatches
4009
selectline $l 1
4713
selectline $l 1
4010
4714
}
4011
4715
4012
4716
proc unselectline {} {
4043
4747
}
4044
4748
incr historyindex
4045
4749
if {$historyindex > 1} {
4046
.ctop.top.bar.leftbut conf -state normal
4750
.tf.bar.leftbut conf -state normal
4047
4751
} else {
4048
.ctop.top.bar.leftbut conf -state disabled
4752
.tf.bar.leftbut conf -state disabled
4049
4753
}
4050
.ctop.top.bar.rightbut conf -state disabled
4754
.tf.bar.rightbut conf -state disabled
4051
4755
}
4052
4756
4053
4757
proc godo {elt} {
4063
4767
4064
4768
proc goback {} {
4065
4769
global history historyindex
4770
focus .
4066
4771
4067
4772
if {$historyindex > 1} {
4068
4773
incr historyindex -1
4069
4774
godo [lindex $history [expr {$historyindex - 1}]]
4070
.ctop.top.bar.rightbut conf -state normal
4775
.tf.bar.rightbut conf -state normal
4071
4776
}
4072
4777
if {$historyindex <= 1} {
4073
.ctop.top.bar.leftbut conf -state disabled
4778
.tf.bar.leftbut conf -state disabled
4074
4779
}
4075
4780
}
4076
4781
4077
4782
proc goforw {} {
4078
4783
global history historyindex
4784
focus .
4079
4785
4080
4786
if {$historyindex < [llength $history]} {
4081
4787
set cmd [lindex $history $historyindex]
4082
4788
incr historyindex
4083
4789
godo $cmd
4084
.ctop.top.bar.leftbut conf -state normal
4790
.tf.bar.leftbut conf -state normal
4085
4791
}
4086
4792
if {$historyindex >= [llength $history]} {
4087
.ctop.top.bar.rightbut conf -state disabled
4793
.tf.bar.rightbut conf -state disabled
4088
4794
}
4089
4795
}
4090
4796
4091
4797
proc gettree {id} {
4092
4798
global treefilelist treeidlist diffids diffmergeid treepending
4799
global nullid nullid2
4093
4800
4094
4801
set diffids $id
4095
4802
catch {unset diffmergeid}
4096
4803
if {![info exists treefilelist($id)]} {
4097
4804
if {![info exists treepending]} {
4098
if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4805
if {$id eq $nullid} {
4806
set cmd [list | git ls-files]
4807
} elseif {$id eq $nullid2} {
4808
set cmd [list | git ls-files --stage -t]
4809
} else {
4810
set cmd [list | git ls-tree -r $id]
4811
}
4812
if {[catch {set gtf [open $cmd r]}]} {
4099
4813
return
4100
4814
}
4101
4815
set treepending $id
4102
4816
set treefilelist($id) {}
4103
4817
set treeidlist($id) {}
4104
4818
fconfigure $gtf -blocking 0
4105
fileevent $gtf readable [list gettreeline $gtf $id]
4819
filerun $gtf [list gettreeline $gtf $id]
4106
4820
}
4107
4821
} else {
4108
4822
setfilelist $id
4110
4824
}
4111
4825
4112
4826
proc gettreeline {gtf id} {
4113
global treefilelist treeidlist treepending cmitmode diffids
4827
global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4114
4828
4115
while {[gets $gtf line] >= 0} {
4116
if {[lindex $line 1] ne "blob"} continue
4117
set sha1 [lindex $line 2]
4118
set fname [lindex $line 3]
4829
set nl 0
4830
while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4831
if {$diffids eq $nullid} {
4832
set fname $line
4833
} else {
4834
if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4835
set i [string first "\t" $line]
4836
if {$i < 0} continue
4837
set sha1 [lindex $line 2]
4838
set fname [string range $line [expr {$i+1}] end]
4839
if {[string index $fname 0] eq "\""} {
4840
set fname [lindex $fname 0]
4841
}
4842
lappend treeidlist($id) $sha1
4843
}
4119
4844
lappend treefilelist($id) $fname
4120
lappend treeidlist($id) $sha1
4121
}
4122
if {![eof $gtf]} return
4845
}
4846
if {![eof $gtf]} {
4847
return [expr {$nl >= 1000? 2: 1}]
4848
}
4123
4849
close $gtf
4124
4850
unset treepending
4125
4851
if {$cmitmode ne "tree"} {
4131
4857
} else {
4132
4858
setfilelist $id
4133
4859
}
4860
return 0
4134
4861
}
4135
4862
4136
4863
proc showfile {f} {
4137
global treefilelist treeidlist diffids
4864
global treefilelist treeidlist diffids nullid nullid2
4138
4865
global ctext commentend
4139
4866
4140
4867
set i [lsearch -exact $treefilelist($diffids) $f]
4142
4869
puts "oops, $f not in list for id $diffids"
4143
4870
return
4144
4871
}
4145
set blob [lindex $treeidlist($diffids) $i]
4146
if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4147
puts "oops, error reading blob $blob: $err"
4148
return
4872
if {$diffids eq $nullid} {
4873
if {[catch {set bf [open $f r]} err]} {
4874
puts "oops, can't read $f: $err"
4875
return
4876
}
4877
} else {
4878
set blob [lindex $treeidlist($diffids) $i]
4879
if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4880
puts "oops, error reading blob $blob: $err"
4881
return
4882
}
4149
4883
}
4150
4884
fconfigure $bf -blocking 0
4151
fileevent $bf readable [list getblobline $bf $diffids]
4885
filerun $bf [list getblobline $bf $diffids]
4152
4886
$ctext config -state normal
4153
4887
clear_ctext $commentend
4154
4888
$ctext insert end "\n"
4162
4896
4163
4897
if {$id ne $diffids || $cmitmode ne "tree"} {
4164
4898
catch {close $bf}
4165
return
4899
return 0
4166
4900
}
4167
4901
$ctext config -state normal
4168
while {[gets $bf line] >= 0} {
4902
set nl 0
4903
while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4169
4904
$ctext insert end "$line\n"
4170
4905
}
4171
4906
if {[eof $bf]} {
4172
4907
# delete last newline
4173
4908
$ctext delete "end - 2c" "end - 1c"
4174
4909
close $bf
4910
return 0
4175
4911
}
4176
4912
$ctext config -state disabled
4913
return [expr {$nl >= 1000? 2: 1}]
4177
4914
}
4178
4915
4179
4916
proc mergediff {id l} {
4193
4930
fconfigure $mdf -blocking 0
4194
4931
set mdifffd($id) $mdf
4195
4932
set np [llength [lindex $parentlist $l]]
4196
fileevent $mdf readable [list getmergediffline $mdf $id $np]
4197
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4933
filerun $mdf [list getmergediffline $mdf $id $np]
4198
4934
}
4199
4935
4200
4936
proc getmergediffline {mdf id np} {
4201
global diffmergeid ctext cflist nextupdate mergemax
4937
global diffmergeid ctext cflist mergemax
4202
4938
global difffilestart mdifffd
4203
4939
4204
set n [gets $mdf line]
4205
if {$n < 0} {
4206
if {[eof $mdf]} {
4940
$ctext conf -state normal
4941
set nr 0
4942
while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4943
if {![info exists diffmergeid] || $id != $diffmergeid
4944
|| $mdf != $mdifffd($id)} {
4207
4945
close $mdf
4208
}
4209
return
4210
}
4211
if {![info exists diffmergeid] || $id != $diffmergeid
4212
|| $mdf != $mdifffd($id)} {
4213
return
4214
}
4215
$ctext conf -state normal
4216
if {[regexp {^diff --cc (.*)} $line match fname]} {
4217
# start of a new file
4218
$ctext insert end "\n"
4219
set here [$ctext index "end - 1c"]
4220
lappend difffilestart $here
4221
add_flist [list $fname]
4222
set l [expr {(78 - [string length $fname]) / 2}]
4223
set pad [string range "----------------------------------------" 1 $l]
4224
$ctext insert end "$pad $fname $pad\n" filesep
4225
} elseif {[regexp {^@@} $line]} {
4226
$ctext insert end "$line\n" hunksep
4227
} elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4228
# do nothing
4229
} else {
4230
# parse the prefix - one ' ', '-' or '+' for each parent
4231
set spaces {}
4232
set minuses {}
4233
set pluses {}
4234
set isbad 0
4235
for {set j 0} {$j < $np} {incr j} {
4236
set c [string range $line $j $j]
4237
if {$c == " "} {
4238
lappend spaces $j
4239
} elseif {$c == "-"} {
4240
lappend minuses $j
4241
} elseif {$c == "+"} {
4242
lappend pluses $j
4243
} else {
4244
set isbad 1
4245
break
4246
}
4247
}
4248
set tags {}
4249
set num {}
4250
if {!$isbad && $minuses ne {} && $pluses eq {}} {
4251
# line doesn't appear in result, parents in $minuses have the line
4252
set num [lindex $minuses 0]
4253
} elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4254
# line appears in result, parents in $pluses don't have the line
4255
lappend tags mresult
4256
set num [lindex $spaces 0]
4257
}
4258
if {$num ne {}} {
4259
if {$num >= $mergemax} {
4260
set num "max"
4261
}
4262
lappend tags m$num
4263
}
4264
$ctext insert end "$line\n" $tags
4946
return 0
4947
}
4948
if {[regexp {^diff --cc (.*)} $line match fname]} {
4949
# start of a new file
4950
$ctext insert end "\n"
4951
set here [$ctext index "end - 1c"]
4952
lappend difffilestart $here
4953
add_flist [list $fname]
4954
set l [expr {(78 - [string length $fname]) / 2}]
4955
set pad [string range "----------------------------------------" 1 $l]
4956
$ctext insert end "$pad $fname $pad\n" filesep
4957
} elseif {[regexp {^@@} $line]} {
4958
$ctext insert end "$line\n" hunksep
4959
} elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4960
# do nothing
4961
} else {
4962
# parse the prefix - one ' ', '-' or '+' for each parent
4963
set spaces {}
4964
set minuses {}
4965
set pluses {}
4966
set isbad 0
4967
for {set j 0} {$j < $np} {incr j} {
4968
set c [string range $line $j $j]
4969
if {$c == " "} {
4970
lappend spaces $j
4971
} elseif {$c == "-"} {
4972
lappend minuses $j
4973
} elseif {$c == "+"} {
4974
lappend pluses $j
4975
} else {
4976
set isbad 1
4977
break
4978
}
4979
}
4980
set tags {}
4981
set num {}
4982
if {!$isbad && $minuses ne {} && $pluses eq {}} {
4983
# line doesn't appear in result, parents in $minuses have the line
4984
set num [lindex $minuses 0]
4985
} elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4986
# line appears in result, parents in $pluses don't have the line
4987
lappend tags mresult
4988
set num [lindex $spaces 0]
4989
}
4990
if {$num ne {}} {
4991
if {$num >= $mergemax} {
4992
set num "max"
4993
}
4994
lappend tags m$num
4995
}
4996
$ctext insert end "$line\n" $tags
4997
}
4265
4998
}
4266
4999
$ctext conf -state disabled
4267
if {[clock clicks -milliseconds] >= $nextupdate} {
4268
incr nextupdate 100
4269
fileevent $mdf readable {}
4270
update
4271
fileevent $mdf readable [list getmergediffline $mdf $id $np]
5000
if {[eof $mdf]} {
5001
close $mdf
5002
return 0
4272
5003
}
5004
return [expr {$nr >= 1000? 2: 1}]
4273
5005
}
4274
5006
4275
5007
proc startdiff {ids} {
4276
global treediffs diffids treepending diffmergeid
5008
global treediffs diffids treepending diffmergeid nullid nullid2
4277
5009
4278
5010
set diffids $ids
4279
5011
catch {unset diffmergeid}
4280
if {![info exists treediffs($ids)]} {
5012
if {![info exists treediffs($ids)] ||
5013
[lsearch -exact $ids $nullid] >= 0 ||
5014
[lsearch -exact $ids $nullid2] >= 0} {
4281
5015
if {![info exists treepending]} {
4282
5016
gettreediffs $ids
4283
5017
}
4292
5026
getblobdiffs $ids
4293
5027
}
4294
5028
5029
proc diffcmd {ids flags} {
5030
global nullid nullid2
5031
5032
set i [lsearch -exact $ids $nullid]
5033
set j [lsearch -exact $ids $nullid2]
5034
if {$i >= 0} {
5035
if {[llength $ids] > 1 && $j < 0} {
5036
# comparing working directory with some specific revision
5037
set cmd [concat | git diff-index $flags]
5038
if {$i == 0} {
5039
lappend cmd -R [lindex $ids 1]
5040
} else {
5041
lappend cmd [lindex $ids 0]
5042
}
5043
} else {
5044
# comparing working directory with index
5045
set cmd [concat | git diff-files $flags]
5046
if {$j == 1} {
5047
lappend cmd -R
5048
}
5049
}
5050
} elseif {$j >= 0} {
5051
set cmd [concat | git diff-index --cached $flags]
5052
if {[llength $ids] > 1} {
5053
# comparing index with specific revision
5054
if {$i == 0} {
5055
lappend cmd -R [lindex $ids 1]
5056
} else {
5057
lappend cmd [lindex $ids 0]
5058
}
5059
} else {
5060
# comparing index with HEAD
5061
lappend cmd HEAD
5062
}
5063
} else {
5064
set cmd [concat | git diff-tree -r $flags $ids]
5065
}
5066
return $cmd
5067
}
5068
4295
5069
proc gettreediffs {ids} {
4296
5070
global treediff treepending
5071
4297
5072
set treepending $ids
4298
5073
set treediff {}
4299
if {[catch \
4300
{set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4301
]} return
5074
if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
4302
5075
fconfigure $gdtf -blocking 0
4303
fileevent $gdtf readable [list gettreediffline $gdtf $ids]
5076
filerun $gdtf [list gettreediffline $gdtf $ids]
4304
5077
}
4305
5078
4306
5079
proc gettreediffline {gdtf ids} {
4307
5080
global treediff treediffs treepending diffids diffmergeid
4308
5081
global cmitmode
4309
5082
4310
set n [gets $gdtf line]
4311
if {$n < 0} {
4312
if {![eof $gdtf]} return
4313
close $gdtf
4314
set treediffs($ids) $treediff
4315
unset treepending
4316
if {$cmitmode eq "tree"} {
4317
gettree $diffids
4318
} elseif {$ids != $diffids} {
4319
if {![info exists diffmergeid]} {
4320
gettreediffs $diffids
5083
set nr 0
5084
while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5085
set i [string first "\t" $line]
5086
if {$i >= 0} {
5087
set file [string range $line [expr {$i+1}] end]
5088
if {[string index $file 0] eq "\""} {
5089
set file [lindex $file 0]
4321
5090
}
4322
} else {
4323
addtocflist $ids
4324
}
4325
return
4326
}
4327
set file [lindex $line 5]
4328
lappend treediff $file
5091
lappend treediff $file
5092
}
5093
}
5094
if {![eof $gdtf]} {
5095
return [expr {$nr >= 1000? 2: 1}]
5096
}
5097
close $gdtf
5098
set treediffs($ids) $treediff
5099
unset treepending
5100
if {$cmitmode eq "tree"} {
5101
gettree $diffids
5102
} elseif {$ids != $diffids} {
5103
if {![info exists diffmergeid]} {
5104
gettreediffs $diffids
5105
}
5106
} else {
5107
addtocflist $ids
5108
}
5109
return 0
5110
}
5111
5112
# empty string or positive integer
5113
proc diffcontextvalidate {v} {
5114
return [regexp {^(|[1-9][0-9]*)$} $v]
5115
}
5116
5117
proc diffcontextchange {n1 n2 op} {
5118
global diffcontextstring diffcontext
5119
5120
if {[string is integer -strict $diffcontextstring]} {
5121
if {$diffcontextstring > 0} {
5122
set diffcontext $diffcontextstring
5123
reselectline
5124
}
5125
}
4329
5126
}
4330
5127
4331
5128
proc getblobdiffs {ids} {
4332
global diffopts blobdifffd diffids env curdifftag curtagstart
4333
global nextupdate diffinhdr treediffs
5129
global diffopts blobdifffd diffids env
5130
global diffinhdr treediffs
5131
global diffcontext
4334
5132
4335
5133
set env(GIT_DIFF_OPTS) $diffopts
4336
set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4337
if {[catch {set bdf [open $cmd r]} err]} {
5134
if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
4338
5135
puts "error getting diffs: $err"
4339
5136
return
4340
5137
}
4341
5138
set diffinhdr 0
4342
5139
fconfigure $bdf -blocking 0
4343
5140
set blobdifffd($ids) $bdf
4344
set curdifftag Comments
4345
set curtagstart 0.0
4346
fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4347
set nextupdate [expr {[clock clicks -milliseconds] + 100}]
5141
filerun $bdf [list getblobdiffline $bdf $diffids]
4348
5142
}
4349
5143
4350
5144
proc setinlist {var i val} {
4360
5154
}
4361
5155
}
4362
5156
5157
proc makediffhdr {fname ids} {
5158
global ctext curdiffstart treediffs
5159
5160
set i [lsearch -exact $treediffs($ids) $fname]
5161
if {$i >= 0} {
5162
setinlist difffilestart $i $curdiffstart
5163
}
5164
set l [expr {(78 - [string length $fname]) / 2}]
5165
set pad [string range "----------------------------------------" 1 $l]
5166
$ctext insert $curdiffstart "$pad $fname $pad" filesep
5167
}
5168
4363
5169
proc getblobdiffline {bdf ids} {
4364
global diffids blobdifffd ctext curdifftag curtagstart
5170
global diffids blobdifffd ctext curdiffstart
4365
5171
global diffnexthead diffnextnote difffilestart
4366
global nextupdate diffinhdr treediffs
5172
global diffinhdr treediffs
4367
5173
4368
set n [gets $bdf line]
4369
if {$n < 0} {
4370
if {[eof $bdf]} {
5174
set nr 0
5175
$ctext conf -state normal
5176
while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5177
if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4371
5178
close $bdf
4372
if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4373
$ctext tag add $curdifftag $curtagstart end
4374
}
4375
}
4376
return
4377
}
4378
if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4379
return
4380
}
4381
$ctext conf -state normal
4382
if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4383
# start of a new file
4384
$ctext insert end "\n"
4385
$ctext tag add $curdifftag $curtagstart end
4386
set here [$ctext index "end - 1c"]
4387
set curtagstart $here
4388
set header $newname
4389
set i [lsearch -exact $treediffs($ids) $fname]
4390
if {$i >= 0} {
4391
setinlist difffilestart $i $here
4392
}
4393
if {$newname ne $fname} {
4394
set i [lsearch -exact $treediffs($ids) $newname]
4395
if {$i >= 0} {
4396
setinlist difffilestart $i $here
4397
}
4398
}
4399
set curdifftag "f:$fname"
4400
$ctext tag delete $curdifftag
4401
set l [expr {(78 - [string length $header]) / 2}]
4402
set pad [string range "----------------------------------------" 1 $l]
4403
$ctext insert end "$pad $header $pad\n" filesep
4404
set diffinhdr 1
4405
} elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4406
# do nothing
4407
} elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4408
set diffinhdr 0
4409
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4410
$line match f1l f1c f2l f2c rest]} {
4411
$ctext insert end "$line\n" hunksep
4412
set diffinhdr 0
4413
} else {
4414
set x [string range $line 0 0]
4415
if {$x == "-" || $x == "+"} {
4416
set tag [expr {$x == "+"}]
4417
$ctext insert end "$line\n" d$tag
4418
} elseif {$x == " "} {
4419
$ctext insert end "$line\n"
4420
} elseif {$diffinhdr || $x == "\\"} {
4421
# e.g. "\ No newline at end of file"
5179
return 0
5180
}
5181
if {![string compare -length 11 "diff --git " $line]} {
5182
# trim off "diff --git "
5183
set line [string range $line 11 end]
5184
set diffinhdr 1
5185
# start of a new file
5186
$ctext insert end "\n"
5187
set curdiffstart [$ctext index "end - 1c"]
5188
$ctext insert end "\n" filesep
5189
# If the name hasn't changed the length will be odd,
5190
# the middle char will be a space, and the two bits either
5191
# side will be a/name and b/name, or "a/name" and "b/name".
5192
# If the name has changed we'll get "rename from" and
5193
# "rename to" or "copy from" and "copy to" lines following this,
5194
# and we'll use them to get the filenames.
5195
# This complexity is necessary because spaces in the filename(s)
5196
# don't get escaped.
5197
set l [string length $line]
5198
set i [expr {$l / 2}]
5199
if {!(($l & 1) && [string index $line $i] eq " " &&
5200
[string range $line 2 [expr {$i - 1}]] eq \
5201
[string range $line [expr {$i + 3}] end])} {
5202
continue
5203
}
5204
# unescape if quoted and chop off the a/ from the front
5205
if {[string index $line 0] eq "\""} {
5206
set fname [string range [lindex $line 0] 2 end]
5207
} else {
5208
set fname [string range $line 2 [expr {$i - 1}]]
5209
}
5210
makediffhdr $fname $ids
5211
5212
} elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5213
$line match f1l f1c f2l f2c rest]} {
5214
$ctext insert end "$line\n" hunksep
5215
set diffinhdr 0
5216
5217
} elseif {$diffinhdr} {
5218
if {![string compare -length 12 "rename from " $line] ||
5219
![string compare -length 10 "copy from " $line]} {
5220
set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5221
if {[string index $fname 0] eq "\""} {
5222
set fname [lindex $fname 0]
5223
}
5224
set i [lsearch -exact $treediffs($ids) $fname]
5225
if {$i >= 0} {
5226
setinlist difffilestart $i $curdiffstart
5227
}
5228
} elseif {![string compare -length 10 $line "rename to "] ||
5229
![string compare -length 8 $line "copy to "]} {
5230
set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5231
if {[string index $fname 0] eq "\""} {
5232
set fname [lindex $fname 0]
5233
}
5234
makediffhdr $fname $ids
5235
} elseif {[string compare -length 3 $line "---"] == 0} {
5236
# do nothing
5237
continue
5238
} elseif {[string compare -length 3 $line "+++"] == 0} {
5239
set diffinhdr 0
5240
continue
5241
}
4422
5242
$ctext insert end "$line\n" filesep
5243
4423
5244
} else {
4424
# Something else we don't recognize
4425
if {$curdifftag != "Comments"} {
4426
$ctext insert end "\n"
4427
$ctext tag add $curdifftag $curtagstart end
4428
set curtagstart [$ctext index "end - 1c"]
4429
set curdifftag Comments
5245
set x [string range $line 0 0]
5246
if {$x == "-" || $x == "+"} {
5247
set tag [expr {$x == "+"}]
5248
$ctext insert end "$line\n" d$tag
5249
} elseif {$x == " "} {
5250
$ctext insert end "$line\n"
5251
} else {
5252
# "\ No newline at end of file",
5253
# or something else we don't recognize
5254
$ctext insert end "$line\n" hunksep
4430
5255
}
4431
$ctext insert end "$line\n" filesep
4432
5256
}
4433
5257
}
4434
5258
$ctext conf -state disabled
4435
if {[clock clicks -milliseconds] >= $nextupdate} {
4436
incr nextupdate 100
4437
fileevent $bdf readable {}
4438
update
4439
fileevent $bdf readable "getblobdiffline $bdf {$ids}"
5259
if {[eof $bdf]} {
5260
close $bdf
5261
return 0
4440
5262
}
5263
return [expr {$nr >= 1000? 2: 1}]
5264
}
5265
5266
proc changediffdisp {} {
5267
global ctext diffelide
5268
5269
$ctext tag conf d0 -elide [lindex $diffelide 0]
5270
$ctext tag conf d1 -elide [lindex $diffelide 1]
4441
5271
}
4442
5272
4443
5273
proc prevfile {} {
4591
5421
proc scrolltext {f0 f1} {
4592
5422
global searchstring
4593
5423
4594
.ctop.cdet.left.sb set $f0 $f1
5424
.bleft.sb set $f0 $f1
4595
5425
if {$searchstring ne {}} {
4596
5426
searchmarkvisible 0
4597
5427
}
4628
5458
}
4629
5459
4630
5460
proc incrfont {inc} {
4631
global mainfont textfont ctext canv phase
5461
global mainfont textfont ctext canv phase cflist showrefstop
5462
global charspc tabstop
4632
5463
global stopped entries
4633
5464
unmarkmatches
4634
5465
set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4635
5466
set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4636
5467
setcoords
4637
$ctext conf -font $textfont
5468
$ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5469
$cflist conf -font $textfont
4638
5470
$ctext tag conf filesep -font [concat $textfont bold]
4639
5471
foreach e $entries {
4640
5472
$e conf -font $mainfont
4642
5474
if {$phase eq "getcommits"} {
4643
5475
$canv itemconf textitems -font $mainfont
4644
5476
}
5477
if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5478
$showrefstop.list conf -font $mainfont
5479
}
4645
5480
redisplay
4646
5481
}
4647
5482
4892
5727
4893
5728
proc rowmenu {x y id} {
4894
5729
global rowctxmenu commitrow selectedline rowmenuid curview
5730
global nullid nullid2 fakerowmenu mainhead
4895
5731
5732
set rowmenuid $id
4896
5733
if {![info exists selectedline]
4897
5734
|| $commitrow($curview,$id) eq $selectedline} {
4898
5735
set state disabled
4899
5736
} else {
4900
5737
set state normal
4901
5738
}
4902
$rowctxmenu entryconfigure 0 -state $state
4903
$rowctxmenu entryconfigure 1 -state $state
4904
$rowctxmenu entryconfigure 2 -state $state
4905
set rowmenuid $id
4906
tk_popup $rowctxmenu $x $y
5739
if {$id ne $nullid && $id ne $nullid2} {
5740
set menu $rowctxmenu
5741
$menu entryconfigure 7 -label "Reset $mainhead branch to here"
5742
} else {
5743
set menu $fakerowmenu
5744
}
5745
$menu entryconfigure "Diff this*" -state $state
5746
$menu entryconfigure "Diff selected*" -state $state
5747
$menu entryconfigure "Make patch" -state $state
5748
tk_popup $menu $x $y
4907
5749
}
4908
5750
4909
5751
proc diffvssel {dirn} {
4943
5785
$ctext insert end [lindex $commitinfo($newid) 0]
4944
5786
$ctext insert end "\n"
4945
5787
$ctext conf -state disabled
4946
$ctext tag delete Comments
4947
5788
$ctext tag remove found 1.0 end
4948
5789
startdiff [list $oldid $newid]
4949
5790
}
5014
5855
}
5015
5856
5016
5857
proc mkpatchgo {} {
5017
global patchtop
5858
global patchtop nullid nullid2
5018
5859
5019
5860
set oldid [$patchtop.fromsha1 get]
5020
5861
set newid [$patchtop.tosha1 get]
5021
5862
set fname [$patchtop.fname get]
5022
if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5863
set cmd [diffcmd [list $oldid $newid] -p]
5864
lappend cmd >$fname &
5865
if {[catch {eval exec $cmd} err]} {
5023
5866
error_popup "Error creating patch: $err"
5024
5867
}
5025
5868
catch {destroy $patchtop}
5092
5935
lappend idtags($id) $tag
5093
5936
redrawtags $id
5094
5937
addedtag $id
5938
dispneartags 0
5939
run refill_reflist
5095
5940
}
5096
5941
5097
5942
proc redrawtags {id} {
5098
5943
global canv linehtag commitrow idpos selectedline curview
5099
global mainfont canvxmax
5944
global mainfont canvxmax iddrawn
5100
5945
5101
5946
if {![info exists commitrow($curview,$id)]} return
5102
drawcmitrow $commitrow($curview,$id)
5947
if {![info exists iddrawn($id)]} return
5948
drawcommits $commitrow($curview,$id)
5103
5949
$canv delete tag.$id
5104
5950
set xt [eval drawtags $id $idpos($id)]
5105
5951
$canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5226
6072
notbusy newbranch
5227
6073
error_popup $err
5228
6074
} else {
6075
set headids($name) $id
6076
lappend idheads($id) $name
5229
6077
addedhead $id $name
5230
# XXX should update list of heads displayed for selected commit
5231
6078
notbusy newbranch
5232
6079
redrawtags $id
6080
dispneartags 0
6081
run refill_reflist
5233
6082
}
5234
6083
}
5235
6084
5236
6085
proc cherrypick {} {
5237
6086
global rowmenuid curview commitrow
5238
global mainhead desc_heads anc_tags desc_tags allparents allchildren
6087
global mainhead
5239
6088
5240
if {[info exists desc_heads($rowmenuid)]
5241
&& [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
6089
set oldhead [exec git rev-parse HEAD]
6090
set dheads [descheads $rowmenuid]
6091
if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5242
6092
set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5243
6093
included in branch $mainhead -- really re-apply it?"]
5244
6094
if {!$ok} return
5245
6095
}
5246
6096
nowbusy cherrypick
5247
6097
update
5248
set oldhead [exec git rev-parse HEAD]
5249
6098
# Unfortunately git-cherry-pick writes stuff to stderr even when
5250
6099
# no error occurs, and exec takes that as an indication of error...
5251
6100
if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5259
6108
error_popup "No changes committed"
5260
6109
return
5261
6110
}
5262
set allparents($newhead) $oldhead
5263
lappend allchildren($oldhead) $newhead
5264
set desc_heads($newhead) $mainhead
5265
if {[info exists anc_tags($oldhead)]} {
5266
set anc_tags($newhead) $anc_tags($oldhead)
5267
}
5268
set desc_tags($newhead) {}
6111
addnewchild $newhead $oldhead
5269
6112
if {[info exists commitrow($curview,$oldhead)]} {
5270
6113
insertrow $commitrow($curview,$oldhead) $newhead
5271
6114
if {$mainhead ne {}} {
6115
movehead $newhead $mainhead
5272
6116
movedhead $newhead $mainhead
5273
6117
}
5274
6118
redrawtags $oldhead
5277
6121
notbusy cherrypick
5278
6122
}
5279
6123
6124
proc resethead {} {
6125
global mainheadid mainhead rowmenuid confirm_ok resettype
6126
global showlocalchanges
6127
6128
set confirm_ok 0
6129
set w ".confirmreset"
6130
toplevel $w
6131
wm transient $w .
6132
wm title $w "Confirm reset"
6133
message $w.m -text \
6134
"Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6135
-justify center -aspect 1000
6136
pack $w.m -side top -fill x -padx 20 -pady 20
6137
frame $w.f -relief sunken -border 2
6138
message $w.f.rt -text "Reset type:" -aspect 1000
6139
grid $w.f.rt -sticky w
6140
set resettype mixed
6141
radiobutton $w.f.soft -value soft -variable resettype -justify left \
6142
-text "Soft: Leave working tree and index untouched"
6143
grid $w.f.soft -sticky w
6144
radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6145
-text "Mixed: Leave working tree untouched, reset index"
6146
grid $w.f.mixed -sticky w
6147
radiobutton $w.f.hard -value hard -variable resettype -justify left \
6148
-text "Hard: Reset working tree and index\n(discard ALL local changes)"
6149
grid $w.f.hard -sticky w
6150
pack $w.f -side top -fill x
6151
button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6152
pack $w.ok -side left -fill x -padx 20 -pady 20
6153
button $w.cancel -text Cancel -command "destroy $w"
6154
pack $w.cancel -side right -fill x -padx 20 -pady 20
6155
bind $w <Visibility> "grab $w; focus $w"
6156
tkwait window $w
6157
if {!$confirm_ok} return
6158
if {[catch {set fd [open \
6159
[list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6160
error_popup $err
6161
} else {
6162
dohidelocalchanges
6163
set w ".resetprogress"
6164
filerun $fd [list readresetstat $fd $w]
6165
toplevel $w
6166
wm transient $w
6167
wm title $w "Reset progress"
6168
message $w.m -text "Reset in progress, please wait..." \
6169
-justify center -aspect 1000
6170
pack $w.m -side top -fill x -padx 20 -pady 5
6171
canvas $w.c -width 150 -height 20 -bg white
6172
$w.c create rect 0 0 0 20 -fill green -tags rect
6173
pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6174
nowbusy reset
6175
}
6176
}
6177
6178
proc readresetstat {fd w} {
6179
global mainhead mainheadid showlocalchanges
6180
6181
if {[gets $fd line] >= 0} {
6182
if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6183
set x [expr {($m * 150) / $n}]
6184
$w.c coords rect 0 0 $x 20
6185
}
6186
return 1
6187
}
6188
destroy $w
6189
notbusy reset
6190
if {[catch {close $fd} err]} {
6191
error_popup $err
6192
}
6193
set oldhead $mainheadid
6194
set newhead [exec git rev-parse HEAD]
6195
if {$newhead ne $oldhead} {
6196
movehead $newhead $mainhead
6197
movedhead $newhead $mainhead
6198
set mainheadid $newhead
6199
redrawtags $oldhead
6200
redrawtags $newhead
6201
}
6202
if {$showlocalchanges} {
6203
doshowlocalchanges
6204
}
6205
return 0
6206
}
6207
5280
6208
# context menu for a head
5281
6209
proc headmenu {x y id head} {
5282
global headmenuid headmenuhead headctxmenu
6210
global headmenuid headmenuhead headctxmenu mainhead
5283
6211
5284
6212
set headmenuid $id
5285
6213
set headmenuhead $head
6214
set state normal
6215
if {$head eq $mainhead} {
6216
set state disabled
6217
}
6218
$headctxmenu entryconfigure 0 -state $state
6219
$headctxmenu entryconfigure 1 -state $state
5286
6220
tk_popup $headctxmenu $x $y
5287
6221
}
5288
6222
5289
6223
proc cobranch {} {
5290
6224
global headmenuid headmenuhead mainhead headids
6225
global showlocalchanges mainheadid
5291
6226
5292
6227
# check the tree is clean first??
5293
6228
set oldmainhead $mainhead
5294
6229
nowbusy checkout
5295
6230
update
6231
dohidelocalchanges
5296
6232
if {[catch {
5297
exec git checkout $headmenuhead
6233
exec git checkout -q $headmenuhead
5298
6234
} err]} {
5299
6235
notbusy checkout
5300
6236
error_popup $err
5301
6237
} else {
5302
6238
notbusy checkout
5303
6239
set mainhead $headmenuhead
6240
set mainheadid $headmenuid
5304
6241
if {[info exists headids($oldmainhead)]} {
5305
6242
redrawtags $headids($oldmainhead)
5306
6243
}
5307
6244
redrawtags $headmenuid
5308
6245
}
6246
if {$showlocalchanges} {
6247
dodiffindex
6248
}
5309
6249
}
5310
6250
5311
6251
proc rmbranch {} {
5312
global desc_heads headmenuid headmenuhead mainhead
5313
global headids idheads
6252
global headmenuid headmenuhead mainhead
6253
global idheads
5314
6254
5315
6255
set head $headmenuhead
5316
6256
set id $headmenuid
6257
# this check shouldn't be needed any more...
5317
6258
if {$head eq $mainhead} {
5318
6259
error_popup "Cannot delete the currently checked-out branch"
5319
6260
return
5320
6261
}
5321
if {$desc_heads($id) eq $head} {
6262
set dheads [descheads $id]
6263
if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
5322
6264
# the stuff on this branch isn't on any other branch
5323
6265
if {![confirm_popup "The commits on branch $head aren't on any other\
5324
6266
branch.\nReally delete branch $head?"]} return
5330
6272
error_popup $err
5331
6273
return
5332
6274
}
6275
removehead $id $head
5333
6276
removedhead $id $head
5334
6277
redrawtags $id
5335
6278
notbusy rmbranch
6279
dispneartags 0
6280
run refill_reflist
6281
}
6282
6283
# Display a list of tags and heads
6284
proc showrefs {} {
6285
global showrefstop bgcolor fgcolor selectbgcolor mainfont
6286
global bglist fglist uifont reflistfilter reflist maincursor
6287
6288
set top .showrefs
6289
set showrefstop $top
6290
if {[winfo exists $top]} {
6291
raise $top
6292
refill_reflist
6293
return
6294
}
6295
toplevel $top
6296
wm title $top "Tags and heads: [file tail [pwd]]"
6297
text $top.list -background $bgcolor -foreground $fgcolor \
6298
-selectbackground $selectbgcolor -font $mainfont \
6299
-xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6300
-width 30 -height 20 -cursor $maincursor \
6301
-spacing1 1 -spacing3 1 -state disabled
6302
$top.list tag configure highlight -background $selectbgcolor
6303
lappend bglist $top.list
6304
lappend fglist $top.list
6305
scrollbar $top.ysb -command "$top.list yview" -orient vertical
6306
scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6307
grid $top.list $top.ysb -sticky nsew
6308
grid $top.xsb x -sticky ew
6309
frame $top.f
6310
label $top.f.l -text "Filter: " -font $uifont
6311
entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6312
set reflistfilter "*"
6313
trace add variable reflistfilter write reflistfilter_change
6314
pack $top.f.e -side right -fill x -expand 1
6315
pack $top.f.l -side left
6316
grid $top.f - -sticky ew -pady 2
6317
button $top.close -command [list destroy $top] -text "Close" \
6318
-font $uifont
6319
grid $top.close -
6320
grid columnconfigure $top 0 -weight 1
6321
grid rowconfigure $top 0 -weight 1
6322
bind $top.list <1> {break}
6323
bind $top.list <B1-Motion> {break}
6324
bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6325
set reflist {}
6326
refill_reflist
6327
}
6328
6329
proc sel_reflist {w x y} {
6330
global showrefstop reflist headids tagids otherrefids
6331
6332
if {![winfo exists $showrefstop]} return
6333
set l [lindex [split [$w index "@$x,$y"] "."] 0]
6334
set ref [lindex $reflist [expr {$l-1}]]
6335
set n [lindex $ref 0]
6336
switch -- [lindex $ref 1] {
6337
"H" {selbyid $headids($n)}
6338
"T" {selbyid $tagids($n)}
6339
"o" {selbyid $otherrefids($n)}
6340
}
6341
$showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6342
}
6343
6344
proc unsel_reflist {} {
6345
global showrefstop
6346
6347
if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6348
$showrefstop.list tag remove highlight 0.0 end
6349
}
6350
6351
proc reflistfilter_change {n1 n2 op} {
6352
global reflistfilter
6353
6354
after cancel refill_reflist
6355
after 200 refill_reflist
6356
}
6357
6358
proc refill_reflist {} {
6359
global reflist reflistfilter showrefstop headids tagids otherrefids
6360
global commitrow curview commitinterest
6361
6362
if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6363
set refs {}
6364
foreach n [array names headids] {
6365
if {[string match $reflistfilter $n]} {
6366
if {[info exists commitrow($curview,$headids($n))]} {
6367
lappend refs [list $n H]
6368
} else {
6369
set commitinterest($headids($n)) {run refill_reflist}
6370
}
6371
}
6372
}
6373
foreach n [array names tagids] {
6374
if {[string match $reflistfilter $n]} {
6375
if {[info exists commitrow($curview,$tagids($n))]} {
6376
lappend refs [list $n T]
6377
} else {
6378
set commitinterest($tagids($n)) {run refill_reflist}
6379
}
6380
}
6381
}
6382
foreach n [array names otherrefids] {
6383
if {[string match $reflistfilter $n]} {
6384
if {[info exists commitrow($curview,$otherrefids($n))]} {
6385
lappend refs [list $n o]
6386
} else {
6387
set commitinterest($otherrefids($n)) {run refill_reflist}
6388
}
6389
}
6390
}
6391
set refs [lsort -index 0 $refs]
6392
if {$refs eq $reflist} return
6393
6394
# Update the contents of $showrefstop.list according to the
6395
# differences between $reflist (old) and $refs (new)
6396
$showrefstop.list conf -state normal
6397
$showrefstop.list insert end "\n"
6398
set i 0
6399
set j 0
6400
while {$i < [llength $reflist] || $j < [llength $refs]} {
6401
if {$i < [llength $reflist]} {
6402
if {$j < [llength $refs]} {
6403
set cmp [string compare [lindex $reflist $i 0] \
6404
[lindex $refs $j 0]]
6405
if {$cmp == 0} {
6406
set cmp [string compare [lindex $reflist $i 1] \
6407
[lindex $refs $j 1]]
6408
}
6409
} else {
6410
set cmp -1
6411
}
6412
} else {
6413
set cmp 1
6414
}
6415
switch -- $cmp {
6416
-1 {
6417
$showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6418
incr i
6419
}
6420
0 {
6421
incr i
6422
incr j
6423
}
6424
1 {
6425
set l [expr {$j + 1}]
6426
$showrefstop.list image create $l.0 -align baseline \
6427
-image reficon-[lindex $refs $j 1] -padx 2
6428
$showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6429
incr j
6430
}
6431
}
6432
}
6433
set reflist $refs
6434
# delete last newline
6435
$showrefstop.list delete end-2c end-1c
6436
$showrefstop.list conf -state disabled
5336
6437
}
5337
6438
5338
6439
# Stuff for finding nearby tags
5339
6440
proc getallcommits {} {
5340
global allcstart allcommits allcfd allids
5341
5342
set allids {}
5343
set fd [open [concat | git rev-list --all --topo-order --parents] r]
5344
set allcfd $fd
6441
global allcommits allids nbmp nextarc seeds
6442
6443
if {![info exists allcommits]} {
6444
set allids {}
6445
set nbmp 0
6446
set nextarc 0
6447
set allcommits 0
6448
set seeds {}
6449
}
6450
6451
set cmd [concat | git rev-list --all --parents]
6452
foreach id $seeds {
6453
lappend cmd "^$id"
6454
}
6455
set fd [open $cmd r]
5345
6456
fconfigure $fd -blocking 0
5346
set allcommits "reading"
6457
incr allcommits
5347
6458
nowbusy allcommits
5348
restartgetall $fd
5349
}
5350
5351
proc discardallcommits {} {
5352
global allparents allchildren allcommits allcfd
5353
global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5354
5355
if {![info exists allcommits]} return
5356
if {$allcommits eq "reading"} {
5357
catch {close $allcfd}
5358
}
5359
foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5360
alldtags tagisdesc desc_heads} {
5361
catch {unset $v}
5362
}
5363
}
5364
5365
proc restartgetall {fd} {
5366
global allcstart
5367
5368
fileevent $fd readable [list getallclines $fd]
5369
set allcstart [clock clicks -milliseconds]
5370
}
5371
5372
proc combine_dtags {l1 l2} {
5373
global tagisdesc notfirstd
5374
5375
set res [lsort -unique [concat $l1 $l2]]
5376
for {set i 0} {$i < [llength $res]} {incr i} {
5377
set x [lindex $res $i]
5378
for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5379
set y [lindex $res $j]
5380
if {[info exists tagisdesc($x,$y)]} {
5381
if {$tagisdesc($x,$y) > 0} {
5382
# x is a descendent of y, exclude x
5383
set res [lreplace $res $i $i]
5384
incr i -1
5385
break
5386
} else {
5387
# y is a descendent of x, exclude y
5388
set res [lreplace $res $j $j]
5389
}
5390
} else {
5391
# no relation, keep going
5392
incr j
5393
}
5394
}
5395
}
5396
return $res
5397
}
5398
5399
proc combine_atags {l1 l2} {
5400
global tagisdesc
5401
5402
set res [lsort -unique [concat $l1 $l2]]
5403
for {set i 0} {$i < [llength $res]} {incr i} {
5404
set x [lindex $res $i]
5405
for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5406
set y [lindex $res $j]
5407
if {[info exists tagisdesc($x,$y)]} {
5408
if {$tagisdesc($x,$y) < 0} {
5409
# x is an ancestor of y, exclude x
5410
set res [lreplace $res $i $i]
5411
incr i -1
5412
break
5413
} else {
5414
# y is an ancestor of x, exclude y
5415
set res [lreplace $res $j $j]
5416
}
5417
} else {
5418
# no relation, keep going
5419
incr j
5420
}
5421
}
5422
}
5423
return $res
5424
}
5425
5426
proc forward_pass {id children} {
5427
global idtags desc_tags idheads desc_heads alldtags tagisdesc
5428
5429
set dtags {}
5430
set dheads {}
5431
foreach child $children {
5432
if {[info exists idtags($child)]} {
5433
set ctags [list $child]
5434
} else {
5435
set ctags $desc_tags($child)
5436
}
5437
if {$dtags eq {}} {
5438
set dtags $ctags
5439
} elseif {$ctags ne $dtags} {
5440
set dtags [combine_dtags $dtags $ctags]
5441
}
5442
set cheads $desc_heads($child)
5443
if {$dheads eq {}} {
5444
set dheads $cheads
5445
} elseif {$cheads ne $dheads} {
5446
set dheads [lsort -unique [concat $dheads $cheads]]
5447
}
5448
}
5449
set desc_tags($id) $dtags
5450
if {[info exists idtags($id)]} {
5451
set adt $dtags
5452
foreach tag $dtags {
5453
set adt [concat $adt $alldtags($tag)]
5454
}
5455
set adt [lsort -unique $adt]
5456
set alldtags($id) $adt
5457
foreach tag $adt {
5458
set tagisdesc($id,$tag) -1
5459
set tagisdesc($tag,$id) 1
5460
}
5461
}
5462
if {[info exists idheads($id)]} {
5463
set dheads [concat $dheads $idheads($id)]
5464
}
5465
set desc_heads($id) $dheads
5466
}
6459
filerun $fd [list getallclines $fd]
6460
}
6461
6462
# Since most commits have 1 parent and 1 child, we group strings of
6463
# such commits into "arcs" joining branch/merge points (BMPs), which
6464
# are commits that either don't have 1 parent or don't have 1 child.
6465
#
6466
# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6467
# arcout(id) - outgoing arcs for BMP
6468
# arcids(a) - list of IDs on arc including end but not start
6469
# arcstart(a) - BMP ID at start of arc
6470
# arcend(a) - BMP ID at end of arc
6471
# growing(a) - arc a is still growing
6472
# arctags(a) - IDs out of arcids (excluding end) that have tags
6473
# archeads(a) - IDs out of arcids (excluding end) that have heads
6474
# The start of an arc is at the descendent end, so "incoming" means
6475
# coming from descendents, and "outgoing" means going towards ancestors.
5467
6476
5468
6477
proc getallclines {fd} {
5469
global allparents allchildren allcommits allcstart
5470
global desc_tags anc_tags idtags tagisdesc allids
5471
global idheads travindex
6478
global allids allparents allchildren idtags idheads nextarc nbmp
6479
global arcnos arcids arctags arcout arcend arcstart archeads growing
6480
global seeds allcommits
5472
6481
5473
while {[gets $fd line] >= 0} {
6482
set nid 0
6483
while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
5474
6484
set id [lindex $line 0]
6485
if {[info exists allparents($id)]} {
6486
# seen it already
6487
continue
6488
}
5475
6489
lappend allids $id
5476
6490
set olds [lrange $line 1 end]
5477
6491
set allparents($id) $olds
5478
6492
if {![info exists allchildren($id)]} {
5479
6493
set allchildren($id) {}
5480
}
6494
set arcnos($id) {}
6495
lappend seeds $id
6496
} else {
6497
set a $arcnos($id)
6498
if {[llength $olds] == 1 && [llength $a] == 1} {
6499
lappend arcids($a) $id
6500
if {[info exists idtags($id)]} {
6501
lappend arctags($a) $id
6502
}
6503
if {[info exists idheads($id)]} {
6504
lappend archeads($a) $id
6505
}
6506
if {[info exists allparents($olds)]} {
6507
# seen parent already
6508
if {![info exists arcout($olds)]} {
6509
splitarc $olds
6510
}
6511
lappend arcids($a) $olds
6512
set arcend($a) $olds
6513
unset growing($a)
6514
}
6515
lappend allchildren($olds) $id
6516
lappend arcnos($olds) $a
6517
continue
6518
}
6519
}
6520
incr nbmp
6521
foreach a $arcnos($id) {
6522
lappend arcids($a) $id
6523
set arcend($a) $id
6524
unset growing($a)
6525
}
6526
6527
set ao {}
5481
6528
foreach p $olds {
5482
6529
lappend allchildren($p) $id
5483
}
5484
# compute nearest tagged descendents as we go
5485
# also compute descendent heads
5486
forward_pass $id $allchildren($id)
5487
if {[clock clicks -milliseconds] - $allcstart >= 50} {
5488
fileevent $fd readable {}
5489
after idle restartgetall $fd
5490
return
5491
}
5492
}
5493
if {[eof $fd]} {
5494
set travindex [llength $allids]
5495
set allcommits "traversing"
5496
after idle restartatags
5497
if {[catch {close $fd} err]} {
5498
error_popup "Error reading full commit graph: $err.\n\
5499
Results may be incomplete."
5500
}
5501
}
5502
}
5503
5504
# walk backward through the tree and compute nearest tagged ancestors
5505
proc restartatags {} {
5506
global allids allparents idtags anc_tags travindex
5507
5508
set t0 [clock clicks -milliseconds]
5509
set i $travindex
5510
while {[incr i -1] >= 0} {
5511
set id [lindex $allids $i]
5512
set atags {}
5513
foreach p $allparents($id) {
5514
if {[info exists idtags($p)]} {
5515
set ptags [list $p]
6530
set a [incr nextarc]
6531
set arcstart($a) $id
6532
set archeads($a) {}
6533
set arctags($a) {}
6534
set archeads($a) {}
6535
set arcids($a) {}
6536
lappend ao $a
6537
set growing($a) 1
6538
if {[info exists allparents($p)]} {
6539
# seen it already, may need to make a new branch
6540
if {![info exists arcout($p)]} {
6541
splitarc $p
6542
}
6543
lappend arcids($a) $p
6544
set arcend($a) $p
6545
unset growing($a)
6546
}
6547
lappend arcnos($p) $a
6548
}
6549
set arcout($id) $ao
6550
}
6551
if {$nid > 0} {
6552
global cached_dheads cached_dtags cached_atags
6553
catch {unset cached_dheads}
6554
catch {unset cached_dtags}
6555
catch {unset cached_atags}
6556
}
6557
if {![eof $fd]} {
6558
return [expr {$nid >= 1000? 2: 1}]
6559
}
6560
close $fd
6561
if {[incr allcommits -1] == 0} {
6562
notbusy allcommits
6563
}
6564
dispneartags 0
6565
return 0
6566
}
6567
6568
proc recalcarc {a} {
6569
global arctags archeads arcids idtags idheads
6570
6571
set at {}
6572
set ah {}
6573
foreach id [lrange $arcids($a) 0 end-1] {
6574
if {[info exists idtags($id)]} {
6575
lappend at $id
6576
}
6577
if {[info exists idheads($id)]} {
6578
lappend ah $id
6579
}
6580
}
6581
set arctags($a) $at
6582
set archeads($a) $ah
6583
}
6584
6585
proc splitarc {p} {
6586
global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6587
global arcstart arcend arcout allparents growing
6588
6589
set a $arcnos($p)
6590
if {[llength $a] != 1} {
6591
puts "oops splitarc called but [llength $a] arcs already"
6592
return
6593
}
6594
set a [lindex $a 0]
6595
set i [lsearch -exact $arcids($a) $p]
6596
if {$i < 0} {
6597
puts "oops splitarc $p not in arc $a"
6598
return
6599
}
6600
set na [incr nextarc]
6601
if {[info exists arcend($a)]} {
6602
set arcend($na) $arcend($a)
6603
} else {
6604
set l [lindex $allparents([lindex $arcids($a) end]) 0]
6605
set j [lsearch -exact $arcnos($l) $a]
6606
set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6607
}
6608
set tail [lrange $arcids($a) [expr {$i+1}] end]
6609
set arcids($a) [lrange $arcids($a) 0 $i]
6610
set arcend($a) $p
6611
set arcstart($na) $p
6612
set arcout($p) $na
6613
set arcids($na) $tail
6614
if {[info exists growing($a)]} {
6615
set growing($na) 1
6616
unset growing($a)
6617
}
6618
incr nbmp
6619
6620
foreach id $tail {
6621
if {[llength $arcnos($id)] == 1} {
6622
set arcnos($id) $na
6623
} else {
6624
set j [lsearch -exact $arcnos($id) $a]
6625
set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6626
}
6627
}
6628
6629
# reconstruct tags and heads lists
6630
if {$arctags($a) ne {} || $archeads($a) ne {}} {
6631
recalcarc $a
6632
recalcarc $na
6633
} else {
6634
set arctags($na) {}
6635
set archeads($na) {}
6636
}
6637
}
6638
6639
# Update things for a new commit added that is a child of one
6640
# existing commit. Used when cherry-picking.
6641
proc addnewchild {id p} {
6642
global allids allparents allchildren idtags nextarc nbmp
6643
global arcnos arcids arctags arcout arcend arcstart archeads growing
6644
global seeds allcommits
6645
6646
if {![info exists allcommits]} return
6647
lappend allids $id
6648
set allparents($id) [list $p]
6649
set allchildren($id) {}
6650
set arcnos($id) {}
6651
lappend seeds $id
6652
incr nbmp
6653
lappend allchildren($p) $id
6654
set a [incr nextarc]
6655
set arcstart($a) $id
6656
set archeads($a) {}
6657
set arctags($a) {}
6658
set arcids($a) [list $p]
6659
set arcend($a) $p
6660
if {![info exists arcout($p)]} {
6661
splitarc $p
6662
}
6663
lappend arcnos($p) $a
6664
set arcout($id) [list $a]
6665
}
6666
6667
# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6668
# or 0 if neither is true.
6669
proc anc_or_desc {a b} {
6670
global arcout arcstart arcend arcnos cached_isanc
6671
6672
if {$arcnos($a) eq $arcnos($b)} {
6673
# Both are on the same arc(s); either both are the same BMP,
6674
# or if one is not a BMP, the other is also not a BMP or is
6675
# the BMP at end of the arc (and it only has 1 incoming arc).
6676
# Or both can be BMPs with no incoming arcs.
6677
if {$a eq $b || $arcnos($a) eq {}} {
6678
return 0
6679
}
6680
# assert {[llength $arcnos($a)] == 1}
6681
set arc [lindex $arcnos($a) 0]
6682
set i [lsearch -exact $arcids($arc) $a]
6683
set j [lsearch -exact $arcids($arc) $b]
6684
if {$i < 0 || $i > $j} {
6685
return 1
6686
} else {
6687
return -1
6688
}
6689
}
6690
6691
if {![info exists arcout($a)]} {
6692
set arc [lindex $arcnos($a) 0]
6693
if {[info exists arcend($arc)]} {
6694
set aend $arcend($arc)
6695
} else {
6696
set aend {}
6697
}
6698
set a $arcstart($arc)
6699
} else {
6700
set aend $a
6701
}
6702
if {![info exists arcout($b)]} {
6703
set arc [lindex $arcnos($b) 0]
6704
if {[info exists arcend($arc)]} {
6705
set bend $arcend($arc)
6706
} else {
6707
set bend {}
6708
}
6709
set b $arcstart($arc)
6710
} else {
6711
set bend $b
6712
}
6713
if {$a eq $bend} {
6714
return 1
6715
}
6716
if {$b eq $aend} {
6717
return -1
6718
}
6719
if {[info exists cached_isanc($a,$bend)]} {
6720
if {$cached_isanc($a,$bend)} {
6721
return 1
6722
}
6723
}
6724
if {[info exists cached_isanc($b,$aend)]} {
6725
if {$cached_isanc($b,$aend)} {
6726
return -1
6727
}
6728
if {[info exists cached_isanc($a,$bend)]} {
6729
return 0
6730
}
6731
}
6732
6733
set todo [list $a $b]
6734
set anc($a) a
6735
set anc($b) b
6736
for {set i 0} {$i < [llength $todo]} {incr i} {
6737
set x [lindex $todo $i]
6738
if {$anc($x) eq {}} {
6739
continue
6740
}
6741
foreach arc $arcnos($x) {
6742
set xd $arcstart($arc)
6743
if {$xd eq $bend} {
6744
set cached_isanc($a,$bend) 1
6745
set cached_isanc($b,$aend) 0
6746
return 1
6747
} elseif {$xd eq $aend} {
6748
set cached_isanc($b,$aend) 1
6749
set cached_isanc($a,$bend) 0
6750
return -1
6751
}
6752
if {![info exists anc($xd)]} {
6753
set anc($xd) $anc($x)
6754
lappend todo $xd
6755
} elseif {$anc($xd) ne $anc($x)} {
6756
set anc($xd) {}
6757
}
6758
}
6759
}
6760
set cached_isanc($a,$bend) 0
6761
set cached_isanc($b,$aend) 0
6762
return 0
6763
}
6764
6765
# This identifies whether $desc has an ancestor that is
6766
# a growing tip of the graph and which is not an ancestor of $anc
6767
# and returns 0 if so and 1 if not.
6768
# If we subsequently discover a tag on such a growing tip, and that
6769
# turns out to be a descendent of $anc (which it could, since we
6770
# don't necessarily see children before parents), then $desc
6771
# isn't a good choice to display as a descendent tag of
6772
# $anc (since it is the descendent of another tag which is
6773
# a descendent of $anc). Similarly, $anc isn't a good choice to
6774
# display as a ancestor tag of $desc.
6775
#
6776
proc is_certain {desc anc} {
6777
global arcnos arcout arcstart arcend growing problems
6778
6779
set certain {}
6780
if {[llength $arcnos($anc)] == 1} {
6781
# tags on the same arc are certain
6782
if {$arcnos($desc) eq $arcnos($anc)} {
6783
return 1
6784
}
6785
if {![info exists arcout($anc)]} {
6786
# if $anc is partway along an arc, use the start of the arc instead
6787
set a [lindex $arcnos($anc) 0]
6788
set anc $arcstart($a)
6789
}
6790
}
6791
if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6792
set x $desc
6793
} else {
6794
set a [lindex $arcnos($desc) 0]
6795
set x $arcend($a)
6796
}
6797
if {$x == $anc} {
6798
return 1
6799
}
6800
set anclist [list $x]
6801
set dl($x) 1
6802
set nnh 1
6803
set ngrowanc 0
6804
for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6805
set x [lindex $anclist $i]
6806
if {$dl($x)} {
6807
incr nnh -1
6808
}
6809
set done($x) 1
6810
foreach a $arcout($x) {
6811
if {[info exists growing($a)]} {
6812
if {![info exists growanc($x)] && $dl($x)} {
6813
set growanc($x) 1
6814
incr ngrowanc
6815
}
5516
6816
} else {
5517
set ptags $anc_tags($p)
5518
}
5519
if {$atags eq {}} {
5520
set atags $ptags
5521
} elseif {$ptags ne $atags} {
5522
set atags [combine_atags $atags $ptags]
5523
}
5524
}
5525
set anc_tags($id) $atags
5526
if {[clock clicks -milliseconds] - $t0 >= 50} {
5527
set travindex $i
5528
after idle restartatags
5529
return
5530
}
5531
}
5532
set allcommits "done"
5533
set travindex 0
5534
notbusy allcommits
5535
dispneartags
5536
}
5537
5538
# update the desc_tags and anc_tags arrays for a new tag just added
6817
set y $arcend($a)
6818
if {[info exists dl($y)]} {
6819
if {$dl($y)} {
6820
if {!$dl($x)} {
6821
set dl($y) 0
6822
if {![info exists done($y)]} {
6823
incr nnh -1
6824
}
6825
if {[info exists growanc($x)]} {
6826
incr ngrowanc -1
6827
}
6828
set xl [list $y]
6829
for {set k 0} {$k < [llength $xl]} {incr k} {
6830
set z [lindex $xl $k]
6831
foreach c $arcout($z) {
6832
if {[info exists arcend($c)]} {
6833
set v $arcend($c)
6834
if {[info exists dl($v)] && $dl($v)} {
6835
set dl($v) 0
6836
if {![info exists done($v)]} {
6837
incr nnh -1
6838
}
6839
if {[info exists growanc($v)]} {
6840
incr ngrowanc -1
6841
}
6842
lappend xl $v
6843
}
6844
}
6845
}
6846
}
6847
}
6848
}
6849
} elseif {$y eq $anc || !$dl($x)} {
6850
set dl($y) 0
6851
lappend anclist $y
6852
} else {
6853
set dl($y) 1
6854
lappend anclist $y
6855
incr nnh
6856
}
6857
}
6858
}
6859
}
6860
foreach x [array names growanc] {
6861
if {$dl($x)} {
6862
return 0
6863
}
6864
return 0
6865
}
6866
return 1
6867
}
6868
6869
proc validate_arctags {a} {
6870
global arctags idtags
6871
6872
set i -1
6873
set na $arctags($a)
6874
foreach id $arctags($a) {
6875
incr i
6876
if {![info exists idtags($id)]} {
6877
set na [lreplace $na $i $i]
6878
incr i -1
6879
}
6880
}
6881
set arctags($a) $na
6882
}
6883
6884
proc validate_archeads {a} {
6885
global archeads idheads
6886
6887
set i -1
6888
set na $archeads($a)
6889
foreach id $archeads($a) {
6890
incr i
6891
if {![info exists idheads($id)]} {
6892
set na [lreplace $na $i $i]
6893
incr i -1
6894
}
6895
}
6896
set archeads($a) $na
6897
}
6898
6899
# Return the list of IDs that have tags that are descendents of id,
6900
# ignoring IDs that are descendents of IDs already reported.
6901
proc desctags {id} {
6902
global arcnos arcstart arcids arctags idtags allparents
6903
global growing cached_dtags
6904
6905
if {![info exists allparents($id)]} {
6906
return {}
6907
}
6908
set t1 [clock clicks -milliseconds]
6909
set argid $id
6910
if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6911
# part-way along an arc; check that arc first
6912
set a [lindex $arcnos($id) 0]
6913
if {$arctags($a) ne {}} {
6914
validate_arctags $a
6915
set i [lsearch -exact $arcids($a) $id]
6916
set tid {}
6917
foreach t $arctags($a) {
6918
set j [lsearch -exact $arcids($a) $t]
6919
if {$j >= $i} break
6920
set tid $t
6921
}
6922
if {$tid ne {}} {
6923
return $tid
6924
}
6925
}
6926
set id $arcstart($a)
6927
if {[info exists idtags($id)]} {
6928
return $id
6929
}
6930
}
6931
if {[info exists cached_dtags($id)]} {
6932
return $cached_dtags($id)
6933
}
6934
6935
set origid $id
6936
set todo [list $id]
6937
set queued($id) 1
6938
set nc 1
6939
for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6940
set id [lindex $todo $i]
6941
set done($id) 1
6942
set ta [info exists hastaggedancestor($id)]
6943
if {!$ta} {
6944
incr nc -1
6945
}
6946
# ignore tags on starting node
6947
if {!$ta && $i > 0} {
6948
if {[info exists idtags($id)]} {
6949
set tagloc($id) $id
6950
set ta 1
6951
} elseif {[info exists cached_dtags($id)]} {
6952
set tagloc($id) $cached_dtags($id)
6953
set ta 1
6954
}
6955
}
6956
foreach a $arcnos($id) {
6957
set d $arcstart($a)
6958
if {!$ta && $arctags($a) ne {}} {
6959
validate_arctags $a
6960
if {$arctags($a) ne {}} {
6961
lappend tagloc($id) [lindex $arctags($a) end]
6962
}
6963
}
6964
if {$ta || $arctags($a) ne {}} {
6965
set tomark [list $d]
6966
for {set j 0} {$j < [llength $tomark]} {incr j} {
6967
set dd [lindex $tomark $j]
6968
if {![info exists hastaggedancestor($dd)]} {
6969
if {[info exists done($dd)]} {
6970
foreach b $arcnos($dd) {
6971
lappend tomark $arcstart($b)
6972
}
6973
if {[info exists tagloc($dd)]} {
6974
unset tagloc($dd)
6975
}
6976
} elseif {[info exists queued($dd)]} {
6977
incr nc -1
6978
}
6979
set hastaggedancestor($dd) 1
6980
}
6981
}
6982
}
6983
if {![info exists queued($d)]} {
6984
lappend todo $d
6985
set queued($d) 1
6986
if {![info exists hastaggedancestor($d)]} {
6987
incr nc
6988
}
6989
}
6990
}
6991
}
6992
set tags {}
6993
foreach id [array names tagloc] {
6994
if {![info exists hastaggedancestor($id)]} {
6995
foreach t $tagloc($id) {
6996
if {[lsearch -exact $tags $t] < 0} {
6997
lappend tags $t
6998
}
6999
}
7000
}
7001
}
7002
set t2 [clock clicks -milliseconds]
7003
set loopix $i
7004
7005
# remove tags that are descendents of other tags
7006
for {set i 0} {$i < [llength $tags]} {incr i} {
7007
set a [lindex $tags $i]
7008
for {set j 0} {$j < $i} {incr j} {
7009
set b [lindex $tags $j]
7010
set r [anc_or_desc $a $b]
7011
if {$r == 1} {
7012
set tags [lreplace $tags $j $j]
7013
incr j -1
7014
incr i -1
7015
} elseif {$r == -1} {
7016
set tags [lreplace $tags $i $i]
7017
incr i -1
7018
break
7019
}
7020
}
7021
}
7022
7023
if {[array names growing] ne {}} {
7024
# graph isn't finished, need to check if any tag could get
7025
# eclipsed by another tag coming later. Simply ignore any
7026
# tags that could later get eclipsed.
7027
set ctags {}
7028
foreach t $tags {
7029
if {[is_certain $t $origid]} {
7030
lappend ctags $t
7031
}
7032
}
7033
if {$tags eq $ctags} {
7034
set cached_dtags($origid) $tags
7035
} else {
7036
set tags $ctags
7037
}
7038
} else {
7039
set cached_dtags($origid) $tags
7040
}
7041
set t3 [clock clicks -milliseconds]
7042
if {0 && $t3 - $t1 >= 100} {
7043
puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7044
[expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7045
}
7046
return $tags
7047
}
7048
7049
proc anctags {id} {
7050
global arcnos arcids arcout arcend arctags idtags allparents
7051
global growing cached_atags
7052
7053
if {![info exists allparents($id)]} {
7054
return {}
7055
}
7056
set t1 [clock clicks -milliseconds]
7057
set argid $id
7058
if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7059
# part-way along an arc; check that arc first
7060
set a [lindex $arcnos($id) 0]
7061
if {$arctags($a) ne {}} {
7062
validate_arctags $a
7063
set i [lsearch -exact $arcids($a) $id]
7064
foreach t $arctags($a) {
7065
set j [lsearch -exact $arcids($a) $t]
7066
if {$j > $i} {
7067
return $t
7068
}
7069
}
7070
}
7071
if {![info exists arcend($a)]} {
7072
return {}
7073
}
7074
set id $arcend($a)
7075
if {[info exists idtags($id)]} {
7076
return $id
7077
}
7078
}
7079
if {[info exists cached_atags($id)]} {
7080
return $cached_atags($id)
7081
}
7082
7083
set origid $id
7084
set todo [list $id]
7085
set queued($id) 1
7086
set taglist {}
7087
set nc 1
7088
for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7089
set id [lindex $todo $i]
7090
set done($id) 1
7091
set td [info exists hastaggeddescendent($id)]
7092
if {!$td} {
7093
incr nc -1
7094
}
7095
# ignore tags on starting node
7096
if {!$td && $i > 0} {
7097
if {[info exists idtags($id)]} {
7098
set tagloc($id) $id
7099
set td 1
7100
} elseif {[info exists cached_atags($id)]} {
7101
set tagloc($id) $cached_atags($id)
7102
set td 1
7103
}
7104
}
7105
foreach a $arcout($id) {
7106
if {!$td && $arctags($a) ne {}} {
7107
validate_arctags $a
7108
if {$arctags($a) ne {}} {
7109
lappend tagloc($id) [lindex $arctags($a) 0]
7110
}
7111
}
7112
if {![info exists arcend($a)]} continue
7113
set d $arcend($a)
7114
if {$td || $arctags($a) ne {}} {
7115
set tomark [list $d]
7116
for {set j 0} {$j < [llength $tomark]} {incr j} {
7117
set dd [lindex $tomark $j]
7118
if {![info exists hastaggeddescendent($dd)]} {
7119
if {[info exists done($dd)]} {
7120
foreach b $arcout($dd) {
7121
if {[info exists arcend($b)]} {
7122
lappend tomark $arcend($b)
7123
}
7124
}
7125
if {[info exists tagloc($dd)]} {
7126
unset tagloc($dd)
7127
}
7128
} elseif {[info exists queued($dd)]} {
7129
incr nc -1
7130
}
7131
set hastaggeddescendent($dd) 1
7132
}
7133
}
7134
}
7135
if {![info exists queued($d)]} {
7136
lappend todo $d
7137
set queued($d) 1
7138
if {![info exists hastaggeddescendent($d)]} {
7139
incr nc
7140
}
7141
}
7142
}
7143
}
7144
set t2 [clock clicks -milliseconds]
7145
set loopix $i
7146
set tags {}
7147
foreach id [array names tagloc] {
7148
if {![info exists hastaggeddescendent($id)]} {
7149
foreach t $tagloc($id) {
7150
if {[lsearch -exact $tags $t] < 0} {
7151
lappend tags $t
7152
}
7153
}
7154
}
7155
}
7156
7157
# remove tags that are ancestors of other tags
7158
for {set i 0} {$i < [llength $tags]} {incr i} {
7159
set a [lindex $tags $i]
7160
for {set j 0} {$j < $i} {incr j} {
7161
set b [lindex $tags $j]
7162
set r [anc_or_desc $a $b]
7163
if {$r == -1} {
7164
set tags [lreplace $tags $j $j]
7165
incr j -1
7166
incr i -1
7167
} elseif {$r == 1} {
7168
set tags [lreplace $tags $i $i]
7169
incr i -1
7170
break
7171
}
7172
}
7173
}
7174
7175
if {[array names growing] ne {}} {
7176
# graph isn't finished, need to check if any tag could get
7177
# eclipsed by another tag coming later. Simply ignore any
7178
# tags that could later get eclipsed.
7179
set ctags {}
7180
foreach t $tags {
7181
if {[is_certain $origid $t]} {
7182
lappend ctags $t
7183
}
7184
}
7185
if {$tags eq $ctags} {
7186
set cached_atags($origid) $tags
7187
} else {
7188
set tags $ctags
7189
}
7190
} else {
7191
set cached_atags($origid) $tags
7192
}
7193
set t3 [clock clicks -milliseconds]
7194
if {0 && $t3 - $t1 >= 100} {
7195
puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7196
[expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7197
}
7198
return $tags
7199
}
7200
7201
# Return the list of IDs that have heads that are descendents of id,
7202
# including id itself if it has a head.
7203
proc descheads {id} {
7204
global arcnos arcstart arcids archeads idheads cached_dheads
7205
global allparents
7206
7207
if {![info exists allparents($id)]} {
7208
return {}
7209
}
7210
set aret {}
7211
if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7212
# part-way along an arc; check it first
7213
set a [lindex $arcnos($id) 0]
7214
if {$archeads($a) ne {}} {
7215
validate_archeads $a
7216
set i [lsearch -exact $arcids($a) $id]
7217
foreach t $archeads($a) {
7218
set j [lsearch -exact $arcids($a) $t]
7219
if {$j > $i} break
7220
lappend aret $t
7221
}
7222
}
7223
set id $arcstart($a)
7224
}
7225
set origid $id
7226
set todo [list $id]
7227
set seen($id) 1
7228
set ret {}
7229
for {set i 0} {$i < [llength $todo]} {incr i} {
7230
set id [lindex $todo $i]
7231
if {[info exists cached_dheads($id)]} {
7232
set ret [concat $ret $cached_dheads($id)]
7233
} else {
7234
if {[info exists idheads($id)]} {
7235
lappend ret $id
7236
}
7237
foreach a $arcnos($id) {
7238
if {$archeads($a) ne {}} {
7239
validate_archeads $a
7240
if {$archeads($a) ne {}} {
7241
set ret [concat $ret $archeads($a)]
7242
}
7243
}
7244
set d $arcstart($a)
7245
if {![info exists seen($d)]} {
7246
lappend todo $d
7247
set seen($d) 1
7248
}
7249
}
7250
}
7251
}
7252
set ret [lsort -unique $ret]
7253
set cached_dheads($origid) $ret
7254
return [concat $ret $aret]
7255
}
7256
5539
7257
proc addedtag {id} {
5540
global desc_tags anc_tags allparents allchildren allcommits
5541
global idtags tagisdesc alldtags
5542
5543
if {![info exists desc_tags($id)]} return
5544
set adt $desc_tags($id)
5545
foreach t $desc_tags($id) {
5546
set adt [concat $adt $alldtags($t)]
5547
}
5548
set adt [lsort -unique $adt]
5549
set alldtags($id) $adt
5550
foreach t $adt {
5551
set tagisdesc($id,$t) -1
5552
set tagisdesc($t,$id) 1
5553
}
5554
if {[info exists anc_tags($id)]} {
5555
set todo $anc_tags($id)
5556
while {$todo ne {}} {
5557
set do [lindex $todo 0]
5558
set todo [lrange $todo 1 end]
5559
if {[info exists tagisdesc($id,$do)]} continue
5560
set tagisdesc($do,$id) -1
5561
set tagisdesc($id,$do) 1
5562
if {[info exists anc_tags($do)]} {
5563
set todo [concat $todo $anc_tags($do)]
5564
}
5565
}
5566
}
5567
5568
set lastold $desc_tags($id)
5569
set lastnew [list $id]
5570
set nup 0
5571
set nch 0
5572
set todo $allparents($id)
5573
while {$todo ne {}} {
5574
set do [lindex $todo 0]
5575
set todo [lrange $todo 1 end]
5576
if {![info exists desc_tags($do)]} continue
5577
if {$desc_tags($do) ne $lastold} {
5578
set lastold $desc_tags($do)
5579
set lastnew [combine_dtags $lastold [list $id]]
5580
incr nch
5581
}
5582
if {$lastold eq $lastnew} continue
5583
set desc_tags($do) $lastnew
5584
incr nup
5585
if {![info exists idtags($do)]} {
5586
set todo [concat $todo $allparents($do)]
5587
}
5588
}
5589
5590
if {![info exists anc_tags($id)]} return
5591
set lastold $anc_tags($id)
5592
set lastnew [list $id]
5593
set nup 0
5594
set nch 0
5595
set todo $allchildren($id)
5596
while {$todo ne {}} {
5597
set do [lindex $todo 0]
5598
set todo [lrange $todo 1 end]
5599
if {![info exists anc_tags($do)]} continue
5600
if {$anc_tags($do) ne $lastold} {
5601
set lastold $anc_tags($do)
5602
set lastnew [combine_atags $lastold [list $id]]
5603
incr nch
5604
}
5605
if {$lastold eq $lastnew} continue
5606
set anc_tags($do) $lastnew
5607
incr nup
5608
if {![info exists idtags($do)]} {
5609
set todo [concat $todo $allchildren($do)]
5610
}
5611
}
7258
global arcnos arcout cached_dtags cached_atags
7259
7260
if {![info exists arcnos($id)]} return
7261
if {![info exists arcout($id)]} {
7262
recalcarc [lindex $arcnos($id) 0]
7263
}
7264
catch {unset cached_dtags}
7265
catch {unset cached_atags}
5612
7266
}
5613
7267
5614
# update the desc_heads array for a new head just added
5615
7268
proc addedhead {hid head} {
5616
global desc_heads allparents headids idheads
5617
5618
set headids($head) $hid
5619
lappend idheads($hid) $head
5620
5621
set todo [list $hid]
5622
while {$todo ne {}} {
5623
set do [lindex $todo 0]
5624
set todo [lrange $todo 1 end]
5625
if {![info exists desc_heads($do)] ||
5626
[lsearch -exact $desc_heads($do) $head] >= 0} continue
5627
set oldheads $desc_heads($do)
5628
lappend desc_heads($do) $head
5629
set heads $desc_heads($do)
5630
while {1} {
5631
set p $allparents($do)
5632
if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5633
$desc_heads($p) ne $oldheads} break
5634
set do $p
5635
set desc_heads($do) $heads
5636
}
5637
set todo [concat $todo $p]
7269
global arcnos arcout cached_dheads
7270
7271
if {![info exists arcnos($hid)]} return
7272
if {![info exists arcout($hid)]} {
7273
recalcarc [lindex $arcnos($hid) 0]
5638
7274
}
7275
catch {unset cached_dheads}
5639
7276
}
5640
7277
5641
# update the desc_heads array for a head just removed
5642
7278
proc removedhead {hid head} {
5643
global desc_heads allparents headids idheads
5644
5645
unset headids($head)
5646
if {$idheads($hid) eq $head} {
5647
unset idheads($hid)
5648
} else {
5649
set i [lsearch -exact $idheads($hid) $head]
5650
if {$i >= 0} {
5651
set idheads($hid) [lreplace $idheads($hid) $i $i]
5652
}
5653
}
5654
5655
set todo [list $hid]
5656
while {$todo ne {}} {
5657
set do [lindex $todo 0]
5658
set todo [lrange $todo 1 end]
5659
if {![info exists desc_heads($do)]} continue
5660
set i [lsearch -exact $desc_heads($do) $head]
5661
if {$i < 0} continue
5662
set oldheads $desc_heads($do)
5663
set heads [lreplace $desc_heads($do) $i $i]
5664
while {1} {
5665
set desc_heads($do) $heads
5666
set p $allparents($do)
5667
if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5668
$desc_heads($p) ne $oldheads} break
5669
set do $p
5670
}
5671
set todo [concat $todo $p]
5672
}
7279
global cached_dheads
7280
7281
catch {unset cached_dheads}
5673
7282
}
5674
7283
5675
# update things for a head moved to a child of its previous location
5676
proc movedhead {id name} {
5677
global headids idheads
7284
proc movedhead {hid head} {
7285
global arcnos arcout cached_dheads
5678
7286
5679
set oldid $headids($name)
5680
set headids($name) $id
5681
if {$idheads($oldid) eq $name} {
5682
unset idheads($oldid)
5683
} else {
5684
set i [lsearch -exact $idheads($oldid) $name]
5685
if {$i >= 0} {
5686
set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5687
}
7287
if {![info exists arcnos($hid)]} return
7288
if {![info exists arcout($hid)]} {
7289
recalcarc [lindex $arcnos($hid) 0]
5688
7290
}
5689
lappend idheads($id) $name
7291
catch {unset cached_dheads}
5690
7292
}
5691
7293
5692
7294
proc changedrefs {} {
5693
global desc_heads desc_tags anc_tags allcommits allids
5694
global allchildren allparents idtags travindex
7295
global cached_dheads cached_dtags cached_atags
7296
global arctags archeads arcnos arcout idheads idtags
5695
7297
5696
if {![info exists allcommits]} return
5697
catch {unset desc_heads}
5698
catch {unset desc_tags}
5699
catch {unset anc_tags}
5700
catch {unset alldtags}
5701
catch {unset tagisdesc}
5702
foreach id $allids {
5703
forward_pass $id $allchildren($id)
5704
}
5705
if {$allcommits ne "reading"} {
5706
set travindex [llength $allids]
5707
if {$allcommits ne "traversing"} {
5708
set allcommits "traversing"
5709
after idle restartatags
7298
foreach id [concat [array names idheads] [array names idtags]] {
7299
if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7300
set a [lindex $arcnos($id) 0]
7301
if {![info exists donearc($a)]} {
7302
recalcarc $a
7303
set donearc($a) 1
7304
}
5710
7305
}
5711
7306
}
7307
catch {unset cached_dtags}
7308
catch {unset cached_atags}
7309
catch {unset cached_dheads}
5712
7310
}
5713
7311
5714
7312
proc rereadrefs {} {
5734
7332
redrawtags $id
5735
7333
}
5736
7334
}
7335
run refill_reflist
5737
7336
}
5738
7337
5739
7338
proc listrefs {id} {
5755
7354
}
5756
7355
5757
7356
proc showtag {tag isnew} {
5758
global ctext tagcontents tagids linknum
7357
global ctext tagcontents tagids linknum tagobjid
5759
7358
5760
7359
if {$isnew} {
5761
7360
addtohistory [list showtag $tag 0]
5763
7362
$ctext conf -state normal
5764
7363
clear_ctext
5765
7364
set linknum 0
7365
if {![info exists tagcontents($tag)]} {
7366
catch {
7367
set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7368
}
7369
}
5766
7370
if {[info exists tagcontents($tag)]} {
5767
7371
set text $tagcontents($tag)
5768
7372
} else {
5776
7380
proc doquit {} {
5777
7381
global stopped
5778
7382
set stopped 100
7383
savestuff .
5779
7384
destroy .
5780
7385
}
5781
7386
5782
7387
proc doprefs {} {
5783
7388
global maxwidth maxgraphpct diffopts
5784
global oldprefs prefstop showneartags
5785
global bgcolor fgcolor ctext diffcolors
7389
global oldprefs prefstop showneartags showlocalchanges
7390
global bgcolor fgcolor ctext diffcolors selectbgcolor
7391
global uifont tabstop
5786
7392
5787
7393
set top .gitkprefs
5788
7394
set prefstop $top
5790
7396
raise $top
5791
7397
return
5792
7398
}
5793
foreach v {maxwidth maxgraphpct diffopts showneartags} {
7399
foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
5794
7400
set oldprefs($v) [set $v]
5795
7401
}
5796
7402
toplevel $top
5797
7403
wm title $top "Gitk preferences"
5798
7404
label $top.ldisp -text "Commit list display options"
7405
$top.ldisp configure -font $uifont
5799
7406
grid $top.ldisp - -sticky w -pady 10
5800
7407
label $top.spacer -text " "
5801
7408
label $top.maxwidthl -text "Maximum graph width (lines)" \
5806
7413
-font optionfont
5807
7414
spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5808
7415
grid x $top.maxpctl $top.maxpct -sticky w
7416
frame $top.showlocal
7417
label $top.showlocal.l -text "Show local changes" -font optionfont
7418
checkbutton $top.showlocal.b -variable showlocalchanges
7419
pack $top.showlocal.b $top.showlocal.l -side left
7420
grid x $top.showlocal -sticky w
5809
7421
5810
7422
label $top.ddisp -text "Diff display options"
7423
$top.ddisp configure -font $uifont
5811
7424
grid $top.ddisp - -sticky w -pady 10
5812
7425
label $top.diffoptl -text "Options for diff program" \
5813
7426
-font optionfont
5818
7431
checkbutton $top.ntag.b -variable showneartags
5819
7432
pack $top.ntag.b $top.ntag.l -side left
5820
7433
grid x $top.ntag -sticky w
7434
label $top.tabstopl -text "tabstop" -font optionfont
7435
spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7436
grid x $top.tabstopl $top.tabstop -sticky w
5821
7437
5822
7438
label $top.cdisp -text "Colors: press to choose"
7439
$top.cdisp configure -font $uifont
5823
7440
grid $top.cdisp - -sticky w -pady 10
5824
7441
label $top.bg -padx 40 -relief sunk -background $bgcolor
5825
7442
button $top.bgbut -text "Background" -font optionfont \
5845
7462
"diff hunk header" \
5846
7463
[list $ctext tag conf hunksep -foreground]]
5847
7464
grid x $top.hunksepbut $top.hunksep -sticky w
7465
label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7466
button $top.selbgbut -text "Select bg" -font optionfont \
7467
-command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7468
grid x $top.selbgbut $top.selbgsep -sticky w
5848
7469
5849
7470
frame $top.buts
5850
button $top.buts.ok -text "OK" -command prefsok
5851
button $top.buts.can -text "Cancel" -command prefscan
7471
button $top.buts.ok -text "OK" -command prefsok -default active
7472
$top.buts.ok configure -font $uifont
7473
button $top.buts.can -text "Cancel" -command prefscan -default normal
7474
$top.buts.can configure -font $uifont
5852
7475
grid $top.buts.ok $top.buts.can
5853
7476
grid columnconfigure $top.buts 0 -weight 1 -uniform a
5854
7477
grid columnconfigure $top.buts 1 -weight 1 -uniform a
5855
7478
grid $top.buts - - -pady 10 -sticky ew
7479
bind $top <Visibility> "focus $top.buts.ok"
5856
7480
}
5857
7481
5858
7482
proc choosecolor {v vi w x cmd} {
5866
7490
eval $cmd $c
5867
7491
}
5868
7492
7493
proc setselbg {c} {
7494
global bglist cflist
7495
foreach w $bglist {
7496
$w configure -selectbackground $c
7497
}
7498
$cflist tag configure highlight \
7499
-background [$cflist cget -selectbackground]
7500
allcanvs itemconf secsel -fill $c
7501
}
7502
5869
7503
proc setbg {c} {
5870
7504
global bglist
5871
7505
5886
7520
5887
7521
proc prefscan {} {
5888
7522
global maxwidth maxgraphpct diffopts
5889
global oldprefs prefstop showneartags
7523
global oldprefs prefstop showneartags showlocalchanges
5890
7524
5891
foreach v {maxwidth maxgraphpct diffopts showneartags} {
7525
foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
5892
7526
set $v $oldprefs($v)
5893
7527
}
5894
7528
catch {destroy $prefstop}
5897
7531
5898
7532
proc prefsok {} {
5899
7533
global maxwidth maxgraphpct
5900
global oldprefs prefstop showneartags
7534
global oldprefs prefstop showneartags showlocalchanges
7535
global charspc ctext tabstop
5901
7536
5902
7537
catch {destroy $prefstop}
5903
7538
unset prefstop
7539
$ctext configure -tabs "[expr {$tabstop * $charspc}]"
7540
if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7541
if {$showlocalchanges} {
7542
doshowlocalchanges
7543
} else {
7544
dohidelocalchanges
7545
}
7546
}
5904
7547
if {$maxwidth != $oldprefs(maxwidth)
5905
7548
|| $maxgraphpct != $oldprefs(maxgraphpct)} {
5906
7549
redisplay
5910
7553
}
5911
7554
5912
7555
proc formatdate {d} {
5913
return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7556
global datetimeformat
7557
if {$d ne {}} {
7558
set d [clock format $d -format $datetimeformat]
7559
}
7560
return $d
5914
7561
}
5915
7562
5916
7563
# This list of encoding names and aliases is distilled from
6193
7840
6194
7841
set gitencoding {}
6195
7842
catch {
6196
set gitencoding [exec git repo-config --get i18n.commitencoding]
7843
set gitencoding [exec git config --get i18n.commitencoding]
6197
7844
}
6198
7845
if {$gitencoding == ""} {
6199
7846
set gitencoding "utf-8"
6206
7853
set mainfont {Helvetica 9}
6207
7854
set textfont {Courier 9}
6208
7855
set uifont {Helvetica 9 bold}
7856
set tabstop 8
6209
7857
set findmergefiles 0
6210
7858
set maxgraphpct 50
6211
7859
set maxwidth 16
6217
7865
set cmitmode "patch"
6218
7866
set wrapcomment "none"
6219
7867
set showneartags 1
7868
set maxrefs 20
7869
set maxlinelen 200
7870
set showlocalchanges 1
7871
set datetimeformat "%Y-%m-%d %H:%M:%S"
6220
7872
6221
7873
set colors {green red blue magenta darkgrey brown orange}
6222
7874
set bgcolor white
6223
7875
set fgcolor black
6224
7876
set diffcolors {red "#00a000" blue}
7877
set diffcontext 3
7878
set selectbgcolor gray85
6225
7879
6226
7880
catch {source ~/.gitk}
6227
7881
6228
7882
font create optionfont -family sans-serif -size -12
6229
7883
7884
# check that we can find a .git directory somewhere...
7885
if {[catch {set gitdir [gitdir]}]} {
7886
show_error {} . "Cannot find a git repository here."
7887
exit 1
7888
}
7889
if {![file isdirectory $gitdir]} {
7890
show_error {} . "Cannot find the git directory \"$gitdir\"."
7891
exit 1
7892
}
7893
6230
7894
set revtreeargs {}
7895
set cmdline_files {}
7896
set i 0
6231
7897
foreach arg $argv {
6232
switch -regexp -- $arg {
6233
"^$" { }
6234
"^-d" { set datemode 1 }
7898
switch -- $arg {
7899
"" { }
7900
"-d" { set datemode 1 }
7901
"--" {
7902
set cmdline_files [lrange $argv [expr {$i + 1}] end]
7903
break
7904
}
6235
7905
default {
6236
7906
lappend revtreeargs $arg
6237
7907
}
6238
7908
}
6239
}
6240
6241
# check that we can find a .git directory somewhere...
6242
set gitdir [gitdir]
6243
if {![file isdirectory $gitdir]} {
6244
show_error {} . "Cannot find the git directory \"$gitdir\"."
6245
exit 1
6246
}
6247
6248
set cmdline_files {}
6249
set i [lsearch -exact $revtreeargs "--"]
6250
if {$i >= 0} {
6251
set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6252
set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6253
} elseif {$revtreeargs ne {}} {
7909
incr i
7910
}
7911
7912
if {$i >= [llength $argv] && $revtreeargs ne {}} {
7913
# no -- on command line, but some arguments (other than -d)
6254
7914
if {[catch {
6255
7915
set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6256
7916
set cmdline_files [split $f "\n"]
6257
7917
set n [llength $cmdline_files]
6258
7918
set revtreeargs [lrange $revtreeargs 0 end-$n]
7919
# Unfortunately git rev-parse doesn't produce an error when
7920
# something is both a revision and a filename. To be consistent
7921
# with git log and git rev-list, check revtreeargs for filenames.
7922
foreach arg $revtreeargs {
7923
if {[file exists $arg]} {
7924
show_error {} . "Ambiguous argument '$arg': both revision\
7925
and filename"
7926
exit 1
7927
}
7928
}
6259
7929
} err]} {
6260
7930
# unfortunately we get both stdout and stderr in $err,
6261
7931
# so look for "fatal:".
6268
7938
}
6269
7939
}
6270
7940
7941
set nullid "0000000000000000000000000000000000000000"
7942
set nullid2 "0000000000000000000000000000000000000001"
7943
7944
7945
set runq {}
6271
7946
set history {}
6272
7947
set historyindex 0
6273
7948
set fh_serial 0
6276
7951
set searchdirn -forwards
6277
7952
set boldrows {}
6278
7953
set boldnamerows {}
7954
set diffelide {0 0}
7955
set markingmatches 0
6279
7956
6280
7957
set optim_delay 16
6281
7958
6291
7968
set stopped 0
6292
7969
set stuffsaved 0
6293
7970
set patchnum 0
7971
set lookingforhead 0
7972
set localirow -1
7973
set localfrow -1
7974
set lserial 0
6294
7975
setcoords
6295
7976
makewindow
7977
# wait for the window to become visible
7978
tkwait visibility .
7979
wm title . "[file tail $argv0]: [file tail [pwd]]"
6296
7980
readrefs
6297
7981
6298
7982
if {$cmdline_files ne {} || $revtreeargs ne {}} {
6305
7989
set viewargs(1) $revtreeargs
6306
7990
set viewperm(1) 0
6307
7991
addviewmenu 1
6308
.bar.view entryconf 2 -state normal
6309
.bar.view entryconf 3 -state normal
7992
.bar.view entryconf Edit* -state normal
7993
.bar.view entryconf Delete* -state normal
6310
7994
}
6311
7995
6312
7996
if {[info exists permviews]} {
Loggerhead is a web-based interface for Breezy
Version: 2.0.1