gitk: Add a row context-menu item for creating a new branch
[git/libgit-gsoc.git] / gitk
blob61106f2d37342255b431c421ed2ca2268acff52a
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc start_rev_list {view} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
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)]
32 set order "--topo-order"
33 if {$datemode} {
34 set order "--date-order"
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
43 set commfd($view) $fd
44 set leftover($view) {}
45 fconfigure $fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure $fd -encoding $tclencoding
49 fileevent $fd readable [list getcommitlines $fd $view]
50 nowbusy $view
53 proc stop_rev_list {} {
54 global commfd curview
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
58 catch {
59 set pid [pid $fd]
60 exec kill $pid
62 catch {close $fd}
63 unset commfd($curview)
66 proc getcommits {} {
67 global phase canv mainfont curview
69 set phase getcommits
70 initlayout
71 start_rev_list $curview
72 show_status "Reading commits..."
75 proc 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
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"
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.)"
103 } else {
104 set err "Error reading commits$fv: $err"
106 error_popup $err
108 if {$view == $curview} {
109 after idle finishcommits
111 return
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
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}]]
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]
138 set ok 1
139 foreach id $ids {
140 if {[string length $id] != 40} {
141 set ok 0
142 break
146 if {!$ok} {
147 set shortcmit $cmit
148 if {[string length $shortcmit] > 80} {
149 set shortcmit "[string range $shortcmit 0 80]..."
151 error_popup "Can't parse git rev-list output: {$shortcmit}"
152 exit 1
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
162 incr i
164 } else {
165 set olds {}
167 if {![info exists children($view,$id)]} {
168 set children($view,$id) {}
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
184 set gotsome 1
186 if {$gotsome} {
187 if {$view == $curview} {
188 layoutmore
189 } elseif {[info exists hlview] && $view == $hlview} {
190 vhighlightmore
193 if {[clock clicks -milliseconds] >= $nextupdate} {
194 doupdate
198 proc doupdate {} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v [array names commfd] {
202 fileevent $commfd($v) readable {}
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}]
213 foreach v [array names commfd] {
214 set fd $commfd($v)
215 fileevent $fd readable [list getcommitlines $fd $v]
219 proc readcommit {id} {
220 if {[catch {set contents [exec git cat-file commit $id]}]} return
221 parsecommit $id $contents 0
224 proc updatecommits {} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
228 if {$phase ne {}} {
229 stop_rev_list
230 set phase {}
232 set n $curview
233 foreach id $displayorder {
234 catch {unset children($n,$id)}
235 catch {unset commitrow($n,$id)}
237 set curview -1
238 catch {unset selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
241 discardallcommits
242 readrefs
243 showview $n
246 proc parsecommit {id contents listed} {
247 global commitinfo cdate
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]
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]
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
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"
290 set comment $newcomment
292 if {$comdate != {}} {
293 set cdate($id) $comdate
295 set commitinfo($id) [list $headline $auname $audate \
296 $comname $comdate $comment]
299 proc getcommit {id} {
300 global commitdata commitinfo
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"}
310 return 1
313 proc readrefs {} {
314 global tagids idtags headids idheads tagcontents
315 global otherrefids idotherrefs mainhead
317 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
318 catch {unset $v}
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
326 if {[regexp {^remotes/.*/HEAD$} $path match]} {
327 continue
329 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
330 set type others
331 set name $path
333 if {[regexp {^remotes/} $path match]} {
334 set type heads
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
349 catch {
350 set tagcontents($name) [exec git cat-file tag $id]
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
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]
370 proc 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
380 proc error_popup msg {
381 set w .error
382 toplevel $w
383 wm transient $w .
384 show_error $w $w $msg
387 proc makewindow {} {
388 global canv canv2 canv3 linespc charspc ctext cflist
389 global textfont mainfont uifont
390 global findtype findtypemenu findloc findstring fstring geometry
391 global entries sha1entry sha1string sha1but
392 global maincursor textcursor curtextcursor
393 global rowctxmenu mergemax wrapcomment
394 global highlight_files gdttype
395 global searchstring sstring
396 global bgcolor fgcolor bglist fglist diffcolors
398 menu .bar
399 .bar add cascade -label "File" -menu .bar.file
400 .bar configure -font $uifont
401 menu .bar.file
402 .bar.file add command -label "Update" -command updatecommits
403 .bar.file add command -label "Reread references" -command rereadrefs
404 .bar.file add command -label "Quit" -command doquit
405 .bar.file configure -font $uifont
406 menu .bar.edit
407 .bar add cascade -label "Edit" -menu .bar.edit
408 .bar.edit add command -label "Preferences" -command doprefs
409 .bar.edit configure -font $uifont
411 menu .bar.view -font $uifont
412 .bar add cascade -label "View" -menu .bar.view
413 .bar.view add command -label "New view..." -command {newview 0}
414 .bar.view add command -label "Edit view..." -command editview \
415 -state disabled
416 .bar.view add command -label "Delete view" -command delview -state disabled
417 .bar.view add separator
418 .bar.view add radiobutton -label "All files" -command {showview 0} \
419 -variable selectedview -value 0
421 menu .bar.help
422 .bar add cascade -label "Help" -menu .bar.help
423 .bar.help add command -label "About gitk" -command about
424 .bar.help add command -label "Key bindings" -command keys
425 .bar.help configure -font $uifont
426 . configure -menu .bar
428 if {![info exists geometry(canv1)]} {
429 set geometry(canv1) [expr {45 * $charspc}]
430 set geometry(canv2) [expr {30 * $charspc}]
431 set geometry(canv3) [expr {15 * $charspc}]
432 set geometry(canvh) [expr {25 * $linespc + 4}]
433 set geometry(ctextw) 80
434 set geometry(ctexth) 30
435 set geometry(cflistw) 30
437 panedwindow .ctop -orient vertical
438 if {[info exists geometry(width)]} {
439 .ctop conf -width $geometry(width) -height $geometry(height)
440 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
441 set geometry(ctexth) [expr {($texth - 8) /
442 [font metrics $textfont -linespace]}]
444 frame .ctop.top
445 frame .ctop.top.bar
446 frame .ctop.top.lbar
447 pack .ctop.top.lbar -side bottom -fill x
448 pack .ctop.top.bar -side bottom -fill x
449 set cscroll .ctop.top.csb
450 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
451 pack $cscroll -side right -fill y
452 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
453 pack .ctop.top.clist -side top -fill both -expand 1
454 .ctop add .ctop.top
455 set canv .ctop.top.clist.canv
456 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
457 -background $bgcolor -bd 0 \
458 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
459 .ctop.top.clist add $canv
460 set canv2 .ctop.top.clist.canv2
461 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
462 -background $bgcolor -bd 0 -yscrollincr $linespc
463 .ctop.top.clist add $canv2
464 set canv3 .ctop.top.clist.canv3
465 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
466 -background $bgcolor -bd 0 -yscrollincr $linespc
467 .ctop.top.clist add $canv3
468 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
469 lappend bglist $canv $canv2 $canv3
471 set sha1entry .ctop.top.bar.sha1
472 set entries $sha1entry
473 set sha1but .ctop.top.bar.sha1label
474 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
475 -command gotocommit -width 8 -font $uifont
476 $sha1but conf -disabledforeground [$sha1but cget -foreground]
477 pack .ctop.top.bar.sha1label -side left
478 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
479 trace add variable sha1string write sha1change
480 pack $sha1entry -side left -pady 2
482 image create bitmap bm-left -data {
483 #define left_width 16
484 #define left_height 16
485 static unsigned char left_bits[] = {
486 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
487 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
488 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
490 image create bitmap bm-right -data {
491 #define right_width 16
492 #define right_height 16
493 static unsigned char right_bits[] = {
494 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
495 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
496 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
498 button .ctop.top.bar.leftbut -image bm-left -command goback \
499 -state disabled -width 26
500 pack .ctop.top.bar.leftbut -side left -fill y
501 button .ctop.top.bar.rightbut -image bm-right -command goforw \
502 -state disabled -width 26
503 pack .ctop.top.bar.rightbut -side left -fill y
505 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
506 pack .ctop.top.bar.findbut -side left
507 set findstring {}
508 set fstring .ctop.top.bar.findstring
509 lappend entries $fstring
510 entry $fstring -width 30 -font $textfont -textvariable findstring
511 trace add variable findstring write find_change
512 pack $fstring -side left -expand 1 -fill x
513 set findtype Exact
514 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
515 findtype Exact IgnCase Regexp]
516 trace add variable findtype write find_change
517 .ctop.top.bar.findtype configure -font $uifont
518 .ctop.top.bar.findtype.menu configure -font $uifont
519 set findloc "All fields"
520 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
521 Comments Author Committer
522 trace add variable findloc write find_change
523 .ctop.top.bar.findloc configure -font $uifont
524 .ctop.top.bar.findloc.menu configure -font $uifont
525 pack .ctop.top.bar.findloc -side right
526 pack .ctop.top.bar.findtype -side right
528 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
529 -font $uifont
530 pack .ctop.top.lbar.flabel -side left -fill y
531 set gdttype "touching paths:"
532 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
533 "adding/removing string:"]
534 trace add variable gdttype write hfiles_change
535 $gm conf -font $uifont
536 .ctop.top.lbar.gdttype conf -font $uifont
537 pack .ctop.top.lbar.gdttype -side left -fill y
538 entry .ctop.top.lbar.fent -width 25 -font $textfont \
539 -textvariable highlight_files
540 trace add variable highlight_files write hfiles_change
541 lappend entries .ctop.top.lbar.fent
542 pack .ctop.top.lbar.fent -side left -fill x -expand 1
543 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
544 pack .ctop.top.lbar.vlabel -side left -fill y
545 global viewhlmenu selectedhlview
546 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
547 $viewhlmenu entryconf 0 -command delvhighlight
548 $viewhlmenu conf -font $uifont
549 .ctop.top.lbar.vhl conf -font $uifont
550 pack .ctop.top.lbar.vhl -side left -fill y
551 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
552 pack .ctop.top.lbar.rlabel -side left -fill y
553 global highlight_related
554 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
555 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
556 $m conf -font $uifont
557 .ctop.top.lbar.relm conf -font $uifont
558 trace add variable highlight_related write vrel_change
559 pack .ctop.top.lbar.relm -side left -fill y
561 panedwindow .ctop.cdet -orient horizontal
562 .ctop add .ctop.cdet
563 frame .ctop.cdet.left
564 frame .ctop.cdet.left.bot
565 pack .ctop.cdet.left.bot -side bottom -fill x
566 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
567 -font $uifont
568 pack .ctop.cdet.left.bot.search -side left -padx 5
569 set sstring .ctop.cdet.left.bot.sstring
570 entry $sstring -width 20 -font $textfont -textvariable searchstring
571 lappend entries $sstring
572 trace add variable searchstring write incrsearch
573 pack $sstring -side left -expand 1 -fill x
574 set ctext .ctop.cdet.left.ctext
575 text $ctext -background $bgcolor -foreground $fgcolor \
576 -state disabled -font $textfont \
577 -width $geometry(ctextw) -height $geometry(ctexth) \
578 -yscrollcommand scrolltext -wrap none
579 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
580 pack .ctop.cdet.left.sb -side right -fill y
581 pack $ctext -side left -fill both -expand 1
582 .ctop.cdet add .ctop.cdet.left
583 lappend bglist $ctext
584 lappend fglist $ctext
586 $ctext tag conf comment -wrap $wrapcomment
587 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
588 $ctext tag conf hunksep -fore [lindex $diffcolors 2]
589 $ctext tag conf d0 -fore [lindex $diffcolors 0]
590 $ctext tag conf d1 -fore [lindex $diffcolors 1]
591 $ctext tag conf m0 -fore red
592 $ctext tag conf m1 -fore blue
593 $ctext tag conf m2 -fore green
594 $ctext tag conf m3 -fore purple
595 $ctext tag conf m4 -fore brown
596 $ctext tag conf m5 -fore "#009090"
597 $ctext tag conf m6 -fore magenta
598 $ctext tag conf m7 -fore "#808000"
599 $ctext tag conf m8 -fore "#009000"
600 $ctext tag conf m9 -fore "#ff0080"
601 $ctext tag conf m10 -fore cyan
602 $ctext tag conf m11 -fore "#b07070"
603 $ctext tag conf m12 -fore "#70b0f0"
604 $ctext tag conf m13 -fore "#70f0b0"
605 $ctext tag conf m14 -fore "#f0b070"
606 $ctext tag conf m15 -fore "#ff70b0"
607 $ctext tag conf mmax -fore darkgrey
608 set mergemax 16
609 $ctext tag conf mresult -font [concat $textfont bold]
610 $ctext tag conf msep -font [concat $textfont bold]
611 $ctext tag conf found -back yellow
613 frame .ctop.cdet.right
614 frame .ctop.cdet.right.mode
615 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
616 -command reselectline -variable cmitmode -value "patch"
617 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
618 -command reselectline -variable cmitmode -value "tree"
619 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
620 pack .ctop.cdet.right.mode -side top -fill x
621 set cflist .ctop.cdet.right.cfiles
622 set indent [font measure $mainfont "nn"]
623 text $cflist -width $geometry(cflistw) \
624 -background $bgcolor -foreground $fgcolor \
625 -font $mainfont \
626 -tabs [list $indent [expr {2 * $indent}]] \
627 -yscrollcommand ".ctop.cdet.right.sb set" \
628 -cursor [. cget -cursor] \
629 -spacing1 1 -spacing3 1
630 lappend bglist $cflist
631 lappend fglist $cflist
632 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
633 pack .ctop.cdet.right.sb -side right -fill y
634 pack $cflist -side left -fill both -expand 1
635 $cflist tag configure highlight \
636 -background [$cflist cget -selectbackground]
637 $cflist tag configure bold -font [concat $mainfont bold]
638 .ctop.cdet add .ctop.cdet.right
639 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
641 pack .ctop -side top -fill both -expand 1
643 bindall <1> {selcanvline %W %x %y}
644 #bindall <B1-Motion> {selcanvline %W %x %y}
645 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
646 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
647 bindall <2> "canvscan mark %W %x %y"
648 bindall <B2-Motion> "canvscan dragto %W %x %y"
649 bindkey <Home> selfirstline
650 bindkey <End> sellastline
651 bind . <Key-Up> "selnextline -1"
652 bind . <Key-Down> "selnextline 1"
653 bind . <Shift-Key-Up> "next_highlight -1"
654 bind . <Shift-Key-Down> "next_highlight 1"
655 bindkey <Key-Right> "goforw"
656 bindkey <Key-Left> "goback"
657 bind . <Key-Prior> "selnextpage -1"
658 bind . <Key-Next> "selnextpage 1"
659 bind . <Control-Home> "allcanvs yview moveto 0.0"
660 bind . <Control-End> "allcanvs yview moveto 1.0"
661 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
662 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
663 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
664 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
665 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
666 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
667 bindkey <Key-space> "$ctext yview scroll 1 pages"
668 bindkey p "selnextline -1"
669 bindkey n "selnextline 1"
670 bindkey z "goback"
671 bindkey x "goforw"
672 bindkey i "selnextline -1"
673 bindkey k "selnextline 1"
674 bindkey j "goback"
675 bindkey l "goforw"
676 bindkey b "$ctext yview scroll -1 pages"
677 bindkey d "$ctext yview scroll 18 units"
678 bindkey u "$ctext yview scroll -18 units"
679 bindkey / {findnext 1}
680 bindkey <Key-Return> {findnext 0}
681 bindkey ? findprev
682 bindkey f nextfile
683 bind . <Control-q> doquit
684 bind . <Control-f> dofind
685 bind . <Control-g> {findnext 0}
686 bind . <Control-r> dosearchback
687 bind . <Control-s> dosearch
688 bind . <Control-equal> {incrfont 1}
689 bind . <Control-KP_Add> {incrfont 1}
690 bind . <Control-minus> {incrfont -1}
691 bind . <Control-KP_Subtract> {incrfont -1}
692 bind . <Destroy> {savestuff %W}
693 bind . <Button-1> "click %W"
694 bind $fstring <Key-Return> dofind
695 bind $sha1entry <Key-Return> gotocommit
696 bind $sha1entry <<PasteSelection>> clearsha1
697 bind $cflist <1> {sel_flist %W %x %y; break}
698 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
699 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
701 set maincursor [. cget -cursor]
702 set textcursor [$ctext cget -cursor]
703 set curtextcursor $textcursor
705 set rowctxmenu .rowctxmenu
706 menu $rowctxmenu -tearoff 0
707 $rowctxmenu add command -label "Diff this -> selected" \
708 -command {diffvssel 0}
709 $rowctxmenu add command -label "Diff selected -> this" \
710 -command {diffvssel 1}
711 $rowctxmenu add command -label "Make patch" -command mkpatch
712 $rowctxmenu add command -label "Create tag" -command mktag
713 $rowctxmenu add command -label "Write commit to file" -command writecommit
714 $rowctxmenu add command -label "Create new branch" -command mkbranch
717 # mouse-2 makes all windows scan vertically, but only the one
718 # the cursor is in scans horizontally
719 proc canvscan {op w x y} {
720 global canv canv2 canv3
721 foreach c [list $canv $canv2 $canv3] {
722 if {$c == $w} {
723 $c scan $op $x $y
724 } else {
725 $c scan $op 0 $y
730 proc scrollcanv {cscroll f0 f1} {
731 $cscroll set $f0 $f1
732 drawfrac $f0 $f1
733 flushhighlights
736 # when we make a key binding for the toplevel, make sure
737 # it doesn't get triggered when that key is pressed in the
738 # find string entry widget.
739 proc bindkey {ev script} {
740 global entries
741 bind . $ev $script
742 set escript [bind Entry $ev]
743 if {$escript == {}} {
744 set escript [bind Entry <Key>]
746 foreach e $entries {
747 bind $e $ev "$escript; break"
751 # set the focus back to the toplevel for any click outside
752 # the entry widgets
753 proc click {w} {
754 global entries
755 foreach e $entries {
756 if {$w == $e} return
758 focus .
761 proc savestuff {w} {
762 global canv canv2 canv3 ctext cflist mainfont textfont uifont
763 global stuffsaved findmergefiles maxgraphpct
764 global maxwidth showneartags
765 global viewname viewfiles viewargs viewperm nextviewnum
766 global cmitmode wrapcomment
767 global colors bgcolor fgcolor diffcolors
769 if {$stuffsaved} return
770 if {![winfo viewable .]} return
771 catch {
772 set f [open "~/.gitk-new" w]
773 puts $f [list set mainfont $mainfont]
774 puts $f [list set textfont $textfont]
775 puts $f [list set uifont $uifont]
776 puts $f [list set findmergefiles $findmergefiles]
777 puts $f [list set maxgraphpct $maxgraphpct]
778 puts $f [list set maxwidth $maxwidth]
779 puts $f [list set cmitmode $cmitmode]
780 puts $f [list set wrapcomment $wrapcomment]
781 puts $f [list set showneartags $showneartags]
782 puts $f [list set bgcolor $bgcolor]
783 puts $f [list set fgcolor $fgcolor]
784 puts $f [list set colors $colors]
785 puts $f [list set diffcolors $diffcolors]
786 puts $f "set geometry(width) [winfo width .ctop]"
787 puts $f "set geometry(height) [winfo height .ctop]"
788 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
789 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
790 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
791 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
792 set wid [expr {([winfo width $ctext] - 8) \
793 / [font measure $textfont "0"]}]
794 puts $f "set geometry(ctextw) $wid"
795 set wid [expr {([winfo width $cflist] - 11) \
796 / [font measure [$cflist cget -font] "0"]}]
797 puts $f "set geometry(cflistw) $wid"
798 puts -nonewline $f "set permviews {"
799 for {set v 0} {$v < $nextviewnum} {incr v} {
800 if {$viewperm($v)} {
801 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
804 puts $f "}"
805 close $f
806 file rename -force "~/.gitk-new" "~/.gitk"
808 set stuffsaved 1
811 proc resizeclistpanes {win w} {
812 global oldwidth
813 if {[info exists oldwidth($win)]} {
814 set s0 [$win sash coord 0]
815 set s1 [$win sash coord 1]
816 if {$w < 60} {
817 set sash0 [expr {int($w/2 - 2)}]
818 set sash1 [expr {int($w*5/6 - 2)}]
819 } else {
820 set factor [expr {1.0 * $w / $oldwidth($win)}]
821 set sash0 [expr {int($factor * [lindex $s0 0])}]
822 set sash1 [expr {int($factor * [lindex $s1 0])}]
823 if {$sash0 < 30} {
824 set sash0 30
826 if {$sash1 < $sash0 + 20} {
827 set sash1 [expr {$sash0 + 20}]
829 if {$sash1 > $w - 10} {
830 set sash1 [expr {$w - 10}]
831 if {$sash0 > $sash1 - 20} {
832 set sash0 [expr {$sash1 - 20}]
836 $win sash place 0 $sash0 [lindex $s0 1]
837 $win sash place 1 $sash1 [lindex $s1 1]
839 set oldwidth($win) $w
842 proc resizecdetpanes {win w} {
843 global oldwidth
844 if {[info exists oldwidth($win)]} {
845 set s0 [$win sash coord 0]
846 if {$w < 60} {
847 set sash0 [expr {int($w*3/4 - 2)}]
848 } else {
849 set factor [expr {1.0 * $w / $oldwidth($win)}]
850 set sash0 [expr {int($factor * [lindex $s0 0])}]
851 if {$sash0 < 45} {
852 set sash0 45
854 if {$sash0 > $w - 15} {
855 set sash0 [expr {$w - 15}]
858 $win sash place 0 $sash0 [lindex $s0 1]
860 set oldwidth($win) $w
863 proc allcanvs args {
864 global canv canv2 canv3
865 eval $canv $args
866 eval $canv2 $args
867 eval $canv3 $args
870 proc bindall {event action} {
871 global canv canv2 canv3
872 bind $canv $event $action
873 bind $canv2 $event $action
874 bind $canv3 $event $action
877 proc about {} {
878 set w .about
879 if {[winfo exists $w]} {
880 raise $w
881 return
883 toplevel $w
884 wm title $w "About gitk"
885 message $w.m -text {
886 Gitk - a commit viewer for git
888 Copyright © 2005-2006 Paul Mackerras
890 Use and redistribute under the terms of the GNU General Public License} \
891 -justify center -aspect 400
892 pack $w.m -side top -fill x -padx 20 -pady 20
893 button $w.ok -text Close -command "destroy $w"
894 pack $w.ok -side bottom
897 proc keys {} {
898 set w .keys
899 if {[winfo exists $w]} {
900 raise $w
901 return
903 toplevel $w
904 wm title $w "Gitk key bindings"
905 message $w.m -text {
906 Gitk key bindings:
908 <Ctrl-Q> Quit
909 <Home> Move to first commit
910 <End> Move to last commit
911 <Up>, p, i Move up one commit
912 <Down>, n, k Move down one commit
913 <Left>, z, j Go back in history list
914 <Right>, x, l Go forward in history list
915 <PageUp> Move up one page in commit list
916 <PageDown> Move down one page in commit list
917 <Ctrl-Home> Scroll to top of commit list
918 <Ctrl-End> Scroll to bottom of commit list
919 <Ctrl-Up> Scroll commit list up one line
920 <Ctrl-Down> Scroll commit list down one line
921 <Ctrl-PageUp> Scroll commit list up one page
922 <Ctrl-PageDown> Scroll commit list down one page
923 <Shift-Up> Move to previous highlighted line
924 <Shift-Down> Move to next highlighted line
925 <Delete>, b Scroll diff view up one page
926 <Backspace> Scroll diff view up one page
927 <Space> Scroll diff view down one page
928 u Scroll diff view up 18 lines
929 d Scroll diff view down 18 lines
930 <Ctrl-F> Find
931 <Ctrl-G> Move to next find hit
932 <Return> Move to next find hit
933 / Move to next find hit, or redo find
934 ? Move to previous find hit
935 f Scroll diff view to next file
936 <Ctrl-S> Search for next hit in diff view
937 <Ctrl-R> Search for previous hit in diff view
938 <Ctrl-KP+> Increase font size
939 <Ctrl-plus> Increase font size
940 <Ctrl-KP-> Decrease font size
941 <Ctrl-minus> Decrease font size
943 -justify left -bg white -border 2 -relief sunken
944 pack $w.m -side top -fill both
945 button $w.ok -text Close -command "destroy $w"
946 pack $w.ok -side bottom
949 # Procedures for manipulating the file list window at the
950 # bottom right of the overall window.
952 proc treeview {w l openlevs} {
953 global treecontents treediropen treeheight treeparent treeindex
955 set ix 0
956 set treeindex() 0
957 set lev 0
958 set prefix {}
959 set prefixend -1
960 set prefendstack {}
961 set htstack {}
962 set ht 0
963 set treecontents() {}
964 $w conf -state normal
965 foreach f $l {
966 while {[string range $f 0 $prefixend] ne $prefix} {
967 if {$lev <= $openlevs} {
968 $w mark set e:$treeindex($prefix) "end -1c"
969 $w mark gravity e:$treeindex($prefix) left
971 set treeheight($prefix) $ht
972 incr ht [lindex $htstack end]
973 set htstack [lreplace $htstack end end]
974 set prefixend [lindex $prefendstack end]
975 set prefendstack [lreplace $prefendstack end end]
976 set prefix [string range $prefix 0 $prefixend]
977 incr lev -1
979 set tail [string range $f [expr {$prefixend+1}] end]
980 while {[set slash [string first "/" $tail]] >= 0} {
981 lappend htstack $ht
982 set ht 0
983 lappend prefendstack $prefixend
984 incr prefixend [expr {$slash + 1}]
985 set d [string range $tail 0 $slash]
986 lappend treecontents($prefix) $d
987 set oldprefix $prefix
988 append prefix $d
989 set treecontents($prefix) {}
990 set treeindex($prefix) [incr ix]
991 set treeparent($prefix) $oldprefix
992 set tail [string range $tail [expr {$slash+1}] end]
993 if {$lev <= $openlevs} {
994 set ht 1
995 set treediropen($prefix) [expr {$lev < $openlevs}]
996 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
997 $w mark set d:$ix "end -1c"
998 $w mark gravity d:$ix left
999 set str "\n"
1000 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1001 $w insert end $str
1002 $w image create end -align center -image $bm -padx 1 \
1003 -name a:$ix
1004 $w insert end $d [highlight_tag $prefix]
1005 $w mark set s:$ix "end -1c"
1006 $w mark gravity s:$ix left
1008 incr lev
1010 if {$tail ne {}} {
1011 if {$lev <= $openlevs} {
1012 incr ht
1013 set str "\n"
1014 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1015 $w insert end $str
1016 $w insert end $tail [highlight_tag $f]
1018 lappend treecontents($prefix) $tail
1021 while {$htstack ne {}} {
1022 set treeheight($prefix) $ht
1023 incr ht [lindex $htstack end]
1024 set htstack [lreplace $htstack end end]
1026 $w conf -state disabled
1029 proc linetoelt {l} {
1030 global treeheight treecontents
1032 set y 2
1033 set prefix {}
1034 while {1} {
1035 foreach e $treecontents($prefix) {
1036 if {$y == $l} {
1037 return "$prefix$e"
1039 set n 1
1040 if {[string index $e end] eq "/"} {
1041 set n $treeheight($prefix$e)
1042 if {$y + $n > $l} {
1043 append prefix $e
1044 incr y
1045 break
1048 incr y $n
1053 proc highlight_tree {y prefix} {
1054 global treeheight treecontents cflist
1056 foreach e $treecontents($prefix) {
1057 set path $prefix$e
1058 if {[highlight_tag $path] ne {}} {
1059 $cflist tag add bold $y.0 "$y.0 lineend"
1061 incr y
1062 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1063 set y [highlight_tree $y $path]
1066 return $y
1069 proc treeclosedir {w dir} {
1070 global treediropen treeheight treeparent treeindex
1072 set ix $treeindex($dir)
1073 $w conf -state normal
1074 $w delete s:$ix e:$ix
1075 set treediropen($dir) 0
1076 $w image configure a:$ix -image tri-rt
1077 $w conf -state disabled
1078 set n [expr {1 - $treeheight($dir)}]
1079 while {$dir ne {}} {
1080 incr treeheight($dir) $n
1081 set dir $treeparent($dir)
1085 proc treeopendir {w dir} {
1086 global treediropen treeheight treeparent treecontents treeindex
1088 set ix $treeindex($dir)
1089 $w conf -state normal
1090 $w image configure a:$ix -image tri-dn
1091 $w mark set e:$ix s:$ix
1092 $w mark gravity e:$ix right
1093 set lev 0
1094 set str "\n"
1095 set n [llength $treecontents($dir)]
1096 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1097 incr lev
1098 append str "\t"
1099 incr treeheight($x) $n
1101 foreach e $treecontents($dir) {
1102 set de $dir$e
1103 if {[string index $e end] eq "/"} {
1104 set iy $treeindex($de)
1105 $w mark set d:$iy e:$ix
1106 $w mark gravity d:$iy left
1107 $w insert e:$ix $str
1108 set treediropen($de) 0
1109 $w image create e:$ix -align center -image tri-rt -padx 1 \
1110 -name a:$iy
1111 $w insert e:$ix $e [highlight_tag $de]
1112 $w mark set s:$iy e:$ix
1113 $w mark gravity s:$iy left
1114 set treeheight($de) 1
1115 } else {
1116 $w insert e:$ix $str
1117 $w insert e:$ix $e [highlight_tag $de]
1120 $w mark gravity e:$ix left
1121 $w conf -state disabled
1122 set treediropen($dir) 1
1123 set top [lindex [split [$w index @0,0] .] 0]
1124 set ht [$w cget -height]
1125 set l [lindex [split [$w index s:$ix] .] 0]
1126 if {$l < $top} {
1127 $w yview $l.0
1128 } elseif {$l + $n + 1 > $top + $ht} {
1129 set top [expr {$l + $n + 2 - $ht}]
1130 if {$l < $top} {
1131 set top $l
1133 $w yview $top.0
1137 proc treeclick {w x y} {
1138 global treediropen cmitmode ctext cflist cflist_top
1140 if {$cmitmode ne "tree"} return
1141 if {![info exists cflist_top]} return
1142 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1143 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1144 $cflist tag add highlight $l.0 "$l.0 lineend"
1145 set cflist_top $l
1146 if {$l == 1} {
1147 $ctext yview 1.0
1148 return
1150 set e [linetoelt $l]
1151 if {[string index $e end] ne "/"} {
1152 showfile $e
1153 } elseif {$treediropen($e)} {
1154 treeclosedir $w $e
1155 } else {
1156 treeopendir $w $e
1160 proc setfilelist {id} {
1161 global treefilelist cflist
1163 treeview $cflist $treefilelist($id) 0
1166 image create bitmap tri-rt -background black -foreground blue -data {
1167 #define tri-rt_width 13
1168 #define tri-rt_height 13
1169 static unsigned char tri-rt_bits[] = {
1170 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1171 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1172 0x00, 0x00};
1173 } -maskdata {
1174 #define tri-rt-mask_width 13
1175 #define tri-rt-mask_height 13
1176 static unsigned char tri-rt-mask_bits[] = {
1177 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1178 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1179 0x08, 0x00};
1181 image create bitmap tri-dn -background black -foreground blue -data {
1182 #define tri-dn_width 13
1183 #define tri-dn_height 13
1184 static unsigned char tri-dn_bits[] = {
1185 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1186 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1187 0x00, 0x00};
1188 } -maskdata {
1189 #define tri-dn-mask_width 13
1190 #define tri-dn-mask_height 13
1191 static unsigned char tri-dn-mask_bits[] = {
1192 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1193 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1194 0x00, 0x00};
1197 proc init_flist {first} {
1198 global cflist cflist_top selectedline difffilestart
1200 $cflist conf -state normal
1201 $cflist delete 0.0 end
1202 if {$first ne {}} {
1203 $cflist insert end $first
1204 set cflist_top 1
1205 $cflist tag add highlight 1.0 "1.0 lineend"
1206 } else {
1207 catch {unset cflist_top}
1209 $cflist conf -state disabled
1210 set difffilestart {}
1213 proc highlight_tag {f} {
1214 global highlight_paths
1216 foreach p $highlight_paths {
1217 if {[string match $p $f]} {
1218 return "bold"
1221 return {}
1224 proc highlight_filelist {} {
1225 global cmitmode cflist
1227 $cflist conf -state normal
1228 if {$cmitmode ne "tree"} {
1229 set end [lindex [split [$cflist index end] .] 0]
1230 for {set l 2} {$l < $end} {incr l} {
1231 set line [$cflist get $l.0 "$l.0 lineend"]
1232 if {[highlight_tag $line] ne {}} {
1233 $cflist tag add bold $l.0 "$l.0 lineend"
1236 } else {
1237 highlight_tree 2 {}
1239 $cflist conf -state disabled
1242 proc unhighlight_filelist {} {
1243 global cflist
1245 $cflist conf -state normal
1246 $cflist tag remove bold 1.0 end
1247 $cflist conf -state disabled
1250 proc add_flist {fl} {
1251 global cflist
1253 $cflist conf -state normal
1254 foreach f $fl {
1255 $cflist insert end "\n"
1256 $cflist insert end $f [highlight_tag $f]
1258 $cflist conf -state disabled
1261 proc sel_flist {w x y} {
1262 global ctext difffilestart cflist cflist_top cmitmode
1264 if {$cmitmode eq "tree"} return
1265 if {![info exists cflist_top]} return
1266 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1267 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1268 $cflist tag add highlight $l.0 "$l.0 lineend"
1269 set cflist_top $l
1270 if {$l == 1} {
1271 $ctext yview 1.0
1272 } else {
1273 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1277 # Functions for adding and removing shell-type quoting
1279 proc shellquote {str} {
1280 if {![string match "*\['\"\\ \t]*" $str]} {
1281 return $str
1283 if {![string match "*\['\"\\]*" $str]} {
1284 return "\"$str\""
1286 if {![string match "*'*" $str]} {
1287 return "'$str'"
1289 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1292 proc shellarglist {l} {
1293 set str {}
1294 foreach a $l {
1295 if {$str ne {}} {
1296 append str " "
1298 append str [shellquote $a]
1300 return $str
1303 proc shelldequote {str} {
1304 set ret {}
1305 set used -1
1306 while {1} {
1307 incr used
1308 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1309 append ret [string range $str $used end]
1310 set used [string length $str]
1311 break
1313 set first [lindex $first 0]
1314 set ch [string index $str $first]
1315 if {$first > $used} {
1316 append ret [string range $str $used [expr {$first - 1}]]
1317 set used $first
1319 if {$ch eq " " || $ch eq "\t"} break
1320 incr used
1321 if {$ch eq "'"} {
1322 set first [string first "'" $str $used]
1323 if {$first < 0} {
1324 error "unmatched single-quote"
1326 append ret [string range $str $used [expr {$first - 1}]]
1327 set used $first
1328 continue
1330 if {$ch eq "\\"} {
1331 if {$used >= [string length $str]} {
1332 error "trailing backslash"
1334 append ret [string index $str $used]
1335 continue
1337 # here ch == "\""
1338 while {1} {
1339 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1340 error "unmatched double-quote"
1342 set first [lindex $first 0]
1343 set ch [string index $str $first]
1344 if {$first > $used} {
1345 append ret [string range $str $used [expr {$first - 1}]]
1346 set used $first
1348 if {$ch eq "\""} break
1349 incr used
1350 append ret [string index $str $used]
1351 incr used
1354 return [list $used $ret]
1357 proc shellsplit {str} {
1358 set l {}
1359 while {1} {
1360 set str [string trimleft $str]
1361 if {$str eq {}} break
1362 set dq [shelldequote $str]
1363 set n [lindex $dq 0]
1364 set word [lindex $dq 1]
1365 set str [string range $str $n end]
1366 lappend l $word
1368 return $l
1371 # Code to implement multiple views
1373 proc newview {ishighlight} {
1374 global nextviewnum newviewname newviewperm uifont newishighlight
1375 global newviewargs revtreeargs
1377 set newishighlight $ishighlight
1378 set top .gitkview
1379 if {[winfo exists $top]} {
1380 raise $top
1381 return
1383 set newviewname($nextviewnum) "View $nextviewnum"
1384 set newviewperm($nextviewnum) 0
1385 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1386 vieweditor $top $nextviewnum "Gitk view definition"
1389 proc editview {} {
1390 global curview
1391 global viewname viewperm newviewname newviewperm
1392 global viewargs newviewargs
1394 set top .gitkvedit-$curview
1395 if {[winfo exists $top]} {
1396 raise $top
1397 return
1399 set newviewname($curview) $viewname($curview)
1400 set newviewperm($curview) $viewperm($curview)
1401 set newviewargs($curview) [shellarglist $viewargs($curview)]
1402 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1405 proc vieweditor {top n title} {
1406 global newviewname newviewperm viewfiles
1407 global uifont
1409 toplevel $top
1410 wm title $top $title
1411 label $top.nl -text "Name" -font $uifont
1412 entry $top.name -width 20 -textvariable newviewname($n)
1413 grid $top.nl $top.name -sticky w -pady 5
1414 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1415 grid $top.perm - -pady 5 -sticky w
1416 message $top.al -aspect 1000 -font $uifont \
1417 -text "Commits to include (arguments to git rev-list):"
1418 grid $top.al - -sticky w -pady 5
1419 entry $top.args -width 50 -textvariable newviewargs($n) \
1420 -background white
1421 grid $top.args - -sticky ew -padx 5
1422 message $top.l -aspect 1000 -font $uifont \
1423 -text "Enter files and directories to include, one per line:"
1424 grid $top.l - -sticky w
1425 text $top.t -width 40 -height 10 -background white
1426 if {[info exists viewfiles($n)]} {
1427 foreach f $viewfiles($n) {
1428 $top.t insert end $f
1429 $top.t insert end "\n"
1431 $top.t delete {end - 1c} end
1432 $top.t mark set insert 0.0
1434 grid $top.t - -sticky ew -padx 5
1435 frame $top.buts
1436 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1437 button $top.buts.can -text "Cancel" -command [list destroy $top]
1438 grid $top.buts.ok $top.buts.can
1439 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1440 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1441 grid $top.buts - -pady 10 -sticky ew
1442 focus $top.t
1445 proc doviewmenu {m first cmd op argv} {
1446 set nmenu [$m index end]
1447 for {set i $first} {$i <= $nmenu} {incr i} {
1448 if {[$m entrycget $i -command] eq $cmd} {
1449 eval $m $op $i $argv
1450 break
1455 proc allviewmenus {n op args} {
1456 global viewhlmenu
1458 doviewmenu .bar.view 7 [list showview $n] $op $args
1459 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1462 proc newviewok {top n} {
1463 global nextviewnum newviewperm newviewname newishighlight
1464 global viewname viewfiles viewperm selectedview curview
1465 global viewargs newviewargs viewhlmenu
1467 if {[catch {
1468 set newargs [shellsplit $newviewargs($n)]
1469 } err]} {
1470 error_popup "Error in commit selection arguments: $err"
1471 wm raise $top
1472 focus $top
1473 return
1475 set files {}
1476 foreach f [split [$top.t get 0.0 end] "\n"] {
1477 set ft [string trim $f]
1478 if {$ft ne {}} {
1479 lappend files $ft
1482 if {![info exists viewfiles($n)]} {
1483 # creating a new view
1484 incr nextviewnum
1485 set viewname($n) $newviewname($n)
1486 set viewperm($n) $newviewperm($n)
1487 set viewfiles($n) $files
1488 set viewargs($n) $newargs
1489 addviewmenu $n
1490 if {!$newishighlight} {
1491 after idle showview $n
1492 } else {
1493 after idle addvhighlight $n
1495 } else {
1496 # editing an existing view
1497 set viewperm($n) $newviewperm($n)
1498 if {$newviewname($n) ne $viewname($n)} {
1499 set viewname($n) $newviewname($n)
1500 doviewmenu .bar.view 7 [list showview $n] \
1501 entryconf [list -label $viewname($n)]
1502 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1503 entryconf [list -label $viewname($n) -value $viewname($n)]
1505 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1506 set viewfiles($n) $files
1507 set viewargs($n) $newargs
1508 if {$curview == $n} {
1509 after idle updatecommits
1513 catch {destroy $top}
1516 proc delview {} {
1517 global curview viewdata viewperm hlview selectedhlview
1519 if {$curview == 0} return
1520 if {[info exists hlview] && $hlview == $curview} {
1521 set selectedhlview None
1522 unset hlview
1524 allviewmenus $curview delete
1525 set viewdata($curview) {}
1526 set viewperm($curview) 0
1527 showview 0
1530 proc addviewmenu {n} {
1531 global viewname viewhlmenu
1533 .bar.view add radiobutton -label $viewname($n) \
1534 -command [list showview $n] -variable selectedview -value $n
1535 $viewhlmenu add radiobutton -label $viewname($n) \
1536 -command [list addvhighlight $n] -variable selectedhlview
1539 proc flatten {var} {
1540 global $var
1542 set ret {}
1543 foreach i [array names $var] {
1544 lappend ret $i [set $var\($i\)]
1546 return $ret
1549 proc unflatten {var l} {
1550 global $var
1552 catch {unset $var}
1553 foreach {i v} $l {
1554 set $var\($i\) $v
1558 proc showview {n} {
1559 global curview viewdata viewfiles
1560 global displayorder parentlist childlist rowidlist rowoffsets
1561 global colormap rowtextx commitrow nextcolor canvxmax
1562 global numcommits rowrangelist commitlisted idrowranges
1563 global selectedline currentid canv canvy0
1564 global matchinglines treediffs
1565 global pending_select phase
1566 global commitidx rowlaidout rowoptim linesegends
1567 global commfd nextupdate
1568 global selectedview
1569 global vparentlist vchildlist vdisporder vcmitlisted
1570 global hlview selectedhlview
1572 if {$n == $curview} return
1573 set selid {}
1574 if {[info exists selectedline]} {
1575 set selid $currentid
1576 set y [yc $selectedline]
1577 set ymax [lindex [$canv cget -scrollregion] 3]
1578 set span [$canv yview]
1579 set ytop [expr {[lindex $span 0] * $ymax}]
1580 set ybot [expr {[lindex $span 1] * $ymax}]
1581 if {$ytop < $y && $y < $ybot} {
1582 set yscreen [expr {$y - $ytop}]
1583 } else {
1584 set yscreen [expr {($ybot - $ytop) / 2}]
1587 unselectline
1588 normalline
1589 stopfindproc
1590 if {$curview >= 0} {
1591 set vparentlist($curview) $parentlist
1592 set vchildlist($curview) $childlist
1593 set vdisporder($curview) $displayorder
1594 set vcmitlisted($curview) $commitlisted
1595 if {$phase ne {}} {
1596 set viewdata($curview) \
1597 [list $phase $rowidlist $rowoffsets $rowrangelist \
1598 [flatten idrowranges] [flatten idinlist] \
1599 $rowlaidout $rowoptim $numcommits $linesegends]
1600 } elseif {![info exists viewdata($curview)]
1601 || [lindex $viewdata($curview) 0] ne {}} {
1602 set viewdata($curview) \
1603 [list {} $rowidlist $rowoffsets $rowrangelist]
1606 catch {unset matchinglines}
1607 catch {unset treediffs}
1608 clear_display
1609 if {[info exists hlview] && $hlview == $n} {
1610 unset hlview
1611 set selectedhlview None
1614 set curview $n
1615 set selectedview $n
1616 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1617 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1619 if {![info exists viewdata($n)]} {
1620 set pending_select $selid
1621 getcommits
1622 return
1625 set v $viewdata($n)
1626 set phase [lindex $v 0]
1627 set displayorder $vdisporder($n)
1628 set parentlist $vparentlist($n)
1629 set childlist $vchildlist($n)
1630 set commitlisted $vcmitlisted($n)
1631 set rowidlist [lindex $v 1]
1632 set rowoffsets [lindex $v 2]
1633 set rowrangelist [lindex $v 3]
1634 if {$phase eq {}} {
1635 set numcommits [llength $displayorder]
1636 catch {unset idrowranges}
1637 } else {
1638 unflatten idrowranges [lindex $v 4]
1639 unflatten idinlist [lindex $v 5]
1640 set rowlaidout [lindex $v 6]
1641 set rowoptim [lindex $v 7]
1642 set numcommits [lindex $v 8]
1643 set linesegends [lindex $v 9]
1646 catch {unset colormap}
1647 catch {unset rowtextx}
1648 set nextcolor 0
1649 set canvxmax [$canv cget -width]
1650 set curview $n
1651 set row 0
1652 setcanvscroll
1653 set yf 0
1654 set row 0
1655 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1656 set row $commitrow($n,$selid)
1657 # try to get the selected row in the same position on the screen
1658 set ymax [lindex [$canv cget -scrollregion] 3]
1659 set ytop [expr {[yc $row] - $yscreen}]
1660 if {$ytop < 0} {
1661 set ytop 0
1663 set yf [expr {$ytop * 1.0 / $ymax}]
1665 allcanvs yview moveto $yf
1666 drawvisible
1667 selectline $row 0
1668 if {$phase ne {}} {
1669 if {$phase eq "getcommits"} {
1670 show_status "Reading commits..."
1672 if {[info exists commfd($n)]} {
1673 layoutmore
1674 } else {
1675 finishcommits
1677 } elseif {$numcommits == 0} {
1678 show_status "No commits selected"
1682 # Stuff relating to the highlighting facility
1684 proc ishighlighted {row} {
1685 global vhighlights fhighlights nhighlights rhighlights
1687 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1688 return $nhighlights($row)
1690 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1691 return $vhighlights($row)
1693 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1694 return $fhighlights($row)
1696 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1697 return $rhighlights($row)
1699 return 0
1702 proc bolden {row font} {
1703 global canv linehtag selectedline boldrows
1705 lappend boldrows $row
1706 $canv itemconf $linehtag($row) -font $font
1707 if {[info exists selectedline] && $row == $selectedline} {
1708 $canv delete secsel
1709 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1710 -outline {{}} -tags secsel \
1711 -fill [$canv cget -selectbackground]]
1712 $canv lower $t
1716 proc bolden_name {row font} {
1717 global canv2 linentag selectedline boldnamerows
1719 lappend boldnamerows $row
1720 $canv2 itemconf $linentag($row) -font $font
1721 if {[info exists selectedline] && $row == $selectedline} {
1722 $canv2 delete secsel
1723 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1724 -outline {{}} -tags secsel \
1725 -fill [$canv2 cget -selectbackground]]
1726 $canv2 lower $t
1730 proc unbolden {} {
1731 global mainfont boldrows
1733 set stillbold {}
1734 foreach row $boldrows {
1735 if {![ishighlighted $row]} {
1736 bolden $row $mainfont
1737 } else {
1738 lappend stillbold $row
1741 set boldrows $stillbold
1744 proc addvhighlight {n} {
1745 global hlview curview viewdata vhl_done vhighlights commitidx
1747 if {[info exists hlview]} {
1748 delvhighlight
1750 set hlview $n
1751 if {$n != $curview && ![info exists viewdata($n)]} {
1752 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1753 set vparentlist($n) {}
1754 set vchildlist($n) {}
1755 set vdisporder($n) {}
1756 set vcmitlisted($n) {}
1757 start_rev_list $n
1759 set vhl_done $commitidx($hlview)
1760 if {$vhl_done > 0} {
1761 drawvisible
1765 proc delvhighlight {} {
1766 global hlview vhighlights
1768 if {![info exists hlview]} return
1769 unset hlview
1770 catch {unset vhighlights}
1771 unbolden
1774 proc vhighlightmore {} {
1775 global hlview vhl_done commitidx vhighlights
1776 global displayorder vdisporder curview mainfont
1778 set font [concat $mainfont bold]
1779 set max $commitidx($hlview)
1780 if {$hlview == $curview} {
1781 set disp $displayorder
1782 } else {
1783 set disp $vdisporder($hlview)
1785 set vr [visiblerows]
1786 set r0 [lindex $vr 0]
1787 set r1 [lindex $vr 1]
1788 for {set i $vhl_done} {$i < $max} {incr i} {
1789 set id [lindex $disp $i]
1790 if {[info exists commitrow($curview,$id)]} {
1791 set row $commitrow($curview,$id)
1792 if {$r0 <= $row && $row <= $r1} {
1793 if {![highlighted $row]} {
1794 bolden $row $font
1796 set vhighlights($row) 1
1800 set vhl_done $max
1803 proc askvhighlight {row id} {
1804 global hlview vhighlights commitrow iddrawn mainfont
1806 if {[info exists commitrow($hlview,$id)]} {
1807 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1808 bolden $row [concat $mainfont bold]
1810 set vhighlights($row) 1
1811 } else {
1812 set vhighlights($row) 0
1816 proc hfiles_change {name ix op} {
1817 global highlight_files filehighlight fhighlights fh_serial
1818 global mainfont highlight_paths
1820 if {[info exists filehighlight]} {
1821 # delete previous highlights
1822 catch {close $filehighlight}
1823 unset filehighlight
1824 catch {unset fhighlights}
1825 unbolden
1826 unhighlight_filelist
1828 set highlight_paths {}
1829 after cancel do_file_hl $fh_serial
1830 incr fh_serial
1831 if {$highlight_files ne {}} {
1832 after 300 do_file_hl $fh_serial
1836 proc makepatterns {l} {
1837 set ret {}
1838 foreach e $l {
1839 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1840 if {[string index $ee end] eq "/"} {
1841 lappend ret "$ee*"
1842 } else {
1843 lappend ret $ee
1844 lappend ret "$ee/*"
1847 return $ret
1850 proc do_file_hl {serial} {
1851 global highlight_files filehighlight highlight_paths gdttype fhl_list
1853 if {$gdttype eq "touching paths:"} {
1854 if {[catch {set paths [shellsplit $highlight_files]}]} return
1855 set highlight_paths [makepatterns $paths]
1856 highlight_filelist
1857 set gdtargs [concat -- $paths]
1858 } else {
1859 set gdtargs [list "-S$highlight_files"]
1861 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1862 set filehighlight [open $cmd r+]
1863 fconfigure $filehighlight -blocking 0
1864 fileevent $filehighlight readable readfhighlight
1865 set fhl_list {}
1866 drawvisible
1867 flushhighlights
1870 proc flushhighlights {} {
1871 global filehighlight fhl_list
1873 if {[info exists filehighlight]} {
1874 lappend fhl_list {}
1875 puts $filehighlight ""
1876 flush $filehighlight
1880 proc askfilehighlight {row id} {
1881 global filehighlight fhighlights fhl_list
1883 lappend fhl_list $id
1884 set fhighlights($row) -1
1885 puts $filehighlight $id
1888 proc readfhighlight {} {
1889 global filehighlight fhighlights commitrow curview mainfont iddrawn
1890 global fhl_list
1892 while {[gets $filehighlight line] >= 0} {
1893 set line [string trim $line]
1894 set i [lsearch -exact $fhl_list $line]
1895 if {$i < 0} continue
1896 for {set j 0} {$j < $i} {incr j} {
1897 set id [lindex $fhl_list $j]
1898 if {[info exists commitrow($curview,$id)]} {
1899 set fhighlights($commitrow($curview,$id)) 0
1902 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1903 if {$line eq {}} continue
1904 if {![info exists commitrow($curview,$line)]} continue
1905 set row $commitrow($curview,$line)
1906 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1907 bolden $row [concat $mainfont bold]
1909 set fhighlights($row) 1
1911 if {[eof $filehighlight]} {
1912 # strange...
1913 puts "oops, git-diff-tree died"
1914 catch {close $filehighlight}
1915 unset filehighlight
1917 next_hlcont
1920 proc find_change {name ix op} {
1921 global nhighlights mainfont boldnamerows
1922 global findstring findpattern findtype
1924 # delete previous highlights, if any
1925 foreach row $boldnamerows {
1926 bolden_name $row $mainfont
1928 set boldnamerows {}
1929 catch {unset nhighlights}
1930 unbolden
1931 if {$findtype ne "Regexp"} {
1932 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1933 $findstring]
1934 set findpattern "*$e*"
1936 drawvisible
1939 proc askfindhighlight {row id} {
1940 global nhighlights commitinfo iddrawn mainfont
1941 global findstring findtype findloc findpattern
1943 if {![info exists commitinfo($id)]} {
1944 getcommit $id
1946 set info $commitinfo($id)
1947 set isbold 0
1948 set fldtypes {Headline Author Date Committer CDate Comments}
1949 foreach f $info ty $fldtypes {
1950 if {$findloc ne "All fields" && $findloc ne $ty} {
1951 continue
1953 if {$findtype eq "Regexp"} {
1954 set doesmatch [regexp $findstring $f]
1955 } elseif {$findtype eq "IgnCase"} {
1956 set doesmatch [string match -nocase $findpattern $f]
1957 } else {
1958 set doesmatch [string match $findpattern $f]
1960 if {$doesmatch} {
1961 if {$ty eq "Author"} {
1962 set isbold 2
1963 } else {
1964 set isbold 1
1968 if {[info exists iddrawn($id)]} {
1969 if {$isbold && ![ishighlighted $row]} {
1970 bolden $row [concat $mainfont bold]
1972 if {$isbold >= 2} {
1973 bolden_name $row [concat $mainfont bold]
1976 set nhighlights($row) $isbold
1979 proc vrel_change {name ix op} {
1980 global highlight_related
1982 rhighlight_none
1983 if {$highlight_related ne "None"} {
1984 after idle drawvisible
1988 # prepare for testing whether commits are descendents or ancestors of a
1989 proc rhighlight_sel {a} {
1990 global descendent desc_todo ancestor anc_todo
1991 global highlight_related rhighlights
1993 catch {unset descendent}
1994 set desc_todo [list $a]
1995 catch {unset ancestor}
1996 set anc_todo [list $a]
1997 if {$highlight_related ne "None"} {
1998 rhighlight_none
1999 after idle drawvisible
2003 proc rhighlight_none {} {
2004 global rhighlights
2006 catch {unset rhighlights}
2007 unbolden
2010 proc is_descendent {a} {
2011 global curview children commitrow descendent desc_todo
2013 set v $curview
2014 set la $commitrow($v,$a)
2015 set todo $desc_todo
2016 set leftover {}
2017 set done 0
2018 for {set i 0} {$i < [llength $todo]} {incr i} {
2019 set do [lindex $todo $i]
2020 if {$commitrow($v,$do) < $la} {
2021 lappend leftover $do
2022 continue
2024 foreach nk $children($v,$do) {
2025 if {![info exists descendent($nk)]} {
2026 set descendent($nk) 1
2027 lappend todo $nk
2028 if {$nk eq $a} {
2029 set done 1
2033 if {$done} {
2034 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2035 return
2038 set descendent($a) 0
2039 set desc_todo $leftover
2042 proc is_ancestor {a} {
2043 global curview parentlist commitrow ancestor anc_todo
2045 set v $curview
2046 set la $commitrow($v,$a)
2047 set todo $anc_todo
2048 set leftover {}
2049 set done 0
2050 for {set i 0} {$i < [llength $todo]} {incr i} {
2051 set do [lindex $todo $i]
2052 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2053 lappend leftover $do
2054 continue
2056 foreach np [lindex $parentlist $commitrow($v,$do)] {
2057 if {![info exists ancestor($np)]} {
2058 set ancestor($np) 1
2059 lappend todo $np
2060 if {$np eq $a} {
2061 set done 1
2065 if {$done} {
2066 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2067 return
2070 set ancestor($a) 0
2071 set anc_todo $leftover
2074 proc askrelhighlight {row id} {
2075 global descendent highlight_related iddrawn mainfont rhighlights
2076 global selectedline ancestor
2078 if {![info exists selectedline]} return
2079 set isbold 0
2080 if {$highlight_related eq "Descendent" ||
2081 $highlight_related eq "Not descendent"} {
2082 if {![info exists descendent($id)]} {
2083 is_descendent $id
2085 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2086 set isbold 1
2088 } elseif {$highlight_related eq "Ancestor" ||
2089 $highlight_related eq "Not ancestor"} {
2090 if {![info exists ancestor($id)]} {
2091 is_ancestor $id
2093 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2094 set isbold 1
2097 if {[info exists iddrawn($id)]} {
2098 if {$isbold && ![ishighlighted $row]} {
2099 bolden $row [concat $mainfont bold]
2102 set rhighlights($row) $isbold
2105 proc next_hlcont {} {
2106 global fhl_row fhl_dirn displayorder numcommits
2107 global vhighlights fhighlights nhighlights rhighlights
2108 global hlview filehighlight findstring highlight_related
2110 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2111 set row $fhl_row
2112 while {1} {
2113 if {$row < 0 || $row >= $numcommits} {
2114 bell
2115 set fhl_dirn 0
2116 return
2118 set id [lindex $displayorder $row]
2119 if {[info exists hlview]} {
2120 if {![info exists vhighlights($row)]} {
2121 askvhighlight $row $id
2123 if {$vhighlights($row) > 0} break
2125 if {$findstring ne {}} {
2126 if {![info exists nhighlights($row)]} {
2127 askfindhighlight $row $id
2129 if {$nhighlights($row) > 0} break
2131 if {$highlight_related ne "None"} {
2132 if {![info exists rhighlights($row)]} {
2133 askrelhighlight $row $id
2135 if {$rhighlights($row) > 0} break
2137 if {[info exists filehighlight]} {
2138 if {![info exists fhighlights($row)]} {
2139 # ask for a few more while we're at it...
2140 set r $row
2141 for {set n 0} {$n < 100} {incr n} {
2142 if {![info exists fhighlights($r)]} {
2143 askfilehighlight $r [lindex $displayorder $r]
2145 incr r $fhl_dirn
2146 if {$r < 0 || $r >= $numcommits} break
2148 flushhighlights
2150 if {$fhighlights($row) < 0} {
2151 set fhl_row $row
2152 return
2154 if {$fhighlights($row) > 0} break
2156 incr row $fhl_dirn
2158 set fhl_dirn 0
2159 selectline $row 1
2162 proc next_highlight {dirn} {
2163 global selectedline fhl_row fhl_dirn
2164 global hlview filehighlight findstring highlight_related
2166 if {![info exists selectedline]} return
2167 if {!([info exists hlview] || $findstring ne {} ||
2168 $highlight_related ne "None" || [info exists filehighlight])} return
2169 set fhl_row [expr {$selectedline + $dirn}]
2170 set fhl_dirn $dirn
2171 next_hlcont
2174 proc cancel_next_highlight {} {
2175 global fhl_dirn
2177 set fhl_dirn 0
2180 # Graph layout functions
2182 proc shortids {ids} {
2183 set res {}
2184 foreach id $ids {
2185 if {[llength $id] > 1} {
2186 lappend res [shortids $id]
2187 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2188 lappend res [string range $id 0 7]
2189 } else {
2190 lappend res $id
2193 return $res
2196 proc incrange {l x o} {
2197 set n [llength $l]
2198 while {$x < $n} {
2199 set e [lindex $l $x]
2200 if {$e ne {}} {
2201 lset l $x [expr {$e + $o}]
2203 incr x
2205 return $l
2208 proc ntimes {n o} {
2209 set ret {}
2210 for {} {$n > 0} {incr n -1} {
2211 lappend ret $o
2213 return $ret
2216 proc usedinrange {id l1 l2} {
2217 global children commitrow childlist curview
2219 if {[info exists commitrow($curview,$id)]} {
2220 set r $commitrow($curview,$id)
2221 if {$l1 <= $r && $r <= $l2} {
2222 return [expr {$r - $l1 + 1}]
2224 set kids [lindex $childlist $r]
2225 } else {
2226 set kids $children($curview,$id)
2228 foreach c $kids {
2229 set r $commitrow($curview,$c)
2230 if {$l1 <= $r && $r <= $l2} {
2231 return [expr {$r - $l1 + 1}]
2234 return 0
2237 proc sanity {row {full 0}} {
2238 global rowidlist rowoffsets
2240 set col -1
2241 set ids [lindex $rowidlist $row]
2242 foreach id $ids {
2243 incr col
2244 if {$id eq {}} continue
2245 if {$col < [llength $ids] - 1 &&
2246 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2247 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2249 set o [lindex $rowoffsets $row $col]
2250 set y $row
2251 set x $col
2252 while {$o ne {}} {
2253 incr y -1
2254 incr x $o
2255 if {[lindex $rowidlist $y $x] != $id} {
2256 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2257 puts " id=[shortids $id] check started at row $row"
2258 for {set i $row} {$i >= $y} {incr i -1} {
2259 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2261 break
2263 if {!$full} break
2264 set o [lindex $rowoffsets $y $x]
2269 proc makeuparrow {oid x y z} {
2270 global rowidlist rowoffsets uparrowlen idrowranges
2272 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2273 incr y -1
2274 incr x $z
2275 set off0 [lindex $rowoffsets $y]
2276 for {set x0 $x} {1} {incr x0} {
2277 if {$x0 >= [llength $off0]} {
2278 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2279 break
2281 set z [lindex $off0 $x0]
2282 if {$z ne {}} {
2283 incr x0 $z
2284 break
2287 set z [expr {$x0 - $x}]
2288 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2289 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2291 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2292 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2293 lappend idrowranges($oid) $y
2296 proc initlayout {} {
2297 global rowidlist rowoffsets displayorder commitlisted
2298 global rowlaidout rowoptim
2299 global idinlist rowchk rowrangelist idrowranges
2300 global numcommits canvxmax canv
2301 global nextcolor
2302 global parentlist childlist children
2303 global colormap rowtextx
2304 global linesegends
2306 set numcommits 0
2307 set displayorder {}
2308 set commitlisted {}
2309 set parentlist {}
2310 set childlist {}
2311 set rowrangelist {}
2312 set nextcolor 0
2313 set rowidlist {{}}
2314 set rowoffsets {{}}
2315 catch {unset idinlist}
2316 catch {unset rowchk}
2317 set rowlaidout 0
2318 set rowoptim 0
2319 set canvxmax [$canv cget -width]
2320 catch {unset colormap}
2321 catch {unset rowtextx}
2322 catch {unset idrowranges}
2323 set linesegends {}
2326 proc setcanvscroll {} {
2327 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2329 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2330 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2331 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2332 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2335 proc visiblerows {} {
2336 global canv numcommits linespc
2338 set ymax [lindex [$canv cget -scrollregion] 3]
2339 if {$ymax eq {} || $ymax == 0} return
2340 set f [$canv yview]
2341 set y0 [expr {int([lindex $f 0] * $ymax)}]
2342 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2343 if {$r0 < 0} {
2344 set r0 0
2346 set y1 [expr {int([lindex $f 1] * $ymax)}]
2347 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2348 if {$r1 >= $numcommits} {
2349 set r1 [expr {$numcommits - 1}]
2351 return [list $r0 $r1]
2354 proc layoutmore {} {
2355 global rowlaidout rowoptim commitidx numcommits optim_delay
2356 global uparrowlen curview
2358 set row $rowlaidout
2359 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2360 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2361 if {$orow > $rowoptim} {
2362 optimize_rows $rowoptim 0 $orow
2363 set rowoptim $orow
2365 set canshow [expr {$rowoptim - $optim_delay}]
2366 if {$canshow > $numcommits} {
2367 showstuff $canshow
2371 proc showstuff {canshow} {
2372 global numcommits commitrow pending_select selectedline
2373 global linesegends idrowranges idrangedrawn curview
2375 if {$numcommits == 0} {
2376 global phase
2377 set phase "incrdraw"
2378 allcanvs delete all
2380 set row $numcommits
2381 set numcommits $canshow
2382 setcanvscroll
2383 set rows [visiblerows]
2384 set r0 [lindex $rows 0]
2385 set r1 [lindex $rows 1]
2386 set selrow -1
2387 for {set r $row} {$r < $canshow} {incr r} {
2388 foreach id [lindex $linesegends [expr {$r+1}]] {
2389 set i -1
2390 foreach {s e} [rowranges $id] {
2391 incr i
2392 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2393 && ![info exists idrangedrawn($id,$i)]} {
2394 drawlineseg $id $i
2395 set idrangedrawn($id,$i) 1
2400 if {$canshow > $r1} {
2401 set canshow $r1
2403 while {$row < $canshow} {
2404 drawcmitrow $row
2405 incr row
2407 if {[info exists pending_select] &&
2408 [info exists commitrow($curview,$pending_select)] &&
2409 $commitrow($curview,$pending_select) < $numcommits} {
2410 selectline $commitrow($curview,$pending_select) 1
2412 if {![info exists selectedline] && ![info exists pending_select]} {
2413 selectline 0 1
2417 proc layoutrows {row endrow last} {
2418 global rowidlist rowoffsets displayorder
2419 global uparrowlen downarrowlen maxwidth mingaplen
2420 global childlist parentlist
2421 global idrowranges linesegends
2422 global commitidx curview
2423 global idinlist rowchk rowrangelist
2425 set idlist [lindex $rowidlist $row]
2426 set offs [lindex $rowoffsets $row]
2427 while {$row < $endrow} {
2428 set id [lindex $displayorder $row]
2429 set oldolds {}
2430 set newolds {}
2431 foreach p [lindex $parentlist $row] {
2432 if {![info exists idinlist($p)]} {
2433 lappend newolds $p
2434 } elseif {!$idinlist($p)} {
2435 lappend oldolds $p
2438 set lse {}
2439 set nev [expr {[llength $idlist] + [llength $newolds]
2440 + [llength $oldolds] - $maxwidth + 1}]
2441 if {$nev > 0} {
2442 if {!$last &&
2443 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2444 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2445 set i [lindex $idlist $x]
2446 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2447 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2448 [expr {$row + $uparrowlen + $mingaplen}]]
2449 if {$r == 0} {
2450 set idlist [lreplace $idlist $x $x]
2451 set offs [lreplace $offs $x $x]
2452 set offs [incrange $offs $x 1]
2453 set idinlist($i) 0
2454 set rm1 [expr {$row - 1}]
2455 lappend lse $i
2456 lappend idrowranges($i) $rm1
2457 if {[incr nev -1] <= 0} break
2458 continue
2460 set rowchk($id) [expr {$row + $r}]
2463 lset rowidlist $row $idlist
2464 lset rowoffsets $row $offs
2466 lappend linesegends $lse
2467 set col [lsearch -exact $idlist $id]
2468 if {$col < 0} {
2469 set col [llength $idlist]
2470 lappend idlist $id
2471 lset rowidlist $row $idlist
2472 set z {}
2473 if {[lindex $childlist $row] ne {}} {
2474 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2475 unset idinlist($id)
2477 lappend offs $z
2478 lset rowoffsets $row $offs
2479 if {$z ne {}} {
2480 makeuparrow $id $col $row $z
2482 } else {
2483 unset idinlist($id)
2485 set ranges {}
2486 if {[info exists idrowranges($id)]} {
2487 set ranges $idrowranges($id)
2488 lappend ranges $row
2489 unset idrowranges($id)
2491 lappend rowrangelist $ranges
2492 incr row
2493 set offs [ntimes [llength $idlist] 0]
2494 set l [llength $newolds]
2495 set idlist [eval lreplace \$idlist $col $col $newolds]
2496 set o 0
2497 if {$l != 1} {
2498 set offs [lrange $offs 0 [expr {$col - 1}]]
2499 foreach x $newolds {
2500 lappend offs {}
2501 incr o -1
2503 incr o
2504 set tmp [expr {[llength $idlist] - [llength $offs]}]
2505 if {$tmp > 0} {
2506 set offs [concat $offs [ntimes $tmp $o]]
2508 } else {
2509 lset offs $col {}
2511 foreach i $newolds {
2512 set idinlist($i) 1
2513 set idrowranges($i) $row
2515 incr col $l
2516 foreach oid $oldolds {
2517 set idinlist($oid) 1
2518 set idlist [linsert $idlist $col $oid]
2519 set offs [linsert $offs $col $o]
2520 makeuparrow $oid $col $row $o
2521 incr col
2523 lappend rowidlist $idlist
2524 lappend rowoffsets $offs
2526 return $row
2529 proc addextraid {id row} {
2530 global displayorder commitrow commitinfo
2531 global commitidx commitlisted
2532 global parentlist childlist children curview
2534 incr commitidx($curview)
2535 lappend displayorder $id
2536 lappend commitlisted 0
2537 lappend parentlist {}
2538 set commitrow($curview,$id) $row
2539 readcommit $id
2540 if {![info exists commitinfo($id)]} {
2541 set commitinfo($id) {"No commit information available"}
2543 if {![info exists children($curview,$id)]} {
2544 set children($curview,$id) {}
2546 lappend childlist $children($curview,$id)
2549 proc layouttail {} {
2550 global rowidlist rowoffsets idinlist commitidx curview
2551 global idrowranges rowrangelist
2553 set row $commitidx($curview)
2554 set idlist [lindex $rowidlist $row]
2555 while {$idlist ne {}} {
2556 set col [expr {[llength $idlist] - 1}]
2557 set id [lindex $idlist $col]
2558 addextraid $id $row
2559 unset idinlist($id)
2560 lappend idrowranges($id) $row
2561 lappend rowrangelist $idrowranges($id)
2562 unset idrowranges($id)
2563 incr row
2564 set offs [ntimes $col 0]
2565 set idlist [lreplace $idlist $col $col]
2566 lappend rowidlist $idlist
2567 lappend rowoffsets $offs
2570 foreach id [array names idinlist] {
2571 addextraid $id $row
2572 lset rowidlist $row [list $id]
2573 lset rowoffsets $row 0
2574 makeuparrow $id 0 $row 0
2575 lappend idrowranges($id) $row
2576 lappend rowrangelist $idrowranges($id)
2577 unset idrowranges($id)
2578 incr row
2579 lappend rowidlist {}
2580 lappend rowoffsets {}
2584 proc insert_pad {row col npad} {
2585 global rowidlist rowoffsets
2587 set pad [ntimes $npad {}]
2588 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2589 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2590 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2593 proc optimize_rows {row col endrow} {
2594 global rowidlist rowoffsets idrowranges displayorder
2596 for {} {$row < $endrow} {incr row} {
2597 set idlist [lindex $rowidlist $row]
2598 set offs [lindex $rowoffsets $row]
2599 set haspad 0
2600 for {} {$col < [llength $offs]} {incr col} {
2601 if {[lindex $idlist $col] eq {}} {
2602 set haspad 1
2603 continue
2605 set z [lindex $offs $col]
2606 if {$z eq {}} continue
2607 set isarrow 0
2608 set x0 [expr {$col + $z}]
2609 set y0 [expr {$row - 1}]
2610 set z0 [lindex $rowoffsets $y0 $x0]
2611 if {$z0 eq {}} {
2612 set id [lindex $idlist $col]
2613 set ranges [rowranges $id]
2614 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2615 set isarrow 1
2618 if {$z < -1 || ($z < 0 && $isarrow)} {
2619 set npad [expr {-1 - $z + $isarrow}]
2620 set offs [incrange $offs $col $npad]
2621 insert_pad $y0 $x0 $npad
2622 if {$y0 > 0} {
2623 optimize_rows $y0 $x0 $row
2625 set z [lindex $offs $col]
2626 set x0 [expr {$col + $z}]
2627 set z0 [lindex $rowoffsets $y0 $x0]
2628 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2629 set npad [expr {$z - 1 + $isarrow}]
2630 set y1 [expr {$row + 1}]
2631 set offs2 [lindex $rowoffsets $y1]
2632 set x1 -1
2633 foreach z $offs2 {
2634 incr x1
2635 if {$z eq {} || $x1 + $z < $col} continue
2636 if {$x1 + $z > $col} {
2637 incr npad
2639 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2640 break
2642 set pad [ntimes $npad {}]
2643 set idlist [eval linsert \$idlist $col $pad]
2644 set tmp [eval linsert \$offs $col $pad]
2645 incr col $npad
2646 set offs [incrange $tmp $col [expr {-$npad}]]
2647 set z [lindex $offs $col]
2648 set haspad 1
2650 if {$z0 eq {} && !$isarrow} {
2651 # this line links to its first child on row $row-2
2652 set rm2 [expr {$row - 2}]
2653 set id [lindex $displayorder $rm2]
2654 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2655 if {$xc >= 0} {
2656 set z0 [expr {$xc - $x0}]
2659 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2660 insert_pad $y0 $x0 1
2661 set offs [incrange $offs $col 1]
2662 optimize_rows $y0 [expr {$x0 + 1}] $row
2665 if {!$haspad} {
2666 set o {}
2667 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2668 set o [lindex $offs $col]
2669 if {$o eq {}} {
2670 # check if this is the link to the first child
2671 set id [lindex $idlist $col]
2672 set ranges [rowranges $id]
2673 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2674 # it is, work out offset to child
2675 set y0 [expr {$row - 1}]
2676 set id [lindex $displayorder $y0]
2677 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2678 if {$x0 >= 0} {
2679 set o [expr {$x0 - $col}]
2683 if {$o eq {} || $o <= 0} break
2685 if {$o ne {} && [incr col] < [llength $idlist]} {
2686 set y1 [expr {$row + 1}]
2687 set offs2 [lindex $rowoffsets $y1]
2688 set x1 -1
2689 foreach z $offs2 {
2690 incr x1
2691 if {$z eq {} || $x1 + $z < $col} continue
2692 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2693 break
2695 set idlist [linsert $idlist $col {}]
2696 set tmp [linsert $offs $col {}]
2697 incr col
2698 set offs [incrange $tmp $col -1]
2701 lset rowidlist $row $idlist
2702 lset rowoffsets $row $offs
2703 set col 0
2707 proc xc {row col} {
2708 global canvx0 linespc
2709 return [expr {$canvx0 + $col * $linespc}]
2712 proc yc {row} {
2713 global canvy0 linespc
2714 return [expr {$canvy0 + $row * $linespc}]
2717 proc linewidth {id} {
2718 global thickerline lthickness
2720 set wid $lthickness
2721 if {[info exists thickerline] && $id eq $thickerline} {
2722 set wid [expr {2 * $lthickness}]
2724 return $wid
2727 proc rowranges {id} {
2728 global phase idrowranges commitrow rowlaidout rowrangelist curview
2730 set ranges {}
2731 if {$phase eq {} ||
2732 ([info exists commitrow($curview,$id)]
2733 && $commitrow($curview,$id) < $rowlaidout)} {
2734 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2735 } elseif {[info exists idrowranges($id)]} {
2736 set ranges $idrowranges($id)
2738 return $ranges
2741 proc drawlineseg {id i} {
2742 global rowoffsets rowidlist
2743 global displayorder
2744 global canv colormap linespc
2745 global numcommits commitrow curview
2747 set ranges [rowranges $id]
2748 set downarrow 1
2749 if {[info exists commitrow($curview,$id)]
2750 && $commitrow($curview,$id) < $numcommits} {
2751 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2752 } else {
2753 set downarrow 1
2755 set startrow [lindex $ranges [expr {2 * $i}]]
2756 set row [lindex $ranges [expr {2 * $i + 1}]]
2757 if {$startrow == $row} return
2758 assigncolor $id
2759 set coords {}
2760 set col [lsearch -exact [lindex $rowidlist $row] $id]
2761 if {$col < 0} {
2762 puts "oops: drawline: id $id not on row $row"
2763 return
2765 set lasto {}
2766 set ns 0
2767 while {1} {
2768 set o [lindex $rowoffsets $row $col]
2769 if {$o eq {}} break
2770 if {$o ne $lasto} {
2771 # changing direction
2772 set x [xc $row $col]
2773 set y [yc $row]
2774 lappend coords $x $y
2775 set lasto $o
2777 incr col $o
2778 incr row -1
2780 set x [xc $row $col]
2781 set y [yc $row]
2782 lappend coords $x $y
2783 if {$i == 0} {
2784 # draw the link to the first child as part of this line
2785 incr row -1
2786 set child [lindex $displayorder $row]
2787 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2788 if {$ccol >= 0} {
2789 set x [xc $row $ccol]
2790 set y [yc $row]
2791 if {$ccol < $col - 1} {
2792 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2793 } elseif {$ccol > $col + 1} {
2794 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2796 lappend coords $x $y
2799 if {[llength $coords] < 4} return
2800 if {$downarrow} {
2801 # This line has an arrow at the lower end: check if the arrow is
2802 # on a diagonal segment, and if so, work around the Tk 8.4
2803 # refusal to draw arrows on diagonal lines.
2804 set x0 [lindex $coords 0]
2805 set x1 [lindex $coords 2]
2806 if {$x0 != $x1} {
2807 set y0 [lindex $coords 1]
2808 set y1 [lindex $coords 3]
2809 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2810 # we have a nearby vertical segment, just trim off the diag bit
2811 set coords [lrange $coords 2 end]
2812 } else {
2813 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2814 set xi [expr {$x0 - $slope * $linespc / 2}]
2815 set yi [expr {$y0 - $linespc / 2}]
2816 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2820 set arrow [expr {2 * ($i > 0) + $downarrow}]
2821 set arrow [lindex {none first last both} $arrow]
2822 set t [$canv create line $coords -width [linewidth $id] \
2823 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2824 $canv lower $t
2825 bindline $t $id
2828 proc drawparentlinks {id row col olds} {
2829 global rowidlist canv colormap
2831 set row2 [expr {$row + 1}]
2832 set x [xc $row $col]
2833 set y [yc $row]
2834 set y2 [yc $row2]
2835 set ids [lindex $rowidlist $row2]
2836 # rmx = right-most X coord used
2837 set rmx 0
2838 foreach p $olds {
2839 set i [lsearch -exact $ids $p]
2840 if {$i < 0} {
2841 puts "oops, parent $p of $id not in list"
2842 continue
2844 set x2 [xc $row2 $i]
2845 if {$x2 > $rmx} {
2846 set rmx $x2
2848 set ranges [rowranges $p]
2849 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2850 && $row2 < [lindex $ranges 1]} {
2851 # drawlineseg will do this one for us
2852 continue
2854 assigncolor $p
2855 # should handle duplicated parents here...
2856 set coords [list $x $y]
2857 if {$i < $col - 1} {
2858 lappend coords [xc $row [expr {$i + 1}]] $y
2859 } elseif {$i > $col + 1} {
2860 lappend coords [xc $row [expr {$i - 1}]] $y
2862 lappend coords $x2 $y2
2863 set t [$canv create line $coords -width [linewidth $p] \
2864 -fill $colormap($p) -tags lines.$p]
2865 $canv lower $t
2866 bindline $t $p
2868 return $rmx
2871 proc drawlines {id} {
2872 global colormap canv
2873 global idrangedrawn
2874 global children iddrawn commitrow rowidlist curview
2876 $canv delete lines.$id
2877 set nr [expr {[llength [rowranges $id]] / 2}]
2878 for {set i 0} {$i < $nr} {incr i} {
2879 if {[info exists idrangedrawn($id,$i)]} {
2880 drawlineseg $id $i
2883 foreach child $children($curview,$id) {
2884 if {[info exists iddrawn($child)]} {
2885 set row $commitrow($curview,$child)
2886 set col [lsearch -exact [lindex $rowidlist $row] $child]
2887 if {$col >= 0} {
2888 drawparentlinks $child $row $col [list $id]
2894 proc drawcmittext {id row col rmx} {
2895 global linespc canv canv2 canv3 canvy0 fgcolor
2896 global commitlisted commitinfo rowidlist
2897 global rowtextx idpos idtags idheads idotherrefs
2898 global linehtag linentag linedtag
2899 global mainfont canvxmax boldrows boldnamerows fgcolor
2901 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2902 set x [xc $row $col]
2903 set y [yc $row]
2904 set orad [expr {$linespc / 3}]
2905 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2906 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2907 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2908 $canv raise $t
2909 $canv bind $t <1> {selcanvline {} %x %y}
2910 set xt [xc $row [llength [lindex $rowidlist $row]]]
2911 if {$xt < $rmx} {
2912 set xt $rmx
2914 set rowtextx($row) $xt
2915 set idpos($id) [list $x $xt $y]
2916 if {[info exists idtags($id)] || [info exists idheads($id)]
2917 || [info exists idotherrefs($id)]} {
2918 set xt [drawtags $id $x $xt $y]
2920 set headline [lindex $commitinfo($id) 0]
2921 set name [lindex $commitinfo($id) 1]
2922 set date [lindex $commitinfo($id) 2]
2923 set date [formatdate $date]
2924 set font $mainfont
2925 set nfont $mainfont
2926 set isbold [ishighlighted $row]
2927 if {$isbold > 0} {
2928 lappend boldrows $row
2929 lappend font bold
2930 if {$isbold > 1} {
2931 lappend boldnamerows $row
2932 lappend nfont bold
2935 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2936 -text $headline -font $font -tags text]
2937 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2938 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2939 -text $name -font $nfont -tags text]
2940 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2941 -text $date -font $mainfont -tags text]
2942 set xr [expr {$xt + [font measure $mainfont $headline]}]
2943 if {$xr > $canvxmax} {
2944 set canvxmax $xr
2945 setcanvscroll
2949 proc drawcmitrow {row} {
2950 global displayorder rowidlist
2951 global idrangedrawn iddrawn
2952 global commitinfo parentlist numcommits
2953 global filehighlight fhighlights findstring nhighlights
2954 global hlview vhighlights
2955 global highlight_related rhighlights
2957 if {$row >= $numcommits} return
2958 foreach id [lindex $rowidlist $row] {
2959 if {$id eq {}} continue
2960 set i -1
2961 foreach {s e} [rowranges $id] {
2962 incr i
2963 if {$row < $s} continue
2964 if {$e eq {}} break
2965 if {$row <= $e} {
2966 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2967 drawlineseg $id $i
2968 set idrangedrawn($id,$i) 1
2970 break
2975 set id [lindex $displayorder $row]
2976 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2977 askvhighlight $row $id
2979 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2980 askfilehighlight $row $id
2982 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2983 askfindhighlight $row $id
2985 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2986 askrelhighlight $row $id
2988 if {[info exists iddrawn($id)]} return
2989 set col [lsearch -exact [lindex $rowidlist $row] $id]
2990 if {$col < 0} {
2991 puts "oops, row $row id $id not in list"
2992 return
2994 if {![info exists commitinfo($id)]} {
2995 getcommit $id
2997 assigncolor $id
2998 set olds [lindex $parentlist $row]
2999 if {$olds ne {}} {
3000 set rmx [drawparentlinks $id $row $col $olds]
3001 } else {
3002 set rmx 0
3004 drawcmittext $id $row $col $rmx
3005 set iddrawn($id) 1
3008 proc drawfrac {f0 f1} {
3009 global numcommits canv
3010 global linespc
3012 set ymax [lindex [$canv cget -scrollregion] 3]
3013 if {$ymax eq {} || $ymax == 0} return
3014 set y0 [expr {int($f0 * $ymax)}]
3015 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3016 if {$row < 0} {
3017 set row 0
3019 set y1 [expr {int($f1 * $ymax)}]
3020 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3021 if {$endrow >= $numcommits} {
3022 set endrow [expr {$numcommits - 1}]
3024 for {} {$row <= $endrow} {incr row} {
3025 drawcmitrow $row
3029 proc drawvisible {} {
3030 global canv
3031 eval drawfrac [$canv yview]
3034 proc clear_display {} {
3035 global iddrawn idrangedrawn
3036 global vhighlights fhighlights nhighlights rhighlights
3038 allcanvs delete all
3039 catch {unset iddrawn}
3040 catch {unset idrangedrawn}
3041 catch {unset vhighlights}
3042 catch {unset fhighlights}
3043 catch {unset nhighlights}
3044 catch {unset rhighlights}
3047 proc findcrossings {id} {
3048 global rowidlist parentlist numcommits rowoffsets displayorder
3050 set cross {}
3051 set ccross {}
3052 foreach {s e} [rowranges $id] {
3053 if {$e >= $numcommits} {
3054 set e [expr {$numcommits - 1}]
3056 if {$e <= $s} continue
3057 set x [lsearch -exact [lindex $rowidlist $e] $id]
3058 if {$x < 0} {
3059 puts "findcrossings: oops, no [shortids $id] in row $e"
3060 continue
3062 for {set row $e} {[incr row -1] >= $s} {} {
3063 set olds [lindex $parentlist $row]
3064 set kid [lindex $displayorder $row]
3065 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3066 if {$kidx < 0} continue
3067 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3068 foreach p $olds {
3069 set px [lsearch -exact $nextrow $p]
3070 if {$px < 0} continue
3071 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3072 if {[lsearch -exact $ccross $p] >= 0} continue
3073 if {$x == $px + ($kidx < $px? -1: 1)} {
3074 lappend ccross $p
3075 } elseif {[lsearch -exact $cross $p] < 0} {
3076 lappend cross $p
3080 set inc [lindex $rowoffsets $row $x]
3081 if {$inc eq {}} break
3082 incr x $inc
3085 return [concat $ccross {{}} $cross]
3088 proc assigncolor {id} {
3089 global colormap colors nextcolor
3090 global commitrow parentlist children children curview
3092 if {[info exists colormap($id)]} return
3093 set ncolors [llength $colors]
3094 if {[info exists children($curview,$id)]} {
3095 set kids $children($curview,$id)
3096 } else {
3097 set kids {}
3099 if {[llength $kids] == 1} {
3100 set child [lindex $kids 0]
3101 if {[info exists colormap($child)]
3102 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3103 set colormap($id) $colormap($child)
3104 return
3107 set badcolors {}
3108 set origbad {}
3109 foreach x [findcrossings $id] {
3110 if {$x eq {}} {
3111 # delimiter between corner crossings and other crossings
3112 if {[llength $badcolors] >= $ncolors - 1} break
3113 set origbad $badcolors
3115 if {[info exists colormap($x)]
3116 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3117 lappend badcolors $colormap($x)
3120 if {[llength $badcolors] >= $ncolors} {
3121 set badcolors $origbad
3123 set origbad $badcolors
3124 if {[llength $badcolors] < $ncolors - 1} {
3125 foreach child $kids {
3126 if {[info exists colormap($child)]
3127 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3128 lappend badcolors $colormap($child)
3130 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3131 if {[info exists colormap($p)]
3132 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3133 lappend badcolors $colormap($p)
3137 if {[llength $badcolors] >= $ncolors} {
3138 set badcolors $origbad
3141 for {set i 0} {$i <= $ncolors} {incr i} {
3142 set c [lindex $colors $nextcolor]
3143 if {[incr nextcolor] >= $ncolors} {
3144 set nextcolor 0
3146 if {[lsearch -exact $badcolors $c]} break
3148 set colormap($id) $c
3151 proc bindline {t id} {
3152 global canv
3154 $canv bind $t <Enter> "lineenter %x %y $id"
3155 $canv bind $t <Motion> "linemotion %x %y $id"
3156 $canv bind $t <Leave> "lineleave $id"
3157 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3160 proc drawtags {id x xt y1} {
3161 global idtags idheads idotherrefs mainhead
3162 global linespc lthickness
3163 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3165 set marks {}
3166 set ntags 0
3167 set nheads 0
3168 if {[info exists idtags($id)]} {
3169 set marks $idtags($id)
3170 set ntags [llength $marks]
3172 if {[info exists idheads($id)]} {
3173 set marks [concat $marks $idheads($id)]
3174 set nheads [llength $idheads($id)]
3176 if {[info exists idotherrefs($id)]} {
3177 set marks [concat $marks $idotherrefs($id)]
3179 if {$marks eq {}} {
3180 return $xt
3183 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3184 set yt [expr {$y1 - 0.5 * $linespc}]
3185 set yb [expr {$yt + $linespc - 1}]
3186 set xvals {}
3187 set wvals {}
3188 set i -1
3189 foreach tag $marks {
3190 incr i
3191 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3192 set wid [font measure [concat $mainfont bold] $tag]
3193 } else {
3194 set wid [font measure $mainfont $tag]
3196 lappend xvals $xt
3197 lappend wvals $wid
3198 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3200 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3201 -width $lthickness -fill black -tags tag.$id]
3202 $canv lower $t
3203 foreach tag $marks x $xvals wid $wvals {
3204 set xl [expr {$x + $delta}]
3205 set xr [expr {$x + $delta + $wid + $lthickness}]
3206 set font $mainfont
3207 if {[incr ntags -1] >= 0} {
3208 # draw a tag
3209 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3210 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3211 -width 1 -outline black -fill yellow -tags tag.$id]
3212 $canv bind $t <1> [list showtag $tag 1]
3213 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3214 } else {
3215 # draw a head or other ref
3216 if {[incr nheads -1] >= 0} {
3217 set col green
3218 if {$tag eq $mainhead} {
3219 lappend font bold
3221 } else {
3222 set col "#ddddff"
3224 set xl [expr {$xl - $delta/2}]
3225 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3226 -width 1 -outline black -fill $col -tags tag.$id
3227 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3228 set rwid [font measure $mainfont $remoteprefix]
3229 set xi [expr {$x + 1}]
3230 set yti [expr {$yt + 1}]
3231 set xri [expr {$x + $rwid}]
3232 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3233 -width 0 -fill "#ffddaa" -tags tag.$id
3236 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3237 -font $font -tags [list tag.$id text]]
3238 if {$ntags >= 0} {
3239 $canv bind $t <1> [list showtag $tag 1]
3242 return $xt
3245 proc xcoord {i level ln} {
3246 global canvx0 xspc1 xspc2
3248 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3249 if {$i > 0 && $i == $level} {
3250 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3251 } elseif {$i > $level} {
3252 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3254 return $x
3257 proc show_status {msg} {
3258 global canv mainfont fgcolor
3260 clear_display
3261 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3262 -tags text -fill $fgcolor
3265 proc finishcommits {} {
3266 global commitidx phase curview
3267 global pending_select
3269 if {$commitidx($curview) > 0} {
3270 drawrest
3271 } else {
3272 show_status "No commits selected"
3274 set phase {}
3275 catch {unset pending_select}
3278 # Don't change the text pane cursor if it is currently the hand cursor,
3279 # showing that we are over a sha1 ID link.
3280 proc settextcursor {c} {
3281 global ctext curtextcursor
3283 if {[$ctext cget -cursor] == $curtextcursor} {
3284 $ctext config -cursor $c
3286 set curtextcursor $c
3289 proc nowbusy {what} {
3290 global isbusy
3292 if {[array names isbusy] eq {}} {
3293 . config -cursor watch
3294 settextcursor watch
3296 set isbusy($what) 1
3299 proc notbusy {what} {
3300 global isbusy maincursor textcursor
3302 catch {unset isbusy($what)}
3303 if {[array names isbusy] eq {}} {
3304 . config -cursor $maincursor
3305 settextcursor $textcursor
3309 proc drawrest {} {
3310 global startmsecs
3311 global rowlaidout commitidx curview
3312 global pending_select
3314 set row $rowlaidout
3315 layoutrows $rowlaidout $commitidx($curview) 1
3316 layouttail
3317 optimize_rows $row 0 $commitidx($curview)
3318 showstuff $commitidx($curview)
3319 if {[info exists pending_select]} {
3320 selectline 0 1
3323 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3324 #global numcommits
3325 #puts "overall $drawmsecs ms for $numcommits commits"
3328 proc findmatches {f} {
3329 global findtype foundstring foundstrlen
3330 if {$findtype == "Regexp"} {
3331 set matches [regexp -indices -all -inline $foundstring $f]
3332 } else {
3333 if {$findtype == "IgnCase"} {
3334 set str [string tolower $f]
3335 } else {
3336 set str $f
3338 set matches {}
3339 set i 0
3340 while {[set j [string first $foundstring $str $i]] >= 0} {
3341 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3342 set i [expr {$j + $foundstrlen}]
3345 return $matches
3348 proc dofind {} {
3349 global findtype findloc findstring markedmatches commitinfo
3350 global numcommits displayorder linehtag linentag linedtag
3351 global mainfont canv canv2 canv3 selectedline
3352 global matchinglines foundstring foundstrlen matchstring
3353 global commitdata
3355 stopfindproc
3356 unmarkmatches
3357 cancel_next_highlight
3358 focus .
3359 set matchinglines {}
3360 if {$findtype == "IgnCase"} {
3361 set foundstring [string tolower $findstring]
3362 } else {
3363 set foundstring $findstring
3365 set foundstrlen [string length $findstring]
3366 if {$foundstrlen == 0} return
3367 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3368 set matchstring "*$matchstring*"
3369 if {![info exists selectedline]} {
3370 set oldsel -1
3371 } else {
3372 set oldsel $selectedline
3374 set didsel 0
3375 set fldtypes {Headline Author Date Committer CDate Comments}
3376 set l -1
3377 foreach id $displayorder {
3378 set d $commitdata($id)
3379 incr l
3380 if {$findtype == "Regexp"} {
3381 set doesmatch [regexp $foundstring $d]
3382 } elseif {$findtype == "IgnCase"} {
3383 set doesmatch [string match -nocase $matchstring $d]
3384 } else {
3385 set doesmatch [string match $matchstring $d]
3387 if {!$doesmatch} continue
3388 if {![info exists commitinfo($id)]} {
3389 getcommit $id
3391 set info $commitinfo($id)
3392 set doesmatch 0
3393 foreach f $info ty $fldtypes {
3394 if {$findloc != "All fields" && $findloc != $ty} {
3395 continue
3397 set matches [findmatches $f]
3398 if {$matches == {}} continue
3399 set doesmatch 1
3400 if {$ty == "Headline"} {
3401 drawcmitrow $l
3402 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3403 } elseif {$ty == "Author"} {
3404 drawcmitrow $l
3405 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3406 } elseif {$ty == "Date"} {
3407 drawcmitrow $l
3408 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3411 if {$doesmatch} {
3412 lappend matchinglines $l
3413 if {!$didsel && $l > $oldsel} {
3414 findselectline $l
3415 set didsel 1
3419 if {$matchinglines == {}} {
3420 bell
3421 } elseif {!$didsel} {
3422 findselectline [lindex $matchinglines 0]
3426 proc findselectline {l} {
3427 global findloc commentend ctext
3428 selectline $l 1
3429 if {$findloc == "All fields" || $findloc == "Comments"} {
3430 # highlight the matches in the comments
3431 set f [$ctext get 1.0 $commentend]
3432 set matches [findmatches $f]
3433 foreach match $matches {
3434 set start [lindex $match 0]
3435 set end [expr {[lindex $match 1] + 1}]
3436 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3441 proc findnext {restart} {
3442 global matchinglines selectedline
3443 if {![info exists matchinglines]} {
3444 if {$restart} {
3445 dofind
3447 return
3449 if {![info exists selectedline]} return
3450 foreach l $matchinglines {
3451 if {$l > $selectedline} {
3452 findselectline $l
3453 return
3456 bell
3459 proc findprev {} {
3460 global matchinglines selectedline
3461 if {![info exists matchinglines]} {
3462 dofind
3463 return
3465 if {![info exists selectedline]} return
3466 set prev {}
3467 foreach l $matchinglines {
3468 if {$l >= $selectedline} break
3469 set prev $l
3471 if {$prev != {}} {
3472 findselectline $prev
3473 } else {
3474 bell
3478 proc stopfindproc {{done 0}} {
3479 global findprocpid findprocfile findids
3480 global ctext findoldcursor phase maincursor textcursor
3481 global findinprogress
3483 catch {unset findids}
3484 if {[info exists findprocpid]} {
3485 if {!$done} {
3486 catch {exec kill $findprocpid}
3488 catch {close $findprocfile}
3489 unset findprocpid
3491 catch {unset findinprogress}
3492 notbusy find
3495 # mark a commit as matching by putting a yellow background
3496 # behind the headline
3497 proc markheadline {l id} {
3498 global canv mainfont linehtag
3500 drawcmitrow $l
3501 set bbox [$canv bbox $linehtag($l)]
3502 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3503 $canv lower $t
3506 # mark the bits of a headline, author or date that match a find string
3507 proc markmatches {canv l str tag matches font} {
3508 set bbox [$canv bbox $tag]
3509 set x0 [lindex $bbox 0]
3510 set y0 [lindex $bbox 1]
3511 set y1 [lindex $bbox 3]
3512 foreach match $matches {
3513 set start [lindex $match 0]
3514 set end [lindex $match 1]
3515 if {$start > $end} continue
3516 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3517 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3518 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3519 [expr {$x0+$xlen+2}] $y1 \
3520 -outline {} -tags matches -fill yellow]
3521 $canv lower $t
3525 proc unmarkmatches {} {
3526 global matchinglines findids
3527 allcanvs delete matches
3528 catch {unset matchinglines}
3529 catch {unset findids}
3532 proc selcanvline {w x y} {
3533 global canv canvy0 ctext linespc
3534 global rowtextx
3535 set ymax [lindex [$canv cget -scrollregion] 3]
3536 if {$ymax == {}} return
3537 set yfrac [lindex [$canv yview] 0]
3538 set y [expr {$y + $yfrac * $ymax}]
3539 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3540 if {$l < 0} {
3541 set l 0
3543 if {$w eq $canv} {
3544 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3546 unmarkmatches
3547 selectline $l 1
3550 proc commit_descriptor {p} {
3551 global commitinfo
3552 if {![info exists commitinfo($p)]} {
3553 getcommit $p
3555 set l "..."
3556 if {[llength $commitinfo($p)] > 1} {
3557 set l [lindex $commitinfo($p) 0]
3559 return "$p ($l)\n"
3562 # append some text to the ctext widget, and make any SHA1 ID
3563 # that we know about be a clickable link.
3564 proc appendwithlinks {text tags} {
3565 global ctext commitrow linknum curview
3567 set start [$ctext index "end - 1c"]
3568 $ctext insert end $text $tags
3569 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3570 foreach l $links {
3571 set s [lindex $l 0]
3572 set e [lindex $l 1]
3573 set linkid [string range $text $s $e]
3574 if {![info exists commitrow($curview,$linkid)]} continue
3575 incr e
3576 $ctext tag add link "$start + $s c" "$start + $e c"
3577 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3578 $ctext tag bind link$linknum <1> \
3579 [list selectline $commitrow($curview,$linkid) 1]
3580 incr linknum
3582 $ctext tag conf link -foreground blue -underline 1
3583 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3584 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3587 proc viewnextline {dir} {
3588 global canv linespc
3590 $canv delete hover
3591 set ymax [lindex [$canv cget -scrollregion] 3]
3592 set wnow [$canv yview]
3593 set wtop [expr {[lindex $wnow 0] * $ymax}]
3594 set newtop [expr {$wtop + $dir * $linespc}]
3595 if {$newtop < 0} {
3596 set newtop 0
3597 } elseif {$newtop > $ymax} {
3598 set newtop $ymax
3600 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3603 # add a list of tag or branch names at position pos
3604 # returns the number of names inserted
3605 proc appendrefs {pos l var} {
3606 global ctext commitrow linknum curview idtags $var
3608 if {[catch {$ctext index $pos}]} {
3609 return 0
3611 set tags {}
3612 foreach id $l {
3613 foreach tag [set $var\($id\)] {
3614 lappend tags [concat $tag $id]
3617 set tags [lsort -index 1 $tags]
3618 set sep {}
3619 foreach tag $tags {
3620 set name [lindex $tag 0]
3621 set id [lindex $tag 1]
3622 set lk link$linknum
3623 incr linknum
3624 $ctext insert $pos $sep
3625 $ctext insert $pos $name $lk
3626 $ctext tag conf $lk -foreground blue
3627 if {[info exists commitrow($curview,$id)]} {
3628 $ctext tag bind $lk <1> \
3629 [list selectline $commitrow($curview,$id) 1]
3630 $ctext tag conf $lk -underline 1
3631 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3632 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3634 set sep ", "
3636 return [llength $tags]
3639 # called when we have finished computing the nearby tags
3640 proc dispneartags {} {
3641 global selectedline currentid ctext anc_tags desc_tags showneartags
3642 global desc_heads
3644 if {![info exists selectedline] || !$showneartags} return
3645 set id $currentid
3646 $ctext conf -state normal
3647 if {[info exists desc_heads($id)]} {
3648 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3649 $ctext insert "branch -2c" "es"
3652 if {[info exists anc_tags($id)]} {
3653 appendrefs follows $anc_tags($id) idtags
3655 if {[info exists desc_tags($id)]} {
3656 appendrefs precedes $desc_tags($id) idtags
3658 $ctext conf -state disabled
3661 proc selectline {l isnew} {
3662 global canv canv2 canv3 ctext commitinfo selectedline
3663 global displayorder linehtag linentag linedtag
3664 global canvy0 linespc parentlist childlist
3665 global currentid sha1entry
3666 global commentend idtags linknum
3667 global mergemax numcommits pending_select
3668 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3670 catch {unset pending_select}
3671 $canv delete hover
3672 normalline
3673 cancel_next_highlight
3674 if {$l < 0 || $l >= $numcommits} return
3675 set y [expr {$canvy0 + $l * $linespc}]
3676 set ymax [lindex [$canv cget -scrollregion] 3]
3677 set ytop [expr {$y - $linespc - 1}]
3678 set ybot [expr {$y + $linespc + 1}]
3679 set wnow [$canv yview]
3680 set wtop [expr {[lindex $wnow 0] * $ymax}]
3681 set wbot [expr {[lindex $wnow 1] * $ymax}]
3682 set wh [expr {$wbot - $wtop}]
3683 set newtop $wtop
3684 if {$ytop < $wtop} {
3685 if {$ybot < $wtop} {
3686 set newtop [expr {$y - $wh / 2.0}]
3687 } else {
3688 set newtop $ytop
3689 if {$newtop > $wtop - $linespc} {
3690 set newtop [expr {$wtop - $linespc}]
3693 } elseif {$ybot > $wbot} {
3694 if {$ytop > $wbot} {
3695 set newtop [expr {$y - $wh / 2.0}]
3696 } else {
3697 set newtop [expr {$ybot - $wh}]
3698 if {$newtop < $wtop + $linespc} {
3699 set newtop [expr {$wtop + $linespc}]
3703 if {$newtop != $wtop} {
3704 if {$newtop < 0} {
3705 set newtop 0
3707 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3708 drawvisible
3711 if {![info exists linehtag($l)]} return
3712 $canv delete secsel
3713 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3714 -tags secsel -fill [$canv cget -selectbackground]]
3715 $canv lower $t
3716 $canv2 delete secsel
3717 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3718 -tags secsel -fill [$canv2 cget -selectbackground]]
3719 $canv2 lower $t
3720 $canv3 delete secsel
3721 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3722 -tags secsel -fill [$canv3 cget -selectbackground]]
3723 $canv3 lower $t
3725 if {$isnew} {
3726 addtohistory [list selectline $l 0]
3729 set selectedline $l
3731 set id [lindex $displayorder $l]
3732 set currentid $id
3733 $sha1entry delete 0 end
3734 $sha1entry insert 0 $id
3735 $sha1entry selection from 0
3736 $sha1entry selection to end
3737 rhighlight_sel $id
3739 $ctext conf -state normal
3740 clear_ctext
3741 set linknum 0
3742 set info $commitinfo($id)
3743 set date [formatdate [lindex $info 2]]
3744 $ctext insert end "Author: [lindex $info 1] $date\n"
3745 set date [formatdate [lindex $info 4]]
3746 $ctext insert end "Committer: [lindex $info 3] $date\n"
3747 if {[info exists idtags($id)]} {
3748 $ctext insert end "Tags:"
3749 foreach tag $idtags($id) {
3750 $ctext insert end " $tag"
3752 $ctext insert end "\n"
3755 set headers {}
3756 set olds [lindex $parentlist $l]
3757 if {[llength $olds] > 1} {
3758 set np 0
3759 foreach p $olds {
3760 if {$np >= $mergemax} {
3761 set tag mmax
3762 } else {
3763 set tag m$np
3765 $ctext insert end "Parent: " $tag
3766 appendwithlinks [commit_descriptor $p] {}
3767 incr np
3769 } else {
3770 foreach p $olds {
3771 append headers "Parent: [commit_descriptor $p]"
3775 foreach c [lindex $childlist $l] {
3776 append headers "Child: [commit_descriptor $c]"
3779 # make anything that looks like a SHA1 ID be a clickable link
3780 appendwithlinks $headers {}
3781 if {$showneartags} {
3782 if {![info exists allcommits]} {
3783 getallcommits
3785 $ctext insert end "Branch: "
3786 $ctext mark set branch "end -1c"
3787 $ctext mark gravity branch left
3788 if {[info exists desc_heads($id)]} {
3789 if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3790 # turn "Branch" into "Branches"
3791 $ctext insert "branch -2c" "es"
3794 $ctext insert end "\nFollows: "
3795 $ctext mark set follows "end -1c"
3796 $ctext mark gravity follows left
3797 if {[info exists anc_tags($id)]} {
3798 appendrefs follows $anc_tags($id) idtags
3800 $ctext insert end "\nPrecedes: "
3801 $ctext mark set precedes "end -1c"
3802 $ctext mark gravity precedes left
3803 if {[info exists desc_tags($id)]} {
3804 appendrefs precedes $desc_tags($id) idtags
3806 $ctext insert end "\n"
3808 $ctext insert end "\n"
3809 appendwithlinks [lindex $info 5] {comment}
3811 $ctext tag delete Comments
3812 $ctext tag remove found 1.0 end
3813 $ctext conf -state disabled
3814 set commentend [$ctext index "end - 1c"]
3816 init_flist "Comments"
3817 if {$cmitmode eq "tree"} {
3818 gettree $id
3819 } elseif {[llength $olds] <= 1} {
3820 startdiff $id
3821 } else {
3822 mergediff $id $l
3826 proc selfirstline {} {
3827 unmarkmatches
3828 selectline 0 1
3831 proc sellastline {} {
3832 global numcommits
3833 unmarkmatches
3834 set l [expr {$numcommits - 1}]
3835 selectline $l 1
3838 proc selnextline {dir} {
3839 global selectedline
3840 if {![info exists selectedline]} return
3841 set l [expr {$selectedline + $dir}]
3842 unmarkmatches
3843 selectline $l 1
3846 proc selnextpage {dir} {
3847 global canv linespc selectedline numcommits
3849 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3850 if {$lpp < 1} {
3851 set lpp 1
3853 allcanvs yview scroll [expr {$dir * $lpp}] units
3854 drawvisible
3855 if {![info exists selectedline]} return
3856 set l [expr {$selectedline + $dir * $lpp}]
3857 if {$l < 0} {
3858 set l 0
3859 } elseif {$l >= $numcommits} {
3860 set l [expr $numcommits - 1]
3862 unmarkmatches
3863 selectline $l 1
3866 proc unselectline {} {
3867 global selectedline currentid
3869 catch {unset selectedline}
3870 catch {unset currentid}
3871 allcanvs delete secsel
3872 rhighlight_none
3873 cancel_next_highlight
3876 proc reselectline {} {
3877 global selectedline
3879 if {[info exists selectedline]} {
3880 selectline $selectedline 0
3884 proc addtohistory {cmd} {
3885 global history historyindex curview
3887 set elt [list $curview $cmd]
3888 if {$historyindex > 0
3889 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3890 return
3893 if {$historyindex < [llength $history]} {
3894 set history [lreplace $history $historyindex end $elt]
3895 } else {
3896 lappend history $elt
3898 incr historyindex
3899 if {$historyindex > 1} {
3900 .ctop.top.bar.leftbut conf -state normal
3901 } else {
3902 .ctop.top.bar.leftbut conf -state disabled
3904 .ctop.top.bar.rightbut conf -state disabled
3907 proc godo {elt} {
3908 global curview
3910 set view [lindex $elt 0]
3911 set cmd [lindex $elt 1]
3912 if {$curview != $view} {
3913 showview $view
3915 eval $cmd
3918 proc goback {} {
3919 global history historyindex
3921 if {$historyindex > 1} {
3922 incr historyindex -1
3923 godo [lindex $history [expr {$historyindex - 1}]]
3924 .ctop.top.bar.rightbut conf -state normal
3926 if {$historyindex <= 1} {
3927 .ctop.top.bar.leftbut conf -state disabled
3931 proc goforw {} {
3932 global history historyindex
3934 if {$historyindex < [llength $history]} {
3935 set cmd [lindex $history $historyindex]
3936 incr historyindex
3937 godo $cmd
3938 .ctop.top.bar.leftbut conf -state normal
3940 if {$historyindex >= [llength $history]} {
3941 .ctop.top.bar.rightbut conf -state disabled
3945 proc gettree {id} {
3946 global treefilelist treeidlist diffids diffmergeid treepending
3948 set diffids $id
3949 catch {unset diffmergeid}
3950 if {![info exists treefilelist($id)]} {
3951 if {![info exists treepending]} {
3952 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3953 return
3955 set treepending $id
3956 set treefilelist($id) {}
3957 set treeidlist($id) {}
3958 fconfigure $gtf -blocking 0
3959 fileevent $gtf readable [list gettreeline $gtf $id]
3961 } else {
3962 setfilelist $id
3966 proc gettreeline {gtf id} {
3967 global treefilelist treeidlist treepending cmitmode diffids
3969 while {[gets $gtf line] >= 0} {
3970 if {[lindex $line 1] ne "blob"} continue
3971 set sha1 [lindex $line 2]
3972 set fname [lindex $line 3]
3973 lappend treefilelist($id) $fname
3974 lappend treeidlist($id) $sha1
3976 if {![eof $gtf]} return
3977 close $gtf
3978 unset treepending
3979 if {$cmitmode ne "tree"} {
3980 if {![info exists diffmergeid]} {
3981 gettreediffs $diffids
3983 } elseif {$id ne $diffids} {
3984 gettree $diffids
3985 } else {
3986 setfilelist $id
3990 proc showfile {f} {
3991 global treefilelist treeidlist diffids
3992 global ctext commentend
3994 set i [lsearch -exact $treefilelist($diffids) $f]
3995 if {$i < 0} {
3996 puts "oops, $f not in list for id $diffids"
3997 return
3999 set blob [lindex $treeidlist($diffids) $i]
4000 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4001 puts "oops, error reading blob $blob: $err"
4002 return
4004 fconfigure $bf -blocking 0
4005 fileevent $bf readable [list getblobline $bf $diffids]
4006 $ctext config -state normal
4007 clear_ctext $commentend
4008 $ctext insert end "\n"
4009 $ctext insert end "$f\n" filesep
4010 $ctext config -state disabled
4011 $ctext yview $commentend
4014 proc getblobline {bf id} {
4015 global diffids cmitmode ctext
4017 if {$id ne $diffids || $cmitmode ne "tree"} {
4018 catch {close $bf}
4019 return
4021 $ctext config -state normal
4022 while {[gets $bf line] >= 0} {
4023 $ctext insert end "$line\n"
4025 if {[eof $bf]} {
4026 # delete last newline
4027 $ctext delete "end - 2c" "end - 1c"
4028 close $bf
4030 $ctext config -state disabled
4033 proc mergediff {id l} {
4034 global diffmergeid diffopts mdifffd
4035 global diffids
4036 global parentlist
4038 set diffmergeid $id
4039 set diffids $id
4040 # this doesn't seem to actually affect anything...
4041 set env(GIT_DIFF_OPTS) $diffopts
4042 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4043 if {[catch {set mdf [open $cmd r]} err]} {
4044 error_popup "Error getting merge diffs: $err"
4045 return
4047 fconfigure $mdf -blocking 0
4048 set mdifffd($id) $mdf
4049 set np [llength [lindex $parentlist $l]]
4050 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4051 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4054 proc getmergediffline {mdf id np} {
4055 global diffmergeid ctext cflist nextupdate mergemax
4056 global difffilestart mdifffd
4058 set n [gets $mdf line]
4059 if {$n < 0} {
4060 if {[eof $mdf]} {
4061 close $mdf
4063 return
4065 if {![info exists diffmergeid] || $id != $diffmergeid
4066 || $mdf != $mdifffd($id)} {
4067 return
4069 $ctext conf -state normal
4070 if {[regexp {^diff --cc (.*)} $line match fname]} {
4071 # start of a new file
4072 $ctext insert end "\n"
4073 set here [$ctext index "end - 1c"]
4074 lappend difffilestart $here
4075 add_flist [list $fname]
4076 set l [expr {(78 - [string length $fname]) / 2}]
4077 set pad [string range "----------------------------------------" 1 $l]
4078 $ctext insert end "$pad $fname $pad\n" filesep
4079 } elseif {[regexp {^@@} $line]} {
4080 $ctext insert end "$line\n" hunksep
4081 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4082 # do nothing
4083 } else {
4084 # parse the prefix - one ' ', '-' or '+' for each parent
4085 set spaces {}
4086 set minuses {}
4087 set pluses {}
4088 set isbad 0
4089 for {set j 0} {$j < $np} {incr j} {
4090 set c [string range $line $j $j]
4091 if {$c == " "} {
4092 lappend spaces $j
4093 } elseif {$c == "-"} {
4094 lappend minuses $j
4095 } elseif {$c == "+"} {
4096 lappend pluses $j
4097 } else {
4098 set isbad 1
4099 break
4102 set tags {}
4103 set num {}
4104 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4105 # line doesn't appear in result, parents in $minuses have the line
4106 set num [lindex $minuses 0]
4107 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4108 # line appears in result, parents in $pluses don't have the line
4109 lappend tags mresult
4110 set num [lindex $spaces 0]
4112 if {$num ne {}} {
4113 if {$num >= $mergemax} {
4114 set num "max"
4116 lappend tags m$num
4118 $ctext insert end "$line\n" $tags
4120 $ctext conf -state disabled
4121 if {[clock clicks -milliseconds] >= $nextupdate} {
4122 incr nextupdate 100
4123 fileevent $mdf readable {}
4124 update
4125 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4129 proc startdiff {ids} {
4130 global treediffs diffids treepending diffmergeid
4132 set diffids $ids
4133 catch {unset diffmergeid}
4134 if {![info exists treediffs($ids)]} {
4135 if {![info exists treepending]} {
4136 gettreediffs $ids
4138 } else {
4139 addtocflist $ids
4143 proc addtocflist {ids} {
4144 global treediffs cflist
4145 add_flist $treediffs($ids)
4146 getblobdiffs $ids
4149 proc gettreediffs {ids} {
4150 global treediff treepending
4151 set treepending $ids
4152 set treediff {}
4153 if {[catch \
4154 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4155 ]} return
4156 fconfigure $gdtf -blocking 0
4157 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4160 proc gettreediffline {gdtf ids} {
4161 global treediff treediffs treepending diffids diffmergeid
4162 global cmitmode
4164 set n [gets $gdtf line]
4165 if {$n < 0} {
4166 if {![eof $gdtf]} return
4167 close $gdtf
4168 set treediffs($ids) $treediff
4169 unset treepending
4170 if {$cmitmode eq "tree"} {
4171 gettree $diffids
4172 } elseif {$ids != $diffids} {
4173 if {![info exists diffmergeid]} {
4174 gettreediffs $diffids
4176 } else {
4177 addtocflist $ids
4179 return
4181 set file [lindex $line 5]
4182 lappend treediff $file
4185 proc getblobdiffs {ids} {
4186 global diffopts blobdifffd diffids env curdifftag curtagstart
4187 global nextupdate diffinhdr treediffs
4189 set env(GIT_DIFF_OPTS) $diffopts
4190 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4191 if {[catch {set bdf [open $cmd r]} err]} {
4192 puts "error getting diffs: $err"
4193 return
4195 set diffinhdr 0
4196 fconfigure $bdf -blocking 0
4197 set blobdifffd($ids) $bdf
4198 set curdifftag Comments
4199 set curtagstart 0.0
4200 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4201 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4204 proc setinlist {var i val} {
4205 global $var
4207 while {[llength [set $var]] < $i} {
4208 lappend $var {}
4210 if {[llength [set $var]] == $i} {
4211 lappend $var $val
4212 } else {
4213 lset $var $i $val
4217 proc getblobdiffline {bdf ids} {
4218 global diffids blobdifffd ctext curdifftag curtagstart
4219 global diffnexthead diffnextnote difffilestart
4220 global nextupdate diffinhdr treediffs
4222 set n [gets $bdf line]
4223 if {$n < 0} {
4224 if {[eof $bdf]} {
4225 close $bdf
4226 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4227 $ctext tag add $curdifftag $curtagstart end
4230 return
4232 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4233 return
4235 $ctext conf -state normal
4236 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4237 # start of a new file
4238 $ctext insert end "\n"
4239 $ctext tag add $curdifftag $curtagstart end
4240 set here [$ctext index "end - 1c"]
4241 set curtagstart $here
4242 set header $newname
4243 set i [lsearch -exact $treediffs($ids) $fname]
4244 if {$i >= 0} {
4245 setinlist difffilestart $i $here
4247 if {$newname ne $fname} {
4248 set i [lsearch -exact $treediffs($ids) $newname]
4249 if {$i >= 0} {
4250 setinlist difffilestart $i $here
4253 set curdifftag "f:$fname"
4254 $ctext tag delete $curdifftag
4255 set l [expr {(78 - [string length $header]) / 2}]
4256 set pad [string range "----------------------------------------" 1 $l]
4257 $ctext insert end "$pad $header $pad\n" filesep
4258 set diffinhdr 1
4259 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4260 # do nothing
4261 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4262 set diffinhdr 0
4263 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4264 $line match f1l f1c f2l f2c rest]} {
4265 $ctext insert end "$line\n" hunksep
4266 set diffinhdr 0
4267 } else {
4268 set x [string range $line 0 0]
4269 if {$x == "-" || $x == "+"} {
4270 set tag [expr {$x == "+"}]
4271 $ctext insert end "$line\n" d$tag
4272 } elseif {$x == " "} {
4273 $ctext insert end "$line\n"
4274 } elseif {$diffinhdr || $x == "\\"} {
4275 # e.g. "\ No newline at end of file"
4276 $ctext insert end "$line\n" filesep
4277 } else {
4278 # Something else we don't recognize
4279 if {$curdifftag != "Comments"} {
4280 $ctext insert end "\n"
4281 $ctext tag add $curdifftag $curtagstart end
4282 set curtagstart [$ctext index "end - 1c"]
4283 set curdifftag Comments
4285 $ctext insert end "$line\n" filesep
4288 $ctext conf -state disabled
4289 if {[clock clicks -milliseconds] >= $nextupdate} {
4290 incr nextupdate 100
4291 fileevent $bdf readable {}
4292 update
4293 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4297 proc nextfile {} {
4298 global difffilestart ctext
4299 set here [$ctext index @0,0]
4300 foreach loc $difffilestart {
4301 if {[$ctext compare $loc > $here]} {
4302 $ctext yview $loc
4307 proc clear_ctext {{first 1.0}} {
4308 global ctext smarktop smarkbot
4310 set l [lindex [split $first .] 0]
4311 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4312 set smarktop $l
4314 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4315 set smarkbot $l
4317 $ctext delete $first end
4320 proc incrsearch {name ix op} {
4321 global ctext searchstring searchdirn
4323 $ctext tag remove found 1.0 end
4324 if {[catch {$ctext index anchor}]} {
4325 # no anchor set, use start of selection, or of visible area
4326 set sel [$ctext tag ranges sel]
4327 if {$sel ne {}} {
4328 $ctext mark set anchor [lindex $sel 0]
4329 } elseif {$searchdirn eq "-forwards"} {
4330 $ctext mark set anchor @0,0
4331 } else {
4332 $ctext mark set anchor @0,[winfo height $ctext]
4335 if {$searchstring ne {}} {
4336 set here [$ctext search $searchdirn -- $searchstring anchor]
4337 if {$here ne {}} {
4338 $ctext see $here
4340 searchmarkvisible 1
4344 proc dosearch {} {
4345 global sstring ctext searchstring searchdirn
4347 focus $sstring
4348 $sstring icursor end
4349 set searchdirn -forwards
4350 if {$searchstring ne {}} {
4351 set sel [$ctext tag ranges sel]
4352 if {$sel ne {}} {
4353 set start "[lindex $sel 0] + 1c"
4354 } elseif {[catch {set start [$ctext index anchor]}]} {
4355 set start "@0,0"
4357 set match [$ctext search -count mlen -- $searchstring $start]
4358 $ctext tag remove sel 1.0 end
4359 if {$match eq {}} {
4360 bell
4361 return
4363 $ctext see $match
4364 set mend "$match + $mlen c"
4365 $ctext tag add sel $match $mend
4366 $ctext mark unset anchor
4370 proc dosearchback {} {
4371 global sstring ctext searchstring searchdirn
4373 focus $sstring
4374 $sstring icursor end
4375 set searchdirn -backwards
4376 if {$searchstring ne {}} {
4377 set sel [$ctext tag ranges sel]
4378 if {$sel ne {}} {
4379 set start [lindex $sel 0]
4380 } elseif {[catch {set start [$ctext index anchor]}]} {
4381 set start @0,[winfo height $ctext]
4383 set match [$ctext search -backwards -count ml -- $searchstring $start]
4384 $ctext tag remove sel 1.0 end
4385 if {$match eq {}} {
4386 bell
4387 return
4389 $ctext see $match
4390 set mend "$match + $ml c"
4391 $ctext tag add sel $match $mend
4392 $ctext mark unset anchor
4396 proc searchmark {first last} {
4397 global ctext searchstring
4399 set mend $first.0
4400 while {1} {
4401 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4402 if {$match eq {}} break
4403 set mend "$match + $mlen c"
4404 $ctext tag add found $match $mend
4408 proc searchmarkvisible {doall} {
4409 global ctext smarktop smarkbot
4411 set topline [lindex [split [$ctext index @0,0] .] 0]
4412 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4413 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4414 # no overlap with previous
4415 searchmark $topline $botline
4416 set smarktop $topline
4417 set smarkbot $botline
4418 } else {
4419 if {$topline < $smarktop} {
4420 searchmark $topline [expr {$smarktop-1}]
4421 set smarktop $topline
4423 if {$botline > $smarkbot} {
4424 searchmark [expr {$smarkbot+1}] $botline
4425 set smarkbot $botline
4430 proc scrolltext {f0 f1} {
4431 global searchstring
4433 .ctop.cdet.left.sb set $f0 $f1
4434 if {$searchstring ne {}} {
4435 searchmarkvisible 0
4439 proc setcoords {} {
4440 global linespc charspc canvx0 canvy0 mainfont
4441 global xspc1 xspc2 lthickness
4443 set linespc [font metrics $mainfont -linespace]
4444 set charspc [font measure $mainfont "m"]
4445 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4446 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4447 set lthickness [expr {int($linespc / 9) + 1}]
4448 set xspc1(0) $linespc
4449 set xspc2 $linespc
4452 proc redisplay {} {
4453 global canv
4454 global selectedline
4456 set ymax [lindex [$canv cget -scrollregion] 3]
4457 if {$ymax eq {} || $ymax == 0} return
4458 set span [$canv yview]
4459 clear_display
4460 setcanvscroll
4461 allcanvs yview moveto [lindex $span 0]
4462 drawvisible
4463 if {[info exists selectedline]} {
4464 selectline $selectedline 0
4468 proc incrfont {inc} {
4469 global mainfont textfont ctext canv phase
4470 global stopped entries
4471 unmarkmatches
4472 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4473 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4474 setcoords
4475 $ctext conf -font $textfont
4476 $ctext tag conf filesep -font [concat $textfont bold]
4477 foreach e $entries {
4478 $e conf -font $mainfont
4480 if {$phase eq "getcommits"} {
4481 $canv itemconf textitems -font $mainfont
4483 redisplay
4486 proc clearsha1 {} {
4487 global sha1entry sha1string
4488 if {[string length $sha1string] == 40} {
4489 $sha1entry delete 0 end
4493 proc sha1change {n1 n2 op} {
4494 global sha1string currentid sha1but
4495 if {$sha1string == {}
4496 || ([info exists currentid] && $sha1string == $currentid)} {
4497 set state disabled
4498 } else {
4499 set state normal
4501 if {[$sha1but cget -state] == $state} return
4502 if {$state == "normal"} {
4503 $sha1but conf -state normal -relief raised -text "Goto: "
4504 } else {
4505 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4509 proc gotocommit {} {
4510 global sha1string currentid commitrow tagids headids
4511 global displayorder numcommits curview
4513 if {$sha1string == {}
4514 || ([info exists currentid] && $sha1string == $currentid)} return
4515 if {[info exists tagids($sha1string)]} {
4516 set id $tagids($sha1string)
4517 } elseif {[info exists headids($sha1string)]} {
4518 set id $headids($sha1string)
4519 } else {
4520 set id [string tolower $sha1string]
4521 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4522 set matches {}
4523 foreach i $displayorder {
4524 if {[string match $id* $i]} {
4525 lappend matches $i
4528 if {$matches ne {}} {
4529 if {[llength $matches] > 1} {
4530 error_popup "Short SHA1 id $id is ambiguous"
4531 return
4533 set id [lindex $matches 0]
4537 if {[info exists commitrow($curview,$id)]} {
4538 selectline $commitrow($curview,$id) 1
4539 return
4541 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4542 set type "SHA1 id"
4543 } else {
4544 set type "Tag/Head"
4546 error_popup "$type $sha1string is not known"
4549 proc lineenter {x y id} {
4550 global hoverx hovery hoverid hovertimer
4551 global commitinfo canv
4553 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4554 set hoverx $x
4555 set hovery $y
4556 set hoverid $id
4557 if {[info exists hovertimer]} {
4558 after cancel $hovertimer
4560 set hovertimer [after 500 linehover]
4561 $canv delete hover
4564 proc linemotion {x y id} {
4565 global hoverx hovery hoverid hovertimer
4567 if {[info exists hoverid] && $id == $hoverid} {
4568 set hoverx $x
4569 set hovery $y
4570 if {[info exists hovertimer]} {
4571 after cancel $hovertimer
4573 set hovertimer [after 500 linehover]
4577 proc lineleave {id} {
4578 global hoverid hovertimer canv
4580 if {[info exists hoverid] && $id == $hoverid} {
4581 $canv delete hover
4582 if {[info exists hovertimer]} {
4583 after cancel $hovertimer
4584 unset hovertimer
4586 unset hoverid
4590 proc linehover {} {
4591 global hoverx hovery hoverid hovertimer
4592 global canv linespc lthickness
4593 global commitinfo mainfont
4595 set text [lindex $commitinfo($hoverid) 0]
4596 set ymax [lindex [$canv cget -scrollregion] 3]
4597 if {$ymax == {}} return
4598 set yfrac [lindex [$canv yview] 0]
4599 set x [expr {$hoverx + 2 * $linespc}]
4600 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4601 set x0 [expr {$x - 2 * $lthickness}]
4602 set y0 [expr {$y - 2 * $lthickness}]
4603 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4604 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4605 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4606 -fill \#ffff80 -outline black -width 1 -tags hover]
4607 $canv raise $t
4608 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4609 -font $mainfont]
4610 $canv raise $t
4613 proc clickisonarrow {id y} {
4614 global lthickness
4616 set ranges [rowranges $id]
4617 set thresh [expr {2 * $lthickness + 6}]
4618 set n [expr {[llength $ranges] - 1}]
4619 for {set i 1} {$i < $n} {incr i} {
4620 set row [lindex $ranges $i]
4621 if {abs([yc $row] - $y) < $thresh} {
4622 return $i
4625 return {}
4628 proc arrowjump {id n y} {
4629 global canv
4631 # 1 <-> 2, 3 <-> 4, etc...
4632 set n [expr {(($n - 1) ^ 1) + 1}]
4633 set row [lindex [rowranges $id] $n]
4634 set yt [yc $row]
4635 set ymax [lindex [$canv cget -scrollregion] 3]
4636 if {$ymax eq {} || $ymax <= 0} return
4637 set view [$canv yview]
4638 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4639 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4640 if {$yfrac < 0} {
4641 set yfrac 0
4643 allcanvs yview moveto $yfrac
4646 proc lineclick {x y id isnew} {
4647 global ctext commitinfo children canv thickerline curview
4649 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4650 unmarkmatches
4651 unselectline
4652 normalline
4653 $canv delete hover
4654 # draw this line thicker than normal
4655 set thickerline $id
4656 drawlines $id
4657 if {$isnew} {
4658 set ymax [lindex [$canv cget -scrollregion] 3]
4659 if {$ymax eq {}} return
4660 set yfrac [lindex [$canv yview] 0]
4661 set y [expr {$y + $yfrac * $ymax}]
4663 set dirn [clickisonarrow $id $y]
4664 if {$dirn ne {}} {
4665 arrowjump $id $dirn $y
4666 return
4669 if {$isnew} {
4670 addtohistory [list lineclick $x $y $id 0]
4672 # fill the details pane with info about this line
4673 $ctext conf -state normal
4674 clear_ctext
4675 $ctext tag conf link -foreground blue -underline 1
4676 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4677 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4678 $ctext insert end "Parent:\t"
4679 $ctext insert end $id [list link link0]
4680 $ctext tag bind link0 <1> [list selbyid $id]
4681 set info $commitinfo($id)
4682 $ctext insert end "\n\t[lindex $info 0]\n"
4683 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4684 set date [formatdate [lindex $info 2]]
4685 $ctext insert end "\tDate:\t$date\n"
4686 set kids $children($curview,$id)
4687 if {$kids ne {}} {
4688 $ctext insert end "\nChildren:"
4689 set i 0
4690 foreach child $kids {
4691 incr i
4692 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4693 set info $commitinfo($child)
4694 $ctext insert end "\n\t"
4695 $ctext insert end $child [list link link$i]
4696 $ctext tag bind link$i <1> [list selbyid $child]
4697 $ctext insert end "\n\t[lindex $info 0]"
4698 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4699 set date [formatdate [lindex $info 2]]
4700 $ctext insert end "\n\tDate:\t$date\n"
4703 $ctext conf -state disabled
4704 init_flist {}
4707 proc normalline {} {
4708 global thickerline
4709 if {[info exists thickerline]} {
4710 set id $thickerline
4711 unset thickerline
4712 drawlines $id
4716 proc selbyid {id} {
4717 global commitrow curview
4718 if {[info exists commitrow($curview,$id)]} {
4719 selectline $commitrow($curview,$id) 1
4723 proc mstime {} {
4724 global startmstime
4725 if {![info exists startmstime]} {
4726 set startmstime [clock clicks -milliseconds]
4728 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4731 proc rowmenu {x y id} {
4732 global rowctxmenu commitrow selectedline rowmenuid curview
4734 if {![info exists selectedline]
4735 || $commitrow($curview,$id) eq $selectedline} {
4736 set state disabled
4737 } else {
4738 set state normal
4740 $rowctxmenu entryconfigure 0 -state $state
4741 $rowctxmenu entryconfigure 1 -state $state
4742 $rowctxmenu entryconfigure 2 -state $state
4743 set rowmenuid $id
4744 tk_popup $rowctxmenu $x $y
4747 proc diffvssel {dirn} {
4748 global rowmenuid selectedline displayorder
4750 if {![info exists selectedline]} return
4751 if {$dirn} {
4752 set oldid [lindex $displayorder $selectedline]
4753 set newid $rowmenuid
4754 } else {
4755 set oldid $rowmenuid
4756 set newid [lindex $displayorder $selectedline]
4758 addtohistory [list doseldiff $oldid $newid]
4759 doseldiff $oldid $newid
4762 proc doseldiff {oldid newid} {
4763 global ctext
4764 global commitinfo
4766 $ctext conf -state normal
4767 clear_ctext
4768 init_flist "Top"
4769 $ctext insert end "From "
4770 $ctext tag conf link -foreground blue -underline 1
4771 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4772 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4773 $ctext tag bind link0 <1> [list selbyid $oldid]
4774 $ctext insert end $oldid [list link link0]
4775 $ctext insert end "\n "
4776 $ctext insert end [lindex $commitinfo($oldid) 0]
4777 $ctext insert end "\n\nTo "
4778 $ctext tag bind link1 <1> [list selbyid $newid]
4779 $ctext insert end $newid [list link link1]
4780 $ctext insert end "\n "
4781 $ctext insert end [lindex $commitinfo($newid) 0]
4782 $ctext insert end "\n"
4783 $ctext conf -state disabled
4784 $ctext tag delete Comments
4785 $ctext tag remove found 1.0 end
4786 startdiff [list $oldid $newid]
4789 proc mkpatch {} {
4790 global rowmenuid currentid commitinfo patchtop patchnum
4792 if {![info exists currentid]} return
4793 set oldid $currentid
4794 set oldhead [lindex $commitinfo($oldid) 0]
4795 set newid $rowmenuid
4796 set newhead [lindex $commitinfo($newid) 0]
4797 set top .patch
4798 set patchtop $top
4799 catch {destroy $top}
4800 toplevel $top
4801 label $top.title -text "Generate patch"
4802 grid $top.title - -pady 10
4803 label $top.from -text "From:"
4804 entry $top.fromsha1 -width 40 -relief flat
4805 $top.fromsha1 insert 0 $oldid
4806 $top.fromsha1 conf -state readonly
4807 grid $top.from $top.fromsha1 -sticky w
4808 entry $top.fromhead -width 60 -relief flat
4809 $top.fromhead insert 0 $oldhead
4810 $top.fromhead conf -state readonly
4811 grid x $top.fromhead -sticky w
4812 label $top.to -text "To:"
4813 entry $top.tosha1 -width 40 -relief flat
4814 $top.tosha1 insert 0 $newid
4815 $top.tosha1 conf -state readonly
4816 grid $top.to $top.tosha1 -sticky w
4817 entry $top.tohead -width 60 -relief flat
4818 $top.tohead insert 0 $newhead
4819 $top.tohead conf -state readonly
4820 grid x $top.tohead -sticky w
4821 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4822 grid $top.rev x -pady 10
4823 label $top.flab -text "Output file:"
4824 entry $top.fname -width 60
4825 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4826 incr patchnum
4827 grid $top.flab $top.fname -sticky w
4828 frame $top.buts
4829 button $top.buts.gen -text "Generate" -command mkpatchgo
4830 button $top.buts.can -text "Cancel" -command mkpatchcan
4831 grid $top.buts.gen $top.buts.can
4832 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4833 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4834 grid $top.buts - -pady 10 -sticky ew
4835 focus $top.fname
4838 proc mkpatchrev {} {
4839 global patchtop
4841 set oldid [$patchtop.fromsha1 get]
4842 set oldhead [$patchtop.fromhead get]
4843 set newid [$patchtop.tosha1 get]
4844 set newhead [$patchtop.tohead get]
4845 foreach e [list fromsha1 fromhead tosha1 tohead] \
4846 v [list $newid $newhead $oldid $oldhead] {
4847 $patchtop.$e conf -state normal
4848 $patchtop.$e delete 0 end
4849 $patchtop.$e insert 0 $v
4850 $patchtop.$e conf -state readonly
4854 proc mkpatchgo {} {
4855 global patchtop
4857 set oldid [$patchtop.fromsha1 get]
4858 set newid [$patchtop.tosha1 get]
4859 set fname [$patchtop.fname get]
4860 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4861 error_popup "Error creating patch: $err"
4863 catch {destroy $patchtop}
4864 unset patchtop
4867 proc mkpatchcan {} {
4868 global patchtop
4870 catch {destroy $patchtop}
4871 unset patchtop
4874 proc mktag {} {
4875 global rowmenuid mktagtop commitinfo
4877 set top .maketag
4878 set mktagtop $top
4879 catch {destroy $top}
4880 toplevel $top
4881 label $top.title -text "Create tag"
4882 grid $top.title - -pady 10
4883 label $top.id -text "ID:"
4884 entry $top.sha1 -width 40 -relief flat
4885 $top.sha1 insert 0 $rowmenuid
4886 $top.sha1 conf -state readonly
4887 grid $top.id $top.sha1 -sticky w
4888 entry $top.head -width 60 -relief flat
4889 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4890 $top.head conf -state readonly
4891 grid x $top.head -sticky w
4892 label $top.tlab -text "Tag name:"
4893 entry $top.tag -width 60
4894 grid $top.tlab $top.tag -sticky w
4895 frame $top.buts
4896 button $top.buts.gen -text "Create" -command mktaggo
4897 button $top.buts.can -text "Cancel" -command mktagcan
4898 grid $top.buts.gen $top.buts.can
4899 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4900 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4901 grid $top.buts - -pady 10 -sticky ew
4902 focus $top.tag
4905 proc domktag {} {
4906 global mktagtop env tagids idtags
4908 set id [$mktagtop.sha1 get]
4909 set tag [$mktagtop.tag get]
4910 if {$tag == {}} {
4911 error_popup "No tag name specified"
4912 return
4914 if {[info exists tagids($tag)]} {
4915 error_popup "Tag \"$tag\" already exists"
4916 return
4918 if {[catch {
4919 set dir [gitdir]
4920 set fname [file join $dir "refs/tags" $tag]
4921 set f [open $fname w]
4922 puts $f $id
4923 close $f
4924 } err]} {
4925 error_popup "Error creating tag: $err"
4926 return
4929 set tagids($tag) $id
4930 lappend idtags($id) $tag
4931 redrawtags $id
4934 proc redrawtags {id} {
4935 global canv linehtag commitrow idpos selectedline curview
4936 global mainfont canvxmax
4938 if {![info exists commitrow($curview,$id)]} return
4939 drawcmitrow $commitrow($curview,$id)
4940 $canv delete tag.$id
4941 set xt [eval drawtags $id $idpos($id)]
4942 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4943 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4944 set xr [expr {$xt + [font measure $mainfont $text]}]
4945 if {$xr > $canvxmax} {
4946 set canvxmax $xr
4947 setcanvscroll
4949 if {[info exists selectedline]
4950 && $selectedline == $commitrow($curview,$id)} {
4951 selectline $selectedline 0
4955 proc mktagcan {} {
4956 global mktagtop
4958 catch {destroy $mktagtop}
4959 unset mktagtop
4962 proc mktaggo {} {
4963 domktag
4964 mktagcan
4967 proc writecommit {} {
4968 global rowmenuid wrcomtop commitinfo wrcomcmd
4970 set top .writecommit
4971 set wrcomtop $top
4972 catch {destroy $top}
4973 toplevel $top
4974 label $top.title -text "Write commit to file"
4975 grid $top.title - -pady 10
4976 label $top.id -text "ID:"
4977 entry $top.sha1 -width 40 -relief flat
4978 $top.sha1 insert 0 $rowmenuid
4979 $top.sha1 conf -state readonly
4980 grid $top.id $top.sha1 -sticky w
4981 entry $top.head -width 60 -relief flat
4982 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4983 $top.head conf -state readonly
4984 grid x $top.head -sticky w
4985 label $top.clab -text "Command:"
4986 entry $top.cmd -width 60 -textvariable wrcomcmd
4987 grid $top.clab $top.cmd -sticky w -pady 10
4988 label $top.flab -text "Output file:"
4989 entry $top.fname -width 60
4990 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4991 grid $top.flab $top.fname -sticky w
4992 frame $top.buts
4993 button $top.buts.gen -text "Write" -command wrcomgo
4994 button $top.buts.can -text "Cancel" -command wrcomcan
4995 grid $top.buts.gen $top.buts.can
4996 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4997 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4998 grid $top.buts - -pady 10 -sticky ew
4999 focus $top.fname
5002 proc wrcomgo {} {
5003 global wrcomtop
5005 set id [$wrcomtop.sha1 get]
5006 set cmd "echo $id | [$wrcomtop.cmd get]"
5007 set fname [$wrcomtop.fname get]
5008 if {[catch {exec sh -c $cmd >$fname &} err]} {
5009 error_popup "Error writing commit: $err"
5011 catch {destroy $wrcomtop}
5012 unset wrcomtop
5015 proc wrcomcan {} {
5016 global wrcomtop
5018 catch {destroy $wrcomtop}
5019 unset wrcomtop
5022 proc mkbranch {} {
5023 global rowmenuid mkbrtop
5025 set top .makebranch
5026 catch {destroy $top}
5027 toplevel $top
5028 label $top.title -text "Create new branch"
5029 grid $top.title - -pady 10
5030 label $top.id -text "ID:"
5031 entry $top.sha1 -width 40 -relief flat
5032 $top.sha1 insert 0 $rowmenuid
5033 $top.sha1 conf -state readonly
5034 grid $top.id $top.sha1 -sticky w
5035 label $top.nlab -text "Name:"
5036 entry $top.name -width 40
5037 grid $top.nlab $top.name -sticky w
5038 frame $top.buts
5039 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5040 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5041 grid $top.buts.go $top.buts.can
5042 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5043 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5044 grid $top.buts - -pady 10 -sticky ew
5045 focus $top.name
5048 proc mkbrgo {top} {
5049 global headids idheads
5051 set name [$top.name get]
5052 set id [$top.sha1 get]
5053 if {$name eq {}} {
5054 error_popup "Please specify a name for the new branch"
5055 return
5057 catch {destroy $top}
5058 nowbusy newbranch
5059 update
5060 if {[catch {
5061 exec git branch $name $id
5062 } err]} {
5063 notbusy newbranch
5064 error_popup $err
5065 } else {
5066 set headids($name) $id
5067 if {![info exists idheads($id)]} {
5068 addedhead $id
5070 lappend idheads($id) $name
5071 # XXX should update list of heads displayed for selected commit
5072 notbusy newbranch
5073 redrawtags $id
5077 # Stuff for finding nearby tags
5078 proc getallcommits {} {
5079 global allcstart allcommits allcfd allids
5081 set allids {}
5082 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5083 set allcfd $fd
5084 fconfigure $fd -blocking 0
5085 set allcommits "reading"
5086 nowbusy allcommits
5087 restartgetall $fd
5090 proc discardallcommits {} {
5091 global allparents allchildren allcommits allcfd
5092 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5094 if {![info exists allcommits]} return
5095 if {$allcommits eq "reading"} {
5096 catch {close $allcfd}
5098 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5099 alldtags tagisdesc desc_heads} {
5100 catch {unset $v}
5104 proc restartgetall {fd} {
5105 global allcstart
5107 fileevent $fd readable [list getallclines $fd]
5108 set allcstart [clock clicks -milliseconds]
5111 proc combine_dtags {l1 l2} {
5112 global tagisdesc notfirstd
5114 set res [lsort -unique [concat $l1 $l2]]
5115 for {set i 0} {$i < [llength $res]} {incr i} {
5116 set x [lindex $res $i]
5117 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5118 set y [lindex $res $j]
5119 if {[info exists tagisdesc($x,$y)]} {
5120 if {$tagisdesc($x,$y) > 0} {
5121 # x is a descendent of y, exclude x
5122 set res [lreplace $res $i $i]
5123 incr i -1
5124 break
5125 } else {
5126 # y is a descendent of x, exclude y
5127 set res [lreplace $res $j $j]
5129 } else {
5130 # no relation, keep going
5131 incr j
5135 return $res
5138 proc combine_atags {l1 l2} {
5139 global tagisdesc
5141 set res [lsort -unique [concat $l1 $l2]]
5142 for {set i 0} {$i < [llength $res]} {incr i} {
5143 set x [lindex $res $i]
5144 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5145 set y [lindex $res $j]
5146 if {[info exists tagisdesc($x,$y)]} {
5147 if {$tagisdesc($x,$y) < 0} {
5148 # x is an ancestor of y, exclude x
5149 set res [lreplace $res $i $i]
5150 incr i -1
5151 break
5152 } else {
5153 # y is an ancestor of x, exclude y
5154 set res [lreplace $res $j $j]
5156 } else {
5157 # no relation, keep going
5158 incr j
5162 return $res
5165 proc forward_pass {id children} {
5166 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5168 set dtags {}
5169 set dheads {}
5170 foreach child $children {
5171 if {[info exists idtags($child)]} {
5172 set ctags [list $child]
5173 } else {
5174 set ctags $desc_tags($child)
5176 if {$dtags eq {}} {
5177 set dtags $ctags
5178 } elseif {$ctags ne $dtags} {
5179 set dtags [combine_dtags $dtags $ctags]
5181 set cheads $desc_heads($child)
5182 if {$dheads eq {}} {
5183 set dheads $cheads
5184 } elseif {$cheads ne $dheads} {
5185 set dheads [lsort -unique [concat $dheads $cheads]]
5188 set desc_tags($id) $dtags
5189 if {[info exists idtags($id)]} {
5190 set adt $dtags
5191 foreach tag $dtags {
5192 set adt [concat $adt $alldtags($tag)]
5194 set adt [lsort -unique $adt]
5195 set alldtags($id) $adt
5196 foreach tag $adt {
5197 set tagisdesc($id,$tag) -1
5198 set tagisdesc($tag,$id) 1
5201 if {[info exists idheads($id)]} {
5202 lappend dheads $id
5204 set desc_heads($id) $dheads
5207 proc getallclines {fd} {
5208 global allparents allchildren allcommits allcstart
5209 global desc_tags anc_tags idtags tagisdesc allids
5210 global desc_heads idheads travindex
5212 while {[gets $fd line] >= 0} {
5213 set id [lindex $line 0]
5214 lappend allids $id
5215 set olds [lrange $line 1 end]
5216 set allparents($id) $olds
5217 if {![info exists allchildren($id)]} {
5218 set allchildren($id) {}
5220 foreach p $olds {
5221 lappend allchildren($p) $id
5223 # compute nearest tagged descendents as we go
5224 # also compute descendent heads
5225 forward_pass $id $allchildren($id)
5226 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5227 fileevent $fd readable {}
5228 after idle restartgetall $fd
5229 return
5232 if {[eof $fd]} {
5233 set travindex [llength $allids]
5234 set allcommits "traversing"
5235 after idle restartatags
5236 if {[catch {close $fd} err]} {
5237 error_popup "Error reading full commit graph: $err.\n\
5238 Results may be incomplete."
5243 # walk backward through the tree and compute nearest tagged ancestors
5244 proc restartatags {} {
5245 global allids allparents idtags anc_tags travindex
5247 set t0 [clock clicks -milliseconds]
5248 set i $travindex
5249 while {[incr i -1] >= 0} {
5250 set id [lindex $allids $i]
5251 set atags {}
5252 foreach p $allparents($id) {
5253 if {[info exists idtags($p)]} {
5254 set ptags [list $p]
5255 } else {
5256 set ptags $anc_tags($p)
5258 if {$atags eq {}} {
5259 set atags $ptags
5260 } elseif {$ptags ne $atags} {
5261 set atags [combine_atags $atags $ptags]
5264 set anc_tags($id) $atags
5265 if {[clock clicks -milliseconds] - $t0 >= 50} {
5266 set travindex $i
5267 after idle restartatags
5268 return
5271 set allcommits "done"
5272 set travindex 0
5273 notbusy allcommits
5274 dispneartags
5277 # update the desc_heads array for a new head just added
5278 proc addedhead {hid} {
5279 global desc_heads allparents
5281 set todo [list $hid]
5282 while {$todo ne {}} {
5283 set do [lindex $todo 0]
5284 set todo [lrange $todo 1 end]
5285 if {![info exists desc_heads($do)] ||
5286 [lsearch -exact $desc_heads($do) $hid] >= 0} continue
5287 set oldheads $desc_heads($do)
5288 lappend desc_heads($do) $hid
5289 set heads $desc_heads($do)
5290 while {1} {
5291 set p $allparents($do)
5292 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5293 $desc_heads($p) ne $oldheads} break
5294 set do $p
5295 set desc_heads($do) $heads
5297 set todo [concat $todo $p]
5301 proc changedrefs {} {
5302 global desc_heads desc_tags anc_tags allcommits allids
5303 global allchildren allparents idtags travindex
5305 if {![info exists allcommits]} return
5306 catch {unset desc_heads}
5307 catch {unset desc_tags}
5308 catch {unset anc_tags}
5309 catch {unset alldtags}
5310 catch {unset tagisdesc}
5311 foreach id $allids {
5312 forward_pass $id $allchildren($id)
5314 if {$allcommits ne "reading"} {
5315 set travindex [llength $allids]
5316 if {$allcommits ne "traversing"} {
5317 set allcommits "traversing"
5318 after idle restartatags
5323 proc rereadrefs {} {
5324 global idtags idheads idotherrefs mainhead
5326 set refids [concat [array names idtags] \
5327 [array names idheads] [array names idotherrefs]]
5328 foreach id $refids {
5329 if {![info exists ref($id)]} {
5330 set ref($id) [listrefs $id]
5333 set oldmainhead $mainhead
5334 readrefs
5335 changedrefs
5336 set refids [lsort -unique [concat $refids [array names idtags] \
5337 [array names idheads] [array names idotherrefs]]]
5338 foreach id $refids {
5339 set v [listrefs $id]
5340 if {![info exists ref($id)] || $ref($id) != $v ||
5341 ($id eq $oldmainhead && $id ne $mainhead) ||
5342 ($id eq $mainhead && $id ne $oldmainhead)} {
5343 redrawtags $id
5348 proc listrefs {id} {
5349 global idtags idheads idotherrefs
5351 set x {}
5352 if {[info exists idtags($id)]} {
5353 set x $idtags($id)
5355 set y {}
5356 if {[info exists idheads($id)]} {
5357 set y $idheads($id)
5359 set z {}
5360 if {[info exists idotherrefs($id)]} {
5361 set z $idotherrefs($id)
5363 return [list $x $y $z]
5366 proc showtag {tag isnew} {
5367 global ctext tagcontents tagids linknum
5369 if {$isnew} {
5370 addtohistory [list showtag $tag 0]
5372 $ctext conf -state normal
5373 clear_ctext
5374 set linknum 0
5375 if {[info exists tagcontents($tag)]} {
5376 set text $tagcontents($tag)
5377 } else {
5378 set text "Tag: $tag\nId: $tagids($tag)"
5380 appendwithlinks $text {}
5381 $ctext conf -state disabled
5382 init_flist {}
5385 proc doquit {} {
5386 global stopped
5387 set stopped 100
5388 destroy .
5391 proc doprefs {} {
5392 global maxwidth maxgraphpct diffopts
5393 global oldprefs prefstop showneartags
5394 global bgcolor fgcolor ctext diffcolors
5396 set top .gitkprefs
5397 set prefstop $top
5398 if {[winfo exists $top]} {
5399 raise $top
5400 return
5402 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5403 set oldprefs($v) [set $v]
5405 toplevel $top
5406 wm title $top "Gitk preferences"
5407 label $top.ldisp -text "Commit list display options"
5408 grid $top.ldisp - -sticky w -pady 10
5409 label $top.spacer -text " "
5410 label $top.maxwidthl -text "Maximum graph width (lines)" \
5411 -font optionfont
5412 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5413 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5414 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5415 -font optionfont
5416 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5417 grid x $top.maxpctl $top.maxpct -sticky w
5419 label $top.ddisp -text "Diff display options"
5420 grid $top.ddisp - -sticky w -pady 10
5421 label $top.diffoptl -text "Options for diff program" \
5422 -font optionfont
5423 entry $top.diffopt -width 20 -textvariable diffopts
5424 grid x $top.diffoptl $top.diffopt -sticky w
5425 frame $top.ntag
5426 label $top.ntag.l -text "Display nearby tags" -font optionfont
5427 checkbutton $top.ntag.b -variable showneartags
5428 pack $top.ntag.b $top.ntag.l -side left
5429 grid x $top.ntag -sticky w
5431 label $top.cdisp -text "Colors: press to choose"
5432 grid $top.cdisp - -sticky w -pady 10
5433 label $top.bg -padx 40 -relief sunk -background $bgcolor
5434 button $top.bgbut -text "Background" -font optionfont \
5435 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5436 grid x $top.bgbut $top.bg -sticky w
5437 label $top.fg -padx 40 -relief sunk -background $fgcolor
5438 button $top.fgbut -text "Foreground" -font optionfont \
5439 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5440 grid x $top.fgbut $top.fg -sticky w
5441 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5442 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5443 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5444 [list $ctext tag conf d0 -foreground]]
5445 grid x $top.diffoldbut $top.diffold -sticky w
5446 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5447 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5448 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5449 [list $ctext tag conf d1 -foreground]]
5450 grid x $top.diffnewbut $top.diffnew -sticky w
5451 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5452 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5453 -command [list choosecolor diffcolors 2 $top.hunksep \
5454 "diff hunk header" \
5455 [list $ctext tag conf hunksep -foreground]]
5456 grid x $top.hunksepbut $top.hunksep -sticky w
5458 frame $top.buts
5459 button $top.buts.ok -text "OK" -command prefsok
5460 button $top.buts.can -text "Cancel" -command prefscan
5461 grid $top.buts.ok $top.buts.can
5462 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5463 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5464 grid $top.buts - - -pady 10 -sticky ew
5467 proc choosecolor {v vi w x cmd} {
5468 global $v
5470 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5471 -title "Gitk: choose color for $x"]
5472 if {$c eq {}} return
5473 $w conf -background $c
5474 lset $v $vi $c
5475 eval $cmd $c
5478 proc setbg {c} {
5479 global bglist
5481 foreach w $bglist {
5482 $w conf -background $c
5486 proc setfg {c} {
5487 global fglist canv
5489 foreach w $fglist {
5490 $w conf -foreground $c
5492 allcanvs itemconf text -fill $c
5493 $canv itemconf circle -outline $c
5496 proc prefscan {} {
5497 global maxwidth maxgraphpct diffopts
5498 global oldprefs prefstop showneartags
5500 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5501 set $v $oldprefs($v)
5503 catch {destroy $prefstop}
5504 unset prefstop
5507 proc prefsok {} {
5508 global maxwidth maxgraphpct
5509 global oldprefs prefstop showneartags
5511 catch {destroy $prefstop}
5512 unset prefstop
5513 if {$maxwidth != $oldprefs(maxwidth)
5514 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5515 redisplay
5516 } elseif {$showneartags != $oldprefs(showneartags)} {
5517 reselectline
5521 proc formatdate {d} {
5522 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5525 # This list of encoding names and aliases is distilled from
5526 # http://www.iana.org/assignments/character-sets.
5527 # Not all of them are supported by Tcl.
5528 set encoding_aliases {
5529 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5530 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5531 { ISO-10646-UTF-1 csISO10646UTF1 }
5532 { ISO_646.basic:1983 ref csISO646basic1983 }
5533 { INVARIANT csINVARIANT }
5534 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5535 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5536 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5537 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5538 { NATS-DANO iso-ir-9-1 csNATSDANO }
5539 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5540 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5541 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5542 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5543 { ISO-2022-KR csISO2022KR }
5544 { EUC-KR csEUCKR }
5545 { ISO-2022-JP csISO2022JP }
5546 { ISO-2022-JP-2 csISO2022JP2 }
5547 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5548 csISO13JISC6220jp }
5549 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5550 { IT iso-ir-15 ISO646-IT csISO15Italian }
5551 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5552 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5553 { greek7-old iso-ir-18 csISO18Greek7Old }
5554 { latin-greek iso-ir-19 csISO19LatinGreek }
5555 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5556 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5557 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5558 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5559 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5560 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5561 { INIS iso-ir-49 csISO49INIS }
5562 { INIS-8 iso-ir-50 csISO50INIS8 }
5563 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5564 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5565 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5566 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5567 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5568 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5569 csISO60Norwegian1 }
5570 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5571 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5572 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5573 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5574 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5575 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5576 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5577 { greek7 iso-ir-88 csISO88Greek7 }
5578 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5579 { iso-ir-90 csISO90 }
5580 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5581 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5582 csISO92JISC62991984b }
5583 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5584 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5585 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5586 csISO95JIS62291984handadd }
5587 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5588 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5589 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5590 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5591 CP819 csISOLatin1 }
5592 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5593 { T.61-7bit iso-ir-102 csISO102T617bit }
5594 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5595 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5596 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5597 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5598 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5599 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5600 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5601 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5602 arabic csISOLatinArabic }
5603 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5604 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5605 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5606 greek greek8 csISOLatinGreek }
5607 { T.101-G2 iso-ir-128 csISO128T101G2 }
5608 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5609 csISOLatinHebrew }
5610 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5611 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5612 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5613 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5614 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5615 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5616 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5617 csISOLatinCyrillic }
5618 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5619 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5620 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5621 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5622 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5623 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5624 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5625 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5626 { ISO_10367-box iso-ir-155 csISO10367Box }
5627 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5628 { latin-lap lap iso-ir-158 csISO158Lap }
5629 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5630 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5631 { us-dk csUSDK }
5632 { dk-us csDKUS }
5633 { JIS_X0201 X0201 csHalfWidthKatakana }
5634 { KSC5636 ISO646-KR csKSC5636 }
5635 { ISO-10646-UCS-2 csUnicode }
5636 { ISO-10646-UCS-4 csUCS4 }
5637 { DEC-MCS dec csDECMCS }
5638 { hp-roman8 roman8 r8 csHPRoman8 }
5639 { macintosh mac csMacintosh }
5640 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5641 csIBM037 }
5642 { IBM038 EBCDIC-INT cp038 csIBM038 }
5643 { IBM273 CP273 csIBM273 }
5644 { IBM274 EBCDIC-BE CP274 csIBM274 }
5645 { IBM275 EBCDIC-BR cp275 csIBM275 }
5646 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5647 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5648 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5649 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5650 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5651 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5652 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5653 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5654 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5655 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5656 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5657 { IBM437 cp437 437 csPC8CodePage437 }
5658 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5659 { IBM775 cp775 csPC775Baltic }
5660 { IBM850 cp850 850 csPC850Multilingual }
5661 { IBM851 cp851 851 csIBM851 }
5662 { IBM852 cp852 852 csPCp852 }
5663 { IBM855 cp855 855 csIBM855 }
5664 { IBM857 cp857 857 csIBM857 }
5665 { IBM860 cp860 860 csIBM860 }
5666 { IBM861 cp861 861 cp-is csIBM861 }
5667 { IBM862 cp862 862 csPC862LatinHebrew }
5668 { IBM863 cp863 863 csIBM863 }
5669 { IBM864 cp864 csIBM864 }
5670 { IBM865 cp865 865 csIBM865 }
5671 { IBM866 cp866 866 csIBM866 }
5672 { IBM868 CP868 cp-ar csIBM868 }
5673 { IBM869 cp869 869 cp-gr csIBM869 }
5674 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5675 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5676 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5677 { IBM891 cp891 csIBM891 }
5678 { IBM903 cp903 csIBM903 }
5679 { IBM904 cp904 904 csIBBM904 }
5680 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5681 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5682 { IBM1026 CP1026 csIBM1026 }
5683 { EBCDIC-AT-DE csIBMEBCDICATDE }
5684 { EBCDIC-AT-DE-A csEBCDICATDEA }
5685 { EBCDIC-CA-FR csEBCDICCAFR }
5686 { EBCDIC-DK-NO csEBCDICDKNO }
5687 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5688 { EBCDIC-FI-SE csEBCDICFISE }
5689 { EBCDIC-FI-SE-A csEBCDICFISEA }
5690 { EBCDIC-FR csEBCDICFR }
5691 { EBCDIC-IT csEBCDICIT }
5692 { EBCDIC-PT csEBCDICPT }
5693 { EBCDIC-ES csEBCDICES }
5694 { EBCDIC-ES-A csEBCDICESA }
5695 { EBCDIC-ES-S csEBCDICESS }
5696 { EBCDIC-UK csEBCDICUK }
5697 { EBCDIC-US csEBCDICUS }
5698 { UNKNOWN-8BIT csUnknown8BiT }
5699 { MNEMONIC csMnemonic }
5700 { MNEM csMnem }
5701 { VISCII csVISCII }
5702 { VIQR csVIQR }
5703 { KOI8-R csKOI8R }
5704 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5705 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5706 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5707 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5708 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5709 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5710 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5711 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5712 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5713 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5714 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5715 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5716 { IBM1047 IBM-1047 }
5717 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5718 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5719 { UNICODE-1-1 csUnicode11 }
5720 { CESU-8 csCESU-8 }
5721 { BOCU-1 csBOCU-1 }
5722 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5723 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5724 l8 }
5725 { ISO-8859-15 ISO_8859-15 Latin-9 }
5726 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5727 { GBK CP936 MS936 windows-936 }
5728 { JIS_Encoding csJISEncoding }
5729 { Shift_JIS MS_Kanji csShiftJIS }
5730 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5731 EUC-JP }
5732 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5733 { ISO-10646-UCS-Basic csUnicodeASCII }
5734 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5735 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5736 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5737 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5738 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5739 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5740 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5741 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5742 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5743 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5744 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5745 { Ventura-US csVenturaUS }
5746 { Ventura-International csVenturaInternational }
5747 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5748 { PC8-Turkish csPC8Turkish }
5749 { IBM-Symbols csIBMSymbols }
5750 { IBM-Thai csIBMThai }
5751 { HP-Legal csHPLegal }
5752 { HP-Pi-font csHPPiFont }
5753 { HP-Math8 csHPMath8 }
5754 { Adobe-Symbol-Encoding csHPPSMath }
5755 { HP-DeskTop csHPDesktop }
5756 { Ventura-Math csVenturaMath }
5757 { Microsoft-Publishing csMicrosoftPublishing }
5758 { Windows-31J csWindows31J }
5759 { GB2312 csGB2312 }
5760 { Big5 csBig5 }
5763 proc tcl_encoding {enc} {
5764 global encoding_aliases
5765 set names [encoding names]
5766 set lcnames [string tolower $names]
5767 set enc [string tolower $enc]
5768 set i [lsearch -exact $lcnames $enc]
5769 if {$i < 0} {
5770 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5771 if {[regsub {^iso[-_]} $enc iso encx]} {
5772 set i [lsearch -exact $lcnames $encx]
5775 if {$i < 0} {
5776 foreach l $encoding_aliases {
5777 set ll [string tolower $l]
5778 if {[lsearch -exact $ll $enc] < 0} continue
5779 # look through the aliases for one that tcl knows about
5780 foreach e $ll {
5781 set i [lsearch -exact $lcnames $e]
5782 if {$i < 0} {
5783 if {[regsub {^iso[-_]} $e iso ex]} {
5784 set i [lsearch -exact $lcnames $ex]
5787 if {$i >= 0} break
5789 break
5792 if {$i >= 0} {
5793 return [lindex $names $i]
5795 return {}
5798 # defaults...
5799 set datemode 0
5800 set diffopts "-U 5 -p"
5801 set wrcomcmd "git diff-tree --stdin -p --pretty"
5803 set gitencoding {}
5804 catch {
5805 set gitencoding [exec git repo-config --get i18n.commitencoding]
5807 if {$gitencoding == ""} {
5808 set gitencoding "utf-8"
5810 set tclencoding [tcl_encoding $gitencoding]
5811 if {$tclencoding == {}} {
5812 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5815 set mainfont {Helvetica 9}
5816 set textfont {Courier 9}
5817 set uifont {Helvetica 9 bold}
5818 set findmergefiles 0
5819 set maxgraphpct 50
5820 set maxwidth 16
5821 set revlistorder 0
5822 set fastdate 0
5823 set uparrowlen 7
5824 set downarrowlen 7
5825 set mingaplen 30
5826 set cmitmode "patch"
5827 set wrapcomment "none"
5828 set showneartags 1
5830 set colors {green red blue magenta darkgrey brown orange}
5831 set bgcolor white
5832 set fgcolor black
5833 set diffcolors {red "#00a000" blue}
5835 catch {source ~/.gitk}
5837 font create optionfont -family sans-serif -size -12
5839 set revtreeargs {}
5840 foreach arg $argv {
5841 switch -regexp -- $arg {
5842 "^$" { }
5843 "^-d" { set datemode 1 }
5844 default {
5845 lappend revtreeargs $arg
5850 # check that we can find a .git directory somewhere...
5851 set gitdir [gitdir]
5852 if {![file isdirectory $gitdir]} {
5853 show_error {} . "Cannot find the git directory \"$gitdir\"."
5854 exit 1
5857 set cmdline_files {}
5858 set i [lsearch -exact $revtreeargs "--"]
5859 if {$i >= 0} {
5860 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5861 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5862 } elseif {$revtreeargs ne {}} {
5863 if {[catch {
5864 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5865 set cmdline_files [split $f "\n"]
5866 set n [llength $cmdline_files]
5867 set revtreeargs [lrange $revtreeargs 0 end-$n]
5868 } err]} {
5869 # unfortunately we get both stdout and stderr in $err,
5870 # so look for "fatal:".
5871 set i [string first "fatal:" $err]
5872 if {$i > 0} {
5873 set err [string range $err [expr {$i + 6}] end]
5875 show_error {} . "Bad arguments to gitk:\n$err"
5876 exit 1
5880 set history {}
5881 set historyindex 0
5882 set fh_serial 0
5883 set nhl_names {}
5884 set highlight_paths {}
5885 set searchdirn -forwards
5886 set boldrows {}
5887 set boldnamerows {}
5889 set optim_delay 16
5891 set nextviewnum 1
5892 set curview 0
5893 set selectedview 0
5894 set selectedhlview None
5895 set viewfiles(0) {}
5896 set viewperm(0) 0
5897 set viewargs(0) {}
5899 set cmdlineok 0
5900 set stopped 0
5901 set stuffsaved 0
5902 set patchnum 0
5903 setcoords
5904 makewindow
5905 readrefs
5907 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5908 # create a view for the files/dirs specified on the command line
5909 set curview 1
5910 set selectedview 1
5911 set nextviewnum 2
5912 set viewname(1) "Command line"
5913 set viewfiles(1) $cmdline_files
5914 set viewargs(1) $revtreeargs
5915 set viewperm(1) 0
5916 addviewmenu 1
5917 .bar.view entryconf 2 -state normal
5918 .bar.view entryconf 3 -state normal
5921 if {[info exists permviews]} {
5922 foreach v $permviews {
5923 set n $nextviewnum
5924 incr nextviewnum
5925 set viewname($n) [lindex $v 0]
5926 set viewfiles($n) [lindex $v 1]
5927 set viewargs($n) [lindex $v 2]
5928 set viewperm($n) 1
5929 addviewmenu $n
5932 getcommits