1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
5# Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
10proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
16 }
17}
18
19proc start_rev_list {view} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
23
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
26 set ncmupdate 1
27 set commitidx($view) 0
28 set args $viewargs($view)
29 if {$viewfiles($view) ne {}} {
30 set args [concat $args "--" $viewfiles($view)]
31 }
32 set order "--topo-order"
33 if {$datemode} {
34 set order "--date-order"
35 }
36 if {[catch {
37 set fd [open [concat | git rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
39 } err]} {
40 puts stderr "Error executing git rev-list: $err"
41 exit 1
42 }
43 set commfd($view) $fd
44 set leftover($view) {}
45 fconfigure $fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure $fd -encoding $tclencoding
48 }
49 fileevent $fd readable [list getcommitlines $fd $view]
50 nowbusy $view
51}
52
53proc stop_rev_list {} {
54 global commfd curview
55
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
58 catch {
59 set pid [pid $fd]
60 exec kill $pid
61 }
62 catch {close $fd}
63 unset commfd($curview)
64}
65
66proc getcommits {} {
67 global phase canv mainfont curview
68
69 set phase getcommits
70 initlayout
71 start_rev_list $curview
72 show_status "Reading commits..."
73}
74
75proc getcommitlines {fd view} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
81
82 set stuff [read $fd]
83 if {$stuff == {}} {
84 if {![eof $fd]} return
85 global viewname
86 unset commfd($view)
87 notbusy $view
88 # set it blocking so we wait for the process to terminate
89 fconfigure $fd -blocking 1
90 if {[catch {close $fd} err]} {
91 set fv {}
92 if {$view != $curview} {
93 set fv " for the \"$viewname($view)\" view"
94 }
95 if {[string range $err 0 4] == "usage"} {
96 set err "Gitk: error reading commits$fv:\
97 bad arguments to git rev-list."
98 if {$viewname($view) eq "Command line"} {
99 append err \
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
102 }
103 } else {
104 set err "Error reading commits$fv: $err"
105 }
106 error_popup $err
107 }
108 if {$view == $curview} {
109 after idle finishcommits
110 }
111 return
112 }
113 set start 0
114 set gotsome 0
115 while 1 {
116 set i [string first "\0" $stuff $start]
117 if {$i < 0} {
118 append leftover($view) [string range $stuff $start end]
119 break
120 }
121 if {$start == 0} {
122 set cmit $leftover($view)
123 append cmit [string range $stuff 0 [expr {$i - 1}]]
124 set leftover($view) {}
125 } else {
126 set cmit [string range $stuff $start [expr {$i - 1}]]
127 }
128 set start [expr {$i + 1}]
129 set j [string first "\n" $cmit]
130 set ok 0
131 set listed 1
132 if {$j >= 0} {
133 set ids [string range $cmit 0 [expr {$j - 1}]]
134 if {[string range $ids 0 0] == "-"} {
135 set listed 0
136 set ids [string range $ids 1 end]
137 }
138 set ok 1
139 foreach id $ids {
140 if {[string length $id] != 40} {
141 set ok 0
142 break
143 }
144 }
145 }
146 if {!$ok} {
147 set shortcmit $cmit
148 if {[string length $shortcmit] > 80} {
149 set shortcmit "[string range $shortcmit 0 80]..."
150 }
151 error_popup "Can't parse git rev-list output: {$shortcmit}"
152 exit 1
153 }
154 set id [lindex $ids 0]
155 if {$listed} {
156 set olds [lrange $ids 1 end]
157 set i 0
158 foreach p $olds {
159 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
160 lappend children($view,$p) $id
161 }
162 incr i
163 }
164 } else {
165 set olds {}
166 }
167 if {![info exists children($view,$id)]} {
168 set children($view,$id) {}
169 }
170 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
171 set commitrow($view,$id) $commitidx($view)
172 incr commitidx($view)
173 if {$view == $curview} {
174 lappend parentlist $olds
175 lappend childlist $children($view,$id)
176 lappend displayorder $id
177 lappend commitlisted $listed
178 } else {
179 lappend vparentlist($view) $olds
180 lappend vchildlist($view) $children($view,$id)
181 lappend vdisporder($view) $id
182 lappend vcmitlisted($view) $listed
183 }
184 set gotsome 1
185 }
186 if {$gotsome} {
187 if {$view == $curview} {
188 layoutmore
189 } elseif {[info exists hlview] && $view == $hlview} {
190 vhighlightmore
191 }
192 }
193 if {[clock clicks -milliseconds] >= $nextupdate} {
194 doupdate
195 }
196}
197
198proc doupdate {} {
199 global commfd nextupdate numcommits ncmupdate
200
201 foreach v [array names commfd] {
202 fileevent $commfd($v) readable {}
203 }
204 update
205 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate [expr {$numcommits + 1}]
208 } elseif {$numcommits < 10000} {
209 set ncmupdate [expr {$numcommits + 10}]
210 } else {
211 set ncmupdate [expr {$numcommits + 100}]
212 }
213 foreach v [array names commfd] {
214 set fd $commfd($v)
215 fileevent $fd readable [list getcommitlines $fd $v]
216 }
217}
218
219proc readcommit {id} {
220 if {[catch {set contents [exec git cat-file commit $id]}]} return
221 parsecommit $id $contents 0
222}
223
224proc updatecommits {} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
227
228 if {$phase ne {}} {
229 stop_rev_list
230 set phase {}
231 }
232 set n $curview
233 foreach id $displayorder {
234 catch {unset children($n,$id)}
235 catch {unset commitrow($n,$id)}
236 }
237 set curview -1
238 catch {unset selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
241 discardallcommits
242 readrefs
243 showview $n
244}
245
246proc parsecommit {id contents listed} {
247 global commitinfo cdate
248
249 set inhdr 1
250 set comment {}
251 set headline {}
252 set auname {}
253 set audate {}
254 set comname {}
255 set comdate {}
256 set hdrend [string first "\n\n" $contents]
257 if {$hdrend < 0} {
258 # should never happen...
259 set hdrend [string length $contents]
260 }
261 set header [string range $contents 0 [expr {$hdrend - 1}]]
262 set comment [string range $contents [expr {$hdrend + 2}] end]
263 foreach line [split $header "\n"] {
264 set tag [lindex $line 0]
265 if {$tag == "author"} {
266 set audate [lindex $line end-1]
267 set auname [lrange $line 1 end-2]
268 } elseif {$tag == "committer"} {
269 set comdate [lindex $line end-1]
270 set comname [lrange $line 1 end-2]
271 }
272 }
273 set headline {}
274 # take the first line of the comment as the headline
275 set i [string first "\n" $comment]
276 if {$i >= 0} {
277 set headline [string trim [string range $comment 0 $i]]
278 } else {
279 set headline $comment
280 }
281 if {!$listed} {
282 # git rev-list indents the comment by 4 spaces;
283 # if we got this via git cat-file, add the indentation
284 set newcomment {}
285 foreach line [split $comment "\n"] {
286 append newcomment " "
287 append newcomment $line
288 append newcomment "\n"
289 }
290 set comment $newcomment
291 }
292 if {$comdate != {}} {
293 set cdate($id) $comdate
294 }
295 set commitinfo($id) [list $headline $auname $audate \
296 $comname $comdate $comment]
297}
298
299proc getcommit {id} {
300 global commitdata commitinfo
301
302 if {[info exists commitdata($id)]} {
303 parsecommit $id $commitdata($id) 1
304 } else {
305 readcommit $id
306 if {![info exists commitinfo($id)]} {
307 set commitinfo($id) {"No commit information available"}
308 }
309 }
310 return 1
311}
312
313proc readrefs {} {
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs mainhead
316
317 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
318 catch {unset $v}
319 }
320 set refd [open [list | git ls-remote [gitdir]] r]
321 while {0 <= [set n [gets $refd line]]} {
322 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
323 match id path]} {
324 continue
325 }
326 if {[regexp {^remotes/.*/HEAD$} $path match]} {
327 continue
328 }
329 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
330 set type others
331 set name $path
332 }
333 if {[regexp {^remotes/} $path match]} {
334 set type heads
335 }
336 if {$type == "tags"} {
337 set tagids($name) $id
338 lappend idtags($id) $name
339 set obj {}
340 set type {}
341 set tag {}
342 catch {
343 set commit [exec git rev-parse "$id^0"]
344 if {$commit != $id} {
345 set tagids($name) $commit
346 lappend idtags($commit) $name
347 }
348 }
349 catch {
350 set tagcontents($name) [exec git cat-file tag $id]
351 }
352 } elseif { $type == "heads" } {
353 set headids($name) $id
354 lappend idheads($id) $name
355 } else {
356 set otherrefids($name) $id
357 lappend idotherrefs($id) $name
358 }
359 }
360 close $refd
361 set mainhead {}
362 catch {
363 set thehead [exec git symbolic-ref HEAD]
364 if {[string match "refs/heads/*" $thehead]} {
365 set mainhead [string range $thehead 11 end]
366 }
367 }
368}
369
370proc show_error {w top msg} {
371 message $w.m -text $msg -justify center -aspect 400
372 pack $w.m -side top -fill x -padx 20 -pady 20
373 button $w.ok -text OK -command "destroy $top"
374 pack $w.ok -side bottom -fill x
375 bind $top <Visibility> "grab $top; focus $top"
376 bind $top <Key-Return> "destroy $top"
377 tkwait window $top
378}
379
380proc error_popup msg {
381 set w .error
382 toplevel $w
383 wm transient $w .
384 show_error $w $w $msg
385}
386
387proc confirm_popup msg {
388 global confirm_ok
389 set confirm_ok 0
390 set w .confirm
391 toplevel $w
392 wm transient $w .
393 message $w.m -text $msg -justify center -aspect 400
394 pack $w.m -side top -fill x -padx 20 -pady 20
395 button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
396 pack $w.ok -side left -fill x
397 button $w.cancel -text Cancel -command "destroy $w"
398 pack $w.cancel -side right -fill x
399 bind $w <Visibility> "grab $w; focus $w"
400 tkwait window $w
401 return $confirm_ok
402}
403
404proc makewindow {} {
405 global canv canv2 canv3 linespc charspc ctext cflist
406 global textfont mainfont uifont
407 global findtype findtypemenu findloc findstring fstring geometry
408 global entries sha1entry sha1string sha1but
409 global maincursor textcursor curtextcursor
410 global rowctxmenu mergemax wrapcomment
411 global highlight_files gdttype
412 global searchstring sstring
413 global bgcolor fgcolor bglist fglist diffcolors
414 global headctxmenu
415
416 menu .bar
417 .bar add cascade -label "File" -menu .bar.file
418 .bar configure -font $uifont
419 menu .bar.file
420 .bar.file add command -label "Update" -command updatecommits
421 .bar.file add command -label "Reread references" -command rereadrefs
422 .bar.file add command -label "Quit" -command doquit
423 .bar.file configure -font $uifont
424 menu .bar.edit
425 .bar add cascade -label "Edit" -menu .bar.edit
426 .bar.edit add command -label "Preferences" -command doprefs
427 .bar.edit configure -font $uifont
428
429 menu .bar.view -font $uifont
430 .bar add cascade -label "View" -menu .bar.view
431 .bar.view add command -label "New view..." -command {newview 0}
432 .bar.view add command -label "Edit view..." -command editview \
433 -state disabled
434 .bar.view add command -label "Delete view" -command delview -state disabled
435 .bar.view add separator
436 .bar.view add radiobutton -label "All files" -command {showview 0} \
437 -variable selectedview -value 0
438
439 menu .bar.help
440 .bar add cascade -label "Help" -menu .bar.help
441 .bar.help add command -label "About gitk" -command about
442 .bar.help add command -label "Key bindings" -command keys
443 .bar.help configure -font $uifont
444 . configure -menu .bar
445
446 if {![info exists geometry(canv1)]} {
447 set geometry(canv1) [expr {45 * $charspc}]
448 set geometry(canv2) [expr {30 * $charspc}]
449 set geometry(canv3) [expr {15 * $charspc}]
450 set geometry(canvh) [expr {25 * $linespc + 4}]
451 set geometry(ctextw) 80
452 set geometry(ctexth) 30
453 set geometry(cflistw) 30
454 }
455 panedwindow .ctop -orient vertical
456 if {[info exists geometry(width)]} {
457 .ctop conf -width $geometry(width) -height $geometry(height)
458 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
459 set geometry(ctexth) [expr {($texth - 8) /
460 [font metrics $textfont -linespace]}]
461 }
462 frame .ctop.top
463 frame .ctop.top.bar
464 frame .ctop.top.lbar
465 pack .ctop.top.lbar -side bottom -fill x
466 pack .ctop.top.bar -side bottom -fill x
467 set cscroll .ctop.top.csb
468 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
469 pack $cscroll -side right -fill y
470 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
471 pack .ctop.top.clist -side top -fill both -expand 1
472 .ctop add .ctop.top
473 set canv .ctop.top.clist.canv
474 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
475 -background $bgcolor -bd 0 \
476 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
477 .ctop.top.clist add $canv
478 set canv2 .ctop.top.clist.canv2
479 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
480 -background $bgcolor -bd 0 -yscrollincr $linespc
481 .ctop.top.clist add $canv2
482 set canv3 .ctop.top.clist.canv3
483 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
484 -background $bgcolor -bd 0 -yscrollincr $linespc
485 .ctop.top.clist add $canv3
486 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
487 lappend bglist $canv $canv2 $canv3
488
489 set sha1entry .ctop.top.bar.sha1
490 set entries $sha1entry
491 set sha1but .ctop.top.bar.sha1label
492 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
493 -command gotocommit -width 8 -font $uifont
494 $sha1but conf -disabledforeground [$sha1but cget -foreground]
495 pack .ctop.top.bar.sha1label -side left
496 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
497 trace add variable sha1string write sha1change
498 pack $sha1entry -side left -pady 2
499
500 image create bitmap bm-left -data {
501 #define left_width 16
502 #define left_height 16
503 static unsigned char left_bits[] = {
504 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
505 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
506 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
507 }
508 image create bitmap bm-right -data {
509 #define right_width 16
510 #define right_height 16
511 static unsigned char right_bits[] = {
512 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
513 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
514 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
515 }
516 button .ctop.top.bar.leftbut -image bm-left -command goback \
517 -state disabled -width 26
518 pack .ctop.top.bar.leftbut -side left -fill y
519 button .ctop.top.bar.rightbut -image bm-right -command goforw \
520 -state disabled -width 26
521 pack .ctop.top.bar.rightbut -side left -fill y
522
523 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
524 pack .ctop.top.bar.findbut -side left
525 set findstring {}
526 set fstring .ctop.top.bar.findstring
527 lappend entries $fstring
528 entry $fstring -width 30 -font $textfont -textvariable findstring
529 trace add variable findstring write find_change
530 pack $fstring -side left -expand 1 -fill x
531 set findtype Exact
532 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
533 findtype Exact IgnCase Regexp]
534 trace add variable findtype write find_change
535 .ctop.top.bar.findtype configure -font $uifont
536 .ctop.top.bar.findtype.menu configure -font $uifont
537 set findloc "All fields"
538 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
539 Comments Author Committer
540 trace add variable findloc write find_change
541 .ctop.top.bar.findloc configure -font $uifont
542 .ctop.top.bar.findloc.menu configure -font $uifont
543 pack .ctop.top.bar.findloc -side right
544 pack .ctop.top.bar.findtype -side right
545
546 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
547 -font $uifont
548 pack .ctop.top.lbar.flabel -side left -fill y
549 set gdttype "touching paths:"
550 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
551 "adding/removing string:"]
552 trace add variable gdttype write hfiles_change
553 $gm conf -font $uifont
554 .ctop.top.lbar.gdttype conf -font $uifont
555 pack .ctop.top.lbar.gdttype -side left -fill y
556 entry .ctop.top.lbar.fent -width 25 -font $textfont \
557 -textvariable highlight_files
558 trace add variable highlight_files write hfiles_change
559 lappend entries .ctop.top.lbar.fent
560 pack .ctop.top.lbar.fent -side left -fill x -expand 1
561 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
562 pack .ctop.top.lbar.vlabel -side left -fill y
563 global viewhlmenu selectedhlview
564 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
565 $viewhlmenu entryconf 0 -command delvhighlight
566 $viewhlmenu conf -font $uifont
567 .ctop.top.lbar.vhl conf -font $uifont
568 pack .ctop.top.lbar.vhl -side left -fill y
569 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
570 pack .ctop.top.lbar.rlabel -side left -fill y
571 global highlight_related
572 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
573 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
574 $m conf -font $uifont
575 .ctop.top.lbar.relm conf -font $uifont
576 trace add variable highlight_related write vrel_change
577 pack .ctop.top.lbar.relm -side left -fill y
578
579 panedwindow .ctop.cdet -orient horizontal
580 .ctop add .ctop.cdet
581 frame .ctop.cdet.left
582 frame .ctop.cdet.left.bot
583 pack .ctop.cdet.left.bot -side bottom -fill x
584 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
585 -font $uifont
586 pack .ctop.cdet.left.bot.search -side left -padx 5
587 set sstring .ctop.cdet.left.bot.sstring
588 entry $sstring -width 20 -font $textfont -textvariable searchstring
589 lappend entries $sstring
590 trace add variable searchstring write incrsearch
591 pack $sstring -side left -expand 1 -fill x
592 set ctext .ctop.cdet.left.ctext
593 text $ctext -background $bgcolor -foreground $fgcolor \
594 -state disabled -font $textfont \
595 -width $geometry(ctextw) -height $geometry(ctexth) \
596 -yscrollcommand scrolltext -wrap none
597 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
598 pack .ctop.cdet.left.sb -side right -fill y
599 pack $ctext -side left -fill both -expand 1
600 .ctop.cdet add .ctop.cdet.left
601 lappend bglist $ctext
602 lappend fglist $ctext
603
604 $ctext tag conf comment -wrap $wrapcomment
605 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
606 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
607 $ctext tag conf d0 -fore [lindex $diffcolors 0]
608 $ctext tag conf d1 -fore [lindex $diffcolors 1]
609 $ctext tag conf m0 -fore red
610 $ctext tag conf m1 -fore blue
611 $ctext tag conf m2 -fore green
612 $ctext tag conf m3 -fore purple
613 $ctext tag conf m4 -fore brown
614 $ctext tag conf m5 -fore "#009090"
615 $ctext tag conf m6 -fore magenta
616 $ctext tag conf m7 -fore "#808000"
617 $ctext tag conf m8 -fore "#009000"
618 $ctext tag conf m9 -fore "#ff0080"
619 $ctext tag conf m10 -fore cyan
620 $ctext tag conf m11 -fore "#b07070"
621 $ctext tag conf m12 -fore "#70b0f0"
622 $ctext tag conf m13 -fore "#70f0b0"
623 $ctext tag conf m14 -fore "#f0b070"
624 $ctext tag conf m15 -fore "#ff70b0"
625 $ctext tag conf mmax -fore darkgrey
626 set mergemax 16
627 $ctext tag conf mresult -font [concat $textfont bold]
628 $ctext tag conf msep -font [concat $textfont bold]
629 $ctext tag conf found -back yellow
630
631 frame .ctop.cdet.right
632 frame .ctop.cdet.right.mode
633 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
634 -command reselectline -variable cmitmode -value "patch"
635 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
636 -command reselectline -variable cmitmode -value "tree"
637 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
638 pack .ctop.cdet.right.mode -side top -fill x
639 set cflist .ctop.cdet.right.cfiles
640 set indent [font measure $mainfont "nn"]
641 text $cflist -width $geometry(cflistw) \
642 -background $bgcolor -foreground $fgcolor \
643 -font $mainfont \
644 -tabs [list $indent [expr {2 * $indent}]] \
645 -yscrollcommand ".ctop.cdet.right.sb set" \
646 -cursor [. cget -cursor] \
647 -spacing1 1 -spacing3 1
648 lappend bglist $cflist
649 lappend fglist $cflist
650 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
651 pack .ctop.cdet.right.sb -side right -fill y
652 pack $cflist -side left -fill both -expand 1
653 $cflist tag configure highlight \
654 -background [$cflist cget -selectbackground]
655 $cflist tag configure bold -font [concat $mainfont bold]
656 .ctop.cdet add .ctop.cdet.right
657 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
658
659 pack .ctop -side top -fill both -expand 1
660
661 bindall <1> {selcanvline %W %x %y}
662 #bindall <B1-Motion> {selcanvline %W %x %y}
663 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
664 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
665 bindall <2> "canvscan mark %W %x %y"
666 bindall <B2-Motion> "canvscan dragto %W %x %y"
667 bindkey <Home> selfirstline
668 bindkey <End> sellastline
669 bind . <Key-Up> "selnextline -1"
670 bind . <Key-Down> "selnextline 1"
671 bind . <Shift-Key-Up> "next_highlight -1"
672 bind . <Shift-Key-Down> "next_highlight 1"
673 bindkey <Key-Right> "goforw"
674 bindkey <Key-Left> "goback"
675 bind . <Key-Prior> "selnextpage -1"
676 bind . <Key-Next> "selnextpage 1"
677 bind . <Control-Home> "allcanvs yview moveto 0.0"
678 bind . <Control-End> "allcanvs yview moveto 1.0"
679 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
680 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
681 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
682 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
683 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
684 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
685 bindkey <Key-space> "$ctext yview scroll 1 pages"
686 bindkey p "selnextline -1"
687 bindkey n "selnextline 1"
688 bindkey z "goback"
689 bindkey x "goforw"
690 bindkey i "selnextline -1"
691 bindkey k "selnextline 1"
692 bindkey j "goback"
693 bindkey l "goforw"
694 bindkey b "$ctext yview scroll -1 pages"
695 bindkey d "$ctext yview scroll 18 units"
696 bindkey u "$ctext yview scroll -18 units"
697 bindkey / {findnext 1}
698 bindkey <Key-Return> {findnext 0}
699 bindkey ? findprev
700 bindkey f nextfile
701 bind . <Control-q> doquit
702 bind . <Control-f> dofind
703 bind . <Control-g> {findnext 0}
704 bind . <Control-r> dosearchback
705 bind . <Control-s> dosearch
706 bind . <Control-equal> {incrfont 1}
707 bind . <Control-KP_Add> {incrfont 1}
708 bind . <Control-minus> {incrfont -1}
709 bind . <Control-KP_Subtract> {incrfont -1}
710 bind . <Destroy> {savestuff %W}
711 bind . <Button-1> "click %W"
712 bind $fstring <Key-Return> dofind
713 bind $sha1entry <Key-Return> gotocommit
714 bind $sha1entry <<PasteSelection>> clearsha1
715 bind $cflist <1> {sel_flist %W %x %y; break}
716 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
717 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
718
719 set maincursor [. cget -cursor]
720 set textcursor [$ctext cget -cursor]
721 set curtextcursor $textcursor
722
723 set rowctxmenu .rowctxmenu
724 menu $rowctxmenu -tearoff 0
725 $rowctxmenu add command -label "Diff this -> selected" \
726 -command {diffvssel 0}
727 $rowctxmenu add command -label "Diff selected -> this" \
728 -command {diffvssel 1}
729 $rowctxmenu add command -label "Make patch" -command mkpatch
730 $rowctxmenu add command -label "Create tag" -command mktag
731 $rowctxmenu add command -label "Write commit to file" -command writecommit
732 $rowctxmenu add command -label "Create new branch" -command mkbranch
733 $rowctxmenu add command -label "Cherry-pick this commit" \
734 -command cherrypick
735
736 set headctxmenu .headctxmenu
737 menu $headctxmenu -tearoff 0
738 $headctxmenu add command -label "Check out this branch" \
739 -command cobranch
740 $headctxmenu add command -label "Remove this branch" \
741 -command rmbranch
742}
743
744# mouse-2 makes all windows scan vertically, but only the one
745# the cursor is in scans horizontally
746proc canvscan {op w x y} {
747 global canv canv2 canv3
748 foreach c [list $canv $canv2 $canv3] {
749 if {$c == $w} {
750 $c scan $op $x $y
751 } else {
752 $c scan $op 0 $y
753 }
754 }
755}
756
757proc scrollcanv {cscroll f0 f1} {
758 $cscroll set $f0 $f1
759 drawfrac $f0 $f1
760 flushhighlights
761}
762
763# when we make a key binding for the toplevel, make sure
764# it doesn't get triggered when that key is pressed in the
765# find string entry widget.
766proc bindkey {ev script} {
767 global entries
768 bind . $ev $script
769 set escript [bind Entry $ev]
770 if {$escript == {}} {
771 set escript [bind Entry <Key>]
772 }
773 foreach e $entries {
774 bind $e $ev "$escript; break"
775 }
776}
777
778# set the focus back to the toplevel for any click outside
779# the entry widgets
780proc click {w} {
781 global entries
782 foreach e $entries {
783 if {$w == $e} return
784 }
785 focus .
786}
787
788proc savestuff {w} {
789 global canv canv2 canv3 ctext cflist mainfont textfont uifont
790 global stuffsaved findmergefiles maxgraphpct
791 global maxwidth showneartags
792 global viewname viewfiles viewargs viewperm nextviewnum
793 global cmitmode wrapcomment
794 global colors bgcolor fgcolor diffcolors
795
796 if {$stuffsaved} return
797 if {![winfo viewable .]} return
798 catch {
799 set f [open "~/.gitk-new" w]
800 puts $f [list set mainfont $mainfont]
801 puts $f [list set textfont $textfont]
802 puts $f [list set uifont $uifont]
803 puts $f [list set findmergefiles $findmergefiles]
804 puts $f [list set maxgraphpct $maxgraphpct]
805 puts $f [list set maxwidth $maxwidth]
806 puts $f [list set cmitmode $cmitmode]
807 puts $f [list set wrapcomment $wrapcomment]
808 puts $f [list set showneartags $showneartags]
809 puts $f [list set bgcolor $bgcolor]
810 puts $f [list set fgcolor $fgcolor]
811 puts $f [list set colors $colors]
812 puts $f [list set diffcolors $diffcolors]
813 puts $f "set geometry(width) [winfo width .ctop]"
814 puts $f "set geometry(height) [winfo height .ctop]"
815 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
816 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
817 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
818 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
819 set wid [expr {([winfo width $ctext] - 8) \
820 / [font measure $textfont "0"]}]
821 puts $f "set geometry(ctextw) $wid"
822 set wid [expr {([winfo width $cflist] - 11) \
823 / [font measure [$cflist cget -font] "0"]}]
824 puts $f "set geometry(cflistw) $wid"
825 puts -nonewline $f "set permviews {"
826 for {set v 0} {$v < $nextviewnum} {incr v} {
827 if {$viewperm($v)} {
828 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
829 }
830 }
831 puts $f "}"
832 close $f
833 file rename -force "~/.gitk-new" "~/.gitk"
834 }
835 set stuffsaved 1
836}
837
838proc resizeclistpanes {win w} {
839 global oldwidth
840 if {[info exists oldwidth($win)]} {
841 set s0 [$win sash coord 0]
842 set s1 [$win sash coord 1]
843 if {$w < 60} {
844 set sash0 [expr {int($w/2 - 2)}]
845 set sash1 [expr {int($w*5/6 - 2)}]
846 } else {
847 set factor [expr {1.0 * $w / $oldwidth($win)}]
848 set sash0 [expr {int($factor * [lindex $s0 0])}]
849 set sash1 [expr {int($factor * [lindex $s1 0])}]
850 if {$sash0 < 30} {
851 set sash0 30
852 }
853 if {$sash1 < $sash0 + 20} {
854 set sash1 [expr {$sash0 + 20}]
855 }
856 if {$sash1 > $w - 10} {
857 set sash1 [expr {$w - 10}]
858 if {$sash0 > $sash1 - 20} {
859 set sash0 [expr {$sash1 - 20}]
860 }
861 }
862 }
863 $win sash place 0 $sash0 [lindex $s0 1]
864 $win sash place 1 $sash1 [lindex $s1 1]
865 }
866 set oldwidth($win) $w
867}
868
869proc resizecdetpanes {win w} {
870 global oldwidth
871 if {[info exists oldwidth($win)]} {
872 set s0 [$win sash coord 0]
873 if {$w < 60} {
874 set sash0 [expr {int($w*3/4 - 2)}]
875 } else {
876 set factor [expr {1.0 * $w / $oldwidth($win)}]
877 set sash0 [expr {int($factor * [lindex $s0 0])}]
878 if {$sash0 < 45} {
879 set sash0 45
880 }
881 if {$sash0 > $w - 15} {
882 set sash0 [expr {$w - 15}]
883 }
884 }
885 $win sash place 0 $sash0 [lindex $s0 1]
886 }
887 set oldwidth($win) $w
888}
889
890proc allcanvs args {
891 global canv canv2 canv3
892 eval $canv $args
893 eval $canv2 $args
894 eval $canv3 $args
895}
896
897proc bindall {event action} {
898 global canv canv2 canv3
899 bind $canv $event $action
900 bind $canv2 $event $action
901 bind $canv3 $event $action
902}
903
904proc about {} {
905 set w .about
906 if {[winfo exists $w]} {
907 raise $w
908 return
909 }
910 toplevel $w
911 wm title $w "About gitk"
912 message $w.m -text {
913Gitk - a commit viewer for git
914
915Copyright © 2005-2006 Paul Mackerras
916
917Use and redistribute under the terms of the GNU General Public License} \
918 -justify center -aspect 400
919 pack $w.m -side top -fill x -padx 20 -pady 20
920 button $w.ok -text Close -command "destroy $w"
921 pack $w.ok -side bottom
922}
923
924proc keys {} {
925 set w .keys
926 if {[winfo exists $w]} {
927 raise $w
928 return
929 }
930 toplevel $w
931 wm title $w "Gitk key bindings"
932 message $w.m -text {
933Gitk key bindings:
934
935<Ctrl-Q> Quit
936<Home> Move to first commit
937<End> Move to last commit
938<Up>, p, i Move up one commit
939<Down>, n, k Move down one commit
940<Left>, z, j Go back in history list
941<Right>, x, l Go forward in history list
942<PageUp> Move up one page in commit list
943<PageDown> Move down one page in commit list
944<Ctrl-Home> Scroll to top of commit list
945<Ctrl-End> Scroll to bottom of commit list
946<Ctrl-Up> Scroll commit list up one line
947<Ctrl-Down> Scroll commit list down one line
948<Ctrl-PageUp> Scroll commit list up one page
949<Ctrl-PageDown> Scroll commit list down one page
950<Shift-Up> Move to previous highlighted line
951<Shift-Down> Move to next highlighted line
952<Delete>, b Scroll diff view up one page
953<Backspace> Scroll diff view up one page
954<Space> Scroll diff view down one page
955u Scroll diff view up 18 lines
956d Scroll diff view down 18 lines
957<Ctrl-F> Find
958<Ctrl-G> Move to next find hit
959<Return> Move to next find hit
960/ Move to next find hit, or redo find
961? Move to previous find hit
962f Scroll diff view to next file
963<Ctrl-S> Search for next hit in diff view
964<Ctrl-R> Search for previous hit in diff view
965<Ctrl-KP+> Increase font size
966<Ctrl-plus> Increase font size
967<Ctrl-KP-> Decrease font size
968<Ctrl-minus> Decrease font size
969} \
970 -justify left -bg white -border 2 -relief sunken
971 pack $w.m -side top -fill both
972 button $w.ok -text Close -command "destroy $w"
973 pack $w.ok -side bottom
974}
975
976# Procedures for manipulating the file list window at the
977# bottom right of the overall window.
978
979proc treeview {w l openlevs} {
980 global treecontents treediropen treeheight treeparent treeindex
981
982 set ix 0
983 set treeindex() 0
984 set lev 0
985 set prefix {}
986 set prefixend -1
987 set prefendstack {}
988 set htstack {}
989 set ht 0
990 set treecontents() {}
991 $w conf -state normal
992 foreach f $l {
993 while {[string range $f 0 $prefixend] ne $prefix} {
994 if {$lev <= $openlevs} {
995 $w mark set e:$treeindex($prefix) "end -1c"
996 $w mark gravity e:$treeindex($prefix) left
997 }
998 set treeheight($prefix) $ht
999 incr ht [lindex $htstack end]
1000 set htstack [lreplace $htstack end end]
1001 set prefixend [lindex $prefendstack end]
1002 set prefendstack [lreplace $prefendstack end end]
1003 set prefix [string range $prefix 0 $prefixend]
1004 incr lev -1
1005 }
1006 set tail [string range $f [expr {$prefixend+1}] end]
1007 while {[set slash [string first "/" $tail]] >= 0} {
1008 lappend htstack $ht
1009 set ht 0
1010 lappend prefendstack $prefixend
1011 incr prefixend [expr {$slash + 1}]
1012 set d [string range $tail 0 $slash]
1013 lappend treecontents($prefix) $d
1014 set oldprefix $prefix
1015 append prefix $d
1016 set treecontents($prefix) {}
1017 set treeindex($prefix) [incr ix]
1018 set treeparent($prefix) $oldprefix
1019 set tail [string range $tail [expr {$slash+1}] end]
1020 if {$lev <= $openlevs} {
1021 set ht 1
1022 set treediropen($prefix) [expr {$lev < $openlevs}]
1023 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1024 $w mark set d:$ix "end -1c"
1025 $w mark gravity d:$ix left
1026 set str "\n"
1027 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1028 $w insert end $str
1029 $w image create end -align center -image $bm -padx 1 \
1030 -name a:$ix
1031 $w insert end $d [highlight_tag $prefix]
1032 $w mark set s:$ix "end -1c"
1033 $w mark gravity s:$ix left
1034 }
1035 incr lev
1036 }
1037 if {$tail ne {}} {
1038 if {$lev <= $openlevs} {
1039 incr ht
1040 set str "\n"
1041 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1042 $w insert end $str
1043 $w insert end $tail [highlight_tag $f]
1044 }
1045 lappend treecontents($prefix) $tail
1046 }
1047 }
1048 while {$htstack ne {}} {
1049 set treeheight($prefix) $ht
1050 incr ht [lindex $htstack end]
1051 set htstack [lreplace $htstack end end]
1052 }
1053 $w conf -state disabled
1054}
1055
1056proc linetoelt {l} {
1057 global treeheight treecontents
1058
1059 set y 2
1060 set prefix {}
1061 while {1} {
1062 foreach e $treecontents($prefix) {
1063 if {$y == $l} {
1064 return "$prefix$e"
1065 }
1066 set n 1
1067 if {[string index $e end] eq "/"} {
1068 set n $treeheight($prefix$e)
1069 if {$y + $n > $l} {
1070 append prefix $e
1071 incr y
1072 break
1073 }
1074 }
1075 incr y $n
1076 }
1077 }
1078}
1079
1080proc highlight_tree {y prefix} {
1081 global treeheight treecontents cflist
1082
1083 foreach e $treecontents($prefix) {
1084 set path $prefix$e
1085 if {[highlight_tag $path] ne {}} {
1086 $cflist tag add bold $y.0 "$y.0 lineend"
1087 }
1088 incr y
1089 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1090 set y [highlight_tree $y $path]
1091 }
1092 }
1093 return $y
1094}
1095
1096proc treeclosedir {w dir} {
1097 global treediropen treeheight treeparent treeindex
1098
1099 set ix $treeindex($dir)
1100 $w conf -state normal
1101 $w delete s:$ix e:$ix
1102 set treediropen($dir) 0
1103 $w image configure a:$ix -image tri-rt
1104 $w conf -state disabled
1105 set n [expr {1 - $treeheight($dir)}]
1106 while {$dir ne {}} {
1107 incr treeheight($dir) $n
1108 set dir $treeparent($dir)
1109 }
1110}
1111
1112proc treeopendir {w dir} {
1113 global treediropen treeheight treeparent treecontents treeindex
1114
1115 set ix $treeindex($dir)
1116 $w conf -state normal
1117 $w image configure a:$ix -image tri-dn
1118 $w mark set e:$ix s:$ix
1119 $w mark gravity e:$ix right
1120 set lev 0
1121 set str "\n"
1122 set n [llength $treecontents($dir)]
1123 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1124 incr lev
1125 append str "\t"
1126 incr treeheight($x) $n
1127 }
1128 foreach e $treecontents($dir) {
1129 set de $dir$e
1130 if {[string index $e end] eq "/"} {
1131 set iy $treeindex($de)
1132 $w mark set d:$iy e:$ix
1133 $w mark gravity d:$iy left
1134 $w insert e:$ix $str
1135 set treediropen($de) 0
1136 $w image create e:$ix -align center -image tri-rt -padx 1 \
1137 -name a:$iy
1138 $w insert e:$ix $e [highlight_tag $de]
1139 $w mark set s:$iy e:$ix
1140 $w mark gravity s:$iy left
1141 set treeheight($de) 1
1142 } else {
1143 $w insert e:$ix $str
1144 $w insert e:$ix $e [highlight_tag $de]
1145 }
1146 }
1147 $w mark gravity e:$ix left
1148 $w conf -state disabled
1149 set treediropen($dir) 1
1150 set top [lindex [split [$w index @0,0] .] 0]
1151 set ht [$w cget -height]
1152 set l [lindex [split [$w index s:$ix] .] 0]
1153 if {$l < $top} {
1154 $w yview $l.0
1155 } elseif {$l + $n + 1 > $top + $ht} {
1156 set top [expr {$l + $n + 2 - $ht}]
1157 if {$l < $top} {
1158 set top $l
1159 }
1160 $w yview $top.0
1161 }
1162}
1163
1164proc treeclick {w x y} {
1165 global treediropen cmitmode ctext cflist cflist_top
1166
1167 if {$cmitmode ne "tree"} return
1168 if {![info exists cflist_top]} return
1169 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1170 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1171 $cflist tag add highlight $l.0 "$l.0 lineend"
1172 set cflist_top $l
1173 if {$l == 1} {
1174 $ctext yview 1.0
1175 return
1176 }
1177 set e [linetoelt $l]
1178 if {[string index $e end] ne "/"} {
1179 showfile $e
1180 } elseif {$treediropen($e)} {
1181 treeclosedir $w $e
1182 } else {
1183 treeopendir $w $e
1184 }
1185}
1186
1187proc setfilelist {id} {
1188 global treefilelist cflist
1189
1190 treeview $cflist $treefilelist($id) 0
1191}
1192
1193image create bitmap tri-rt -background black -foreground blue -data {
1194 #define tri-rt_width 13
1195 #define tri-rt_height 13
1196 static unsigned char tri-rt_bits[] = {
1197 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1198 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1199 0x00, 0x00};
1200} -maskdata {
1201 #define tri-rt-mask_width 13
1202 #define tri-rt-mask_height 13
1203 static unsigned char tri-rt-mask_bits[] = {
1204 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1205 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1206 0x08, 0x00};
1207}
1208image create bitmap tri-dn -background black -foreground blue -data {
1209 #define tri-dn_width 13
1210 #define tri-dn_height 13
1211 static unsigned char tri-dn_bits[] = {
1212 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1213 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1214 0x00, 0x00};
1215} -maskdata {
1216 #define tri-dn-mask_width 13
1217 #define tri-dn-mask_height 13
1218 static unsigned char tri-dn-mask_bits[] = {
1219 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1220 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1221 0x00, 0x00};
1222}
1223
1224proc init_flist {first} {
1225 global cflist cflist_top selectedline difffilestart
1226
1227 $cflist conf -state normal
1228 $cflist delete 0.0 end
1229 if {$first ne {}} {
1230 $cflist insert end $first
1231 set cflist_top 1
1232 $cflist tag add highlight 1.0 "1.0 lineend"
1233 } else {
1234 catch {unset cflist_top}
1235 }
1236 $cflist conf -state disabled
1237 set difffilestart {}
1238}
1239
1240proc highlight_tag {f} {
1241 global highlight_paths
1242
1243 foreach p $highlight_paths {
1244 if {[string match $p $f]} {
1245 return "bold"
1246 }
1247 }
1248 return {}
1249}
1250
1251proc highlight_filelist {} {
1252 global cmitmode cflist
1253
1254 $cflist conf -state normal
1255 if {$cmitmode ne "tree"} {
1256 set end [lindex [split [$cflist index end] .] 0]
1257 for {set l 2} {$l < $end} {incr l} {
1258 set line [$cflist get $l.0 "$l.0 lineend"]
1259 if {[highlight_tag $line] ne {}} {
1260 $cflist tag add bold $l.0 "$l.0 lineend"
1261 }
1262 }
1263 } else {
1264 highlight_tree 2 {}
1265 }
1266 $cflist conf -state disabled
1267}
1268
1269proc unhighlight_filelist {} {
1270 global cflist
1271
1272 $cflist conf -state normal
1273 $cflist tag remove bold 1.0 end
1274 $cflist conf -state disabled
1275}
1276
1277proc add_flist {fl} {
1278 global cflist
1279
1280 $cflist conf -state normal
1281 foreach f $fl {
1282 $cflist insert end "\n"
1283 $cflist insert end $f [highlight_tag $f]
1284 }
1285 $cflist conf -state disabled
1286}
1287
1288proc sel_flist {w x y} {
1289 global ctext difffilestart cflist cflist_top cmitmode
1290
1291 if {$cmitmode eq "tree"} return
1292 if {![info exists cflist_top]} return
1293 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1294 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1295 $cflist tag add highlight $l.0 "$l.0 lineend"
1296 set cflist_top $l
1297 if {$l == 1} {
1298 $ctext yview 1.0
1299 } else {
1300 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1301 }
1302}
1303
1304# Functions for adding and removing shell-type quoting
1305
1306proc shellquote {str} {
1307 if {![string match "*\['\"\\ \t]*" $str]} {
1308 return $str
1309 }
1310 if {![string match "*\['\"\\]*" $str]} {
1311 return "\"$str\""
1312 }
1313 if {![string match "*'*" $str]} {
1314 return "'$str'"
1315 }
1316 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1317}
1318
1319proc shellarglist {l} {
1320 set str {}
1321 foreach a $l {
1322 if {$str ne {}} {
1323 append str " "
1324 }
1325 append str [shellquote $a]
1326 }
1327 return $str
1328}
1329
1330proc shelldequote {str} {
1331 set ret {}
1332 set used -1
1333 while {1} {
1334 incr used
1335 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1336 append ret [string range $str $used end]
1337 set used [string length $str]
1338 break
1339 }
1340 set first [lindex $first 0]
1341 set ch [string index $str $first]
1342 if {$first > $used} {
1343 append ret [string range $str $used [expr {$first - 1}]]
1344 set used $first
1345 }
1346 if {$ch eq " " || $ch eq "\t"} break
1347 incr used
1348 if {$ch eq "'"} {
1349 set first [string first "'" $str $used]
1350 if {$first < 0} {
1351 error "unmatched single-quote"
1352 }
1353 append ret [string range $str $used [expr {$first - 1}]]
1354 set used $first
1355 continue
1356 }
1357 if {$ch eq "\\"} {
1358 if {$used >= [string length $str]} {
1359 error "trailing backslash"
1360 }
1361 append ret [string index $str $used]
1362 continue
1363 }
1364 # here ch == "\""
1365 while {1} {
1366 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1367 error "unmatched double-quote"
1368 }
1369 set first [lindex $first 0]
1370 set ch [string index $str $first]
1371 if {$first > $used} {
1372 append ret [string range $str $used [expr {$first - 1}]]
1373 set used $first
1374 }
1375 if {$ch eq "\""} break
1376 incr used
1377 append ret [string index $str $used]
1378 incr used
1379 }
1380 }
1381 return [list $used $ret]
1382}
1383
1384proc shellsplit {str} {
1385 set l {}
1386 while {1} {
1387 set str [string trimleft $str]
1388 if {$str eq {}} break
1389 set dq [shelldequote $str]
1390 set n [lindex $dq 0]
1391 set word [lindex $dq 1]
1392 set str [string range $str $n end]
1393 lappend l $word
1394 }
1395 return $l
1396}
1397
1398# Code to implement multiple views
1399
1400proc newview {ishighlight} {
1401 global nextviewnum newviewname newviewperm uifont newishighlight
1402 global newviewargs revtreeargs
1403
1404 set newishighlight $ishighlight
1405 set top .gitkview
1406 if {[winfo exists $top]} {
1407 raise $top
1408 return
1409 }
1410 set newviewname($nextviewnum) "View $nextviewnum"
1411 set newviewperm($nextviewnum) 0
1412 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1413 vieweditor $top $nextviewnum "Gitk view definition"
1414}
1415
1416proc editview {} {
1417 global curview
1418 global viewname viewperm newviewname newviewperm
1419 global viewargs newviewargs
1420
1421 set top .gitkvedit-$curview
1422 if {[winfo exists $top]} {
1423 raise $top
1424 return
1425 }
1426 set newviewname($curview) $viewname($curview)
1427 set newviewperm($curview) $viewperm($curview)
1428 set newviewargs($curview) [shellarglist $viewargs($curview)]
1429 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1430}
1431
1432proc vieweditor {top n title} {
1433 global newviewname newviewperm viewfiles
1434 global uifont
1435
1436 toplevel $top
1437 wm title $top $title
1438 label $top.nl -text "Name" -font $uifont
1439 entry $top.name -width 20 -textvariable newviewname($n)
1440 grid $top.nl $top.name -sticky w -pady 5
1441 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1442 grid $top.perm - -pady 5 -sticky w
1443 message $top.al -aspect 1000 -font $uifont \
1444 -text "Commits to include (arguments to git rev-list):"
1445 grid $top.al - -sticky w -pady 5
1446 entry $top.args -width 50 -textvariable newviewargs($n) \
1447 -background white
1448 grid $top.args - -sticky ew -padx 5
1449 message $top.l -aspect 1000 -font $uifont \
1450 -text "Enter files and directories to include, one per line:"
1451 grid $top.l - -sticky w
1452 text $top.t -width 40 -height 10 -background white
1453 if {[info exists viewfiles($n)]} {
1454 foreach f $viewfiles($n) {
1455 $top.t insert end $f
1456 $top.t insert end "\n"
1457 }
1458 $top.t delete {end - 1c} end
1459 $top.t mark set insert 0.0
1460 }
1461 grid $top.t - -sticky ew -padx 5
1462 frame $top.buts
1463 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1464 button $top.buts.can -text "Cancel" -command [list destroy $top]
1465 grid $top.buts.ok $top.buts.can
1466 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1467 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1468 grid $top.buts - -pady 10 -sticky ew
1469 focus $top.t
1470}
1471
1472proc doviewmenu {m first cmd op argv} {
1473 set nmenu [$m index end]
1474 for {set i $first} {$i <= $nmenu} {incr i} {
1475 if {[$m entrycget $i -command] eq $cmd} {
1476 eval $m $op $i $argv
1477 break
1478 }
1479 }
1480}
1481
1482proc allviewmenus {n op args} {
1483 global viewhlmenu
1484
1485 doviewmenu .bar.view 7 [list showview $n] $op $args
1486 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1487}
1488
1489proc newviewok {top n} {
1490 global nextviewnum newviewperm newviewname newishighlight
1491 global viewname viewfiles viewperm selectedview curview
1492 global viewargs newviewargs viewhlmenu
1493
1494 if {[catch {
1495 set newargs [shellsplit $newviewargs($n)]
1496 } err]} {
1497 error_popup "Error in commit selection arguments: $err"
1498 wm raise $top
1499 focus $top
1500 return
1501 }
1502 set files {}
1503 foreach f [split [$top.t get 0.0 end] "\n"] {
1504 set ft [string trim $f]
1505 if {$ft ne {}} {
1506 lappend files $ft
1507 }
1508 }
1509 if {![info exists viewfiles($n)]} {
1510 # creating a new view
1511 incr nextviewnum
1512 set viewname($n) $newviewname($n)
1513 set viewperm($n) $newviewperm($n)
1514 set viewfiles($n) $files
1515 set viewargs($n) $newargs
1516 addviewmenu $n
1517 if {!$newishighlight} {
1518 after idle showview $n
1519 } else {
1520 after idle addvhighlight $n
1521 }
1522 } else {
1523 # editing an existing view
1524 set viewperm($n) $newviewperm($n)
1525 if {$newviewname($n) ne $viewname($n)} {
1526 set viewname($n) $newviewname($n)
1527 doviewmenu .bar.view 7 [list showview $n] \
1528 entryconf [list -label $viewname($n)]
1529 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1530 entryconf [list -label $viewname($n) -value $viewname($n)]
1531 }
1532 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1533 set viewfiles($n) $files
1534 set viewargs($n) $newargs
1535 if {$curview == $n} {
1536 after idle updatecommits
1537 }
1538 }
1539 }
1540 catch {destroy $top}
1541}
1542
1543proc delview {} {
1544 global curview viewdata viewperm hlview selectedhlview
1545
1546 if {$curview == 0} return
1547 if {[info exists hlview] && $hlview == $curview} {
1548 set selectedhlview None
1549 unset hlview
1550 }
1551 allviewmenus $curview delete
1552 set viewdata($curview) {}
1553 set viewperm($curview) 0
1554 showview 0
1555}
1556
1557proc addviewmenu {n} {
1558 global viewname viewhlmenu
1559
1560 .bar.view add radiobutton -label $viewname($n) \
1561 -command [list showview $n] -variable selectedview -value $n
1562 $viewhlmenu add radiobutton -label $viewname($n) \
1563 -command [list addvhighlight $n] -variable selectedhlview
1564}
1565
1566proc flatten {var} {
1567 global $var
1568
1569 set ret {}
1570 foreach i [array names $var] {
1571 lappend ret $i [set $var\($i\)]
1572 }
1573 return $ret
1574}
1575
1576proc unflatten {var l} {
1577 global $var
1578
1579 catch {unset $var}
1580 foreach {i v} $l {
1581 set $var\($i\) $v
1582 }
1583}
1584
1585proc showview {n} {
1586 global curview viewdata viewfiles
1587 global displayorder parentlist childlist rowidlist rowoffsets
1588 global colormap rowtextx commitrow nextcolor canvxmax
1589 global numcommits rowrangelist commitlisted idrowranges
1590 global selectedline currentid canv canvy0
1591 global matchinglines treediffs
1592 global pending_select phase
1593 global commitidx rowlaidout rowoptim linesegends
1594 global commfd nextupdate
1595 global selectedview
1596 global vparentlist vchildlist vdisporder vcmitlisted
1597 global hlview selectedhlview
1598
1599 if {$n == $curview} return
1600 set selid {}
1601 if {[info exists selectedline]} {
1602 set selid $currentid
1603 set y [yc $selectedline]
1604 set ymax [lindex [$canv cget -scrollregion] 3]
1605 set span [$canv yview]
1606 set ytop [expr {[lindex $span 0] * $ymax}]
1607 set ybot [expr {[lindex $span 1] * $ymax}]
1608 if {$ytop < $y && $y < $ybot} {
1609 set yscreen [expr {$y - $ytop}]
1610 } else {
1611 set yscreen [expr {($ybot - $ytop) / 2}]
1612 }
1613 }
1614 unselectline
1615 normalline
1616 stopfindproc
1617 if {$curview >= 0} {
1618 set vparentlist($curview) $parentlist
1619 set vchildlist($curview) $childlist
1620 set vdisporder($curview) $displayorder
1621 set vcmitlisted($curview) $commitlisted
1622 if {$phase ne {}} {
1623 set viewdata($curview) \
1624 [list $phase $rowidlist $rowoffsets $rowrangelist \
1625 [flatten idrowranges] [flatten idinlist] \
1626 $rowlaidout $rowoptim $numcommits $linesegends]
1627 } elseif {![info exists viewdata($curview)]
1628 || [lindex $viewdata($curview) 0] ne {}} {
1629 set viewdata($curview) \
1630 [list {} $rowidlist $rowoffsets $rowrangelist]
1631 }
1632 }
1633 catch {unset matchinglines}
1634 catch {unset treediffs}
1635 clear_display
1636 if {[info exists hlview] && $hlview == $n} {
1637 unset hlview
1638 set selectedhlview None
1639 }
1640
1641 set curview $n
1642 set selectedview $n
1643 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1644 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1645
1646 if {![info exists viewdata($n)]} {
1647 set pending_select $selid
1648 getcommits
1649 return
1650 }
1651
1652 set v $viewdata($n)
1653 set phase [lindex $v 0]
1654 set displayorder $vdisporder($n)
1655 set parentlist $vparentlist($n)
1656 set childlist $vchildlist($n)
1657 set commitlisted $vcmitlisted($n)
1658 set rowidlist [lindex $v 1]
1659 set rowoffsets [lindex $v 2]
1660 set rowrangelist [lindex $v 3]
1661 if {$phase eq {}} {
1662 set numcommits [llength $displayorder]
1663 catch {unset idrowranges}
1664 } else {
1665 unflatten idrowranges [lindex $v 4]
1666 unflatten idinlist [lindex $v 5]
1667 set rowlaidout [lindex $v 6]
1668 set rowoptim [lindex $v 7]
1669 set numcommits [lindex $v 8]
1670 set linesegends [lindex $v 9]
1671 }
1672
1673 catch {unset colormap}
1674 catch {unset rowtextx}
1675 set nextcolor 0
1676 set canvxmax [$canv cget -width]
1677 set curview $n
1678 set row 0
1679 setcanvscroll
1680 set yf 0
1681 set row 0
1682 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1683 set row $commitrow($n,$selid)
1684 # try to get the selected row in the same position on the screen
1685 set ymax [lindex [$canv cget -scrollregion] 3]
1686 set ytop [expr {[yc $row] - $yscreen}]
1687 if {$ytop < 0} {
1688 set ytop 0
1689 }
1690 set yf [expr {$ytop * 1.0 / $ymax}]
1691 }
1692 allcanvs yview moveto $yf
1693 drawvisible
1694 selectline $row 0
1695 if {$phase ne {}} {
1696 if {$phase eq "getcommits"} {
1697 show_status "Reading commits..."
1698 }
1699 if {[info exists commfd($n)]} {
1700 layoutmore
1701 } else {
1702 finishcommits
1703 }
1704 } elseif {$numcommits == 0} {
1705 show_status "No commits selected"
1706 }
1707}
1708
1709# Stuff relating to the highlighting facility
1710
1711proc ishighlighted {row} {
1712 global vhighlights fhighlights nhighlights rhighlights
1713
1714 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1715 return $nhighlights($row)
1716 }
1717 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1718 return $vhighlights($row)
1719 }
1720 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1721 return $fhighlights($row)
1722 }
1723 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1724 return $rhighlights($row)
1725 }
1726 return 0
1727}
1728
1729proc bolden {row font} {
1730 global canv linehtag selectedline boldrows
1731
1732 lappend boldrows $row
1733 $canv itemconf $linehtag($row) -font $font
1734 if {[info exists selectedline] && $row == $selectedline} {
1735 $canv delete secsel
1736 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1737 -outline {{}} -tags secsel \
1738 -fill [$canv cget -selectbackground]]
1739 $canv lower $t
1740 }
1741}
1742
1743proc bolden_name {row font} {
1744 global canv2 linentag selectedline boldnamerows
1745
1746 lappend boldnamerows $row
1747 $canv2 itemconf $linentag($row) -font $font
1748 if {[info exists selectedline] && $row == $selectedline} {
1749 $canv2 delete secsel
1750 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1751 -outline {{}} -tags secsel \
1752 -fill [$canv2 cget -selectbackground]]
1753 $canv2 lower $t
1754 }
1755}
1756
1757proc unbolden {} {
1758 global mainfont boldrows
1759
1760 set stillbold {}
1761 foreach row $boldrows {
1762 if {![ishighlighted $row]} {
1763 bolden $row $mainfont
1764 } else {
1765 lappend stillbold $row
1766 }
1767 }
1768 set boldrows $stillbold
1769}
1770
1771proc addvhighlight {n} {
1772 global hlview curview viewdata vhl_done vhighlights commitidx
1773
1774 if {[info exists hlview]} {
1775 delvhighlight
1776 }
1777 set hlview $n
1778 if {$n != $curview && ![info exists viewdata($n)]} {
1779 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1780 set vparentlist($n) {}
1781 set vchildlist($n) {}
1782 set vdisporder($n) {}
1783 set vcmitlisted($n) {}
1784 start_rev_list $n
1785 }
1786 set vhl_done $commitidx($hlview)
1787 if {$vhl_done > 0} {
1788 drawvisible
1789 }
1790}
1791
1792proc delvhighlight {} {
1793 global hlview vhighlights
1794
1795 if {![info exists hlview]} return
1796 unset hlview
1797 catch {unset vhighlights}
1798 unbolden
1799}
1800
1801proc vhighlightmore {} {
1802 global hlview vhl_done commitidx vhighlights
1803 global displayorder vdisporder curview mainfont
1804
1805 set font [concat $mainfont bold]
1806 set max $commitidx($hlview)
1807 if {$hlview == $curview} {
1808 set disp $displayorder
1809 } else {
1810 set disp $vdisporder($hlview)
1811 }
1812 set vr [visiblerows]
1813 set r0 [lindex $vr 0]
1814 set r1 [lindex $vr 1]
1815 for {set i $vhl_done} {$i < $max} {incr i} {
1816 set id [lindex $disp $i]
1817 if {[info exists commitrow($curview,$id)]} {
1818 set row $commitrow($curview,$id)
1819 if {$r0 <= $row && $row <= $r1} {
1820 if {![highlighted $row]} {
1821 bolden $row $font
1822 }
1823 set vhighlights($row) 1
1824 }
1825 }
1826 }
1827 set vhl_done $max
1828}
1829
1830proc askvhighlight {row id} {
1831 global hlview vhighlights commitrow iddrawn mainfont
1832
1833 if {[info exists commitrow($hlview,$id)]} {
1834 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1835 bolden $row [concat $mainfont bold]
1836 }
1837 set vhighlights($row) 1
1838 } else {
1839 set vhighlights($row) 0
1840 }
1841}
1842
1843proc hfiles_change {name ix op} {
1844 global highlight_files filehighlight fhighlights fh_serial
1845 global mainfont highlight_paths
1846
1847 if {[info exists filehighlight]} {
1848 # delete previous highlights
1849 catch {close $filehighlight}
1850 unset filehighlight
1851 catch {unset fhighlights}
1852 unbolden
1853 unhighlight_filelist
1854 }
1855 set highlight_paths {}
1856 after cancel do_file_hl $fh_serial
1857 incr fh_serial
1858 if {$highlight_files ne {}} {
1859 after 300 do_file_hl $fh_serial
1860 }
1861}
1862
1863proc makepatterns {l} {
1864 set ret {}
1865 foreach e $l {
1866 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1867 if {[string index $ee end] eq "/"} {
1868 lappend ret "$ee*"
1869 } else {
1870 lappend ret $ee
1871 lappend ret "$ee/*"
1872 }
1873 }
1874 return $ret
1875}
1876
1877proc do_file_hl {serial} {
1878 global highlight_files filehighlight highlight_paths gdttype fhl_list
1879
1880 if {$gdttype eq "touching paths:"} {
1881 if {[catch {set paths [shellsplit $highlight_files]}]} return
1882 set highlight_paths [makepatterns $paths]
1883 highlight_filelist
1884 set gdtargs [concat -- $paths]
1885 } else {
1886 set gdtargs [list "-S$highlight_files"]
1887 }
1888 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1889 set filehighlight [open $cmd r+]
1890 fconfigure $filehighlight -blocking 0
1891 fileevent $filehighlight readable readfhighlight
1892 set fhl_list {}
1893 drawvisible
1894 flushhighlights
1895}
1896
1897proc flushhighlights {} {
1898 global filehighlight fhl_list
1899
1900 if {[info exists filehighlight]} {
1901 lappend fhl_list {}
1902 puts $filehighlight ""
1903 flush $filehighlight
1904 }
1905}
1906
1907proc askfilehighlight {row id} {
1908 global filehighlight fhighlights fhl_list
1909
1910 lappend fhl_list $id
1911 set fhighlights($row) -1
1912 puts $filehighlight $id
1913}
1914
1915proc readfhighlight {} {
1916 global filehighlight fhighlights commitrow curview mainfont iddrawn
1917 global fhl_list
1918
1919 while {[gets $filehighlight line] >= 0} {
1920 set line [string trim $line]
1921 set i [lsearch -exact $fhl_list $line]
1922 if {$i < 0} continue
1923 for {set j 0} {$j < $i} {incr j} {
1924 set id [lindex $fhl_list $j]
1925 if {[info exists commitrow($curview,$id)]} {
1926 set fhighlights($commitrow($curview,$id)) 0
1927 }
1928 }
1929 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1930 if {$line eq {}} continue
1931 if {![info exists commitrow($curview,$line)]} continue
1932 set row $commitrow($curview,$line)
1933 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1934 bolden $row [concat $mainfont bold]
1935 }
1936 set fhighlights($row) 1
1937 }
1938 if {[eof $filehighlight]} {
1939 # strange...
1940 puts "oops, git-diff-tree died"
1941 catch {close $filehighlight}
1942 unset filehighlight
1943 }
1944 next_hlcont
1945}
1946
1947proc find_change {name ix op} {
1948 global nhighlights mainfont boldnamerows
1949 global findstring findpattern findtype
1950
1951 # delete previous highlights, if any
1952 foreach row $boldnamerows {
1953 bolden_name $row $mainfont
1954 }
1955 set boldnamerows {}
1956 catch {unset nhighlights}
1957 unbolden
1958 if {$findtype ne "Regexp"} {
1959 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1960 $findstring]
1961 set findpattern "*$e*"
1962 }
1963 drawvisible
1964}
1965
1966proc askfindhighlight {row id} {
1967 global nhighlights commitinfo iddrawn mainfont
1968 global findstring findtype findloc findpattern
1969
1970 if {![info exists commitinfo($id)]} {
1971 getcommit $id
1972 }
1973 set info $commitinfo($id)
1974 set isbold 0
1975 set fldtypes {Headline Author Date Committer CDate Comments}
1976 foreach f $info ty $fldtypes {
1977 if {$findloc ne "All fields" && $findloc ne $ty} {
1978 continue
1979 }
1980 if {$findtype eq "Regexp"} {
1981 set doesmatch [regexp $findstring $f]
1982 } elseif {$findtype eq "IgnCase"} {
1983 set doesmatch [string match -nocase $findpattern $f]
1984 } else {
1985 set doesmatch [string match $findpattern $f]
1986 }
1987 if {$doesmatch} {
1988 if {$ty eq "Author"} {
1989 set isbold 2
1990 } else {
1991 set isbold 1
1992 }
1993 }
1994 }
1995 if {[info exists iddrawn($id)]} {
1996 if {$isbold && ![ishighlighted $row]} {
1997 bolden $row [concat $mainfont bold]
1998 }
1999 if {$isbold >= 2} {
2000 bolden_name $row [concat $mainfont bold]
2001 }
2002 }
2003 set nhighlights($row) $isbold
2004}
2005
2006proc vrel_change {name ix op} {
2007 global highlight_related
2008
2009 rhighlight_none
2010 if {$highlight_related ne "None"} {
2011 after idle drawvisible
2012 }
2013}
2014
2015# prepare for testing whether commits are descendents or ancestors of a
2016proc rhighlight_sel {a} {
2017 global descendent desc_todo ancestor anc_todo
2018 global highlight_related rhighlights
2019
2020 catch {unset descendent}
2021 set desc_todo [list $a]
2022 catch {unset ancestor}
2023 set anc_todo [list $a]
2024 if {$highlight_related ne "None"} {
2025 rhighlight_none
2026 after idle drawvisible
2027 }
2028}
2029
2030proc rhighlight_none {} {
2031 global rhighlights
2032
2033 catch {unset rhighlights}
2034 unbolden
2035}
2036
2037proc is_descendent {a} {
2038 global curview children commitrow descendent desc_todo
2039
2040 set v $curview
2041 set la $commitrow($v,$a)
2042 set todo $desc_todo
2043 set leftover {}
2044 set done 0
2045 for {set i 0} {$i < [llength $todo]} {incr i} {
2046 set do [lindex $todo $i]
2047 if {$commitrow($v,$do) < $la} {
2048 lappend leftover $do
2049 continue
2050 }
2051 foreach nk $children($v,$do) {
2052 if {![info exists descendent($nk)]} {
2053 set descendent($nk) 1
2054 lappend todo $nk
2055 if {$nk eq $a} {
2056 set done 1
2057 }
2058 }
2059 }
2060 if {$done} {
2061 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2062 return
2063 }
2064 }
2065 set descendent($a) 0
2066 set desc_todo $leftover
2067}
2068
2069proc is_ancestor {a} {
2070 global curview parentlist commitrow ancestor anc_todo
2071
2072 set v $curview
2073 set la $commitrow($v,$a)
2074 set todo $anc_todo
2075 set leftover {}
2076 set done 0
2077 for {set i 0} {$i < [llength $todo]} {incr i} {
2078 set do [lindex $todo $i]
2079 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2080 lappend leftover $do
2081 continue
2082 }
2083 foreach np [lindex $parentlist $commitrow($v,$do)] {
2084 if {![info exists ancestor($np)]} {
2085 set ancestor($np) 1
2086 lappend todo $np
2087 if {$np eq $a} {
2088 set done 1
2089 }
2090 }
2091 }
2092 if {$done} {
2093 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2094 return
2095 }
2096 }
2097 set ancestor($a) 0
2098 set anc_todo $leftover
2099}
2100
2101proc askrelhighlight {row id} {
2102 global descendent highlight_related iddrawn mainfont rhighlights
2103 global selectedline ancestor
2104
2105 if {![info exists selectedline]} return
2106 set isbold 0
2107 if {$highlight_related eq "Descendent" ||
2108 $highlight_related eq "Not descendent"} {
2109 if {![info exists descendent($id)]} {
2110 is_descendent $id
2111 }
2112 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2113 set isbold 1
2114 }
2115 } elseif {$highlight_related eq "Ancestor" ||
2116 $highlight_related eq "Not ancestor"} {
2117 if {![info exists ancestor($id)]} {
2118 is_ancestor $id
2119 }
2120 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2121 set isbold 1
2122 }
2123 }
2124 if {[info exists iddrawn($id)]} {
2125 if {$isbold && ![ishighlighted $row]} {
2126 bolden $row [concat $mainfont bold]
2127 }
2128 }
2129 set rhighlights($row) $isbold
2130}
2131
2132proc next_hlcont {} {
2133 global fhl_row fhl_dirn displayorder numcommits
2134 global vhighlights fhighlights nhighlights rhighlights
2135 global hlview filehighlight findstring highlight_related
2136
2137 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2138 set row $fhl_row
2139 while {1} {
2140 if {$row < 0 || $row >= $numcommits} {
2141 bell
2142 set fhl_dirn 0
2143 return
2144 }
2145 set id [lindex $displayorder $row]
2146 if {[info exists hlview]} {
2147 if {![info exists vhighlights($row)]} {
2148 askvhighlight $row $id
2149 }
2150 if {$vhighlights($row) > 0} break
2151 }
2152 if {$findstring ne {}} {
2153 if {![info exists nhighlights($row)]} {
2154 askfindhighlight $row $id
2155 }
2156 if {$nhighlights($row) > 0} break
2157 }
2158 if {$highlight_related ne "None"} {
2159 if {![info exists rhighlights($row)]} {
2160 askrelhighlight $row $id
2161 }
2162 if {$rhighlights($row) > 0} break
2163 }
2164 if {[info exists filehighlight]} {
2165 if {![info exists fhighlights($row)]} {
2166 # ask for a few more while we're at it...
2167 set r $row
2168 for {set n 0} {$n < 100} {incr n} {
2169 if {![info exists fhighlights($r)]} {
2170 askfilehighlight $r [lindex $displayorder $r]
2171 }
2172 incr r $fhl_dirn
2173 if {$r < 0 || $r >= $numcommits} break
2174 }
2175 flushhighlights
2176 }
2177 if {$fhighlights($row) < 0} {
2178 set fhl_row $row
2179 return
2180 }
2181 if {$fhighlights($row) > 0} break
2182 }
2183 incr row $fhl_dirn
2184 }
2185 set fhl_dirn 0
2186 selectline $row 1
2187}
2188
2189proc next_highlight {dirn} {
2190 global selectedline fhl_row fhl_dirn
2191 global hlview filehighlight findstring highlight_related
2192
2193 if {![info exists selectedline]} return
2194 if {!([info exists hlview] || $findstring ne {} ||
2195 $highlight_related ne "None" || [info exists filehighlight])} return
2196 set fhl_row [expr {$selectedline + $dirn}]
2197 set fhl_dirn $dirn
2198 next_hlcont
2199}
2200
2201proc cancel_next_highlight {} {
2202 global fhl_dirn
2203
2204 set fhl_dirn 0
2205}
2206
2207# Graph layout functions
2208
2209proc shortids {ids} {
2210 set res {}
2211 foreach id $ids {
2212 if {[llength $id] > 1} {
2213 lappend res [shortids $id]
2214 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2215 lappend res [string range $id 0 7]
2216 } else {
2217 lappend res $id
2218 }
2219 }
2220 return $res
2221}
2222
2223proc incrange {l x o} {
2224 set n [llength $l]
2225 while {$x < $n} {
2226 set e [lindex $l $x]
2227 if {$e ne {}} {
2228 lset l $x [expr {$e + $o}]
2229 }
2230 incr x
2231 }
2232 return $l
2233}
2234
2235proc ntimes {n o} {
2236 set ret {}
2237 for {} {$n > 0} {incr n -1} {
2238 lappend ret $o
2239 }
2240 return $ret
2241}
2242
2243proc usedinrange {id l1 l2} {
2244 global children commitrow childlist curview
2245
2246 if {[info exists commitrow($curview,$id)]} {
2247 set r $commitrow($curview,$id)
2248 if {$l1 <= $r && $r <= $l2} {
2249 return [expr {$r - $l1 + 1}]
2250 }
2251 set kids [lindex $childlist $r]
2252 } else {
2253 set kids $children($curview,$id)
2254 }
2255 foreach c $kids {
2256 set r $commitrow($curview,$c)
2257 if {$l1 <= $r && $r <= $l2} {
2258 return [expr {$r - $l1 + 1}]
2259 }
2260 }
2261 return 0
2262}
2263
2264proc sanity {row {full 0}} {
2265 global rowidlist rowoffsets
2266
2267 set col -1
2268 set ids [lindex $rowidlist $row]
2269 foreach id $ids {
2270 incr col
2271 if {$id eq {}} continue
2272 if {$col < [llength $ids] - 1 &&
2273 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2274 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2275 }
2276 set o [lindex $rowoffsets $row $col]
2277 set y $row
2278 set x $col
2279 while {$o ne {}} {
2280 incr y -1
2281 incr x $o
2282 if {[lindex $rowidlist $y $x] != $id} {
2283 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2284 puts " id=[shortids $id] check started at row $row"
2285 for {set i $row} {$i >= $y} {incr i -1} {
2286 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2287 }
2288 break
2289 }
2290 if {!$full} break
2291 set o [lindex $rowoffsets $y $x]
2292 }
2293 }
2294}
2295
2296proc makeuparrow {oid x y z} {
2297 global rowidlist rowoffsets uparrowlen idrowranges
2298
2299 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2300 incr y -1
2301 incr x $z
2302 set off0 [lindex $rowoffsets $y]
2303 for {set x0 $x} {1} {incr x0} {
2304 if {$x0 >= [llength $off0]} {
2305 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2306 break
2307 }
2308 set z [lindex $off0 $x0]
2309 if {$z ne {}} {
2310 incr x0 $z
2311 break
2312 }
2313 }
2314 set z [expr {$x0 - $x}]
2315 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2316 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2317 }
2318 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2319 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2320 lappend idrowranges($oid) $y
2321}
2322
2323proc initlayout {} {
2324 global rowidlist rowoffsets displayorder commitlisted
2325 global rowlaidout rowoptim
2326 global idinlist rowchk rowrangelist idrowranges
2327 global numcommits canvxmax canv
2328 global nextcolor
2329 global parentlist childlist children
2330 global colormap rowtextx
2331 global linesegends
2332
2333 set numcommits 0
2334 set displayorder {}
2335 set commitlisted {}
2336 set parentlist {}
2337 set childlist {}
2338 set rowrangelist {}
2339 set nextcolor 0
2340 set rowidlist {{}}
2341 set rowoffsets {{}}
2342 catch {unset idinlist}
2343 catch {unset rowchk}
2344 set rowlaidout 0
2345 set rowoptim 0
2346 set canvxmax [$canv cget -width]
2347 catch {unset colormap}
2348 catch {unset rowtextx}
2349 catch {unset idrowranges}
2350 set linesegends {}
2351}
2352
2353proc setcanvscroll {} {
2354 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2355
2356 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2357 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2358 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2359 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2360}
2361
2362proc visiblerows {} {
2363 global canv numcommits linespc
2364
2365 set ymax [lindex [$canv cget -scrollregion] 3]
2366 if {$ymax eq {} || $ymax == 0} return
2367 set f [$canv yview]
2368 set y0 [expr {int([lindex $f 0] * $ymax)}]
2369 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2370 if {$r0 < 0} {
2371 set r0 0
2372 }
2373 set y1 [expr {int([lindex $f 1] * $ymax)}]
2374 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2375 if {$r1 >= $numcommits} {
2376 set r1 [expr {$numcommits - 1}]
2377 }
2378 return [list $r0 $r1]
2379}
2380
2381proc layoutmore {} {
2382 global rowlaidout rowoptim commitidx numcommits optim_delay
2383 global uparrowlen curview
2384
2385 set row $rowlaidout
2386 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2387 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2388 if {$orow > $rowoptim} {
2389 optimize_rows $rowoptim 0 $orow
2390 set rowoptim $orow
2391 }
2392 set canshow [expr {$rowoptim - $optim_delay}]
2393 if {$canshow > $numcommits} {
2394 showstuff $canshow
2395 }
2396}
2397
2398proc showstuff {canshow} {
2399 global numcommits commitrow pending_select selectedline
2400 global linesegends idrowranges idrangedrawn curview
2401
2402 if {$numcommits == 0} {
2403 global phase
2404 set phase "incrdraw"
2405 allcanvs delete all
2406 }
2407 set row $numcommits
2408 set numcommits $canshow
2409 setcanvscroll
2410 set rows [visiblerows]
2411 set r0 [lindex $rows 0]
2412 set r1 [lindex $rows 1]
2413 set selrow -1
2414 for {set r $row} {$r < $canshow} {incr r} {
2415 foreach id [lindex $linesegends [expr {$r+1}]] {
2416 set i -1
2417 foreach {s e} [rowranges $id] {
2418 incr i
2419 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2420 && ![info exists idrangedrawn($id,$i)]} {
2421 drawlineseg $id $i
2422 set idrangedrawn($id,$i) 1
2423 }
2424 }
2425 }
2426 }
2427 if {$canshow > $r1} {
2428 set canshow $r1
2429 }
2430 while {$row < $canshow} {
2431 drawcmitrow $row
2432 incr row
2433 }
2434 if {[info exists pending_select] &&
2435 [info exists commitrow($curview,$pending_select)] &&
2436 $commitrow($curview,$pending_select) < $numcommits} {
2437 selectline $commitrow($curview,$pending_select) 1
2438 }
2439 if {![info exists selectedline] && ![info exists pending_select]} {
2440 selectline 0 1
2441 }
2442}
2443
2444proc layoutrows {row endrow last} {
2445 global rowidlist rowoffsets displayorder
2446 global uparrowlen downarrowlen maxwidth mingaplen
2447 global childlist parentlist
2448 global idrowranges linesegends
2449 global commitidx curview
2450 global idinlist rowchk rowrangelist
2451
2452 set idlist [lindex $rowidlist $row]
2453 set offs [lindex $rowoffsets $row]
2454 while {$row < $endrow} {
2455 set id [lindex $displayorder $row]
2456 set oldolds {}
2457 set newolds {}
2458 foreach p [lindex $parentlist $row] {
2459 if {![info exists idinlist($p)]} {
2460 lappend newolds $p
2461 } elseif {!$idinlist($p)} {
2462 lappend oldolds $p
2463 }
2464 }
2465 set lse {}
2466 set nev [expr {[llength $idlist] + [llength $newolds]
2467 + [llength $oldolds] - $maxwidth + 1}]
2468 if {$nev > 0} {
2469 if {!$last &&
2470 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2471 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2472 set i [lindex $idlist $x]
2473 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2474 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2475 [expr {$row + $uparrowlen + $mingaplen}]]
2476 if {$r == 0} {
2477 set idlist [lreplace $idlist $x $x]
2478 set offs [lreplace $offs $x $x]
2479 set offs [incrange $offs $x 1]
2480 set idinlist($i) 0
2481 set rm1 [expr {$row - 1}]
2482 lappend lse $i
2483 lappend idrowranges($i) $rm1
2484 if {[incr nev -1] <= 0} break
2485 continue
2486 }
2487 set rowchk($id) [expr {$row + $r}]
2488 }
2489 }
2490 lset rowidlist $row $idlist
2491 lset rowoffsets $row $offs
2492 }
2493 lappend linesegends $lse
2494 set col [lsearch -exact $idlist $id]
2495 if {$col < 0} {
2496 set col [llength $idlist]
2497 lappend idlist $id
2498 lset rowidlist $row $idlist
2499 set z {}
2500 if {[lindex $childlist $row] ne {}} {
2501 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2502 unset idinlist($id)
2503 }
2504 lappend offs $z
2505 lset rowoffsets $row $offs
2506 if {$z ne {}} {
2507 makeuparrow $id $col $row $z
2508 }
2509 } else {
2510 unset idinlist($id)
2511 }
2512 set ranges {}
2513 if {[info exists idrowranges($id)]} {
2514 set ranges $idrowranges($id)
2515 lappend ranges $row
2516 unset idrowranges($id)
2517 }
2518 lappend rowrangelist $ranges
2519 incr row
2520 set offs [ntimes [llength $idlist] 0]
2521 set l [llength $newolds]
2522 set idlist [eval lreplace \$idlist $col $col $newolds]
2523 set o 0
2524 if {$l != 1} {
2525 set offs [lrange $offs 0 [expr {$col - 1}]]
2526 foreach x $newolds {
2527 lappend offs {}
2528 incr o -1
2529 }
2530 incr o
2531 set tmp [expr {[llength $idlist] - [llength $offs]}]
2532 if {$tmp > 0} {
2533 set offs [concat $offs [ntimes $tmp $o]]
2534 }
2535 } else {
2536 lset offs $col {}
2537 }
2538 foreach i $newolds {
2539 set idinlist($i) 1
2540 set idrowranges($i) $row
2541 }
2542 incr col $l
2543 foreach oid $oldolds {
2544 set idinlist($oid) 1
2545 set idlist [linsert $idlist $col $oid]
2546 set offs [linsert $offs $col $o]
2547 makeuparrow $oid $col $row $o
2548 incr col
2549 }
2550 lappend rowidlist $idlist
2551 lappend rowoffsets $offs
2552 }
2553 return $row
2554}
2555
2556proc addextraid {id row} {
2557 global displayorder commitrow commitinfo
2558 global commitidx commitlisted
2559 global parentlist childlist children curview
2560
2561 incr commitidx($curview)
2562 lappend displayorder $id
2563 lappend commitlisted 0
2564 lappend parentlist {}
2565 set commitrow($curview,$id) $row
2566 readcommit $id
2567 if {![info exists commitinfo($id)]} {
2568 set commitinfo($id) {"No commit information available"}
2569 }
2570 if {![info exists children($curview,$id)]} {
2571 set children($curview,$id) {}
2572 }
2573 lappend childlist $children($curview,$id)
2574}
2575
2576proc layouttail {} {
2577 global rowidlist rowoffsets idinlist commitidx curview
2578 global idrowranges rowrangelist
2579
2580 set row $commitidx($curview)
2581 set idlist [lindex $rowidlist $row]
2582 while {$idlist ne {}} {
2583 set col [expr {[llength $idlist] - 1}]
2584 set id [lindex $idlist $col]
2585 addextraid $id $row
2586 unset idinlist($id)
2587 lappend idrowranges($id) $row
2588 lappend rowrangelist $idrowranges($id)
2589 unset idrowranges($id)
2590 incr row
2591 set offs [ntimes $col 0]
2592 set idlist [lreplace $idlist $col $col]
2593 lappend rowidlist $idlist
2594 lappend rowoffsets $offs
2595 }
2596
2597 foreach id [array names idinlist] {
2598 addextraid $id $row
2599 lset rowidlist $row [list $id]
2600 lset rowoffsets $row 0
2601 makeuparrow $id 0 $row 0
2602 lappend idrowranges($id) $row
2603 lappend rowrangelist $idrowranges($id)
2604 unset idrowranges($id)
2605 incr row
2606 lappend rowidlist {}
2607 lappend rowoffsets {}
2608 }
2609}
2610
2611proc insert_pad {row col npad} {
2612 global rowidlist rowoffsets
2613
2614 set pad [ntimes $npad {}]
2615 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2616 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2617 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2618}
2619
2620proc optimize_rows {row col endrow} {
2621 global rowidlist rowoffsets idrowranges displayorder
2622
2623 for {} {$row < $endrow} {incr row} {
2624 set idlist [lindex $rowidlist $row]
2625 set offs [lindex $rowoffsets $row]
2626 set haspad 0
2627 for {} {$col < [llength $offs]} {incr col} {
2628 if {[lindex $idlist $col] eq {}} {
2629 set haspad 1
2630 continue
2631 }
2632 set z [lindex $offs $col]
2633 if {$z eq {}} continue
2634 set isarrow 0
2635 set x0 [expr {$col + $z}]
2636 set y0 [expr {$row - 1}]
2637 set z0 [lindex $rowoffsets $y0 $x0]
2638 if {$z0 eq {}} {
2639 set id [lindex $idlist $col]
2640 set ranges [rowranges $id]
2641 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2642 set isarrow 1
2643 }
2644 }
2645 if {$z < -1 || ($z < 0 && $isarrow)} {
2646 set npad [expr {-1 - $z + $isarrow}]
2647 set offs [incrange $offs $col $npad]
2648 insert_pad $y0 $x0 $npad
2649 if {$y0 > 0} {
2650 optimize_rows $y0 $x0 $row
2651 }
2652 set z [lindex $offs $col]
2653 set x0 [expr {$col + $z}]
2654 set z0 [lindex $rowoffsets $y0 $x0]
2655 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2656 set npad [expr {$z - 1 + $isarrow}]
2657 set y1 [expr {$row + 1}]
2658 set offs2 [lindex $rowoffsets $y1]
2659 set x1 -1
2660 foreach z $offs2 {
2661 incr x1
2662 if {$z eq {} || $x1 + $z < $col} continue
2663 if {$x1 + $z > $col} {
2664 incr npad
2665 }
2666 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2667 break
2668 }
2669 set pad [ntimes $npad {}]
2670 set idlist [eval linsert \$idlist $col $pad]
2671 set tmp [eval linsert \$offs $col $pad]
2672 incr col $npad
2673 set offs [incrange $tmp $col [expr {-$npad}]]
2674 set z [lindex $offs $col]
2675 set haspad 1
2676 }
2677 if {$z0 eq {} && !$isarrow} {
2678 # this line links to its first child on row $row-2
2679 set rm2 [expr {$row - 2}]
2680 set id [lindex $displayorder $rm2]
2681 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2682 if {$xc >= 0} {
2683 set z0 [expr {$xc - $x0}]
2684 }
2685 }
2686 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2687 insert_pad $y0 $x0 1
2688 set offs [incrange $offs $col 1]
2689 optimize_rows $y0 [expr {$x0 + 1}] $row
2690 }
2691 }
2692 if {!$haspad} {
2693 set o {}
2694 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2695 set o [lindex $offs $col]
2696 if {$o eq {}} {
2697 # check if this is the link to the first child
2698 set id [lindex $idlist $col]
2699 set ranges [rowranges $id]
2700 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2701 # it is, work out offset to child
2702 set y0 [expr {$row - 1}]
2703 set id [lindex $displayorder $y0]
2704 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2705 if {$x0 >= 0} {
2706 set o [expr {$x0 - $col}]
2707 }
2708 }
2709 }
2710 if {$o eq {} || $o <= 0} break
2711 }
2712 if {$o ne {} && [incr col] < [llength $idlist]} {
2713 set y1 [expr {$row + 1}]
2714 set offs2 [lindex $rowoffsets $y1]
2715 set x1 -1
2716 foreach z $offs2 {
2717 incr x1
2718 if {$z eq {} || $x1 + $z < $col} continue
2719 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2720 break
2721 }
2722 set idlist [linsert $idlist $col {}]
2723 set tmp [linsert $offs $col {}]
2724 incr col
2725 set offs [incrange $tmp $col -1]
2726 }
2727 }
2728 lset rowidlist $row $idlist
2729 lset rowoffsets $row $offs
2730 set col 0
2731 }
2732}
2733
2734proc xc {row col} {
2735 global canvx0 linespc
2736 return [expr {$canvx0 + $col * $linespc}]
2737}
2738
2739proc yc {row} {
2740 global canvy0 linespc
2741 return [expr {$canvy0 + $row * $linespc}]
2742}
2743
2744proc linewidth {id} {
2745 global thickerline lthickness
2746
2747 set wid $lthickness
2748 if {[info exists thickerline] && $id eq $thickerline} {
2749 set wid [expr {2 * $lthickness}]
2750 }
2751 return $wid
2752}
2753
2754proc rowranges {id} {
2755 global phase idrowranges commitrow rowlaidout rowrangelist curview
2756
2757 set ranges {}
2758 if {$phase eq {} ||
2759 ([info exists commitrow($curview,$id)]
2760 && $commitrow($curview,$id) < $rowlaidout)} {
2761 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2762 } elseif {[info exists idrowranges($id)]} {
2763 set ranges $idrowranges($id)
2764 }
2765 return $ranges
2766}
2767
2768proc drawlineseg {id i} {
2769 global rowoffsets rowidlist
2770 global displayorder
2771 global canv colormap linespc
2772 global numcommits commitrow curview
2773
2774 set ranges [rowranges $id]
2775 set downarrow 1
2776 if {[info exists commitrow($curview,$id)]
2777 && $commitrow($curview,$id) < $numcommits} {
2778 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2779 } else {
2780 set downarrow 1
2781 }
2782 set startrow [lindex $ranges [expr {2 * $i}]]
2783 set row [lindex $ranges [expr {2 * $i + 1}]]
2784 if {$startrow == $row} return
2785 assigncolor $id
2786 set coords {}
2787 set col [lsearch -exact [lindex $rowidlist $row] $id]
2788 if {$col < 0} {
2789 puts "oops: drawline: id $id not on row $row"
2790 return
2791 }
2792 set lasto {}
2793 set ns 0
2794 while {1} {
2795 set o [lindex $rowoffsets $row $col]
2796 if {$o eq {}} break
2797 if {$o ne $lasto} {
2798 # changing direction
2799 set x [xc $row $col]
2800 set y [yc $row]
2801 lappend coords $x $y
2802 set lasto $o
2803 }
2804 incr col $o
2805 incr row -1
2806 }
2807 set x [xc $row $col]
2808 set y [yc $row]
2809 lappend coords $x $y
2810 if {$i == 0} {
2811 # draw the link to the first child as part of this line
2812 incr row -1
2813 set child [lindex $displayorder $row]
2814 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2815 if {$ccol >= 0} {
2816 set x [xc $row $ccol]
2817 set y [yc $row]
2818 if {$ccol < $col - 1} {
2819 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2820 } elseif {$ccol > $col + 1} {
2821 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2822 }
2823 lappend coords $x $y
2824 }
2825 }
2826 if {[llength $coords] < 4} return
2827 if {$downarrow} {
2828 # This line has an arrow at the lower end: check if the arrow is
2829 # on a diagonal segment, and if so, work around the Tk 8.4
2830 # refusal to draw arrows on diagonal lines.
2831 set x0 [lindex $coords 0]
2832 set x1 [lindex $coords 2]
2833 if {$x0 != $x1} {
2834 set y0 [lindex $coords 1]
2835 set y1 [lindex $coords 3]
2836 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2837 # we have a nearby vertical segment, just trim off the diag bit
2838 set coords [lrange $coords 2 end]
2839 } else {
2840 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2841 set xi [expr {$x0 - $slope * $linespc / 2}]
2842 set yi [expr {$y0 - $linespc / 2}]
2843 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2844 }
2845 }
2846 }
2847 set arrow [expr {2 * ($i > 0) + $downarrow}]
2848 set arrow [lindex {none first last both} $arrow]
2849 set t [$canv create line $coords -width [linewidth $id] \
2850 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2851 $canv lower $t
2852 bindline $t $id
2853}
2854
2855proc drawparentlinks {id row col olds} {
2856 global rowidlist canv colormap
2857
2858 set row2 [expr {$row + 1}]
2859 set x [xc $row $col]
2860 set y [yc $row]
2861 set y2 [yc $row2]
2862 set ids [lindex $rowidlist $row2]
2863 # rmx = right-most X coord used
2864 set rmx 0
2865 foreach p $olds {
2866 set i [lsearch -exact $ids $p]
2867 if {$i < 0} {
2868 puts "oops, parent $p of $id not in list"
2869 continue
2870 }
2871 set x2 [xc $row2 $i]
2872 if {$x2 > $rmx} {
2873 set rmx $x2
2874 }
2875 set ranges [rowranges $p]
2876 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2877 && $row2 < [lindex $ranges 1]} {
2878 # drawlineseg will do this one for us
2879 continue
2880 }
2881 assigncolor $p
2882 # should handle duplicated parents here...
2883 set coords [list $x $y]
2884 if {$i < $col - 1} {
2885 lappend coords [xc $row [expr {$i + 1}]] $y
2886 } elseif {$i > $col + 1} {
2887 lappend coords [xc $row [expr {$i - 1}]] $y
2888 }
2889 lappend coords $x2 $y2
2890 set t [$canv create line $coords -width [linewidth $p] \
2891 -fill $colormap($p) -tags lines.$p]
2892 $canv lower $t
2893 bindline $t $p
2894 }
2895 return $rmx
2896}
2897
2898proc drawlines {id} {
2899 global colormap canv
2900 global idrangedrawn
2901 global children iddrawn commitrow rowidlist curview
2902
2903 $canv delete lines.$id
2904 set nr [expr {[llength [rowranges $id]] / 2}]
2905 for {set i 0} {$i < $nr} {incr i} {
2906 if {[info exists idrangedrawn($id,$i)]} {
2907 drawlineseg $id $i
2908 }
2909 }
2910 foreach child $children($curview,$id) {
2911 if {[info exists iddrawn($child)]} {
2912 set row $commitrow($curview,$child)
2913 set col [lsearch -exact [lindex $rowidlist $row] $child]
2914 if {$col >= 0} {
2915 drawparentlinks $child $row $col [list $id]
2916 }
2917 }
2918 }
2919}
2920
2921proc drawcmittext {id row col rmx} {
2922 global linespc canv canv2 canv3 canvy0 fgcolor
2923 global commitlisted commitinfo rowidlist
2924 global rowtextx idpos idtags idheads idotherrefs
2925 global linehtag linentag linedtag
2926 global mainfont canvxmax boldrows boldnamerows fgcolor
2927
2928 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2929 set x [xc $row $col]
2930 set y [yc $row]
2931 set orad [expr {$linespc / 3}]
2932 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2933 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2934 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2935 $canv raise $t
2936 $canv bind $t <1> {selcanvline {} %x %y}
2937 set xt [xc $row [llength [lindex $rowidlist $row]]]
2938 if {$xt < $rmx} {
2939 set xt $rmx
2940 }
2941 set rowtextx($row) $xt
2942 set idpos($id) [list $x $xt $y]
2943 if {[info exists idtags($id)] || [info exists idheads($id)]
2944 || [info exists idotherrefs($id)]} {
2945 set xt [drawtags $id $x $xt $y]
2946 }
2947 set headline [lindex $commitinfo($id) 0]
2948 set name [lindex $commitinfo($id) 1]
2949 set date [lindex $commitinfo($id) 2]
2950 set date [formatdate $date]
2951 set font $mainfont
2952 set nfont $mainfont
2953 set isbold [ishighlighted $row]
2954 if {$isbold > 0} {
2955 lappend boldrows $row
2956 lappend font bold
2957 if {$isbold > 1} {
2958 lappend boldnamerows $row
2959 lappend nfont bold
2960 }
2961 }
2962 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2963 -text $headline -font $font -tags text]
2964 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2965 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2966 -text $name -font $nfont -tags text]
2967 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2968 -text $date -font $mainfont -tags text]
2969 set xr [expr {$xt + [font measure $mainfont $headline]}]
2970 if {$xr > $canvxmax} {
2971 set canvxmax $xr
2972 setcanvscroll
2973 }
2974}
2975
2976proc drawcmitrow {row} {
2977 global displayorder rowidlist
2978 global idrangedrawn iddrawn
2979 global commitinfo parentlist numcommits
2980 global filehighlight fhighlights findstring nhighlights
2981 global hlview vhighlights
2982 global highlight_related rhighlights
2983
2984 if {$row >= $numcommits} return
2985 foreach id [lindex $rowidlist $row] {
2986 if {$id eq {}} continue
2987 set i -1
2988 foreach {s e} [rowranges $id] {
2989 incr i
2990 if {$row < $s} continue
2991 if {$e eq {}} break
2992 if {$row <= $e} {
2993 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2994 drawlineseg $id $i
2995 set idrangedrawn($id,$i) 1
2996 }
2997 break
2998 }
2999 }
3000 }
3001
3002 set id [lindex $displayorder $row]
3003 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3004 askvhighlight $row $id
3005 }
3006 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3007 askfilehighlight $row $id
3008 }
3009 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3010 askfindhighlight $row $id
3011 }
3012 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3013 askrelhighlight $row $id
3014 }
3015 if {[info exists iddrawn($id)]} return
3016 set col [lsearch -exact [lindex $rowidlist $row] $id]
3017 if {$col < 0} {
3018 puts "oops, row $row id $id not in list"
3019 return
3020 }
3021 if {![info exists commitinfo($id)]} {
3022 getcommit $id
3023 }
3024 assigncolor $id
3025 set olds [lindex $parentlist $row]
3026 if {$olds ne {}} {
3027 set rmx [drawparentlinks $id $row $col $olds]
3028 } else {
3029 set rmx 0
3030 }
3031 drawcmittext $id $row $col $rmx
3032 set iddrawn($id) 1
3033}
3034
3035proc drawfrac {f0 f1} {
3036 global numcommits canv
3037 global linespc
3038
3039 set ymax [lindex [$canv cget -scrollregion] 3]
3040 if {$ymax eq {} || $ymax == 0} return
3041 set y0 [expr {int($f0 * $ymax)}]
3042 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3043 if {$row < 0} {
3044 set row 0
3045 }
3046 set y1 [expr {int($f1 * $ymax)}]
3047 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3048 if {$endrow >= $numcommits} {
3049 set endrow [expr {$numcommits - 1}]
3050 }
3051 for {} {$row <= $endrow} {incr row} {
3052 drawcmitrow $row
3053 }
3054}
3055
3056proc drawvisible {} {
3057 global canv
3058 eval drawfrac [$canv yview]
3059}
3060
3061proc clear_display {} {
3062 global iddrawn idrangedrawn
3063 global vhighlights fhighlights nhighlights rhighlights
3064
3065 allcanvs delete all
3066 catch {unset iddrawn}
3067 catch {unset idrangedrawn}
3068 catch {unset vhighlights}
3069 catch {unset fhighlights}
3070 catch {unset nhighlights}
3071 catch {unset rhighlights}
3072}
3073
3074proc findcrossings {id} {
3075 global rowidlist parentlist numcommits rowoffsets displayorder
3076
3077 set cross {}
3078 set ccross {}
3079 foreach {s e} [rowranges $id] {
3080 if {$e >= $numcommits} {
3081 set e [expr {$numcommits - 1}]
3082 }
3083 if {$e <= $s} continue
3084 set x [lsearch -exact [lindex $rowidlist $e] $id]
3085 if {$x < 0} {
3086 puts "findcrossings: oops, no [shortids $id] in row $e"
3087 continue
3088 }
3089 for {set row $e} {[incr row -1] >= $s} {} {
3090 set olds [lindex $parentlist $row]
3091 set kid [lindex $displayorder $row]
3092 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3093 if {$kidx < 0} continue
3094 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3095 foreach p $olds {
3096 set px [lsearch -exact $nextrow $p]
3097 if {$px < 0} continue
3098 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3099 if {[lsearch -exact $ccross $p] >= 0} continue
3100 if {$x == $px + ($kidx < $px? -1: 1)} {
3101 lappend ccross $p
3102 } elseif {[lsearch -exact $cross $p] < 0} {
3103 lappend cross $p
3104 }
3105 }
3106 }
3107 set inc [lindex $rowoffsets $row $x]
3108 if {$inc eq {}} break
3109 incr x $inc
3110 }
3111 }
3112 return [concat $ccross {{}} $cross]
3113}
3114
3115proc assigncolor {id} {
3116 global colormap colors nextcolor
3117 global commitrow parentlist children children curview
3118
3119 if {[info exists colormap($id)]} return
3120 set ncolors [llength $colors]
3121 if {[info exists children($curview,$id)]} {
3122 set kids $children($curview,$id)
3123 } else {
3124 set kids {}
3125 }
3126 if {[llength $kids] == 1} {
3127 set child [lindex $kids 0]
3128 if {[info exists colormap($child)]
3129 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3130 set colormap($id) $colormap($child)
3131 return
3132 }
3133 }
3134 set badcolors {}
3135 set origbad {}
3136 foreach x [findcrossings $id] {
3137 if {$x eq {}} {
3138 # delimiter between corner crossings and other crossings
3139 if {[llength $badcolors] >= $ncolors - 1} break
3140 set origbad $badcolors
3141 }
3142 if {[info exists colormap($x)]
3143 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3144 lappend badcolors $colormap($x)
3145 }
3146 }
3147 if {[llength $badcolors] >= $ncolors} {
3148 set badcolors $origbad
3149 }
3150 set origbad $badcolors
3151 if {[llength $badcolors] < $ncolors - 1} {
3152 foreach child $kids {
3153 if {[info exists colormap($child)]
3154 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3155 lappend badcolors $colormap($child)
3156 }
3157 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3158 if {[info exists colormap($p)]
3159 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3160 lappend badcolors $colormap($p)
3161 }
3162 }
3163 }
3164 if {[llength $badcolors] >= $ncolors} {
3165 set badcolors $origbad
3166 }
3167 }
3168 for {set i 0} {$i <= $ncolors} {incr i} {
3169 set c [lindex $colors $nextcolor]
3170 if {[incr nextcolor] >= $ncolors} {
3171 set nextcolor 0
3172 }
3173 if {[lsearch -exact $badcolors $c]} break
3174 }
3175 set colormap($id) $c
3176}
3177
3178proc bindline {t id} {
3179 global canv
3180
3181 $canv bind $t <Enter> "lineenter %x %y $id"
3182 $canv bind $t <Motion> "linemotion %x %y $id"
3183 $canv bind $t <Leave> "lineleave $id"
3184 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3185}
3186
3187proc drawtags {id x xt y1} {
3188 global idtags idheads idotherrefs mainhead
3189 global linespc lthickness
3190 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3191
3192 set marks {}
3193 set ntags 0
3194 set nheads 0
3195 if {[info exists idtags($id)]} {
3196 set marks $idtags($id)
3197 set ntags [llength $marks]
3198 }
3199 if {[info exists idheads($id)]} {
3200 set marks [concat $marks $idheads($id)]
3201 set nheads [llength $idheads($id)]
3202 }
3203 if {[info exists idotherrefs($id)]} {
3204 set marks [concat $marks $idotherrefs($id)]
3205 }
3206 if {$marks eq {}} {
3207 return $xt
3208 }
3209
3210 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3211 set yt [expr {$y1 - 0.5 * $linespc}]
3212 set yb [expr {$yt + $linespc - 1}]
3213 set xvals {}
3214 set wvals {}
3215 set i -1
3216 foreach tag $marks {
3217 incr i
3218 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3219 set wid [font measure [concat $mainfont bold] $tag]
3220 } else {
3221 set wid [font measure $mainfont $tag]
3222 }
3223 lappend xvals $xt
3224 lappend wvals $wid
3225 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3226 }
3227 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3228 -width $lthickness -fill black -tags tag.$id]
3229 $canv lower $t
3230 foreach tag $marks x $xvals wid $wvals {
3231 set xl [expr {$x + $delta}]
3232 set xr [expr {$x + $delta + $wid + $lthickness}]
3233 set font $mainfont
3234 if {[incr ntags -1] >= 0} {
3235 # draw a tag
3236 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3237 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3238 -width 1 -outline black -fill yellow -tags tag.$id]
3239 $canv bind $t <1> [list showtag $tag 1]
3240 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3241 } else {
3242 # draw a head or other ref
3243 if {[incr nheads -1] >= 0} {
3244 set col green
3245 if {$tag eq $mainhead} {
3246 lappend font bold
3247 }
3248 } else {
3249 set col "#ddddff"
3250 }
3251 set xl [expr {$xl - $delta/2}]
3252 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3253 -width 1 -outline black -fill $col -tags tag.$id
3254 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3255 set rwid [font measure $mainfont $remoteprefix]
3256 set xi [expr {$x + 1}]
3257 set yti [expr {$yt + 1}]
3258 set xri [expr {$x + $rwid}]
3259 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3260 -width 0 -fill "#ffddaa" -tags tag.$id
3261 }
3262 }
3263 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3264 -font $font -tags [list tag.$id text]]
3265 if {$ntags >= 0} {
3266 $canv bind $t <1> [list showtag $tag 1]
3267 } elseif {$nheads >= 0} {
3268 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3269 }
3270 }
3271 return $xt
3272}
3273
3274proc xcoord {i level ln} {
3275 global canvx0 xspc1 xspc2
3276
3277 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3278 if {$i > 0 && $i == $level} {
3279 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3280 } elseif {$i > $level} {
3281 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3282 }
3283 return $x
3284}
3285
3286proc show_status {msg} {
3287 global canv mainfont fgcolor
3288
3289 clear_display
3290 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3291 -tags text -fill $fgcolor
3292}
3293
3294proc finishcommits {} {
3295 global commitidx phase curview
3296 global pending_select
3297
3298 if {$commitidx($curview) > 0} {
3299 drawrest
3300 } else {
3301 show_status "No commits selected"
3302 }
3303 set phase {}
3304 catch {unset pending_select}
3305}
3306
3307# Inserting a new commit as the child of the commit on row $row.
3308# The new commit will be displayed on row $row and the commits
3309# on that row and below will move down one row.
3310proc insertrow {row newcmit} {
3311 global displayorder parentlist childlist commitlisted
3312 global commitrow curview rowidlist rowoffsets numcommits
3313 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3314 global linesegends
3315
3316 if {$row >= $numcommits} {
3317 puts "oops, inserting new row $row but only have $numcommits rows"
3318 return
3319 }
3320 set p [lindex $displayorder $row]
3321 set displayorder [linsert $displayorder $row $newcmit]
3322 set parentlist [linsert $parentlist $row $p]
3323 set kids [lindex $childlist $row]
3324 lappend kids $newcmit
3325 lset childlist $row $kids
3326 set childlist [linsert $childlist $row {}]
3327 set l [llength $displayorder]
3328 for {set r $row} {$r < $l} {incr r} {
3329 set id [lindex $displayorder $r]
3330 set commitrow($curview,$id) $r
3331 }
3332
3333 set idlist [lindex $rowidlist $row]
3334 set offs [lindex $rowoffsets $row]
3335 set newoffs {}
3336 foreach x $idlist {
3337 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3338 lappend newoffs {}
3339 } else {
3340 lappend newoffs 0
3341 }
3342 }
3343 if {[llength $kids] == 1} {
3344 set col [lsearch -exact $idlist $p]
3345 lset idlist $col $newcmit
3346 } else {
3347 set col [llength $idlist]
3348 lappend idlist $newcmit
3349 lappend offs {}
3350 lset rowoffsets $row $offs
3351 }
3352 set rowidlist [linsert $rowidlist $row $idlist]
3353 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3354
3355 set rowrangelist [linsert $rowrangelist $row {}]
3356 set l [llength $rowrangelist]
3357 for {set r 0} {$r < $l} {incr r} {
3358 set ranges [lindex $rowrangelist $r]
3359 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3360 set newranges {}
3361 foreach x $ranges {
3362 if {$x >= $row} {
3363 lappend newranges [expr {$x + 1}]
3364 } else {
3365 lappend newranges $x
3366 }
3367 }
3368 lset rowrangelist $r $newranges
3369 }
3370 }
3371 if {[llength $kids] > 1} {
3372 set rp1 [expr {$row + 1}]
3373 set ranges [lindex $rowrangelist $rp1]
3374 if {$ranges eq {}} {
3375 set ranges [list $row $rp1]
3376 } elseif {[lindex $ranges end-1] == $rp1} {
3377 lset ranges end-1 $row
3378 }
3379 lset rowrangelist $rp1 $ranges
3380 }
3381 foreach id [array names idrowranges] {
3382 set ranges $idrowranges($id)
3383 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3384 set newranges {}
3385 foreach x $ranges {
3386 if {$x >= $row} {
3387 lappend newranges [expr {$x + 1}]
3388 } else {
3389 lappend newranges $x
3390 }
3391 }
3392 set idrowranges($id) $newranges
3393 }
3394 }
3395
3396 set linesegends [linsert $linesegends $row {}]
3397
3398 incr rowlaidout
3399 incr rowoptim
3400 incr numcommits
3401
3402 redisplay
3403}
3404
3405# Don't change the text pane cursor if it is currently the hand cursor,
3406# showing that we are over a sha1 ID link.
3407proc settextcursor {c} {
3408 global ctext curtextcursor
3409
3410 if {[$ctext cget -cursor] == $curtextcursor} {
3411 $ctext config -cursor $c
3412 }
3413 set curtextcursor $c
3414}
3415
3416proc nowbusy {what} {
3417 global isbusy
3418
3419 if {[array names isbusy] eq {}} {
3420 . config -cursor watch
3421 settextcursor watch
3422 }
3423 set isbusy($what) 1
3424}
3425
3426proc notbusy {what} {
3427 global isbusy maincursor textcursor
3428
3429 catch {unset isbusy($what)}
3430 if {[array names isbusy] eq {}} {
3431 . config -cursor $maincursor
3432 settextcursor $textcursor
3433 }
3434}
3435
3436proc drawrest {} {
3437 global startmsecs
3438 global rowlaidout commitidx curview
3439 global pending_select
3440
3441 set row $rowlaidout
3442 layoutrows $rowlaidout $commitidx($curview) 1
3443 layouttail
3444 optimize_rows $row 0 $commitidx($curview)
3445 showstuff $commitidx($curview)
3446 if {[info exists pending_select]} {
3447 selectline 0 1
3448 }
3449
3450 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3451 #global numcommits
3452 #puts "overall $drawmsecs ms for $numcommits commits"
3453}
3454
3455proc findmatches {f} {
3456 global findtype foundstring foundstrlen
3457 if {$findtype == "Regexp"} {
3458 set matches [regexp -indices -all -inline $foundstring $f]
3459 } else {
3460 if {$findtype == "IgnCase"} {
3461 set str [string tolower $f]
3462 } else {
3463 set str $f
3464 }
3465 set matches {}
3466 set i 0
3467 while {[set j [string first $foundstring $str $i]] >= 0} {
3468 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3469 set i [expr {$j + $foundstrlen}]
3470 }
3471 }
3472 return $matches
3473}
3474
3475proc dofind {} {
3476 global findtype findloc findstring markedmatches commitinfo
3477 global numcommits displayorder linehtag linentag linedtag
3478 global mainfont canv canv2 canv3 selectedline
3479 global matchinglines foundstring foundstrlen matchstring
3480 global commitdata
3481
3482 stopfindproc
3483 unmarkmatches
3484 cancel_next_highlight
3485 focus .
3486 set matchinglines {}
3487 if {$findtype == "IgnCase"} {
3488 set foundstring [string tolower $findstring]
3489 } else {
3490 set foundstring $findstring
3491 }
3492 set foundstrlen [string length $findstring]
3493 if {$foundstrlen == 0} return
3494 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3495 set matchstring "*$matchstring*"
3496 if {![info exists selectedline]} {
3497 set oldsel -1
3498 } else {
3499 set oldsel $selectedline
3500 }
3501 set didsel 0
3502 set fldtypes {Headline Author Date Committer CDate Comments}
3503 set l -1
3504 foreach id $displayorder {
3505 set d $commitdata($id)
3506 incr l
3507 if {$findtype == "Regexp"} {
3508 set doesmatch [regexp $foundstring $d]
3509 } elseif {$findtype == "IgnCase"} {
3510 set doesmatch [string match -nocase $matchstring $d]
3511 } else {
3512 set doesmatch [string match $matchstring $d]
3513 }
3514 if {!$doesmatch} continue
3515 if {![info exists commitinfo($id)]} {
3516 getcommit $id
3517 }
3518 set info $commitinfo($id)
3519 set doesmatch 0
3520 foreach f $info ty $fldtypes {
3521 if {$findloc != "All fields" && $findloc != $ty} {
3522 continue
3523 }
3524 set matches [findmatches $f]
3525 if {$matches == {}} continue
3526 set doesmatch 1
3527 if {$ty == "Headline"} {
3528 drawcmitrow $l
3529 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3530 } elseif {$ty == "Author"} {
3531 drawcmitrow $l
3532 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3533 } elseif {$ty == "Date"} {
3534 drawcmitrow $l
3535 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3536 }
3537 }
3538 if {$doesmatch} {
3539 lappend matchinglines $l
3540 if {!$didsel && $l > $oldsel} {
3541 findselectline $l
3542 set didsel 1
3543 }
3544 }
3545 }
3546 if {$matchinglines == {}} {
3547 bell
3548 } elseif {!$didsel} {
3549 findselectline [lindex $matchinglines 0]
3550 }
3551}
3552
3553proc findselectline {l} {
3554 global findloc commentend ctext
3555 selectline $l 1
3556 if {$findloc == "All fields" || $findloc == "Comments"} {
3557 # highlight the matches in the comments
3558 set f [$ctext get 1.0 $commentend]
3559 set matches [findmatches $f]
3560 foreach match $matches {
3561 set start [lindex $match 0]
3562 set end [expr {[lindex $match 1] + 1}]
3563 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3564 }
3565 }
3566}
3567
3568proc findnext {restart} {
3569 global matchinglines selectedline
3570 if {![info exists matchinglines]} {
3571 if {$restart} {
3572 dofind
3573 }
3574 return
3575 }
3576 if {![info exists selectedline]} return
3577 foreach l $matchinglines {
3578 if {$l > $selectedline} {
3579 findselectline $l
3580 return
3581 }
3582 }
3583 bell
3584}
3585
3586proc findprev {} {
3587 global matchinglines selectedline
3588 if {![info exists matchinglines]} {
3589 dofind
3590 return
3591 }
3592 if {![info exists selectedline]} return
3593 set prev {}
3594 foreach l $matchinglines {
3595 if {$l >= $selectedline} break
3596 set prev $l
3597 }
3598 if {$prev != {}} {
3599 findselectline $prev
3600 } else {
3601 bell
3602 }
3603}
3604
3605proc stopfindproc {{done 0}} {
3606 global findprocpid findprocfile findids
3607 global ctext findoldcursor phase maincursor textcursor
3608 global findinprogress
3609
3610 catch {unset findids}
3611 if {[info exists findprocpid]} {
3612 if {!$done} {
3613 catch {exec kill $findprocpid}
3614 }
3615 catch {close $findprocfile}
3616 unset findprocpid
3617 }
3618 catch {unset findinprogress}
3619 notbusy find
3620}
3621
3622# mark a commit as matching by putting a yellow background
3623# behind the headline
3624proc markheadline {l id} {
3625 global canv mainfont linehtag
3626
3627 drawcmitrow $l
3628 set bbox [$canv bbox $linehtag($l)]
3629 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3630 $canv lower $t
3631}
3632
3633# mark the bits of a headline, author or date that match a find string
3634proc markmatches {canv l str tag matches font} {
3635 set bbox [$canv bbox $tag]
3636 set x0 [lindex $bbox 0]
3637 set y0 [lindex $bbox 1]
3638 set y1 [lindex $bbox 3]
3639 foreach match $matches {
3640 set start [lindex $match 0]
3641 set end [lindex $match 1]
3642 if {$start > $end} continue
3643 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3644 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3645 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3646 [expr {$x0+$xlen+2}] $y1 \
3647 -outline {} -tags matches -fill yellow]
3648 $canv lower $t
3649 }
3650}
3651
3652proc unmarkmatches {} {
3653 global matchinglines findids
3654 allcanvs delete matches
3655 catch {unset matchinglines}
3656 catch {unset findids}
3657}
3658
3659proc selcanvline {w x y} {
3660 global canv canvy0 ctext linespc
3661 global rowtextx
3662 set ymax [lindex [$canv cget -scrollregion] 3]
3663 if {$ymax == {}} return
3664 set yfrac [lindex [$canv yview] 0]
3665 set y [expr {$y + $yfrac * $ymax}]
3666 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3667 if {$l < 0} {
3668 set l 0
3669 }
3670 if {$w eq $canv} {
3671 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3672 }
3673 unmarkmatches
3674 selectline $l 1
3675}
3676
3677proc commit_descriptor {p} {
3678 global commitinfo
3679 if {![info exists commitinfo($p)]} {
3680 getcommit $p
3681 }
3682 set l "..."
3683 if {[llength $commitinfo($p)] > 1} {
3684 set l [lindex $commitinfo($p) 0]
3685 }
3686 return "$p ($l)\n"
3687}
3688
3689# append some text to the ctext widget, and make any SHA1 ID
3690# that we know about be a clickable link.
3691proc appendwithlinks {text tags} {
3692 global ctext commitrow linknum curview
3693
3694 set start [$ctext index "end - 1c"]
3695 $ctext insert end $text $tags
3696 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3697 foreach l $links {
3698 set s [lindex $l 0]
3699 set e [lindex $l 1]
3700 set linkid [string range $text $s $e]
3701 if {![info exists commitrow($curview,$linkid)]} continue
3702 incr e
3703 $ctext tag add link "$start + $s c" "$start + $e c"
3704 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3705 $ctext tag bind link$linknum <1> \
3706 [list selectline $commitrow($curview,$linkid) 1]
3707 incr linknum
3708 }
3709 $ctext tag conf link -foreground blue -underline 1
3710 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3711 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3712}
3713
3714proc viewnextline {dir} {
3715 global canv linespc
3716
3717 $canv delete hover
3718 set ymax [lindex [$canv cget -scrollregion] 3]
3719 set wnow [$canv yview]
3720 set wtop [expr {[lindex $wnow 0] * $ymax}]
3721 set newtop [expr {$wtop + $dir * $linespc}]
3722 if {$newtop < 0} {
3723 set newtop 0
3724 } elseif {$newtop > $ymax} {
3725 set newtop $ymax
3726 }
3727 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3728}
3729
3730# add a list of tag or branch names at position pos
3731# returns the number of names inserted
3732proc appendrefs {pos tags var} {
3733 global ctext commitrow linknum curview $var
3734
3735 if {[catch {$ctext index $pos}]} {
3736 return 0
3737 }
3738 set tags [lsort $tags]
3739 set sep {}
3740 foreach tag $tags {
3741 set id [set $var\($tag\)]
3742 set lk link$linknum
3743 incr linknum
3744 $ctext insert $pos $sep
3745 $ctext insert $pos $tag $lk
3746 $ctext tag conf $lk -foreground blue
3747 if {[info exists commitrow($curview,$id)]} {
3748 $ctext tag bind $lk <1> \
3749 [list selectline $commitrow($curview,$id) 1]
3750 $ctext tag conf $lk -underline 1
3751 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3752 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3753 }
3754 set sep ", "
3755 }
3756 return [llength $tags]
3757}
3758
3759proc taglist {ids} {
3760 global idtags
3761
3762 set tags {}
3763 foreach id $ids {
3764 foreach tag $idtags($id) {
3765 lappend tags $tag
3766 }
3767 }
3768 return $tags
3769}
3770
3771# called when we have finished computing the nearby tags
3772proc dispneartags {} {
3773 global selectedline currentid ctext anc_tags desc_tags showneartags
3774 global desc_heads
3775
3776 if {![info exists selectedline] || !$showneartags} return
3777 set id $currentid
3778 $ctext conf -state normal
3779 if {[info exists desc_heads($id)]} {
3780 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3781 $ctext insert "branch -2c" "es"
3782 }
3783 }
3784 if {[info exists anc_tags($id)]} {
3785 appendrefs follows [taglist $anc_tags($id)] tagids
3786 }
3787 if {[info exists desc_tags($id)]} {
3788 appendrefs precedes [taglist $desc_tags($id)] tagids
3789 }
3790 $ctext conf -state disabled
3791}
3792
3793proc selectline {l isnew} {
3794 global canv canv2 canv3 ctext commitinfo selectedline
3795 global displayorder linehtag linentag linedtag
3796 global canvy0 linespc parentlist childlist
3797 global currentid sha1entry
3798 global commentend idtags linknum
3799 global mergemax numcommits pending_select
3800 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3801
3802 catch {unset pending_select}
3803 $canv delete hover
3804 normalline
3805 cancel_next_highlight
3806 if {$l < 0 || $l >= $numcommits} return
3807 set y [expr {$canvy0 + $l * $linespc}]
3808 set ymax [lindex [$canv cget -scrollregion] 3]
3809 set ytop [expr {$y - $linespc - 1}]
3810 set ybot [expr {$y + $linespc + 1}]
3811 set wnow [$canv yview]
3812 set wtop [expr {[lindex $wnow 0] * $ymax}]
3813 set wbot [expr {[lindex $wnow 1] * $ymax}]
3814 set wh [expr {$wbot - $wtop}]
3815 set newtop $wtop
3816 if {$ytop < $wtop} {
3817 if {$ybot < $wtop} {
3818 set newtop [expr {$y - $wh / 2.0}]
3819 } else {
3820 set newtop $ytop
3821 if {$newtop > $wtop - $linespc} {
3822 set newtop [expr {$wtop - $linespc}]
3823 }
3824 }
3825 } elseif {$ybot > $wbot} {
3826 if {$ytop > $wbot} {
3827 set newtop [expr {$y - $wh / 2.0}]
3828 } else {
3829 set newtop [expr {$ybot - $wh}]
3830 if {$newtop < $wtop + $linespc} {
3831 set newtop [expr {$wtop + $linespc}]
3832 }
3833 }
3834 }
3835 if {$newtop != $wtop} {
3836 if {$newtop < 0} {
3837 set newtop 0
3838 }
3839 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3840 drawvisible
3841 }
3842
3843 if {![info exists linehtag($l)]} return
3844 $canv delete secsel
3845 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3846 -tags secsel -fill [$canv cget -selectbackground]]
3847 $canv lower $t
3848 $canv2 delete secsel
3849 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3850 -tags secsel -fill [$canv2 cget -selectbackground]]
3851 $canv2 lower $t
3852 $canv3 delete secsel
3853 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3854 -tags secsel -fill [$canv3 cget -selectbackground]]
3855 $canv3 lower $t
3856
3857 if {$isnew} {
3858 addtohistory [list selectline $l 0]
3859 }
3860
3861 set selectedline $l
3862
3863 set id [lindex $displayorder $l]
3864 set currentid $id
3865 $sha1entry delete 0 end
3866 $sha1entry insert 0 $id
3867 $sha1entry selection from 0
3868 $sha1entry selection to end
3869 rhighlight_sel $id
3870
3871 $ctext conf -state normal
3872 clear_ctext
3873 set linknum 0
3874 set info $commitinfo($id)
3875 set date [formatdate [lindex $info 2]]
3876 $ctext insert end "Author: [lindex $info 1] $date\n"
3877 set date [formatdate [lindex $info 4]]
3878 $ctext insert end "Committer: [lindex $info 3] $date\n"
3879 if {[info exists idtags($id)]} {
3880 $ctext insert end "Tags:"
3881 foreach tag $idtags($id) {
3882 $ctext insert end " $tag"
3883 }
3884 $ctext insert end "\n"
3885 }
3886
3887 set headers {}
3888 set olds [lindex $parentlist $l]
3889 if {[llength $olds] > 1} {
3890 set np 0
3891 foreach p $olds {
3892 if {$np >= $mergemax} {
3893 set tag mmax
3894 } else {
3895 set tag m$np
3896 }
3897 $ctext insert end "Parent: " $tag
3898 appendwithlinks [commit_descriptor $p] {}
3899 incr np
3900 }
3901 } else {
3902 foreach p $olds {
3903 append headers "Parent: [commit_descriptor $p]"
3904 }
3905 }
3906
3907 foreach c [lindex $childlist $l] {
3908 append headers "Child: [commit_descriptor $c]"
3909 }
3910
3911 # make anything that looks like a SHA1 ID be a clickable link
3912 appendwithlinks $headers {}
3913 if {$showneartags} {
3914 if {![info exists allcommits]} {
3915 getallcommits
3916 }
3917 $ctext insert end "Branch: "
3918 $ctext mark set branch "end -1c"
3919 $ctext mark gravity branch left
3920 if {[info exists desc_heads($id)]} {
3921 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3922 # turn "Branch" into "Branches"
3923 $ctext insert "branch -2c" "es"
3924 }
3925 }
3926 $ctext insert end "\nFollows: "
3927 $ctext mark set follows "end -1c"
3928 $ctext mark gravity follows left
3929 if {[info exists anc_tags($id)]} {
3930 appendrefs follows [taglist $anc_tags($id)] tagids
3931 }
3932 $ctext insert end "\nPrecedes: "
3933 $ctext mark set precedes "end -1c"
3934 $ctext mark gravity precedes left
3935 if {[info exists desc_tags($id)]} {
3936 appendrefs precedes [taglist $desc_tags($id)] tagids
3937 }
3938 $ctext insert end "\n"
3939 }
3940 $ctext insert end "\n"
3941 appendwithlinks [lindex $info 5] {comment}
3942
3943 $ctext tag delete Comments
3944 $ctext tag remove found 1.0 end
3945 $ctext conf -state disabled
3946 set commentend [$ctext index "end - 1c"]
3947
3948 init_flist "Comments"
3949 if {$cmitmode eq "tree"} {
3950 gettree $id
3951 } elseif {[llength $olds] <= 1} {
3952 startdiff $id
3953 } else {
3954 mergediff $id $l
3955 }
3956}
3957
3958proc selfirstline {} {
3959 unmarkmatches
3960 selectline 0 1
3961}
3962
3963proc sellastline {} {
3964 global numcommits
3965 unmarkmatches
3966 set l [expr {$numcommits - 1}]
3967 selectline $l 1
3968}
3969
3970proc selnextline {dir} {
3971 global selectedline
3972 if {![info exists selectedline]} return
3973 set l [expr {$selectedline + $dir}]
3974 unmarkmatches
3975 selectline $l 1
3976}
3977
3978proc selnextpage {dir} {
3979 global canv linespc selectedline numcommits
3980
3981 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3982 if {$lpp < 1} {
3983 set lpp 1
3984 }
3985 allcanvs yview scroll [expr {$dir * $lpp}] units
3986 drawvisible
3987 if {![info exists selectedline]} return
3988 set l [expr {$selectedline + $dir * $lpp}]
3989 if {$l < 0} {
3990 set l 0
3991 } elseif {$l >= $numcommits} {
3992 set l [expr $numcommits - 1]
3993 }
3994 unmarkmatches
3995 selectline $l 1
3996}
3997
3998proc unselectline {} {
3999 global selectedline currentid
4000
4001 catch {unset selectedline}
4002 catch {unset currentid}
4003 allcanvs delete secsel
4004 rhighlight_none
4005 cancel_next_highlight
4006}
4007
4008proc reselectline {} {
4009 global selectedline
4010
4011 if {[info exists selectedline]} {
4012 selectline $selectedline 0
4013 }
4014}
4015
4016proc addtohistory {cmd} {
4017 global history historyindex curview
4018
4019 set elt [list $curview $cmd]
4020 if {$historyindex > 0
4021 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4022 return
4023 }
4024
4025 if {$historyindex < [llength $history]} {
4026 set history [lreplace $history $historyindex end $elt]
4027 } else {
4028 lappend history $elt
4029 }
4030 incr historyindex
4031 if {$historyindex > 1} {
4032 .ctop.top.bar.leftbut conf -state normal
4033 } else {
4034 .ctop.top.bar.leftbut conf -state disabled
4035 }
4036 .ctop.top.bar.rightbut conf -state disabled
4037}
4038
4039proc godo {elt} {
4040 global curview
4041
4042 set view [lindex $elt 0]
4043 set cmd [lindex $elt 1]
4044 if {$curview != $view} {
4045 showview $view
4046 }
4047 eval $cmd
4048}
4049
4050proc goback {} {
4051 global history historyindex
4052
4053 if {$historyindex > 1} {
4054 incr historyindex -1
4055 godo [lindex $history [expr {$historyindex - 1}]]
4056 .ctop.top.bar.rightbut conf -state normal
4057 }
4058 if {$historyindex <= 1} {
4059 .ctop.top.bar.leftbut conf -state disabled
4060 }
4061}
4062
4063proc goforw {} {
4064 global history historyindex
4065
4066 if {$historyindex < [llength $history]} {
4067 set cmd [lindex $history $historyindex]
4068 incr historyindex
4069 godo $cmd
4070 .ctop.top.bar.leftbut conf -state normal
4071 }
4072 if {$historyindex >= [llength $history]} {
4073 .ctop.top.bar.rightbut conf -state disabled
4074 }
4075}
4076
4077proc gettree {id} {
4078 global treefilelist treeidlist diffids diffmergeid treepending
4079
4080 set diffids $id
4081 catch {unset diffmergeid}
4082 if {![info exists treefilelist($id)]} {
4083 if {![info exists treepending]} {
4084 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4085 return
4086 }
4087 set treepending $id
4088 set treefilelist($id) {}
4089 set treeidlist($id) {}
4090 fconfigure $gtf -blocking 0
4091 fileevent $gtf readable [list gettreeline $gtf $id]
4092 }
4093 } else {
4094 setfilelist $id
4095 }
4096}
4097
4098proc gettreeline {gtf id} {
4099 global treefilelist treeidlist treepending cmitmode diffids
4100
4101 while {[gets $gtf line] >= 0} {
4102 if {[lindex $line 1] ne "blob"} continue
4103 set sha1 [lindex $line 2]
4104 set fname [lindex $line 3]
4105 lappend treefilelist($id) $fname
4106 lappend treeidlist($id) $sha1
4107 }
4108 if {![eof $gtf]} return
4109 close $gtf
4110 unset treepending
4111 if {$cmitmode ne "tree"} {
4112 if {![info exists diffmergeid]} {
4113 gettreediffs $diffids
4114 }
4115 } elseif {$id ne $diffids} {
4116 gettree $diffids
4117 } else {
4118 setfilelist $id
4119 }
4120}
4121
4122proc showfile {f} {
4123 global treefilelist treeidlist diffids
4124 global ctext commentend
4125
4126 set i [lsearch -exact $treefilelist($diffids) $f]
4127 if {$i < 0} {
4128 puts "oops, $f not in list for id $diffids"
4129 return
4130 }
4131 set blob [lindex $treeidlist($diffids) $i]
4132 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4133 puts "oops, error reading blob $blob: $err"
4134 return
4135 }
4136 fconfigure $bf -blocking 0
4137 fileevent $bf readable [list getblobline $bf $diffids]
4138 $ctext config -state normal
4139 clear_ctext $commentend
4140 $ctext insert end "\n"
4141 $ctext insert end "$f\n" filesep
4142 $ctext config -state disabled
4143 $ctext yview $commentend
4144}
4145
4146proc getblobline {bf id} {
4147 global diffids cmitmode ctext
4148
4149 if {$id ne $diffids || $cmitmode ne "tree"} {
4150 catch {close $bf}
4151 return
4152 }
4153 $ctext config -state normal
4154 while {[gets $bf line] >= 0} {
4155 $ctext insert end "$line\n"
4156 }
4157 if {[eof $bf]} {
4158 # delete last newline
4159 $ctext delete "end - 2c" "end - 1c"
4160 close $bf
4161 }
4162 $ctext config -state disabled
4163}
4164
4165proc mergediff {id l} {
4166 global diffmergeid diffopts mdifffd
4167 global diffids
4168 global parentlist
4169
4170 set diffmergeid $id
4171 set diffids $id
4172 # this doesn't seem to actually affect anything...
4173 set env(GIT_DIFF_OPTS) $diffopts
4174 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4175 if {[catch {set mdf [open $cmd r]} err]} {
4176 error_popup "Error getting merge diffs: $err"
4177 return
4178 }
4179 fconfigure $mdf -blocking 0
4180 set mdifffd($id) $mdf
4181 set np [llength [lindex $parentlist $l]]
4182 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4183 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4184}
4185
4186proc getmergediffline {mdf id np} {
4187 global diffmergeid ctext cflist nextupdate mergemax
4188 global difffilestart mdifffd
4189
4190 set n [gets $mdf line]
4191 if {$n < 0} {
4192 if {[eof $mdf]} {
4193 close $mdf
4194 }
4195 return
4196 }
4197 if {![info exists diffmergeid] || $id != $diffmergeid
4198 || $mdf != $mdifffd($id)} {
4199 return
4200 }
4201 $ctext conf -state normal
4202 if {[regexp {^diff --cc (.*)} $line match fname]} {
4203 # start of a new file
4204 $ctext insert end "\n"
4205 set here [$ctext index "end - 1c"]
4206 lappend difffilestart $here
4207 add_flist [list $fname]
4208 set l [expr {(78 - [string length $fname]) / 2}]
4209 set pad [string range "----------------------------------------" 1 $l]
4210 $ctext insert end "$pad $fname $pad\n" filesep
4211 } elseif {[regexp {^@@} $line]} {
4212 $ctext insert end "$line\n" hunksep
4213 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4214 # do nothing
4215 } else {
4216 # parse the prefix - one ' ', '-' or '+' for each parent
4217 set spaces {}
4218 set minuses {}
4219 set pluses {}
4220 set isbad 0
4221 for {set j 0} {$j < $np} {incr j} {
4222 set c [string range $line $j $j]
4223 if {$c == " "} {
4224 lappend spaces $j
4225 } elseif {$c == "-"} {
4226 lappend minuses $j
4227 } elseif {$c == "+"} {
4228 lappend pluses $j
4229 } else {
4230 set isbad 1
4231 break
4232 }
4233 }
4234 set tags {}
4235 set num {}
4236 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4237 # line doesn't appear in result, parents in $minuses have the line
4238 set num [lindex $minuses 0]
4239 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4240 # line appears in result, parents in $pluses don't have the line
4241 lappend tags mresult
4242 set num [lindex $spaces 0]
4243 }
4244 if {$num ne {}} {
4245 if {$num >= $mergemax} {
4246 set num "max"
4247 }
4248 lappend tags m$num
4249 }
4250 $ctext insert end "$line\n" $tags
4251 }
4252 $ctext conf -state disabled
4253 if {[clock clicks -milliseconds] >= $nextupdate} {
4254 incr nextupdate 100
4255 fileevent $mdf readable {}
4256 update
4257 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4258 }
4259}
4260
4261proc startdiff {ids} {
4262 global treediffs diffids treepending diffmergeid
4263
4264 set diffids $ids
4265 catch {unset diffmergeid}
4266 if {![info exists treediffs($ids)]} {
4267 if {![info exists treepending]} {
4268 gettreediffs $ids
4269 }
4270 } else {
4271 addtocflist $ids
4272 }
4273}
4274
4275proc addtocflist {ids} {
4276 global treediffs cflist
4277 add_flist $treediffs($ids)
4278 getblobdiffs $ids
4279}
4280
4281proc gettreediffs {ids} {
4282 global treediff treepending
4283 set treepending $ids
4284 set treediff {}
4285 if {[catch \
4286 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4287 ]} return
4288 fconfigure $gdtf -blocking 0
4289 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4290}
4291
4292proc gettreediffline {gdtf ids} {
4293 global treediff treediffs treepending diffids diffmergeid
4294 global cmitmode
4295
4296 set n [gets $gdtf line]
4297 if {$n < 0} {
4298 if {![eof $gdtf]} return
4299 close $gdtf
4300 set treediffs($ids) $treediff
4301 unset treepending
4302 if {$cmitmode eq "tree"} {
4303 gettree $diffids
4304 } elseif {$ids != $diffids} {
4305 if {![info exists diffmergeid]} {
4306 gettreediffs $diffids
4307 }
4308 } else {
4309 addtocflist $ids
4310 }
4311 return
4312 }
4313 set file [lindex $line 5]
4314 lappend treediff $file
4315}
4316
4317proc getblobdiffs {ids} {
4318 global diffopts blobdifffd diffids env curdifftag curtagstart
4319 global nextupdate diffinhdr treediffs
4320
4321 set env(GIT_DIFF_OPTS) $diffopts
4322 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4323 if {[catch {set bdf [open $cmd r]} err]} {
4324 puts "error getting diffs: $err"
4325 return
4326 }
4327 set diffinhdr 0
4328 fconfigure $bdf -blocking 0
4329 set blobdifffd($ids) $bdf
4330 set curdifftag Comments
4331 set curtagstart 0.0
4332 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4333 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4334}
4335
4336proc setinlist {var i val} {
4337 global $var
4338
4339 while {[llength [set $var]] < $i} {
4340 lappend $var {}
4341 }
4342 if {[llength [set $var]] == $i} {
4343 lappend $var $val
4344 } else {
4345 lset $var $i $val
4346 }
4347}
4348
4349proc getblobdiffline {bdf ids} {
4350 global diffids blobdifffd ctext curdifftag curtagstart
4351 global diffnexthead diffnextnote difffilestart
4352 global nextupdate diffinhdr treediffs
4353
4354 set n [gets $bdf line]
4355 if {$n < 0} {
4356 if {[eof $bdf]} {
4357 close $bdf
4358 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4359 $ctext tag add $curdifftag $curtagstart end
4360 }
4361 }
4362 return
4363 }
4364 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4365 return
4366 }
4367 $ctext conf -state normal
4368 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4369 # start of a new file
4370 $ctext insert end "\n"
4371 $ctext tag add $curdifftag $curtagstart end
4372 set here [$ctext index "end - 1c"]
4373 set curtagstart $here
4374 set header $newname
4375 set i [lsearch -exact $treediffs($ids) $fname]
4376 if {$i >= 0} {
4377 setinlist difffilestart $i $here
4378 }
4379 if {$newname ne $fname} {
4380 set i [lsearch -exact $treediffs($ids) $newname]
4381 if {$i >= 0} {
4382 setinlist difffilestart $i $here
4383 }
4384 }
4385 set curdifftag "f:$fname"
4386 $ctext tag delete $curdifftag
4387 set l [expr {(78 - [string length $header]) / 2}]
4388 set pad [string range "----------------------------------------" 1 $l]
4389 $ctext insert end "$pad $header $pad\n" filesep
4390 set diffinhdr 1
4391 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4392 # do nothing
4393 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4394 set diffinhdr 0
4395 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4396 $line match f1l f1c f2l f2c rest]} {
4397 $ctext insert end "$line\n" hunksep
4398 set diffinhdr 0
4399 } else {
4400 set x [string range $line 0 0]
4401 if {$x == "-" || $x == "+"} {
4402 set tag [expr {$x == "+"}]
4403 $ctext insert end "$line\n" d$tag
4404 } elseif {$x == " "} {
4405 $ctext insert end "$line\n"
4406 } elseif {$diffinhdr || $x == "\\"} {
4407 # e.g. "\ No newline at end of file"
4408 $ctext insert end "$line\n" filesep
4409 } else {
4410 # Something else we don't recognize
4411 if {$curdifftag != "Comments"} {
4412 $ctext insert end "\n"
4413 $ctext tag add $curdifftag $curtagstart end
4414 set curtagstart [$ctext index "end - 1c"]
4415 set curdifftag Comments
4416 }
4417 $ctext insert end "$line\n" filesep
4418 }
4419 }
4420 $ctext conf -state disabled
4421 if {[clock clicks -milliseconds] >= $nextupdate} {
4422 incr nextupdate 100
4423 fileevent $bdf readable {}
4424 update
4425 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4426 }
4427}
4428
4429proc nextfile {} {
4430 global difffilestart ctext
4431 set here [$ctext index @0,0]
4432 foreach loc $difffilestart {
4433 if {[$ctext compare $loc > $here]} {
4434 $ctext yview $loc
4435 }
4436 }
4437}
4438
4439proc clear_ctext {{first 1.0}} {
4440 global ctext smarktop smarkbot
4441
4442 set l [lindex [split $first .] 0]
4443 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4444 set smarktop $l
4445 }
4446 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4447 set smarkbot $l
4448 }
4449 $ctext delete $first end
4450}
4451
4452proc incrsearch {name ix op} {
4453 global ctext searchstring searchdirn
4454
4455 $ctext tag remove found 1.0 end
4456 if {[catch {$ctext index anchor}]} {
4457 # no anchor set, use start of selection, or of visible area
4458 set sel [$ctext tag ranges sel]
4459 if {$sel ne {}} {
4460 $ctext mark set anchor [lindex $sel 0]
4461 } elseif {$searchdirn eq "-forwards"} {
4462 $ctext mark set anchor @0,0
4463 } else {
4464 $ctext mark set anchor @0,[winfo height $ctext]
4465 }
4466 }
4467 if {$searchstring ne {}} {
4468 set here [$ctext search $searchdirn -- $searchstring anchor]
4469 if {$here ne {}} {
4470 $ctext see $here
4471 }
4472 searchmarkvisible 1
4473 }
4474}
4475
4476proc dosearch {} {
4477 global sstring ctext searchstring searchdirn
4478
4479 focus $sstring
4480 $sstring icursor end
4481 set searchdirn -forwards
4482 if {$searchstring ne {}} {
4483 set sel [$ctext tag ranges sel]
4484 if {$sel ne {}} {
4485 set start "[lindex $sel 0] + 1c"
4486 } elseif {[catch {set start [$ctext index anchor]}]} {
4487 set start "@0,0"
4488 }
4489 set match [$ctext search -count mlen -- $searchstring $start]
4490 $ctext tag remove sel 1.0 end
4491 if {$match eq {}} {
4492 bell
4493 return
4494 }
4495 $ctext see $match
4496 set mend "$match + $mlen c"
4497 $ctext tag add sel $match $mend
4498 $ctext mark unset anchor
4499 }
4500}
4501
4502proc dosearchback {} {
4503 global sstring ctext searchstring searchdirn
4504
4505 focus $sstring
4506 $sstring icursor end
4507 set searchdirn -backwards
4508 if {$searchstring ne {}} {
4509 set sel [$ctext tag ranges sel]
4510 if {$sel ne {}} {
4511 set start [lindex $sel 0]
4512 } elseif {[catch {set start [$ctext index anchor]}]} {
4513 set start @0,[winfo height $ctext]
4514 }
4515 set match [$ctext search -backwards -count ml -- $searchstring $start]
4516 $ctext tag remove sel 1.0 end
4517 if {$match eq {}} {
4518 bell
4519 return
4520 }
4521 $ctext see $match
4522 set mend "$match + $ml c"
4523 $ctext tag add sel $match $mend
4524 $ctext mark unset anchor
4525 }
4526}
4527
4528proc searchmark {first last} {
4529 global ctext searchstring
4530
4531 set mend $first.0
4532 while {1} {
4533 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4534 if {$match eq {}} break
4535 set mend "$match + $mlen c"
4536 $ctext tag add found $match $mend
4537 }
4538}
4539
4540proc searchmarkvisible {doall} {
4541 global ctext smarktop smarkbot
4542
4543 set topline [lindex [split [$ctext index @0,0] .] 0]
4544 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4545 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4546 # no overlap with previous
4547 searchmark $topline $botline
4548 set smarktop $topline
4549 set smarkbot $botline
4550 } else {
4551 if {$topline < $smarktop} {
4552 searchmark $topline [expr {$smarktop-1}]
4553 set smarktop $topline
4554 }
4555 if {$botline > $smarkbot} {
4556 searchmark [expr {$smarkbot+1}] $botline
4557 set smarkbot $botline
4558 }
4559 }
4560}
4561
4562proc scrolltext {f0 f1} {
4563 global searchstring
4564
4565 .ctop.cdet.left.sb set $f0 $f1
4566 if {$searchstring ne {}} {
4567 searchmarkvisible 0
4568 }
4569}
4570
4571proc setcoords {} {
4572 global linespc charspc canvx0 canvy0 mainfont
4573 global xspc1 xspc2 lthickness
4574
4575 set linespc [font metrics $mainfont -linespace]
4576 set charspc [font measure $mainfont "m"]
4577 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4578 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4579 set lthickness [expr {int($linespc / 9) + 1}]
4580 set xspc1(0) $linespc
4581 set xspc2 $linespc
4582}
4583
4584proc redisplay {} {
4585 global canv
4586 global selectedline
4587
4588 set ymax [lindex [$canv cget -scrollregion] 3]
4589 if {$ymax eq {} || $ymax == 0} return
4590 set span [$canv yview]
4591 clear_display
4592 setcanvscroll
4593 allcanvs yview moveto [lindex $span 0]
4594 drawvisible
4595 if {[info exists selectedline]} {
4596 selectline $selectedline 0
4597 allcanvs yview moveto [lindex $span 0]
4598 }
4599}
4600
4601proc incrfont {inc} {
4602 global mainfont textfont ctext canv phase
4603 global stopped entries
4604 unmarkmatches
4605 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4606 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4607 setcoords
4608 $ctext conf -font $textfont
4609 $ctext tag conf filesep -font [concat $textfont bold]
4610 foreach e $entries {
4611 $e conf -font $mainfont
4612 }
4613 if {$phase eq "getcommits"} {
4614 $canv itemconf textitems -font $mainfont
4615 }
4616 redisplay
4617}
4618
4619proc clearsha1 {} {
4620 global sha1entry sha1string
4621 if {[string length $sha1string] == 40} {
4622 $sha1entry delete 0 end
4623 }
4624}
4625
4626proc sha1change {n1 n2 op} {
4627 global sha1string currentid sha1but
4628 if {$sha1string == {}
4629 || ([info exists currentid] && $sha1string == $currentid)} {
4630 set state disabled
4631 } else {
4632 set state normal
4633 }
4634 if {[$sha1but cget -state] == $state} return
4635 if {$state == "normal"} {
4636 $sha1but conf -state normal -relief raised -text "Goto: "
4637 } else {
4638 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4639 }
4640}
4641
4642proc gotocommit {} {
4643 global sha1string currentid commitrow tagids headids
4644 global displayorder numcommits curview
4645
4646 if {$sha1string == {}
4647 || ([info exists currentid] && $sha1string == $currentid)} return
4648 if {[info exists tagids($sha1string)]} {
4649 set id $tagids($sha1string)
4650 } elseif {[info exists headids($sha1string)]} {
4651 set id $headids($sha1string)
4652 } else {
4653 set id [string tolower $sha1string]
4654 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4655 set matches {}
4656 foreach i $displayorder {
4657 if {[string match $id* $i]} {
4658 lappend matches $i
4659 }
4660 }
4661 if {$matches ne {}} {
4662 if {[llength $matches] > 1} {
4663 error_popup "Short SHA1 id $id is ambiguous"
4664 return
4665 }
4666 set id [lindex $matches 0]
4667 }
4668 }
4669 }
4670 if {[info exists commitrow($curview,$id)]} {
4671 selectline $commitrow($curview,$id) 1
4672 return
4673 }
4674 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4675 set type "SHA1 id"
4676 } else {
4677 set type "Tag/Head"
4678 }
4679 error_popup "$type $sha1string is not known"
4680}
4681
4682proc lineenter {x y id} {
4683 global hoverx hovery hoverid hovertimer
4684 global commitinfo canv
4685
4686 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4687 set hoverx $x
4688 set hovery $y
4689 set hoverid $id
4690 if {[info exists hovertimer]} {
4691 after cancel $hovertimer
4692 }
4693 set hovertimer [after 500 linehover]
4694 $canv delete hover
4695}
4696
4697proc linemotion {x y id} {
4698 global hoverx hovery hoverid hovertimer
4699
4700 if {[info exists hoverid] && $id == $hoverid} {
4701 set hoverx $x
4702 set hovery $y
4703 if {[info exists hovertimer]} {
4704 after cancel $hovertimer
4705 }
4706 set hovertimer [after 500 linehover]
4707 }
4708}
4709
4710proc lineleave {id} {
4711 global hoverid hovertimer canv
4712
4713 if {[info exists hoverid] && $id == $hoverid} {
4714 $canv delete hover
4715 if {[info exists hovertimer]} {
4716 after cancel $hovertimer
4717 unset hovertimer
4718 }
4719 unset hoverid
4720 }
4721}
4722
4723proc linehover {} {
4724 global hoverx hovery hoverid hovertimer
4725 global canv linespc lthickness
4726 global commitinfo mainfont
4727
4728 set text [lindex $commitinfo($hoverid) 0]
4729 set ymax [lindex [$canv cget -scrollregion] 3]
4730 if {$ymax == {}} return
4731 set yfrac [lindex [$canv yview] 0]
4732 set x [expr {$hoverx + 2 * $linespc}]
4733 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4734 set x0 [expr {$x - 2 * $lthickness}]
4735 set y0 [expr {$y - 2 * $lthickness}]
4736 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4737 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4738 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4739 -fill \#ffff80 -outline black -width 1 -tags hover]
4740 $canv raise $t
4741 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4742 -font $mainfont]
4743 $canv raise $t
4744}
4745
4746proc clickisonarrow {id y} {
4747 global lthickness
4748
4749 set ranges [rowranges $id]
4750 set thresh [expr {2 * $lthickness + 6}]
4751 set n [expr {[llength $ranges] - 1}]
4752 for {set i 1} {$i < $n} {incr i} {
4753 set row [lindex $ranges $i]
4754 if {abs([yc $row] - $y) < $thresh} {
4755 return $i
4756 }
4757 }
4758 return {}
4759}
4760
4761proc arrowjump {id n y} {
4762 global canv
4763
4764 # 1 <-> 2, 3 <-> 4, etc...
4765 set n [expr {(($n - 1) ^ 1) + 1}]
4766 set row [lindex [rowranges $id] $n]
4767 set yt [yc $row]
4768 set ymax [lindex [$canv cget -scrollregion] 3]
4769 if {$ymax eq {} || $ymax <= 0} return
4770 set view [$canv yview]
4771 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4772 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4773 if {$yfrac < 0} {
4774 set yfrac 0
4775 }
4776 allcanvs yview moveto $yfrac
4777}
4778
4779proc lineclick {x y id isnew} {
4780 global ctext commitinfo children canv thickerline curview
4781
4782 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4783 unmarkmatches
4784 unselectline
4785 normalline
4786 $canv delete hover
4787 # draw this line thicker than normal
4788 set thickerline $id
4789 drawlines $id
4790 if {$isnew} {
4791 set ymax [lindex [$canv cget -scrollregion] 3]
4792 if {$ymax eq {}} return
4793 set yfrac [lindex [$canv yview] 0]
4794 set y [expr {$y + $yfrac * $ymax}]
4795 }
4796 set dirn [clickisonarrow $id $y]
4797 if {$dirn ne {}} {
4798 arrowjump $id $dirn $y
4799 return
4800 }
4801
4802 if {$isnew} {
4803 addtohistory [list lineclick $x $y $id 0]
4804 }
4805 # fill the details pane with info about this line
4806 $ctext conf -state normal
4807 clear_ctext
4808 $ctext tag conf link -foreground blue -underline 1
4809 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4810 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4811 $ctext insert end "Parent:\t"
4812 $ctext insert end $id [list link link0]
4813 $ctext tag bind link0 <1> [list selbyid $id]
4814 set info $commitinfo($id)
4815 $ctext insert end "\n\t[lindex $info 0]\n"
4816 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4817 set date [formatdate [lindex $info 2]]
4818 $ctext insert end "\tDate:\t$date\n"
4819 set kids $children($curview,$id)
4820 if {$kids ne {}} {
4821 $ctext insert end "\nChildren:"
4822 set i 0
4823 foreach child $kids {
4824 incr i
4825 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4826 set info $commitinfo($child)
4827 $ctext insert end "\n\t"
4828 $ctext insert end $child [list link link$i]
4829 $ctext tag bind link$i <1> [list selbyid $child]
4830 $ctext insert end "\n\t[lindex $info 0]"
4831 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4832 set date [formatdate [lindex $info 2]]
4833 $ctext insert end "\n\tDate:\t$date\n"
4834 }
4835 }
4836 $ctext conf -state disabled
4837 init_flist {}
4838}
4839
4840proc normalline {} {
4841 global thickerline
4842 if {[info exists thickerline]} {
4843 set id $thickerline
4844 unset thickerline
4845 drawlines $id
4846 }
4847}
4848
4849proc selbyid {id} {
4850 global commitrow curview
4851 if {[info exists commitrow($curview,$id)]} {
4852 selectline $commitrow($curview,$id) 1
4853 }
4854}
4855
4856proc mstime {} {
4857 global startmstime
4858 if {![info exists startmstime]} {
4859 set startmstime [clock clicks -milliseconds]
4860 }
4861 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4862}
4863
4864proc rowmenu {x y id} {
4865 global rowctxmenu commitrow selectedline rowmenuid curview
4866
4867 if {![info exists selectedline]
4868 || $commitrow($curview,$id) eq $selectedline} {
4869 set state disabled
4870 } else {
4871 set state normal
4872 }
4873 $rowctxmenu entryconfigure 0 -state $state
4874 $rowctxmenu entryconfigure 1 -state $state
4875 $rowctxmenu entryconfigure 2 -state $state
4876 set rowmenuid $id
4877 tk_popup $rowctxmenu $x $y
4878}
4879
4880proc diffvssel {dirn} {
4881 global rowmenuid selectedline displayorder
4882
4883 if {![info exists selectedline]} return
4884 if {$dirn} {
4885 set oldid [lindex $displayorder $selectedline]
4886 set newid $rowmenuid
4887 } else {
4888 set oldid $rowmenuid
4889 set newid [lindex $displayorder $selectedline]
4890 }
4891 addtohistory [list doseldiff $oldid $newid]
4892 doseldiff $oldid $newid
4893}
4894
4895proc doseldiff {oldid newid} {
4896 global ctext
4897 global commitinfo
4898
4899 $ctext conf -state normal
4900 clear_ctext
4901 init_flist "Top"
4902 $ctext insert end "From "
4903 $ctext tag conf link -foreground blue -underline 1
4904 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4905 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4906 $ctext tag bind link0 <1> [list selbyid $oldid]
4907 $ctext insert end $oldid [list link link0]
4908 $ctext insert end "\n "
4909 $ctext insert end [lindex $commitinfo($oldid) 0]
4910 $ctext insert end "\n\nTo "
4911 $ctext tag bind link1 <1> [list selbyid $newid]
4912 $ctext insert end $newid [list link link1]
4913 $ctext insert end "\n "
4914 $ctext insert end [lindex $commitinfo($newid) 0]
4915 $ctext insert end "\n"
4916 $ctext conf -state disabled
4917 $ctext tag delete Comments
4918 $ctext tag remove found 1.0 end
4919 startdiff [list $oldid $newid]
4920}
4921
4922proc mkpatch {} {
4923 global rowmenuid currentid commitinfo patchtop patchnum
4924
4925 if {![info exists currentid]} return
4926 set oldid $currentid
4927 set oldhead [lindex $commitinfo($oldid) 0]
4928 set newid $rowmenuid
4929 set newhead [lindex $commitinfo($newid) 0]
4930 set top .patch
4931 set patchtop $top
4932 catch {destroy $top}
4933 toplevel $top
4934 label $top.title -text "Generate patch"
4935 grid $top.title - -pady 10
4936 label $top.from -text "From:"
4937 entry $top.fromsha1 -width 40 -relief flat
4938 $top.fromsha1 insert 0 $oldid
4939 $top.fromsha1 conf -state readonly
4940 grid $top.from $top.fromsha1 -sticky w
4941 entry $top.fromhead -width 60 -relief flat
4942 $top.fromhead insert 0 $oldhead
4943 $top.fromhead conf -state readonly
4944 grid x $top.fromhead -sticky w
4945 label $top.to -text "To:"
4946 entry $top.tosha1 -width 40 -relief flat
4947 $top.tosha1 insert 0 $newid
4948 $top.tosha1 conf -state readonly
4949 grid $top.to $top.tosha1 -sticky w
4950 entry $top.tohead -width 60 -relief flat
4951 $top.tohead insert 0 $newhead
4952 $top.tohead conf -state readonly
4953 grid x $top.tohead -sticky w
4954 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4955 grid $top.rev x -pady 10
4956 label $top.flab -text "Output file:"
4957 entry $top.fname -width 60
4958 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4959 incr patchnum
4960 grid $top.flab $top.fname -sticky w
4961 frame $top.buts
4962 button $top.buts.gen -text "Generate" -command mkpatchgo
4963 button $top.buts.can -text "Cancel" -command mkpatchcan
4964 grid $top.buts.gen $top.buts.can
4965 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4966 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4967 grid $top.buts - -pady 10 -sticky ew
4968 focus $top.fname
4969}
4970
4971proc mkpatchrev {} {
4972 global patchtop
4973
4974 set oldid [$patchtop.fromsha1 get]
4975 set oldhead [$patchtop.fromhead get]
4976 set newid [$patchtop.tosha1 get]
4977 set newhead [$patchtop.tohead get]
4978 foreach e [list fromsha1 fromhead tosha1 tohead] \
4979 v [list $newid $newhead $oldid $oldhead] {
4980 $patchtop.$e conf -state normal
4981 $patchtop.$e delete 0 end
4982 $patchtop.$e insert 0 $v
4983 $patchtop.$e conf -state readonly
4984 }
4985}
4986
4987proc mkpatchgo {} {
4988 global patchtop
4989
4990 set oldid [$patchtop.fromsha1 get]
4991 set newid [$patchtop.tosha1 get]
4992 set fname [$patchtop.fname get]
4993 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4994 error_popup "Error creating patch: $err"
4995 }
4996 catch {destroy $patchtop}
4997 unset patchtop
4998}
4999
5000proc mkpatchcan {} {
5001 global patchtop
5002
5003 catch {destroy $patchtop}
5004 unset patchtop
5005}
5006
5007proc mktag {} {
5008 global rowmenuid mktagtop commitinfo
5009
5010 set top .maketag
5011 set mktagtop $top
5012 catch {destroy $top}
5013 toplevel $top
5014 label $top.title -text "Create tag"
5015 grid $top.title - -pady 10
5016 label $top.id -text "ID:"
5017 entry $top.sha1 -width 40 -relief flat
5018 $top.sha1 insert 0 $rowmenuid
5019 $top.sha1 conf -state readonly
5020 grid $top.id $top.sha1 -sticky w
5021 entry $top.head -width 60 -relief flat
5022 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5023 $top.head conf -state readonly
5024 grid x $top.head -sticky w
5025 label $top.tlab -text "Tag name:"
5026 entry $top.tag -width 60
5027 grid $top.tlab $top.tag -sticky w
5028 frame $top.buts
5029 button $top.buts.gen -text "Create" -command mktaggo
5030 button $top.buts.can -text "Cancel" -command mktagcan
5031 grid $top.buts.gen $top.buts.can
5032 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5033 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5034 grid $top.buts - -pady 10 -sticky ew
5035 focus $top.tag
5036}
5037
5038proc domktag {} {
5039 global mktagtop env tagids idtags
5040
5041 set id [$mktagtop.sha1 get]
5042 set tag [$mktagtop.tag get]
5043 if {$tag == {}} {
5044 error_popup "No tag name specified"
5045 return
5046 }
5047 if {[info exists tagids($tag)]} {
5048 error_popup "Tag \"$tag\" already exists"
5049 return
5050 }
5051 if {[catch {
5052 set dir [gitdir]
5053 set fname [file join $dir "refs/tags" $tag]
5054 set f [open $fname w]
5055 puts $f $id
5056 close $f
5057 } err]} {
5058 error_popup "Error creating tag: $err"
5059 return
5060 }
5061
5062 set tagids($tag) $id
5063 lappend idtags($id) $tag
5064 redrawtags $id
5065 addedtag $id
5066}
5067
5068proc redrawtags {id} {
5069 global canv linehtag commitrow idpos selectedline curview
5070 global mainfont canvxmax
5071
5072 if {![info exists commitrow($curview,$id)]} return
5073 drawcmitrow $commitrow($curview,$id)
5074 $canv delete tag.$id
5075 set xt [eval drawtags $id $idpos($id)]
5076 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5077 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5078 set xr [expr {$xt + [font measure $mainfont $text]}]
5079 if {$xr > $canvxmax} {
5080 set canvxmax $xr
5081 setcanvscroll
5082 }
5083 if {[info exists selectedline]
5084 && $selectedline == $commitrow($curview,$id)} {
5085 selectline $selectedline 0
5086 }
5087}
5088
5089proc mktagcan {} {
5090 global mktagtop
5091
5092 catch {destroy $mktagtop}
5093 unset mktagtop
5094}
5095
5096proc mktaggo {} {
5097 domktag
5098 mktagcan
5099}
5100
5101proc writecommit {} {
5102 global rowmenuid wrcomtop commitinfo wrcomcmd
5103
5104 set top .writecommit
5105 set wrcomtop $top
5106 catch {destroy $top}
5107 toplevel $top
5108 label $top.title -text "Write commit to file"
5109 grid $top.title - -pady 10
5110 label $top.id -text "ID:"
5111 entry $top.sha1 -width 40 -relief flat
5112 $top.sha1 insert 0 $rowmenuid
5113 $top.sha1 conf -state readonly
5114 grid $top.id $top.sha1 -sticky w
5115 entry $top.head -width 60 -relief flat
5116 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5117 $top.head conf -state readonly
5118 grid x $top.head -sticky w
5119 label $top.clab -text "Command:"
5120 entry $top.cmd -width 60 -textvariable wrcomcmd
5121 grid $top.clab $top.cmd -sticky w -pady 10
5122 label $top.flab -text "Output file:"
5123 entry $top.fname -width 60
5124 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5125 grid $top.flab $top.fname -sticky w
5126 frame $top.buts
5127 button $top.buts.gen -text "Write" -command wrcomgo
5128 button $top.buts.can -text "Cancel" -command wrcomcan
5129 grid $top.buts.gen $top.buts.can
5130 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5131 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5132 grid $top.buts - -pady 10 -sticky ew
5133 focus $top.fname
5134}
5135
5136proc wrcomgo {} {
5137 global wrcomtop
5138
5139 set id [$wrcomtop.sha1 get]
5140 set cmd "echo $id | [$wrcomtop.cmd get]"
5141 set fname [$wrcomtop.fname get]
5142 if {[catch {exec sh -c $cmd >$fname &} err]} {
5143 error_popup "Error writing commit: $err"
5144 }
5145 catch {destroy $wrcomtop}
5146 unset wrcomtop
5147}
5148
5149proc wrcomcan {} {
5150 global wrcomtop
5151
5152 catch {destroy $wrcomtop}
5153 unset wrcomtop
5154}
5155
5156proc mkbranch {} {
5157 global rowmenuid mkbrtop
5158
5159 set top .makebranch
5160 catch {destroy $top}
5161 toplevel $top
5162 label $top.title -text "Create new branch"
5163 grid $top.title - -pady 10
5164 label $top.id -text "ID:"
5165 entry $top.sha1 -width 40 -relief flat
5166 $top.sha1 insert 0 $rowmenuid
5167 $top.sha1 conf -state readonly
5168 grid $top.id $top.sha1 -sticky w
5169 label $top.nlab -text "Name:"
5170 entry $top.name -width 40
5171 grid $top.nlab $top.name -sticky w
5172 frame $top.buts
5173 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5174 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5175 grid $top.buts.go $top.buts.can
5176 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5177 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5178 grid $top.buts - -pady 10 -sticky ew
5179 focus $top.name
5180}
5181
5182proc mkbrgo {top} {
5183 global headids idheads
5184
5185 set name [$top.name get]
5186 set id [$top.sha1 get]
5187 if {$name eq {}} {
5188 error_popup "Please specify a name for the new branch"
5189 return
5190 }
5191 catch {destroy $top}
5192 nowbusy newbranch
5193 update
5194 if {[catch {
5195 exec git branch $name $id
5196 } err]} {
5197 notbusy newbranch
5198 error_popup $err
5199 } else {
5200 addedhead $id $name
5201 # XXX should update list of heads displayed for selected commit
5202 notbusy newbranch
5203 redrawtags $id
5204 }
5205}
5206
5207proc cherrypick {} {
5208 global rowmenuid curview commitrow
5209 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5210
5211 if {[info exists desc_heads($rowmenuid)]
5212 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5213 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5214 included in branch $mainhead -- really re-apply it?"]
5215 if {!$ok} return
5216 }
5217 nowbusy cherrypick
5218 update
5219 set oldhead [exec git rev-parse HEAD]
5220 # Unfortunately git-cherry-pick writes stuff to stderr even when
5221 # no error occurs, and exec takes that as an indication of error...
5222 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5223 notbusy cherrypick
5224 error_popup $err
5225 return
5226 }
5227 set newhead [exec git rev-parse HEAD]
5228 if {$newhead eq $oldhead} {
5229 notbusy cherrypick
5230 error_popup "No changes committed"
5231 return
5232 }
5233 set allparents($newhead) $oldhead
5234 lappend allchildren($oldhead) $newhead
5235 set desc_heads($newhead) $mainhead
5236 if {[info exists anc_tags($oldhead)]} {
5237 set anc_tags($newhead) $anc_tags($oldhead)
5238 }
5239 set desc_tags($newhead) {}
5240 if {[info exists commitrow($curview,$oldhead)]} {
5241 insertrow $commitrow($curview,$oldhead) $newhead
5242 if {$mainhead ne {}} {
5243 movedhead $newhead $mainhead
5244 }
5245 redrawtags $oldhead
5246 redrawtags $newhead
5247 }
5248 notbusy cherrypick
5249}
5250
5251# context menu for a head
5252proc headmenu {x y id head} {
5253 global headmenuid headmenuhead headctxmenu
5254
5255 set headmenuid $id
5256 set headmenuhead $head
5257 tk_popup $headctxmenu $x $y
5258}
5259
5260proc cobranch {} {
5261 global headmenuid headmenuhead mainhead headids
5262
5263 # check the tree is clean first??
5264 set oldmainhead $mainhead
5265 nowbusy checkout
5266 update
5267 if {[catch {
5268 exec git checkout $headmenuhead
5269 } err]} {
5270 notbusy checkout
5271 error_popup $err
5272 } else {
5273 notbusy checkout
5274 set mainhead $headmenuhead
5275 if {[info exists headids($oldmainhead)]} {
5276 redrawtags $headids($oldmainhead)
5277 }
5278 redrawtags $headmenuid
5279 }
5280}
5281
5282proc rmbranch {} {
5283 global desc_heads headmenuid headmenuhead mainhead
5284 global headids idheads
5285
5286 set head $headmenuhead
5287 set id $headmenuid
5288 if {$head eq $mainhead} {
5289 error_popup "Cannot delete the currently checked-out branch"
5290 return
5291 }
5292 if {$desc_heads($id) eq $head} {
5293 # the stuff on this branch isn't on any other branch
5294 if {![confirm_popup "The commits on branch $head aren't on any other\
5295 branch.\nReally delete branch $head?"]} return
5296 }
5297 nowbusy rmbranch
5298 update
5299 if {[catch {exec git branch -D $head} err]} {
5300 notbusy rmbranch
5301 error_popup $err
5302 return
5303 }
5304 removedhead $id $head
5305 redrawtags $id
5306 notbusy rmbranch
5307}
5308
5309# Stuff for finding nearby tags
5310proc getallcommits {} {
5311 global allcstart allcommits allcfd allids
5312
5313 set allids {}
5314 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5315 set allcfd $fd
5316 fconfigure $fd -blocking 0
5317 set allcommits "reading"
5318 nowbusy allcommits
5319 restartgetall $fd
5320}
5321
5322proc discardallcommits {} {
5323 global allparents allchildren allcommits allcfd
5324 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5325
5326 if {![info exists allcommits]} return
5327 if {$allcommits eq "reading"} {
5328 catch {close $allcfd}
5329 }
5330 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5331 alldtags tagisdesc desc_heads} {
5332 catch {unset $v}
5333 }
5334}
5335
5336proc restartgetall {fd} {
5337 global allcstart
5338
5339 fileevent $fd readable [list getallclines $fd]
5340 set allcstart [clock clicks -milliseconds]
5341}
5342
5343proc combine_dtags {l1 l2} {
5344 global tagisdesc notfirstd
5345
5346 set res [lsort -unique [concat $l1 $l2]]
5347 for {set i 0} {$i < [llength $res]} {incr i} {
5348 set x [lindex $res $i]
5349 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5350 set y [lindex $res $j]
5351 if {[info exists tagisdesc($x,$y)]} {
5352 if {$tagisdesc($x,$y) > 0} {
5353 # x is a descendent of y, exclude x
5354 set res [lreplace $res $i $i]
5355 incr i -1
5356 break
5357 } else {
5358 # y is a descendent of x, exclude y
5359 set res [lreplace $res $j $j]
5360 }
5361 } else {
5362 # no relation, keep going
5363 incr j
5364 }
5365 }
5366 }
5367 return $res
5368}
5369
5370proc combine_atags {l1 l2} {
5371 global tagisdesc
5372
5373 set res [lsort -unique [concat $l1 $l2]]
5374 for {set i 0} {$i < [llength $res]} {incr i} {
5375 set x [lindex $res $i]
5376 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5377 set y [lindex $res $j]
5378 if {[info exists tagisdesc($x,$y)]} {
5379 if {$tagisdesc($x,$y) < 0} {
5380 # x is an ancestor of y, exclude x
5381 set res [lreplace $res $i $i]
5382 incr i -1
5383 break
5384 } else {
5385 # y is an ancestor of x, exclude y
5386 set res [lreplace $res $j $j]
5387 }
5388 } else {
5389 # no relation, keep going
5390 incr j
5391 }
5392 }
5393 }
5394 return $res
5395}
5396
5397proc forward_pass {id children} {
5398 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5399
5400 set dtags {}
5401 set dheads {}
5402 foreach child $children {
5403 if {[info exists idtags($child)]} {
5404 set ctags [list $child]
5405 } else {
5406 set ctags $desc_tags($child)
5407 }
5408 if {$dtags eq {}} {
5409 set dtags $ctags
5410 } elseif {$ctags ne $dtags} {
5411 set dtags [combine_dtags $dtags $ctags]
5412 }
5413 set cheads $desc_heads($child)
5414 if {$dheads eq {}} {
5415 set dheads $cheads
5416 } elseif {$cheads ne $dheads} {
5417 set dheads [lsort -unique [concat $dheads $cheads]]
5418 }
5419 }
5420 set desc_tags($id) $dtags
5421 if {[info exists idtags($id)]} {
5422 set adt $dtags
5423 foreach tag $dtags {
5424 set adt [concat $adt $alldtags($tag)]
5425 }
5426 set adt [lsort -unique $adt]
5427 set alldtags($id) $adt
5428 foreach tag $adt {
5429 set tagisdesc($id,$tag) -1
5430 set tagisdesc($tag,$id) 1
5431 }
5432 }
5433 if {[info exists idheads($id)]} {
5434 set dheads [concat $dheads $idheads($id)]
5435 }
5436 set desc_heads($id) $dheads
5437}
5438
5439proc getallclines {fd} {
5440 global allparents allchildren allcommits allcstart
5441 global desc_tags anc_tags idtags tagisdesc allids
5442 global idheads travindex
5443
5444 while {[gets $fd line] >= 0} {
5445 set id [lindex $line 0]
5446 lappend allids $id
5447 set olds [lrange $line 1 end]
5448 set allparents($id) $olds
5449 if {![info exists allchildren($id)]} {
5450 set allchildren($id) {}
5451 }
5452 foreach p $olds {
5453 lappend allchildren($p) $id
5454 }
5455 # compute nearest tagged descendents as we go
5456 # also compute descendent heads
5457 forward_pass $id $allchildren($id)
5458 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5459 fileevent $fd readable {}
5460 after idle restartgetall $fd
5461 return
5462 }
5463 }
5464 if {[eof $fd]} {
5465 set travindex [llength $allids]
5466 set allcommits "traversing"
5467 after idle restartatags
5468 if {[catch {close $fd} err]} {
5469 error_popup "Error reading full commit graph: $err.\n\
5470 Results may be incomplete."
5471 }
5472 }
5473}
5474
5475# walk backward through the tree and compute nearest tagged ancestors
5476proc restartatags {} {
5477 global allids allparents idtags anc_tags travindex
5478
5479 set t0 [clock clicks -milliseconds]
5480 set i $travindex
5481 while {[incr i -1] >= 0} {
5482 set id [lindex $allids $i]
5483 set atags {}
5484 foreach p $allparents($id) {
5485 if {[info exists idtags($p)]} {
5486 set ptags [list $p]
5487 } else {
5488 set ptags $anc_tags($p)
5489 }
5490 if {$atags eq {}} {
5491 set atags $ptags
5492 } elseif {$ptags ne $atags} {
5493 set atags [combine_atags $atags $ptags]
5494 }
5495 }
5496 set anc_tags($id) $atags
5497 if {[clock clicks -milliseconds] - $t0 >= 50} {
5498 set travindex $i
5499 after idle restartatags
5500 return
5501 }
5502 }
5503 set allcommits "done"
5504 set travindex 0
5505 notbusy allcommits
5506 dispneartags
5507}
5508
5509# update the desc_tags and anc_tags arrays for a new tag just added
5510proc addedtag {id} {
5511 global desc_tags anc_tags allparents allchildren allcommits
5512 global idtags tagisdesc alldtags
5513
5514 if {![info exists desc_tags($id)]} return
5515 set adt $desc_tags($id)
5516 foreach t $desc_tags($id) {
5517 set adt [concat $adt $alldtags($t)]
5518 }
5519 set adt [lsort -unique $adt]
5520 set alldtags($id) $adt
5521 foreach t $adt {
5522 set tagisdesc($id,$t) -1
5523 set tagisdesc($t,$id) 1
5524 }
5525 if {[info exists anc_tags($id)]} {
5526 set todo $anc_tags($id)
5527 while {$todo ne {}} {
5528 set do [lindex $todo 0]
5529 set todo [lrange $todo 1 end]
5530 if {[info exists tagisdesc($id,$do)]} continue
5531 set tagisdesc($do,$id) -1
5532 set tagisdesc($id,$do) 1
5533 if {[info exists anc_tags($do)]} {
5534 set todo [concat $todo $anc_tags($do)]
5535 }
5536 }
5537 }
5538
5539 set lastold $desc_tags($id)
5540 set lastnew [list $id]
5541 set nup 0
5542 set nch 0
5543 set todo $allparents($id)
5544 while {$todo ne {}} {
5545 set do [lindex $todo 0]
5546 set todo [lrange $todo 1 end]
5547 if {![info exists desc_tags($do)]} continue
5548 if {$desc_tags($do) ne $lastold} {
5549 set lastold $desc_tags($do)
5550 set lastnew [combine_dtags $lastold [list $id]]
5551 incr nch
5552 }
5553 if {$lastold eq $lastnew} continue
5554 set desc_tags($do) $lastnew
5555 incr nup
5556 if {![info exists idtags($do)]} {
5557 set todo [concat $todo $allparents($do)]
5558 }
5559 }
5560
5561 if {![info exists anc_tags($id)]} return
5562 set lastold $anc_tags($id)
5563 set lastnew [list $id]
5564 set nup 0
5565 set nch 0
5566 set todo $allchildren($id)
5567 while {$todo ne {}} {
5568 set do [lindex $todo 0]
5569 set todo [lrange $todo 1 end]
5570 if {![info exists anc_tags($do)]} continue
5571 if {$anc_tags($do) ne $lastold} {
5572 set lastold $anc_tags($do)
5573 set lastnew [combine_atags $lastold [list $id]]
5574 incr nch
5575 }
5576 if {$lastold eq $lastnew} continue
5577 set anc_tags($do) $lastnew
5578 incr nup
5579 if {![info exists idtags($do)]} {
5580 set todo [concat $todo $allchildren($do)]
5581 }
5582 }
5583}
5584
5585# update the desc_heads array for a new head just added
5586proc addedhead {hid head} {
5587 global desc_heads allparents headids idheads
5588
5589 set headids($head) $hid
5590 lappend idheads($hid) $head
5591
5592 set todo [list $hid]
5593 while {$todo ne {}} {
5594 set do [lindex $todo 0]
5595 set todo [lrange $todo 1 end]
5596 if {![info exists desc_heads($do)] ||
5597 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5598 set oldheads $desc_heads($do)
5599 lappend desc_heads($do) $head
5600 set heads $desc_heads($do)
5601 while {1} {
5602 set p $allparents($do)
5603 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5604 $desc_heads($p) ne $oldheads} break
5605 set do $p
5606 set desc_heads($do) $heads
5607 }
5608 set todo [concat $todo $p]
5609 }
5610}
5611
5612# update the desc_heads array for a head just removed
5613proc removedhead {hid head} {
5614 global desc_heads allparents headids idheads
5615
5616 unset headids($head)
5617 if {$idheads($hid) eq $head} {
5618 unset idheads($hid)
5619 } else {
5620 set i [lsearch -exact $idheads($hid) $head]
5621 if {$i >= 0} {
5622 set idheads($hid) [lreplace $idheads($hid) $i $i]
5623 }
5624 }
5625
5626 set todo [list $hid]
5627 while {$todo ne {}} {
5628 set do [lindex $todo 0]
5629 set todo [lrange $todo 1 end]
5630 if {![info exists desc_heads($do)]} continue
5631 set i [lsearch -exact $desc_heads($do) $head]
5632 if {$i < 0} continue
5633 set oldheads $desc_heads($do)
5634 set heads [lreplace $desc_heads($do) $i $i]
5635 while {1} {
5636 set desc_heads($do) $heads
5637 set p $allparents($do)
5638 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5639 $desc_heads($p) ne $oldheads} break
5640 set do $p
5641 }
5642 set todo [concat $todo $p]
5643 }
5644}
5645
5646# update things for a head moved to a child of its previous location
5647proc movedhead {id name} {
5648 global headids idheads
5649
5650 set oldid $headids($name)
5651 set headids($name) $id
5652 if {$idheads($oldid) eq $name} {
5653 unset idheads($oldid)
5654 } else {
5655 set i [lsearch -exact $idheads($oldid) $name]
5656 if {$i >= 0} {
5657 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5658 }
5659 }
5660 lappend idheads($id) $name
5661}
5662
5663proc changedrefs {} {
5664 global desc_heads desc_tags anc_tags allcommits allids
5665 global allchildren allparents idtags travindex
5666
5667 if {![info exists allcommits]} return
5668 catch {unset desc_heads}
5669 catch {unset desc_tags}
5670 catch {unset anc_tags}
5671 catch {unset alldtags}
5672 catch {unset tagisdesc}
5673 foreach id $allids {
5674 forward_pass $id $allchildren($id)
5675 }
5676 if {$allcommits ne "reading"} {
5677 set travindex [llength $allids]
5678 if {$allcommits ne "traversing"} {
5679 set allcommits "traversing"
5680 after idle restartatags
5681 }
5682 }
5683}
5684
5685proc rereadrefs {} {
5686 global idtags idheads idotherrefs mainhead
5687
5688 set refids [concat [array names idtags] \
5689 [array names idheads] [array names idotherrefs]]
5690 foreach id $refids {
5691 if {![info exists ref($id)]} {
5692 set ref($id) [listrefs $id]
5693 }
5694 }
5695 set oldmainhead $mainhead
5696 readrefs
5697 changedrefs
5698 set refids [lsort -unique [concat $refids [array names idtags] \
5699 [array names idheads] [array names idotherrefs]]]
5700 foreach id $refids {
5701 set v [listrefs $id]
5702 if {![info exists ref($id)] || $ref($id) != $v ||
5703 ($id eq $oldmainhead && $id ne $mainhead) ||
5704 ($id eq $mainhead && $id ne $oldmainhead)} {
5705 redrawtags $id
5706 }
5707 }
5708}
5709
5710proc listrefs {id} {
5711 global idtags idheads idotherrefs
5712
5713 set x {}
5714 if {[info exists idtags($id)]} {
5715 set x $idtags($id)
5716 }
5717 set y {}
5718 if {[info exists idheads($id)]} {
5719 set y $idheads($id)
5720 }
5721 set z {}
5722 if {[info exists idotherrefs($id)]} {
5723 set z $idotherrefs($id)
5724 }
5725 return [list $x $y $z]
5726}
5727
5728proc showtag {tag isnew} {
5729 global ctext tagcontents tagids linknum
5730
5731 if {$isnew} {
5732 addtohistory [list showtag $tag 0]
5733 }
5734 $ctext conf -state normal
5735 clear_ctext
5736 set linknum 0
5737 if {[info exists tagcontents($tag)]} {
5738 set text $tagcontents($tag)
5739 } else {
5740 set text "Tag: $tag\nId: $tagids($tag)"
5741 }
5742 appendwithlinks $text {}
5743 $ctext conf -state disabled
5744 init_flist {}
5745}
5746
5747proc doquit {} {
5748 global stopped
5749 set stopped 100
5750 destroy .
5751}
5752
5753proc doprefs {} {
5754 global maxwidth maxgraphpct diffopts
5755 global oldprefs prefstop showneartags
5756 global bgcolor fgcolor ctext diffcolors
5757
5758 set top .gitkprefs
5759 set prefstop $top
5760 if {[winfo exists $top]} {
5761 raise $top
5762 return
5763 }
5764 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5765 set oldprefs($v) [set $v]
5766 }
5767 toplevel $top
5768 wm title $top "Gitk preferences"
5769 label $top.ldisp -text "Commit list display options"
5770 grid $top.ldisp - -sticky w -pady 10
5771 label $top.spacer -text " "
5772 label $top.maxwidthl -text "Maximum graph width (lines)" \
5773 -font optionfont
5774 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5775 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5776 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5777 -font optionfont
5778 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5779 grid x $top.maxpctl $top.maxpct -sticky w
5780
5781 label $top.ddisp -text "Diff display options"
5782 grid $top.ddisp - -sticky w -pady 10
5783 label $top.diffoptl -text "Options for diff program" \
5784 -font optionfont
5785 entry $top.diffopt -width 20 -textvariable diffopts
5786 grid x $top.diffoptl $top.diffopt -sticky w
5787 frame $top.ntag
5788 label $top.ntag.l -text "Display nearby tags" -font optionfont
5789 checkbutton $top.ntag.b -variable showneartags
5790 pack $top.ntag.b $top.ntag.l -side left
5791 grid x $top.ntag -sticky w
5792
5793 label $top.cdisp -text "Colors: press to choose"
5794 grid $top.cdisp - -sticky w -pady 10
5795 label $top.bg -padx 40 -relief sunk -background $bgcolor
5796 button $top.bgbut -text "Background" -font optionfont \
5797 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5798 grid x $top.bgbut $top.bg -sticky w
5799 label $top.fg -padx 40 -relief sunk -background $fgcolor
5800 button $top.fgbut -text "Foreground" -font optionfont \
5801 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5802 grid x $top.fgbut $top.fg -sticky w
5803 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5804 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5805 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5806 [list $ctext tag conf d0 -foreground]]
5807 grid x $top.diffoldbut $top.diffold -sticky w
5808 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5809 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5810 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5811 [list $ctext tag conf d1 -foreground]]
5812 grid x $top.diffnewbut $top.diffnew -sticky w
5813 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5814 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5815 -command [list choosecolor diffcolors 2 $top.hunksep \
5816 "diff hunk header" \
5817 [list $ctext tag conf hunksep -foreground]]
5818 grid x $top.hunksepbut $top.hunksep -sticky w
5819
5820 frame $top.buts
5821 button $top.buts.ok -text "OK" -command prefsok
5822 button $top.buts.can -text "Cancel" -command prefscan
5823 grid $top.buts.ok $top.buts.can
5824 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5825 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5826 grid $top.buts - - -pady 10 -sticky ew
5827}
5828
5829proc choosecolor {v vi w x cmd} {
5830 global $v
5831
5832 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5833 -title "Gitk: choose color for $x"]
5834 if {$c eq {}} return
5835 $w conf -background $c
5836 lset $v $vi $c
5837 eval $cmd $c
5838}
5839
5840proc setbg {c} {
5841 global bglist
5842
5843 foreach w $bglist {
5844 $w conf -background $c
5845 }
5846}
5847
5848proc setfg {c} {
5849 global fglist canv
5850
5851 foreach w $fglist {
5852 $w conf -foreground $c
5853 }
5854 allcanvs itemconf text -fill $c
5855 $canv itemconf circle -outline $c
5856}
5857
5858proc prefscan {} {
5859 global maxwidth maxgraphpct diffopts
5860 global oldprefs prefstop showneartags
5861
5862 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5863 set $v $oldprefs($v)
5864 }
5865 catch {destroy $prefstop}
5866 unset prefstop
5867}
5868
5869proc prefsok {} {
5870 global maxwidth maxgraphpct
5871 global oldprefs prefstop showneartags
5872
5873 catch {destroy $prefstop}
5874 unset prefstop
5875 if {$maxwidth != $oldprefs(maxwidth)
5876 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5877 redisplay
5878 } elseif {$showneartags != $oldprefs(showneartags)} {
5879 reselectline
5880 }
5881}
5882
5883proc formatdate {d} {
5884 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5885}
5886
5887# This list of encoding names and aliases is distilled from
5888# http://www.iana.org/assignments/character-sets.
5889# Not all of them are supported by Tcl.
5890set encoding_aliases {
5891 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5892 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5893 { ISO-10646-UTF-1 csISO10646UTF1 }
5894 { ISO_646.basic:1983 ref csISO646basic1983 }
5895 { INVARIANT csINVARIANT }
5896 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5897 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5898 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5899 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5900 { NATS-DANO iso-ir-9-1 csNATSDANO }
5901 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5902 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5903 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5904 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5905 { ISO-2022-KR csISO2022KR }
5906 { EUC-KR csEUCKR }
5907 { ISO-2022-JP csISO2022JP }
5908 { ISO-2022-JP-2 csISO2022JP2 }
5909 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5910 csISO13JISC6220jp }
5911 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5912 { IT iso-ir-15 ISO646-IT csISO15Italian }
5913 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5914 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5915 { greek7-old iso-ir-18 csISO18Greek7Old }
5916 { latin-greek iso-ir-19 csISO19LatinGreek }
5917 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5918 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5919 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5920 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5921 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5922 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5923 { INIS iso-ir-49 csISO49INIS }
5924 { INIS-8 iso-ir-50 csISO50INIS8 }
5925 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5926 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5927 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5928 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5929 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5930 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5931 csISO60Norwegian1 }
5932 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5933 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5934 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5935 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5936 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5937 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5938 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5939 { greek7 iso-ir-88 csISO88Greek7 }
5940 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5941 { iso-ir-90 csISO90 }
5942 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5943 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5944 csISO92JISC62991984b }
5945 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5946 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5947 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5948 csISO95JIS62291984handadd }
5949 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5950 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5951 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5952 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5953 CP819 csISOLatin1 }
5954 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5955 { T.61-7bit iso-ir-102 csISO102T617bit }
5956 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5957 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5958 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5959 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5960 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5961 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5962 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5963 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5964 arabic csISOLatinArabic }
5965 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5966 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5967 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5968 greek greek8 csISOLatinGreek }
5969 { T.101-G2 iso-ir-128 csISO128T101G2 }
5970 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5971 csISOLatinHebrew }
5972 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5973 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5974 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5975 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5976 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5977 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5978 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5979 csISOLatinCyrillic }
5980 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5981 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5982 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5983 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5984 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5985 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5986 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5987 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5988 { ISO_10367-box iso-ir-155 csISO10367Box }
5989 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5990 { latin-lap lap iso-ir-158 csISO158Lap }
5991 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5992 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5993 { us-dk csUSDK }
5994 { dk-us csDKUS }
5995 { JIS_X0201 X0201 csHalfWidthKatakana }
5996 { KSC5636 ISO646-KR csKSC5636 }
5997 { ISO-10646-UCS-2 csUnicode }
5998 { ISO-10646-UCS-4 csUCS4 }
5999 { DEC-MCS dec csDECMCS }
6000 { hp-roman8 roman8 r8 csHPRoman8 }
6001 { macintosh mac csMacintosh }
6002 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6003 csIBM037 }
6004 { IBM038 EBCDIC-INT cp038 csIBM038 }
6005 { IBM273 CP273 csIBM273 }
6006 { IBM274 EBCDIC-BE CP274 csIBM274 }
6007 { IBM275 EBCDIC-BR cp275 csIBM275 }
6008 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6009 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6010 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6011 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6012 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6013 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6014 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6015 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6016 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6017 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6018 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6019 { IBM437 cp437 437 csPC8CodePage437 }
6020 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6021 { IBM775 cp775 csPC775Baltic }
6022 { IBM850 cp850 850 csPC850Multilingual }
6023 { IBM851 cp851 851 csIBM851 }
6024 { IBM852 cp852 852 csPCp852 }
6025 { IBM855 cp855 855 csIBM855 }
6026 { IBM857 cp857 857 csIBM857 }
6027 { IBM860 cp860 860 csIBM860 }
6028 { IBM861 cp861 861 cp-is csIBM861 }
6029 { IBM862 cp862 862 csPC862LatinHebrew }
6030 { IBM863 cp863 863 csIBM863 }
6031 { IBM864 cp864 csIBM864 }
6032 { IBM865 cp865 865 csIBM865 }
6033 { IBM866 cp866 866 csIBM866 }
6034 { IBM868 CP868 cp-ar csIBM868 }
6035 { IBM869 cp869 869 cp-gr csIBM869 }
6036 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6037 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6038 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6039 { IBM891 cp891 csIBM891 }
6040 { IBM903 cp903 csIBM903 }
6041 { IBM904 cp904 904 csIBBM904 }
6042 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6043 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6044 { IBM1026 CP1026 csIBM1026 }
6045 { EBCDIC-AT-DE csIBMEBCDICATDE }
6046 { EBCDIC-AT-DE-A csEBCDICATDEA }
6047 { EBCDIC-CA-FR csEBCDICCAFR }
6048 { EBCDIC-DK-NO csEBCDICDKNO }
6049 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6050 { EBCDIC-FI-SE csEBCDICFISE }
6051 { EBCDIC-FI-SE-A csEBCDICFISEA }
6052 { EBCDIC-FR csEBCDICFR }
6053 { EBCDIC-IT csEBCDICIT }
6054 { EBCDIC-PT csEBCDICPT }
6055 { EBCDIC-ES csEBCDICES }
6056 { EBCDIC-ES-A csEBCDICESA }
6057 { EBCDIC-ES-S csEBCDICESS }
6058 { EBCDIC-UK csEBCDICUK }
6059 { EBCDIC-US csEBCDICUS }
6060 { UNKNOWN-8BIT csUnknown8BiT }
6061 { MNEMONIC csMnemonic }
6062 { MNEM csMnem }
6063 { VISCII csVISCII }
6064 { VIQR csVIQR }
6065 { KOI8-R csKOI8R }
6066 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6067 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6068 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6069 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6070 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6071 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6072 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6073 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6074 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6075 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6076 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6077 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6078 { IBM1047 IBM-1047 }
6079 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6080 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6081 { UNICODE-1-1 csUnicode11 }
6082 { CESU-8 csCESU-8 }
6083 { BOCU-1 csBOCU-1 }
6084 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6085 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6086 l8 }
6087 { ISO-8859-15 ISO_8859-15 Latin-9 }
6088 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6089 { GBK CP936 MS936 windows-936 }
6090 { JIS_Encoding csJISEncoding }
6091 { Shift_JIS MS_Kanji csShiftJIS }
6092 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6093 EUC-JP }
6094 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6095 { ISO-10646-UCS-Basic csUnicodeASCII }
6096 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6097 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6098 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6099 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6100 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6101 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6102 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6103 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6104 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6105 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6106 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6107 { Ventura-US csVenturaUS }
6108 { Ventura-International csVenturaInternational }
6109 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6110 { PC8-Turkish csPC8Turkish }
6111 { IBM-Symbols csIBMSymbols }
6112 { IBM-Thai csIBMThai }
6113 { HP-Legal csHPLegal }
6114 { HP-Pi-font csHPPiFont }
6115 { HP-Math8 csHPMath8 }
6116 { Adobe-Symbol-Encoding csHPPSMath }
6117 { HP-DeskTop csHPDesktop }
6118 { Ventura-Math csVenturaMath }
6119 { Microsoft-Publishing csMicrosoftPublishing }
6120 { Windows-31J csWindows31J }
6121 { GB2312 csGB2312 }
6122 { Big5 csBig5 }
6123}
6124
6125proc tcl_encoding {enc} {
6126 global encoding_aliases
6127 set names [encoding names]
6128 set lcnames [string tolower $names]
6129 set enc [string tolower $enc]
6130 set i [lsearch -exact $lcnames $enc]
6131 if {$i < 0} {
6132 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6133 if {[regsub {^iso[-_]} $enc iso encx]} {
6134 set i [lsearch -exact $lcnames $encx]
6135 }
6136 }
6137 if {$i < 0} {
6138 foreach l $encoding_aliases {
6139 set ll [string tolower $l]
6140 if {[lsearch -exact $ll $enc] < 0} continue
6141 # look through the aliases for one that tcl knows about
6142 foreach e $ll {
6143 set i [lsearch -exact $lcnames $e]
6144 if {$i < 0} {
6145 if {[regsub {^iso[-_]} $e iso ex]} {
6146 set i [lsearch -exact $lcnames $ex]
6147 }
6148 }
6149 if {$i >= 0} break
6150 }
6151 break
6152 }
6153 }
6154 if {$i >= 0} {
6155 return [lindex $names $i]
6156 }
6157 return {}
6158}
6159
6160# defaults...
6161set datemode 0
6162set diffopts "-U 5 -p"
6163set wrcomcmd "git diff-tree --stdin -p --pretty"
6164
6165set gitencoding {}
6166catch {
6167 set gitencoding [exec git repo-config --get i18n.commitencoding]
6168}
6169if {$gitencoding == ""} {
6170 set gitencoding "utf-8"
6171}
6172set tclencoding [tcl_encoding $gitencoding]
6173if {$tclencoding == {}} {
6174 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6175}
6176
6177set mainfont {Helvetica 9}
6178set textfont {Courier 9}
6179set uifont {Helvetica 9 bold}
6180set findmergefiles 0
6181set maxgraphpct 50
6182set maxwidth 16
6183set revlistorder 0
6184set fastdate 0
6185set uparrowlen 7
6186set downarrowlen 7
6187set mingaplen 30
6188set cmitmode "patch"
6189set wrapcomment "none"
6190set showneartags 1
6191
6192set colors {green red blue magenta darkgrey brown orange}
6193set bgcolor white
6194set fgcolor black
6195set diffcolors {red "#00a000" blue}
6196
6197catch {source ~/.gitk}
6198
6199font create optionfont -family sans-serif -size -12
6200
6201set revtreeargs {}
6202foreach arg $argv {
6203 switch -regexp -- $arg {
6204 "^$" { }
6205 "^-d" { set datemode 1 }
6206 default {
6207 lappend revtreeargs $arg
6208 }
6209 }
6210}
6211
6212# check that we can find a .git directory somewhere...
6213set gitdir [gitdir]
6214if {![file isdirectory $gitdir]} {
6215 show_error {} . "Cannot find the git directory \"$gitdir\"."
6216 exit 1
6217}
6218
6219set cmdline_files {}
6220set i [lsearch -exact $revtreeargs "--"]
6221if {$i >= 0} {
6222 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6223 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6224} elseif {$revtreeargs ne {}} {
6225 if {[catch {
6226 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6227 set cmdline_files [split $f "\n"]
6228 set n [llength $cmdline_files]
6229 set revtreeargs [lrange $revtreeargs 0 end-$n]
6230 } err]} {
6231 # unfortunately we get both stdout and stderr in $err,
6232 # so look for "fatal:".
6233 set i [string first "fatal:" $err]
6234 if {$i > 0} {
6235 set err [string range $err [expr {$i + 6}] end]
6236 }
6237 show_error {} . "Bad arguments to gitk:\n$err"
6238 exit 1
6239 }
6240}
6241
6242set history {}
6243set historyindex 0
6244set fh_serial 0
6245set nhl_names {}
6246set highlight_paths {}
6247set searchdirn -forwards
6248set boldrows {}
6249set boldnamerows {}
6250
6251set optim_delay 16
6252
6253set nextviewnum 1
6254set curview 0
6255set selectedview 0
6256set selectedhlview None
6257set viewfiles(0) {}
6258set viewperm(0) 0
6259set viewargs(0) {}
6260
6261set cmdlineok 0
6262set stopped 0
6263set stuffsaved 0
6264set patchnum 0
6265setcoords
6266makewindow
6267readrefs
6268
6269if {$cmdline_files ne {} || $revtreeargs ne {}} {
6270 # create a view for the files/dirs specified on the command line
6271 set curview 1
6272 set selectedview 1
6273 set nextviewnum 2
6274 set viewname(1) "Command line"
6275 set viewfiles(1) $cmdline_files
6276 set viewargs(1) $revtreeargs
6277 set viewperm(1) 0
6278 addviewmenu 1
6279 .bar.view entryconf 2 -state normal
6280 .bar.view entryconf 3 -state normal
6281}
6282
6283if {[info exists permviews]} {
6284 foreach v $permviews {
6285 set n $nextviewnum
6286 incr nextviewnum
6287 set viewname($n) [lindex $v 0]
6288 set viewfiles($n) [lindex $v 1]
6289 set viewargs($n) [lindex $v 2]
6290 set viewperm($n) 1
6291 addviewmenu $n
6292 }
6293}
6294getcommits