Deprecate usage of git-var -l for getting config vars list
[git/dscho.git] / gitk
blob5362b76bee5ad0ee13964634ac12e7d73b85cdbb
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 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 {rlargs} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
23 set startmsecs [clock clicks -milliseconds]
24 set nextupdate [expr {$startmsecs + 100}]
25 set ncmupdate 1
26 initlayout
27 set order "--topo-order"
28 if {$datemode} {
29 set order "--date-order"
31 if {[catch {
32 set commfd [open [concat | git-rev-list --header $order \
33 --parents --boundary --default HEAD $rlargs] r]
34 } err]} {
35 puts stderr "Error executing git-rev-list: $err"
36 exit 1
38 set leftover {}
39 fconfigure $commfd -blocking 0 -translation lf
40 if {$tclencoding != {}} {
41 fconfigure $commfd -encoding $tclencoding
43 fileevent $commfd readable [list getcommitlines $commfd]
44 . config -cursor watch
45 settextcursor watch
48 proc getcommits {rargs} {
49 global phase canv mainfont
51 set phase getcommits
52 start_rev_list $rargs
53 $canv delete all
54 $canv create text 3 3 -anchor nw -text "Reading commits..." \
55 -font $mainfont -tags textitems
58 proc getcommitlines {commfd} {
59 global commitlisted nextupdate
60 global leftover
61 global displayorder commitidx commitrow commitdata
62 global parentlist childlist children
64 set stuff [read $commfd]
65 if {$stuff == {}} {
66 if {![eof $commfd]} return
67 # set it blocking so we wait for the process to terminate
68 fconfigure $commfd -blocking 1
69 if {![catch {close $commfd} err]} {
70 after idle finishcommits
71 return
73 if {[string range $err 0 4] == "usage"} {
74 set err \
75 "Gitk: error reading commits: bad arguments to git-rev-list.\
76 (Note: arguments to gitk are passed to git-rev-list\
77 to allow selection of commits to be displayed.)"
78 } else {
79 set err "Error reading commits: $err"
81 error_popup $err
82 exit 1
84 set start 0
85 set gotsome 0
86 while 1 {
87 set i [string first "\0" $stuff $start]
88 if {$i < 0} {
89 append leftover [string range $stuff $start end]
90 break
92 if {$start == 0} {
93 set cmit $leftover
94 append cmit [string range $stuff 0 [expr {$i - 1}]]
95 set leftover {}
96 } else {
97 set cmit [string range $stuff $start [expr {$i - 1}]]
99 set start [expr {$i + 1}]
100 set j [string first "\n" $cmit]
101 set ok 0
102 set listed 1
103 if {$j >= 0} {
104 set ids [string range $cmit 0 [expr {$j - 1}]]
105 if {[string range $ids 0 0] == "-"} {
106 set listed 0
107 set ids [string range $ids 1 end]
109 set ok 1
110 foreach id $ids {
111 if {[string length $id] != 40} {
112 set ok 0
113 break
117 if {!$ok} {
118 set shortcmit $cmit
119 if {[string length $shortcmit] > 80} {
120 set shortcmit "[string range $shortcmit 0 80]..."
122 error_popup "Can't parse git-rev-list output: {$shortcmit}"
123 exit 1
125 set id [lindex $ids 0]
126 if {$listed} {
127 set olds [lrange $ids 1 end]
128 if {[llength $olds] > 1} {
129 set olds [lsort -unique $olds]
131 foreach p $olds {
132 lappend children($p) $id
134 } else {
135 set olds {}
137 lappend parentlist $olds
138 if {[info exists children($id)]} {
139 lappend childlist $children($id)
140 } else {
141 lappend childlist {}
143 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
144 set commitrow($id) $commitidx
145 incr commitidx
146 lappend displayorder $id
147 lappend commitlisted $listed
148 set gotsome 1
150 if {$gotsome} {
151 layoutmore
153 if {[clock clicks -milliseconds] >= $nextupdate} {
154 doupdate 1
158 proc doupdate {reading} {
159 global commfd nextupdate numcommits ncmupdate
161 if {$reading} {
162 fileevent $commfd readable {}
164 update
165 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
166 if {$numcommits < 100} {
167 set ncmupdate [expr {$numcommits + 1}]
168 } elseif {$numcommits < 10000} {
169 set ncmupdate [expr {$numcommits + 10}]
170 } else {
171 set ncmupdate [expr {$numcommits + 100}]
173 if {$reading} {
174 fileevent $commfd readable [list getcommitlines $commfd]
178 proc readcommit {id} {
179 if {[catch {set contents [exec git-cat-file commit $id]}]} return
180 parsecommit $id $contents 0
183 proc updatecommits {rargs} {
184 stopfindproc
185 foreach v {colormap selectedline matchinglines treediffs
186 mergefilelist currentid rowtextx commitrow
187 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
188 linesegends crossings cornercrossings} {
189 global $v
190 catch {unset $v}
192 allcanvs delete all
193 readrefs
194 getcommits $rargs
197 proc parsecommit {id contents listed} {
198 global commitinfo cdate
200 set inhdr 1
201 set comment {}
202 set headline {}
203 set auname {}
204 set audate {}
205 set comname {}
206 set comdate {}
207 set hdrend [string first "\n\n" $contents]
208 if {$hdrend < 0} {
209 # should never happen...
210 set hdrend [string length $contents]
212 set header [string range $contents 0 [expr {$hdrend - 1}]]
213 set comment [string range $contents [expr {$hdrend + 2}] end]
214 foreach line [split $header "\n"] {
215 set tag [lindex $line 0]
216 if {$tag == "author"} {
217 set audate [lindex $line end-1]
218 set auname [lrange $line 1 end-2]
219 } elseif {$tag == "committer"} {
220 set comdate [lindex $line end-1]
221 set comname [lrange $line 1 end-2]
224 set headline {}
225 # take the first line of the comment as the headline
226 set i [string first "\n" $comment]
227 if {$i >= 0} {
228 set headline [string trim [string range $comment 0 $i]]
229 } else {
230 set headline $comment
232 if {!$listed} {
233 # git-rev-list indents the comment by 4 spaces;
234 # if we got this via git-cat-file, add the indentation
235 set newcomment {}
236 foreach line [split $comment "\n"] {
237 append newcomment " "
238 append newcomment $line
239 append newcomment "\n"
241 set comment $newcomment
243 if {$comdate != {}} {
244 set cdate($id) $comdate
246 set commitinfo($id) [list $headline $auname $audate \
247 $comname $comdate $comment]
250 proc getcommit {id} {
251 global commitdata commitinfo
253 if {[info exists commitdata($id)]} {
254 parsecommit $id $commitdata($id) 1
255 } else {
256 readcommit $id
257 if {![info exists commitinfo($id)]} {
258 set commitinfo($id) {"No commit information available"}
261 return 1
264 proc readrefs {} {
265 global tagids idtags headids idheads tagcontents
266 global otherrefids idotherrefs
268 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
269 catch {unset $v}
271 set refd [open [list | git ls-remote [gitdir]] r]
272 while {0 <= [set n [gets $refd line]]} {
273 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
274 match id path]} {
275 continue
277 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
278 set type others
279 set name $path
281 if {$type == "tags"} {
282 set tagids($name) $id
283 lappend idtags($id) $name
284 set obj {}
285 set type {}
286 set tag {}
287 catch {
288 set commit [exec git-rev-parse "$id^0"]
289 if {"$commit" != "$id"} {
290 set tagids($name) $commit
291 lappend idtags($commit) $name
294 catch {
295 set tagcontents($name) [exec git-cat-file tag "$id"]
297 } elseif { $type == "heads" } {
298 set headids($name) $id
299 lappend idheads($id) $name
300 } else {
301 set otherrefids($name) $id
302 lappend idotherrefs($id) $name
305 close $refd
308 proc error_popup msg {
309 set w .error
310 toplevel $w
311 wm transient $w .
312 message $w.m -text $msg -justify center -aspect 400
313 pack $w.m -side top -fill x -padx 20 -pady 20
314 button $w.ok -text OK -command "destroy $w"
315 pack $w.ok -side bottom -fill x
316 bind $w <Visibility> "grab $w; focus $w"
317 bind $w <Key-Return> "destroy $w"
318 tkwait window $w
321 proc makewindow {rargs} {
322 global canv canv2 canv3 linespc charspc ctext cflist textfont mainfont uifont
323 global findtype findtypemenu findloc findstring fstring geometry
324 global entries sha1entry sha1string sha1but
325 global maincursor textcursor curtextcursor
326 global rowctxmenu mergemax
328 menu .bar
329 .bar add cascade -label "File" -menu .bar.file
330 .bar configure -font $uifont
331 menu .bar.file
332 .bar.file add command -label "Update" -command [list updatecommits $rargs]
333 .bar.file add command -label "Reread references" -command rereadrefs
334 .bar.file add command -label "Quit" -command doquit
335 .bar.file configure -font $uifont
336 menu .bar.edit
337 .bar add cascade -label "Edit" -menu .bar.edit
338 .bar.edit add command -label "Preferences" -command doprefs
339 .bar.edit configure -font $uifont
340 menu .bar.help
341 .bar add cascade -label "Help" -menu .bar.help
342 .bar.help add command -label "About gitk" -command about
343 .bar.help add command -label "Key bindings" -command keys
344 .bar.help configure -font $uifont
345 . configure -menu .bar
347 if {![info exists geometry(canv1)]} {
348 set geometry(canv1) [expr {45 * $charspc}]
349 set geometry(canv2) [expr {30 * $charspc}]
350 set geometry(canv3) [expr {15 * $charspc}]
351 set geometry(canvh) [expr {25 * $linespc + 4}]
352 set geometry(ctextw) 80
353 set geometry(ctexth) 30
354 set geometry(cflistw) 30
356 panedwindow .ctop -orient vertical
357 if {[info exists geometry(width)]} {
358 .ctop conf -width $geometry(width) -height $geometry(height)
359 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
360 set geometry(ctexth) [expr {($texth - 8) /
361 [font metrics $textfont -linespace]}]
363 frame .ctop.top
364 frame .ctop.top.bar
365 pack .ctop.top.bar -side bottom -fill x
366 set cscroll .ctop.top.csb
367 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
368 pack $cscroll -side right -fill y
369 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
370 pack .ctop.top.clist -side top -fill both -expand 1
371 .ctop add .ctop.top
372 set canv .ctop.top.clist.canv
373 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
374 -bg white -bd 0 \
375 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
376 .ctop.top.clist add $canv
377 set canv2 .ctop.top.clist.canv2
378 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
379 -bg white -bd 0 -yscrollincr $linespc
380 .ctop.top.clist add $canv2
381 set canv3 .ctop.top.clist.canv3
382 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
383 -bg white -bd 0 -yscrollincr $linespc
384 .ctop.top.clist add $canv3
385 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
387 set sha1entry .ctop.top.bar.sha1
388 set entries $sha1entry
389 set sha1but .ctop.top.bar.sha1label
390 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
391 -command gotocommit -width 8 -font $uifont
392 $sha1but conf -disabledforeground [$sha1but cget -foreground]
393 pack .ctop.top.bar.sha1label -side left
394 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
395 trace add variable sha1string write sha1change
396 pack $sha1entry -side left -pady 2
398 image create bitmap bm-left -data {
399 #define left_width 16
400 #define left_height 16
401 static unsigned char left_bits[] = {
402 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
403 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
404 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
406 image create bitmap bm-right -data {
407 #define right_width 16
408 #define right_height 16
409 static unsigned char right_bits[] = {
410 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
411 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
412 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
414 button .ctop.top.bar.leftbut -image bm-left -command goback \
415 -state disabled -width 26
416 pack .ctop.top.bar.leftbut -side left -fill y
417 button .ctop.top.bar.rightbut -image bm-right -command goforw \
418 -state disabled -width 26
419 pack .ctop.top.bar.rightbut -side left -fill y
421 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
422 pack .ctop.top.bar.findbut -side left
423 set findstring {}
424 set fstring .ctop.top.bar.findstring
425 lappend entries $fstring
426 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
427 pack $fstring -side left -expand 1 -fill x
428 set findtype Exact
429 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
430 findtype Exact IgnCase Regexp]
431 .ctop.top.bar.findtype configure -font $uifont
432 .ctop.top.bar.findtype.menu configure -font $uifont
433 set findloc "All fields"
434 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
435 Comments Author Committer Files Pickaxe
436 .ctop.top.bar.findloc configure -font $uifont
437 .ctop.top.bar.findloc.menu configure -font $uifont
439 pack .ctop.top.bar.findloc -side right
440 pack .ctop.top.bar.findtype -side right
441 # for making sure type==Exact whenever loc==Pickaxe
442 trace add variable findloc write findlocchange
444 panedwindow .ctop.cdet -orient horizontal
445 .ctop add .ctop.cdet
446 frame .ctop.cdet.left
447 set ctext .ctop.cdet.left.ctext
448 text $ctext -bg white -state disabled -font $textfont \
449 -width $geometry(ctextw) -height $geometry(ctexth) \
450 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
451 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
452 pack .ctop.cdet.left.sb -side right -fill y
453 pack $ctext -side left -fill both -expand 1
454 .ctop.cdet add .ctop.cdet.left
456 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
457 $ctext tag conf hunksep -fore blue
458 $ctext tag conf d0 -fore red
459 $ctext tag conf d1 -fore "#00a000"
460 $ctext tag conf m0 -fore red
461 $ctext tag conf m1 -fore blue
462 $ctext tag conf m2 -fore green
463 $ctext tag conf m3 -fore purple
464 $ctext tag conf m4 -fore brown
465 $ctext tag conf m5 -fore "#009090"
466 $ctext tag conf m6 -fore magenta
467 $ctext tag conf m7 -fore "#808000"
468 $ctext tag conf m8 -fore "#009000"
469 $ctext tag conf m9 -fore "#ff0080"
470 $ctext tag conf m10 -fore cyan
471 $ctext tag conf m11 -fore "#b07070"
472 $ctext tag conf m12 -fore "#70b0f0"
473 $ctext tag conf m13 -fore "#70f0b0"
474 $ctext tag conf m14 -fore "#f0b070"
475 $ctext tag conf m15 -fore "#ff70b0"
476 $ctext tag conf mmax -fore darkgrey
477 set mergemax 16
478 $ctext tag conf mresult -font [concat $textfont bold]
479 $ctext tag conf msep -font [concat $textfont bold]
480 $ctext tag conf found -back yellow
482 frame .ctop.cdet.right
483 set cflist .ctop.cdet.right.cfiles
484 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
485 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
486 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
487 pack .ctop.cdet.right.sb -side right -fill y
488 pack $cflist -side left -fill both -expand 1
489 .ctop.cdet add .ctop.cdet.right
490 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
492 pack .ctop -side top -fill both -expand 1
494 bindall <1> {selcanvline %W %x %y}
495 #bindall <B1-Motion> {selcanvline %W %x %y}
496 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
497 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
498 bindall <2> "canvscan mark %W %x %y"
499 bindall <B2-Motion> "canvscan dragto %W %x %y"
500 bindkey <Home> selfirstline
501 bindkey <End> sellastline
502 bind . <Key-Up> "selnextline -1"
503 bind . <Key-Down> "selnextline 1"
504 bindkey <Key-Right> "goforw"
505 bindkey <Key-Left> "goback"
506 bind . <Key-Prior> "selnextpage -1"
507 bind . <Key-Next> "selnextpage 1"
508 bind . <Control-Home> "allcanvs yview moveto 0.0"
509 bind . <Control-End> "allcanvs yview moveto 1.0"
510 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
511 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
512 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
513 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
514 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
515 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
516 bindkey <Key-space> "$ctext yview scroll 1 pages"
517 bindkey p "selnextline -1"
518 bindkey n "selnextline 1"
519 bindkey z "goback"
520 bindkey x "goforw"
521 bindkey i "selnextline -1"
522 bindkey k "selnextline 1"
523 bindkey j "goback"
524 bindkey l "goforw"
525 bindkey b "$ctext yview scroll -1 pages"
526 bindkey d "$ctext yview scroll 18 units"
527 bindkey u "$ctext yview scroll -18 units"
528 bindkey / {findnext 1}
529 bindkey <Key-Return> {findnext 0}
530 bindkey ? findprev
531 bindkey f nextfile
532 bind . <Control-q> doquit
533 bind . <Control-f> dofind
534 bind . <Control-g> {findnext 0}
535 bind . <Control-r> findprev
536 bind . <Control-equal> {incrfont 1}
537 bind . <Control-KP_Add> {incrfont 1}
538 bind . <Control-minus> {incrfont -1}
539 bind . <Control-KP_Subtract> {incrfont -1}
540 bind $cflist <<ListboxSelect>> listboxsel
541 bind . <Destroy> {savestuff %W}
542 bind . <Button-1> "click %W"
543 bind $fstring <Key-Return> dofind
544 bind $sha1entry <Key-Return> gotocommit
545 bind $sha1entry <<PasteSelection>> clearsha1
547 set maincursor [. cget -cursor]
548 set textcursor [$ctext cget -cursor]
549 set curtextcursor $textcursor
551 set rowctxmenu .rowctxmenu
552 menu $rowctxmenu -tearoff 0
553 $rowctxmenu add command -label "Diff this -> selected" \
554 -command {diffvssel 0}
555 $rowctxmenu add command -label "Diff selected -> this" \
556 -command {diffvssel 1}
557 $rowctxmenu add command -label "Make patch" -command mkpatch
558 $rowctxmenu add command -label "Create tag" -command mktag
559 $rowctxmenu add command -label "Write commit to file" -command writecommit
562 # mouse-2 makes all windows scan vertically, but only the one
563 # the cursor is in scans horizontally
564 proc canvscan {op w x y} {
565 global canv canv2 canv3
566 foreach c [list $canv $canv2 $canv3] {
567 if {$c == $w} {
568 $c scan $op $x $y
569 } else {
570 $c scan $op 0 $y
575 proc scrollcanv {cscroll f0 f1} {
576 $cscroll set $f0 $f1
577 drawfrac $f0 $f1
580 # when we make a key binding for the toplevel, make sure
581 # it doesn't get triggered when that key is pressed in the
582 # find string entry widget.
583 proc bindkey {ev script} {
584 global entries
585 bind . $ev $script
586 set escript [bind Entry $ev]
587 if {$escript == {}} {
588 set escript [bind Entry <Key>]
590 foreach e $entries {
591 bind $e $ev "$escript; break"
595 # set the focus back to the toplevel for any click outside
596 # the entry widgets
597 proc click {w} {
598 global entries
599 foreach e $entries {
600 if {$w == $e} return
602 focus .
605 proc savestuff {w} {
606 global canv canv2 canv3 ctext cflist mainfont textfont uifont
607 global stuffsaved findmergefiles maxgraphpct
608 global maxwidth
610 if {$stuffsaved} return
611 if {![winfo viewable .]} return
612 catch {
613 set f [open "~/.gitk-new" w]
614 puts $f [list set mainfont $mainfont]
615 puts $f [list set textfont $textfont]
616 puts $f [list set uifont $uifont]
617 puts $f [list set findmergefiles $findmergefiles]
618 puts $f [list set maxgraphpct $maxgraphpct]
619 puts $f [list set maxwidth $maxwidth]
620 puts $f "set geometry(width) [winfo width .ctop]"
621 puts $f "set geometry(height) [winfo height .ctop]"
622 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
623 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
624 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
625 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
626 set wid [expr {([winfo width $ctext] - 8) \
627 / [font measure $textfont "0"]}]
628 puts $f "set geometry(ctextw) $wid"
629 set wid [expr {([winfo width $cflist] - 11) \
630 / [font measure [$cflist cget -font] "0"]}]
631 puts $f "set geometry(cflistw) $wid"
632 close $f
633 file rename -force "~/.gitk-new" "~/.gitk"
635 set stuffsaved 1
638 proc resizeclistpanes {win w} {
639 global oldwidth
640 if {[info exists oldwidth($win)]} {
641 set s0 [$win sash coord 0]
642 set s1 [$win sash coord 1]
643 if {$w < 60} {
644 set sash0 [expr {int($w/2 - 2)}]
645 set sash1 [expr {int($w*5/6 - 2)}]
646 } else {
647 set factor [expr {1.0 * $w / $oldwidth($win)}]
648 set sash0 [expr {int($factor * [lindex $s0 0])}]
649 set sash1 [expr {int($factor * [lindex $s1 0])}]
650 if {$sash0 < 30} {
651 set sash0 30
653 if {$sash1 < $sash0 + 20} {
654 set sash1 [expr {$sash0 + 20}]
656 if {$sash1 > $w - 10} {
657 set sash1 [expr {$w - 10}]
658 if {$sash0 > $sash1 - 20} {
659 set sash0 [expr {$sash1 - 20}]
663 $win sash place 0 $sash0 [lindex $s0 1]
664 $win sash place 1 $sash1 [lindex $s1 1]
666 set oldwidth($win) $w
669 proc resizecdetpanes {win w} {
670 global oldwidth
671 if {[info exists oldwidth($win)]} {
672 set s0 [$win sash coord 0]
673 if {$w < 60} {
674 set sash0 [expr {int($w*3/4 - 2)}]
675 } else {
676 set factor [expr {1.0 * $w / $oldwidth($win)}]
677 set sash0 [expr {int($factor * [lindex $s0 0])}]
678 if {$sash0 < 45} {
679 set sash0 45
681 if {$sash0 > $w - 15} {
682 set sash0 [expr {$w - 15}]
685 $win sash place 0 $sash0 [lindex $s0 1]
687 set oldwidth($win) $w
690 proc allcanvs args {
691 global canv canv2 canv3
692 eval $canv $args
693 eval $canv2 $args
694 eval $canv3 $args
697 proc bindall {event action} {
698 global canv canv2 canv3
699 bind $canv $event $action
700 bind $canv2 $event $action
701 bind $canv3 $event $action
704 proc about {} {
705 set w .about
706 if {[winfo exists $w]} {
707 raise $w
708 return
710 toplevel $w
711 wm title $w "About gitk"
712 message $w.m -text {
713 Gitk - a commit viewer for git
715 Copyright © 2005-2006 Paul Mackerras
717 Use and redistribute under the terms of the GNU General Public License} \
718 -justify center -aspect 400
719 pack $w.m -side top -fill x -padx 20 -pady 20
720 button $w.ok -text Close -command "destroy $w"
721 pack $w.ok -side bottom
724 proc keys {} {
725 set w .keys
726 if {[winfo exists $w]} {
727 raise $w
728 return
730 toplevel $w
731 wm title $w "Gitk key bindings"
732 message $w.m -text {
733 Gitk key bindings:
735 <Ctrl-Q> Quit
736 <Home> Move to first commit
737 <End> Move to last commit
738 <Up>, p, i Move up one commit
739 <Down>, n, k Move down one commit
740 <Left>, z, j Go back in history list
741 <Right>, x, l Go forward in history list
742 <PageUp> Move up one page in commit list
743 <PageDown> Move down one page in commit list
744 <Ctrl-Home> Scroll to top of commit list
745 <Ctrl-End> Scroll to bottom of commit list
746 <Ctrl-Up> Scroll commit list up one line
747 <Ctrl-Down> Scroll commit list down one line
748 <Ctrl-PageUp> Scroll commit list up one page
749 <Ctrl-PageDown> Scroll commit list down one page
750 <Delete>, b Scroll diff view up one page
751 <Backspace> Scroll diff view up one page
752 <Space> Scroll diff view down one page
753 u Scroll diff view up 18 lines
754 d Scroll diff view down 18 lines
755 <Ctrl-F> Find
756 <Ctrl-G> Move to next find hit
757 <Ctrl-R> Move to previous find hit
758 <Return> Move to next find hit
759 / Move to next find hit, or redo find
760 ? Move to previous find hit
761 f Scroll diff view to next file
762 <Ctrl-KP+> Increase font size
763 <Ctrl-plus> Increase font size
764 <Ctrl-KP-> Decrease font size
765 <Ctrl-minus> Decrease font size
767 -justify left -bg white -border 2 -relief sunken
768 pack $w.m -side top -fill both
769 button $w.ok -text Close -command "destroy $w"
770 pack $w.ok -side bottom
773 proc shortids {ids} {
774 set res {}
775 foreach id $ids {
776 if {[llength $id] > 1} {
777 lappend res [shortids $id]
778 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
779 lappend res [string range $id 0 7]
780 } else {
781 lappend res $id
784 return $res
787 proc incrange {l x o} {
788 set n [llength $l]
789 while {$x < $n} {
790 set e [lindex $l $x]
791 if {$e ne {}} {
792 lset l $x [expr {$e + $o}]
794 incr x
796 return $l
799 proc ntimes {n o} {
800 set ret {}
801 for {} {$n > 0} {incr n -1} {
802 lappend ret $o
804 return $ret
807 proc usedinrange {id l1 l2} {
808 global children commitrow
810 if {[info exists commitrow($id)]} {
811 set r $commitrow($id)
812 if {$l1 <= $r && $r <= $l2} {
813 return [expr {$r - $l1 + 1}]
816 foreach c $children($id) {
817 if {[info exists commitrow($c)]} {
818 set r $commitrow($c)
819 if {$l1 <= $r && $r <= $l2} {
820 return [expr {$r - $l1 + 1}]
824 return 0
827 proc sanity {row {full 0}} {
828 global rowidlist rowoffsets
830 set col -1
831 set ids [lindex $rowidlist $row]
832 foreach id $ids {
833 incr col
834 if {$id eq {}} continue
835 if {$col < [llength $ids] - 1 &&
836 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
837 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
839 set o [lindex $rowoffsets $row $col]
840 set y $row
841 set x $col
842 while {$o ne {}} {
843 incr y -1
844 incr x $o
845 if {[lindex $rowidlist $y $x] != $id} {
846 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
847 puts " id=[shortids $id] check started at row $row"
848 for {set i $row} {$i >= $y} {incr i -1} {
849 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
851 break
853 if {!$full} break
854 set o [lindex $rowoffsets $y $x]
859 proc makeuparrow {oid x y z} {
860 global rowidlist rowoffsets uparrowlen idrowranges
862 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
863 incr y -1
864 incr x $z
865 set off0 [lindex $rowoffsets $y]
866 for {set x0 $x} {1} {incr x0} {
867 if {$x0 >= [llength $off0]} {
868 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
869 break
871 set z [lindex $off0 $x0]
872 if {$z ne {}} {
873 incr x0 $z
874 break
877 set z [expr {$x0 - $x}]
878 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
879 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
881 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
882 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
883 lappend idrowranges($oid) $y
886 proc initlayout {} {
887 global rowidlist rowoffsets displayorder commitlisted
888 global rowlaidout rowoptim
889 global idinlist rowchk
890 global commitidx numcommits canvxmax canv
891 global nextcolor
892 global parentlist childlist children
894 set commitidx 0
895 set numcommits 0
896 set displayorder {}
897 set commitlisted {}
898 set parentlist {}
899 set childlist {}
900 catch {unset children}
901 set nextcolor 0
902 set rowidlist {{}}
903 set rowoffsets {{}}
904 catch {unset idinlist}
905 catch {unset rowchk}
906 set rowlaidout 0
907 set rowoptim 0
908 set canvxmax [$canv cget -width]
911 proc setcanvscroll {} {
912 global canv canv2 canv3 numcommits linespc canvxmax canvy0
914 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
915 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
916 $canv2 conf -scrollregion [list 0 0 0 $ymax]
917 $canv3 conf -scrollregion [list 0 0 0 $ymax]
920 proc visiblerows {} {
921 global canv numcommits linespc
923 set ymax [lindex [$canv cget -scrollregion] 3]
924 if {$ymax eq {} || $ymax == 0} return
925 set f [$canv yview]
926 set y0 [expr {int([lindex $f 0] * $ymax)}]
927 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
928 if {$r0 < 0} {
929 set r0 0
931 set y1 [expr {int([lindex $f 1] * $ymax)}]
932 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
933 if {$r1 >= $numcommits} {
934 set r1 [expr {$numcommits - 1}]
936 return [list $r0 $r1]
939 proc layoutmore {} {
940 global rowlaidout rowoptim commitidx numcommits optim_delay
941 global uparrowlen
943 set row $rowlaidout
944 set rowlaidout [layoutrows $row $commitidx 0]
945 set orow [expr {$rowlaidout - $uparrowlen - 1}]
946 if {$orow > $rowoptim} {
947 checkcrossings $rowoptim $orow
948 optimize_rows $rowoptim 0 $orow
949 set rowoptim $orow
951 set canshow [expr {$rowoptim - $optim_delay}]
952 if {$canshow > $numcommits} {
953 showstuff $canshow
957 proc showstuff {canshow} {
958 global numcommits
959 global linesegends idrowranges idrangedrawn
961 if {$numcommits == 0} {
962 global phase
963 set phase "incrdraw"
964 allcanvs delete all
966 set row $numcommits
967 set numcommits $canshow
968 setcanvscroll
969 set rows [visiblerows]
970 set r0 [lindex $rows 0]
971 set r1 [lindex $rows 1]
972 for {set r $row} {$r < $canshow} {incr r} {
973 if {[info exists linesegends($r)]} {
974 foreach id $linesegends($r) {
975 set i -1
976 foreach {s e} $idrowranges($id) {
977 incr i
978 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
979 && ![info exists idrangedrawn($id,$i)]} {
980 drawlineseg $id $i
981 set idrangedrawn($id,$i) 1
987 if {$canshow > $r1} {
988 set canshow $r1
990 while {$row < $canshow} {
991 drawcmitrow $row
992 incr row
996 proc layoutrows {row endrow last} {
997 global rowidlist rowoffsets displayorder
998 global uparrowlen downarrowlen maxwidth mingaplen
999 global childlist parentlist
1000 global idrowranges linesegends
1001 global commitidx
1002 global idinlist rowchk
1004 set idlist [lindex $rowidlist $row]
1005 set offs [lindex $rowoffsets $row]
1006 while {$row < $endrow} {
1007 set id [lindex $displayorder $row]
1008 set oldolds {}
1009 set newolds {}
1010 foreach p [lindex $parentlist $row] {
1011 if {![info exists idinlist($p)]} {
1012 lappend newolds $p
1013 } elseif {!$idinlist($p)} {
1014 lappend oldolds $p
1017 set nev [expr {[llength $idlist] + [llength $newolds]
1018 + [llength $oldolds] - $maxwidth + 1}]
1019 if {$nev > 0} {
1020 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1021 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1022 set i [lindex $idlist $x]
1023 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1024 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1025 [expr {$row + $uparrowlen + $mingaplen}]]
1026 if {$r == 0} {
1027 set idlist [lreplace $idlist $x $x]
1028 set offs [lreplace $offs $x $x]
1029 set offs [incrange $offs $x 1]
1030 set idinlist($i) 0
1031 set rm1 [expr {$row - 1}]
1032 lappend linesegends($rm1) $i
1033 lappend idrowranges($i) $rm1
1034 if {[incr nev -1] <= 0} break
1035 continue
1037 set rowchk($id) [expr {$row + $r}]
1040 lset rowidlist $row $idlist
1041 lset rowoffsets $row $offs
1043 set col [lsearch -exact $idlist $id]
1044 if {$col < 0} {
1045 set col [llength $idlist]
1046 lappend idlist $id
1047 lset rowidlist $row $idlist
1048 set z {}
1049 if {[lindex $childlist $row] ne {}} {
1050 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1051 unset idinlist($id)
1053 lappend offs $z
1054 lset rowoffsets $row $offs
1055 if {$z ne {}} {
1056 makeuparrow $id $col $row $z
1058 } else {
1059 unset idinlist($id)
1061 if {[info exists idrowranges($id)]} {
1062 lappend idrowranges($id) $row
1064 incr row
1065 set offs [ntimes [llength $idlist] 0]
1066 set l [llength $newolds]
1067 set idlist [eval lreplace \$idlist $col $col $newolds]
1068 set o 0
1069 if {$l != 1} {
1070 set offs [lrange $offs 0 [expr {$col - 1}]]
1071 foreach x $newolds {
1072 lappend offs {}
1073 incr o -1
1075 incr o
1076 set tmp [expr {[llength $idlist] - [llength $offs]}]
1077 if {$tmp > 0} {
1078 set offs [concat $offs [ntimes $tmp $o]]
1080 } else {
1081 lset offs $col {}
1083 foreach i $newolds {
1084 set idinlist($i) 1
1085 set idrowranges($i) $row
1087 incr col $l
1088 foreach oid $oldolds {
1089 set idinlist($oid) 1
1090 set idlist [linsert $idlist $col $oid]
1091 set offs [linsert $offs $col $o]
1092 makeuparrow $oid $col $row $o
1093 incr col
1095 lappend rowidlist $idlist
1096 lappend rowoffsets $offs
1098 return $row
1101 proc addextraid {id row} {
1102 global displayorder commitrow commitinfo
1103 global commitidx commitlisted
1104 global parentlist childlist children
1106 incr commitidx
1107 lappend displayorder $id
1108 lappend commitlisted 0
1109 lappend parentlist {}
1110 set commitrow($id) $row
1111 readcommit $id
1112 if {![info exists commitinfo($id)]} {
1113 set commitinfo($id) {"No commit information available"}
1115 if {[info exists children($id)]} {
1116 lappend childlist $children($id)
1117 } else {
1118 lappend childlist {}
1122 proc layouttail {} {
1123 global rowidlist rowoffsets idinlist commitidx
1124 global idrowranges
1126 set row $commitidx
1127 set idlist [lindex $rowidlist $row]
1128 while {$idlist ne {}} {
1129 set col [expr {[llength $idlist] - 1}]
1130 set id [lindex $idlist $col]
1131 addextraid $id $row
1132 unset idinlist($id)
1133 lappend idrowranges($id) $row
1134 incr row
1135 set offs [ntimes $col 0]
1136 set idlist [lreplace $idlist $col $col]
1137 lappend rowidlist $idlist
1138 lappend rowoffsets $offs
1141 foreach id [array names idinlist] {
1142 addextraid $id $row
1143 lset rowidlist $row [list $id]
1144 lset rowoffsets $row 0
1145 makeuparrow $id 0 $row 0
1146 lappend idrowranges($id) $row
1147 incr row
1148 lappend rowidlist {}
1149 lappend rowoffsets {}
1153 proc insert_pad {row col npad} {
1154 global rowidlist rowoffsets
1156 set pad [ntimes $npad {}]
1157 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1158 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1159 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1162 proc optimize_rows {row col endrow} {
1163 global rowidlist rowoffsets idrowranges linesegends displayorder
1165 for {} {$row < $endrow} {incr row} {
1166 set idlist [lindex $rowidlist $row]
1167 set offs [lindex $rowoffsets $row]
1168 set haspad 0
1169 for {} {$col < [llength $offs]} {incr col} {
1170 if {[lindex $idlist $col] eq {}} {
1171 set haspad 1
1172 continue
1174 set z [lindex $offs $col]
1175 if {$z eq {}} continue
1176 set isarrow 0
1177 set x0 [expr {$col + $z}]
1178 set y0 [expr {$row - 1}]
1179 set z0 [lindex $rowoffsets $y0 $x0]
1180 if {$z0 eq {}} {
1181 set id [lindex $idlist $col]
1182 if {[info exists idrowranges($id)] &&
1183 $y0 > [lindex $idrowranges($id) 0]} {
1184 set isarrow 1
1187 if {$z < -1 || ($z < 0 && $isarrow)} {
1188 set npad [expr {-1 - $z + $isarrow}]
1189 set offs [incrange $offs $col $npad]
1190 insert_pad $y0 $x0 $npad
1191 if {$y0 > 0} {
1192 optimize_rows $y0 $x0 $row
1194 set z [lindex $offs $col]
1195 set x0 [expr {$col + $z}]
1196 set z0 [lindex $rowoffsets $y0 $x0]
1197 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1198 set npad [expr {$z - 1 + $isarrow}]
1199 set y1 [expr {$row + 1}]
1200 set offs2 [lindex $rowoffsets $y1]
1201 set x1 -1
1202 foreach z $offs2 {
1203 incr x1
1204 if {$z eq {} || $x1 + $z < $col} continue
1205 if {$x1 + $z > $col} {
1206 incr npad
1208 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1209 break
1211 set pad [ntimes $npad {}]
1212 set idlist [eval linsert \$idlist $col $pad]
1213 set tmp [eval linsert \$offs $col $pad]
1214 incr col $npad
1215 set offs [incrange $tmp $col [expr {-$npad}]]
1216 set z [lindex $offs $col]
1217 set haspad 1
1219 if {$z0 eq {} && !$isarrow} {
1220 # this line links to its first child on row $row-2
1221 set rm2 [expr {$row - 2}]
1222 set id [lindex $displayorder $rm2]
1223 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1224 if {$xc >= 0} {
1225 set z0 [expr {$xc - $x0}]
1228 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1229 insert_pad $y0 $x0 1
1230 set offs [incrange $offs $col 1]
1231 optimize_rows $y0 [expr {$x0 + 1}] $row
1234 if {!$haspad} {
1235 set o {}
1236 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1237 set o [lindex $offs $col]
1238 if {$o eq {}} {
1239 # check if this is the link to the first child
1240 set id [lindex $idlist $col]
1241 if {[info exists idrowranges($id)] &&
1242 $row == [lindex $idrowranges($id) 0]} {
1243 # it is, work out offset to child
1244 set y0 [expr {$row - 1}]
1245 set id [lindex $displayorder $y0]
1246 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1247 if {$x0 >= 0} {
1248 set o [expr {$x0 - $col}]
1252 if {$o eq {} || $o <= 0} break
1254 if {$o ne {} && [incr col] < [llength $idlist]} {
1255 set y1 [expr {$row + 1}]
1256 set offs2 [lindex $rowoffsets $y1]
1257 set x1 -1
1258 foreach z $offs2 {
1259 incr x1
1260 if {$z eq {} || $x1 + $z < $col} continue
1261 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1262 break
1264 set idlist [linsert $idlist $col {}]
1265 set tmp [linsert $offs $col {}]
1266 incr col
1267 set offs [incrange $tmp $col -1]
1270 lset rowidlist $row $idlist
1271 lset rowoffsets $row $offs
1272 set col 0
1276 proc xc {row col} {
1277 global canvx0 linespc
1278 return [expr {$canvx0 + $col * $linespc}]
1281 proc yc {row} {
1282 global canvy0 linespc
1283 return [expr {$canvy0 + $row * $linespc}]
1286 proc linewidth {id} {
1287 global thickerline lthickness
1289 set wid $lthickness
1290 if {[info exists thickerline] && $id eq $thickerline} {
1291 set wid [expr {2 * $lthickness}]
1293 return $wid
1296 proc drawlineseg {id i} {
1297 global rowoffsets rowidlist idrowranges
1298 global displayorder
1299 global canv colormap linespc
1301 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1302 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1303 if {$startrow == $row} return
1304 assigncolor $id
1305 set coords {}
1306 set col [lsearch -exact [lindex $rowidlist $row] $id]
1307 if {$col < 0} {
1308 puts "oops: drawline: id $id not on row $row"
1309 return
1311 set lasto {}
1312 set ns 0
1313 while {1} {
1314 set o [lindex $rowoffsets $row $col]
1315 if {$o eq {}} break
1316 if {$o ne $lasto} {
1317 # changing direction
1318 set x [xc $row $col]
1319 set y [yc $row]
1320 lappend coords $x $y
1321 set lasto $o
1323 incr col $o
1324 incr row -1
1326 set x [xc $row $col]
1327 set y [yc $row]
1328 lappend coords $x $y
1329 if {$i == 0} {
1330 # draw the link to the first child as part of this line
1331 incr row -1
1332 set child [lindex $displayorder $row]
1333 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1334 if {$ccol >= 0} {
1335 set x [xc $row $ccol]
1336 set y [yc $row]
1337 if {$ccol < $col - 1} {
1338 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1339 } elseif {$ccol > $col + 1} {
1340 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1342 lappend coords $x $y
1345 if {[llength $coords] < 4} return
1346 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1347 if {$i < $last} {
1348 # This line has an arrow at the lower end: check if the arrow is
1349 # on a diagonal segment, and if so, work around the Tk 8.4
1350 # refusal to draw arrows on diagonal lines.
1351 set x0 [lindex $coords 0]
1352 set x1 [lindex $coords 2]
1353 if {$x0 != $x1} {
1354 set y0 [lindex $coords 1]
1355 set y1 [lindex $coords 3]
1356 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1357 # we have a nearby vertical segment, just trim off the diag bit
1358 set coords [lrange $coords 2 end]
1359 } else {
1360 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1361 set xi [expr {$x0 - $slope * $linespc / 2}]
1362 set yi [expr {$y0 - $linespc / 2}]
1363 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1367 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1368 set arrow [lindex {none first last both} $arrow]
1369 set t [$canv create line $coords -width [linewidth $id] \
1370 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1371 $canv lower $t
1372 bindline $t $id
1375 proc drawparentlinks {id row col olds} {
1376 global rowidlist canv colormap idrowranges
1378 set row2 [expr {$row + 1}]
1379 set x [xc $row $col]
1380 set y [yc $row]
1381 set y2 [yc $row2]
1382 set ids [lindex $rowidlist $row2]
1383 # rmx = right-most X coord used
1384 set rmx 0
1385 foreach p $olds {
1386 set i [lsearch -exact $ids $p]
1387 if {$i < 0} {
1388 puts "oops, parent $p of $id not in list"
1389 continue
1391 set x2 [xc $row2 $i]
1392 if {$x2 > $rmx} {
1393 set rmx $x2
1395 if {[info exists idrowranges($p)] &&
1396 $row2 == [lindex $idrowranges($p) 0] &&
1397 $row2 < [lindex $idrowranges($p) 1]} {
1398 # drawlineseg will do this one for us
1399 continue
1401 assigncolor $p
1402 # should handle duplicated parents here...
1403 set coords [list $x $y]
1404 if {$i < $col - 1} {
1405 lappend coords [xc $row [expr {$i + 1}]] $y
1406 } elseif {$i > $col + 1} {
1407 lappend coords [xc $row [expr {$i - 1}]] $y
1409 lappend coords $x2 $y2
1410 set t [$canv create line $coords -width [linewidth $p] \
1411 -fill $colormap($p) -tags lines.$p]
1412 $canv lower $t
1413 bindline $t $p
1415 return $rmx
1418 proc drawlines {id} {
1419 global colormap canv
1420 global idrowranges idrangedrawn
1421 global childlist iddrawn commitrow rowidlist
1423 $canv delete lines.$id
1424 set nr [expr {[llength $idrowranges($id)] / 2}]
1425 for {set i 0} {$i < $nr} {incr i} {
1426 if {[info exists idrangedrawn($id,$i)]} {
1427 drawlineseg $id $i
1430 foreach child [lindex $childlist $commitrow($id)] {
1431 if {[info exists iddrawn($child)]} {
1432 set row $commitrow($child)
1433 set col [lsearch -exact [lindex $rowidlist $row] $child]
1434 if {$col >= 0} {
1435 drawparentlinks $child $row $col [list $id]
1441 proc drawcmittext {id row col rmx} {
1442 global linespc canv canv2 canv3 canvy0
1443 global commitlisted commitinfo rowidlist
1444 global rowtextx idpos idtags idheads idotherrefs
1445 global linehtag linentag linedtag
1446 global mainfont namefont canvxmax
1448 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1449 set x [xc $row $col]
1450 set y [yc $row]
1451 set orad [expr {$linespc / 3}]
1452 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1453 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1454 -fill $ofill -outline black -width 1]
1455 $canv raise $t
1456 $canv bind $t <1> {selcanvline {} %x %y}
1457 set xt [xc $row [llength [lindex $rowidlist $row]]]
1458 if {$xt < $rmx} {
1459 set xt $rmx
1461 set rowtextx($row) $xt
1462 set idpos($id) [list $x $xt $y]
1463 if {[info exists idtags($id)] || [info exists idheads($id)]
1464 || [info exists idotherrefs($id)]} {
1465 set xt [drawtags $id $x $xt $y]
1467 set headline [lindex $commitinfo($id) 0]
1468 set name [lindex $commitinfo($id) 1]
1469 set date [lindex $commitinfo($id) 2]
1470 set date [formatdate $date]
1471 set linehtag($row) [$canv create text $xt $y -anchor w \
1472 -text $headline -font $mainfont ]
1473 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1474 set linentag($row) [$canv2 create text 3 $y -anchor w \
1475 -text $name -font $namefont]
1476 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1477 -text $date -font $mainfont]
1478 set xr [expr {$xt + [font measure $mainfont $headline]}]
1479 if {$xr > $canvxmax} {
1480 set canvxmax $xr
1481 setcanvscroll
1485 proc drawcmitrow {row} {
1486 global displayorder rowidlist
1487 global idrowranges idrangedrawn iddrawn
1488 global commitinfo parentlist numcommits
1490 if {$row >= $numcommits} return
1491 foreach id [lindex $rowidlist $row] {
1492 if {![info exists idrowranges($id)]} continue
1493 set i -1
1494 foreach {s e} $idrowranges($id) {
1495 incr i
1496 if {$row < $s} continue
1497 if {$e eq {}} break
1498 if {$row <= $e} {
1499 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1500 drawlineseg $id $i
1501 set idrangedrawn($id,$i) 1
1503 break
1508 set id [lindex $displayorder $row]
1509 if {[info exists iddrawn($id)]} return
1510 set col [lsearch -exact [lindex $rowidlist $row] $id]
1511 if {$col < 0} {
1512 puts "oops, row $row id $id not in list"
1513 return
1515 if {![info exists commitinfo($id)]} {
1516 getcommit $id
1518 assigncolor $id
1519 set olds [lindex $parentlist $row]
1520 if {$olds ne {}} {
1521 set rmx [drawparentlinks $id $row $col $olds]
1522 } else {
1523 set rmx 0
1525 drawcmittext $id $row $col $rmx
1526 set iddrawn($id) 1
1529 proc drawfrac {f0 f1} {
1530 global numcommits canv
1531 global linespc
1533 set ymax [lindex [$canv cget -scrollregion] 3]
1534 if {$ymax eq {} || $ymax == 0} return
1535 set y0 [expr {int($f0 * $ymax)}]
1536 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1537 if {$row < 0} {
1538 set row 0
1540 set y1 [expr {int($f1 * $ymax)}]
1541 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1542 if {$endrow >= $numcommits} {
1543 set endrow [expr {$numcommits - 1}]
1545 for {} {$row <= $endrow} {incr row} {
1546 drawcmitrow $row
1550 proc drawvisible {} {
1551 global canv
1552 eval drawfrac [$canv yview]
1555 proc clear_display {} {
1556 global iddrawn idrangedrawn
1558 allcanvs delete all
1559 catch {unset iddrawn}
1560 catch {unset idrangedrawn}
1563 proc assigncolor {id} {
1564 global colormap colors nextcolor
1565 global commitrow parentlist children childlist
1566 global cornercrossings crossings
1568 if {[info exists colormap($id)]} return
1569 set ncolors [llength $colors]
1570 if {[info exists commitrow($id)]} {
1571 set kids [lindex $childlist $commitrow($id)]
1572 } elseif {[info exists children($id)]} {
1573 set kids $children($id)
1574 } else {
1575 set kids {}
1577 if {[llength $kids] == 1} {
1578 set child [lindex $kids 0]
1579 if {[info exists colormap($child)]
1580 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1581 set colormap($id) $colormap($child)
1582 return
1585 set badcolors {}
1586 if {[info exists cornercrossings($id)]} {
1587 foreach x $cornercrossings($id) {
1588 if {[info exists colormap($x)]
1589 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1590 lappend badcolors $colormap($x)
1593 if {[llength $badcolors] >= $ncolors} {
1594 set badcolors {}
1597 set origbad $badcolors
1598 if {[llength $badcolors] < $ncolors - 1} {
1599 if {[info exists crossings($id)]} {
1600 foreach x $crossings($id) {
1601 if {[info exists colormap($x)]
1602 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1603 lappend badcolors $colormap($x)
1606 if {[llength $badcolors] >= $ncolors} {
1607 set badcolors $origbad
1610 set origbad $badcolors
1612 if {[llength $badcolors] < $ncolors - 1} {
1613 foreach child $kids {
1614 if {[info exists colormap($child)]
1615 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1616 lappend badcolors $colormap($child)
1618 foreach p [lindex $parentlist $commitrow($child)] {
1619 if {[info exists colormap($p)]
1620 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1621 lappend badcolors $colormap($p)
1625 if {[llength $badcolors] >= $ncolors} {
1626 set badcolors $origbad
1629 for {set i 0} {$i <= $ncolors} {incr i} {
1630 set c [lindex $colors $nextcolor]
1631 if {[incr nextcolor] >= $ncolors} {
1632 set nextcolor 0
1634 if {[lsearch -exact $badcolors $c]} break
1636 set colormap($id) $c
1639 proc bindline {t id} {
1640 global canv
1642 $canv bind $t <Enter> "lineenter %x %y $id"
1643 $canv bind $t <Motion> "linemotion %x %y $id"
1644 $canv bind $t <Leave> "lineleave $id"
1645 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1648 proc drawtags {id x xt y1} {
1649 global idtags idheads idotherrefs
1650 global linespc lthickness
1651 global canv mainfont commitrow rowtextx
1653 set marks {}
1654 set ntags 0
1655 set nheads 0
1656 if {[info exists idtags($id)]} {
1657 set marks $idtags($id)
1658 set ntags [llength $marks]
1660 if {[info exists idheads($id)]} {
1661 set marks [concat $marks $idheads($id)]
1662 set nheads [llength $idheads($id)]
1664 if {[info exists idotherrefs($id)]} {
1665 set marks [concat $marks $idotherrefs($id)]
1667 if {$marks eq {}} {
1668 return $xt
1671 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1672 set yt [expr {$y1 - 0.5 * $linespc}]
1673 set yb [expr {$yt + $linespc - 1}]
1674 set xvals {}
1675 set wvals {}
1676 foreach tag $marks {
1677 set wid [font measure $mainfont $tag]
1678 lappend xvals $xt
1679 lappend wvals $wid
1680 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1682 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1683 -width $lthickness -fill black -tags tag.$id]
1684 $canv lower $t
1685 foreach tag $marks x $xvals wid $wvals {
1686 set xl [expr {$x + $delta}]
1687 set xr [expr {$x + $delta + $wid + $lthickness}]
1688 if {[incr ntags -1] >= 0} {
1689 # draw a tag
1690 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1691 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1692 -width 1 -outline black -fill yellow -tags tag.$id]
1693 $canv bind $t <1> [list showtag $tag 1]
1694 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1695 } else {
1696 # draw a head or other ref
1697 if {[incr nheads -1] >= 0} {
1698 set col green
1699 } else {
1700 set col "#ddddff"
1702 set xl [expr {$xl - $delta/2}]
1703 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1704 -width 1 -outline black -fill $col -tags tag.$id
1706 set t [$canv create text $xl $y1 -anchor w -text $tag \
1707 -font $mainfont -tags tag.$id]
1708 if {$ntags >= 0} {
1709 $canv bind $t <1> [list showtag $tag 1]
1712 return $xt
1715 proc checkcrossings {row endrow} {
1716 global displayorder parentlist rowidlist
1718 for {} {$row < $endrow} {incr row} {
1719 set id [lindex $displayorder $row]
1720 set i [lsearch -exact [lindex $rowidlist $row] $id]
1721 if {$i < 0} continue
1722 set idlist [lindex $rowidlist [expr {$row+1}]]
1723 foreach p [lindex $parentlist $row] {
1724 set j [lsearch -exact $idlist $p]
1725 if {$j > 0} {
1726 if {$j < $i - 1} {
1727 notecrossings $row $p $j $i [expr {$j+1}]
1728 } elseif {$j > $i + 1} {
1729 notecrossings $row $p $i $j [expr {$j-1}]
1736 proc notecrossings {row id lo hi corner} {
1737 global rowidlist crossings cornercrossings
1739 for {set i $lo} {[incr i] < $hi} {} {
1740 set p [lindex [lindex $rowidlist $row] $i]
1741 if {$p == {}} continue
1742 if {$i == $corner} {
1743 if {![info exists cornercrossings($id)]
1744 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1745 lappend cornercrossings($id) $p
1747 if {![info exists cornercrossings($p)]
1748 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1749 lappend cornercrossings($p) $id
1751 } else {
1752 if {![info exists crossings($id)]
1753 || [lsearch -exact $crossings($id) $p] < 0} {
1754 lappend crossings($id) $p
1756 if {![info exists crossings($p)]
1757 || [lsearch -exact $crossings($p) $id] < 0} {
1758 lappend crossings($p) $id
1764 proc xcoord {i level ln} {
1765 global canvx0 xspc1 xspc2
1767 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1768 if {$i > 0 && $i == $level} {
1769 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1770 } elseif {$i > $level} {
1771 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1773 return $x
1776 proc finishcommits {} {
1777 global commitidx phase
1778 global canv mainfont ctext maincursor textcursor
1779 global findinprogress
1781 if {$commitidx > 0} {
1782 drawrest
1783 } else {
1784 $canv delete all
1785 $canv create text 3 3 -anchor nw -text "No commits selected" \
1786 -font $mainfont -tags textitems
1788 if {![info exists findinprogress]} {
1789 . config -cursor $maincursor
1790 settextcursor $textcursor
1792 set phase {}
1795 # Don't change the text pane cursor if it is currently the hand cursor,
1796 # showing that we are over a sha1 ID link.
1797 proc settextcursor {c} {
1798 global ctext curtextcursor
1800 if {[$ctext cget -cursor] == $curtextcursor} {
1801 $ctext config -cursor $c
1803 set curtextcursor $c
1806 proc drawrest {} {
1807 global numcommits
1808 global startmsecs
1809 global canvy0 numcommits linespc
1810 global rowlaidout commitidx
1812 set row $rowlaidout
1813 layoutrows $rowlaidout $commitidx 1
1814 layouttail
1815 optimize_rows $row 0 $commitidx
1816 showstuff $commitidx
1818 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1819 #puts "overall $drawmsecs ms for $numcommits commits"
1822 proc findmatches {f} {
1823 global findtype foundstring foundstrlen
1824 if {$findtype == "Regexp"} {
1825 set matches [regexp -indices -all -inline $foundstring $f]
1826 } else {
1827 if {$findtype == "IgnCase"} {
1828 set str [string tolower $f]
1829 } else {
1830 set str $f
1832 set matches {}
1833 set i 0
1834 while {[set j [string first $foundstring $str $i]] >= 0} {
1835 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1836 set i [expr {$j + $foundstrlen}]
1839 return $matches
1842 proc dofind {} {
1843 global findtype findloc findstring markedmatches commitinfo
1844 global numcommits displayorder linehtag linentag linedtag
1845 global mainfont namefont canv canv2 canv3 selectedline
1846 global matchinglines foundstring foundstrlen matchstring
1847 global commitdata
1849 stopfindproc
1850 unmarkmatches
1851 focus .
1852 set matchinglines {}
1853 if {$findloc == "Pickaxe"} {
1854 findpatches
1855 return
1857 if {$findtype == "IgnCase"} {
1858 set foundstring [string tolower $findstring]
1859 } else {
1860 set foundstring $findstring
1862 set foundstrlen [string length $findstring]
1863 if {$foundstrlen == 0} return
1864 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1865 set matchstring "*$matchstring*"
1866 if {$findloc == "Files"} {
1867 findfiles
1868 return
1870 if {![info exists selectedline]} {
1871 set oldsel -1
1872 } else {
1873 set oldsel $selectedline
1875 set didsel 0
1876 set fldtypes {Headline Author Date Committer CDate Comment}
1877 set l -1
1878 foreach id $displayorder {
1879 set d $commitdata($id)
1880 incr l
1881 if {$findtype == "Regexp"} {
1882 set doesmatch [regexp $foundstring $d]
1883 } elseif {$findtype == "IgnCase"} {
1884 set doesmatch [string match -nocase $matchstring $d]
1885 } else {
1886 set doesmatch [string match $matchstring $d]
1888 if {!$doesmatch} continue
1889 if {![info exists commitinfo($id)]} {
1890 getcommit $id
1892 set info $commitinfo($id)
1893 set doesmatch 0
1894 foreach f $info ty $fldtypes {
1895 if {$findloc != "All fields" && $findloc != $ty} {
1896 continue
1898 set matches [findmatches $f]
1899 if {$matches == {}} continue
1900 set doesmatch 1
1901 if {$ty == "Headline"} {
1902 drawcmitrow $l
1903 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1904 } elseif {$ty == "Author"} {
1905 drawcmitrow $l
1906 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1907 } elseif {$ty == "Date"} {
1908 drawcmitrow $l
1909 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1912 if {$doesmatch} {
1913 lappend matchinglines $l
1914 if {!$didsel && $l > $oldsel} {
1915 findselectline $l
1916 set didsel 1
1920 if {$matchinglines == {}} {
1921 bell
1922 } elseif {!$didsel} {
1923 findselectline [lindex $matchinglines 0]
1927 proc findselectline {l} {
1928 global findloc commentend ctext
1929 selectline $l 1
1930 if {$findloc == "All fields" || $findloc == "Comments"} {
1931 # highlight the matches in the comments
1932 set f [$ctext get 1.0 $commentend]
1933 set matches [findmatches $f]
1934 foreach match $matches {
1935 set start [lindex $match 0]
1936 set end [expr {[lindex $match 1] + 1}]
1937 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1942 proc findnext {restart} {
1943 global matchinglines selectedline
1944 if {![info exists matchinglines]} {
1945 if {$restart} {
1946 dofind
1948 return
1950 if {![info exists selectedline]} return
1951 foreach l $matchinglines {
1952 if {$l > $selectedline} {
1953 findselectline $l
1954 return
1957 bell
1960 proc findprev {} {
1961 global matchinglines selectedline
1962 if {![info exists matchinglines]} {
1963 dofind
1964 return
1966 if {![info exists selectedline]} return
1967 set prev {}
1968 foreach l $matchinglines {
1969 if {$l >= $selectedline} break
1970 set prev $l
1972 if {$prev != {}} {
1973 findselectline $prev
1974 } else {
1975 bell
1979 proc findlocchange {name ix op} {
1980 global findloc findtype findtypemenu
1981 if {$findloc == "Pickaxe"} {
1982 set findtype Exact
1983 set state disabled
1984 } else {
1985 set state normal
1987 $findtypemenu entryconf 1 -state $state
1988 $findtypemenu entryconf 2 -state $state
1991 proc stopfindproc {{done 0}} {
1992 global findprocpid findprocfile findids
1993 global ctext findoldcursor phase maincursor textcursor
1994 global findinprogress
1996 catch {unset findids}
1997 if {[info exists findprocpid]} {
1998 if {!$done} {
1999 catch {exec kill $findprocpid}
2001 catch {close $findprocfile}
2002 unset findprocpid
2004 if {[info exists findinprogress]} {
2005 unset findinprogress
2006 if {$phase != "incrdraw"} {
2007 . config -cursor $maincursor
2008 settextcursor $textcursor
2013 proc findpatches {} {
2014 global findstring selectedline numcommits
2015 global findprocpid findprocfile
2016 global finddidsel ctext displayorder findinprogress
2017 global findinsertpos
2019 if {$numcommits == 0} return
2021 # make a list of all the ids to search, starting at the one
2022 # after the selected line (if any)
2023 if {[info exists selectedline]} {
2024 set l $selectedline
2025 } else {
2026 set l -1
2028 set inputids {}
2029 for {set i 0} {$i < $numcommits} {incr i} {
2030 if {[incr l] >= $numcommits} {
2031 set l 0
2033 append inputids [lindex $displayorder $l] "\n"
2036 if {[catch {
2037 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2038 << $inputids] r]
2039 } err]} {
2040 error_popup "Error starting search process: $err"
2041 return
2044 set findinsertpos end
2045 set findprocfile $f
2046 set findprocpid [pid $f]
2047 fconfigure $f -blocking 0
2048 fileevent $f readable readfindproc
2049 set finddidsel 0
2050 . config -cursor watch
2051 settextcursor watch
2052 set findinprogress 1
2055 proc readfindproc {} {
2056 global findprocfile finddidsel
2057 global commitrow matchinglines findinsertpos
2059 set n [gets $findprocfile line]
2060 if {$n < 0} {
2061 if {[eof $findprocfile]} {
2062 stopfindproc 1
2063 if {!$finddidsel} {
2064 bell
2067 return
2069 if {![regexp {^[0-9a-f]{40}} $line id]} {
2070 error_popup "Can't parse git-diff-tree output: $line"
2071 stopfindproc
2072 return
2074 if {![info exists commitrow($id)]} {
2075 puts stderr "spurious id: $id"
2076 return
2078 set l $commitrow($id)
2079 insertmatch $l $id
2082 proc insertmatch {l id} {
2083 global matchinglines findinsertpos finddidsel
2085 if {$findinsertpos == "end"} {
2086 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2087 set matchinglines [linsert $matchinglines 0 $l]
2088 set findinsertpos 1
2089 } else {
2090 lappend matchinglines $l
2092 } else {
2093 set matchinglines [linsert $matchinglines $findinsertpos $l]
2094 incr findinsertpos
2096 markheadline $l $id
2097 if {!$finddidsel} {
2098 findselectline $l
2099 set finddidsel 1
2103 proc findfiles {} {
2104 global selectedline numcommits displayorder ctext
2105 global ffileline finddidsel parentlist
2106 global findinprogress findstartline findinsertpos
2107 global treediffs fdiffid fdiffsneeded fdiffpos
2108 global findmergefiles
2110 if {$numcommits == 0} return
2112 if {[info exists selectedline]} {
2113 set l [expr {$selectedline + 1}]
2114 } else {
2115 set l 0
2117 set ffileline $l
2118 set findstartline $l
2119 set diffsneeded {}
2120 set fdiffsneeded {}
2121 while 1 {
2122 set id [lindex $displayorder $l]
2123 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2124 if {![info exists treediffs($id)]} {
2125 append diffsneeded "$id\n"
2126 lappend fdiffsneeded $id
2129 if {[incr l] >= $numcommits} {
2130 set l 0
2132 if {$l == $findstartline} break
2135 # start off a git-diff-tree process if needed
2136 if {$diffsneeded ne {}} {
2137 if {[catch {
2138 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2139 } err ]} {
2140 error_popup "Error starting search process: $err"
2141 return
2143 catch {unset fdiffid}
2144 set fdiffpos 0
2145 fconfigure $df -blocking 0
2146 fileevent $df readable [list readfilediffs $df]
2149 set finddidsel 0
2150 set findinsertpos end
2151 set id [lindex $displayorder $l]
2152 . config -cursor watch
2153 settextcursor watch
2154 set findinprogress 1
2155 findcont
2156 update
2159 proc readfilediffs {df} {
2160 global findid fdiffid fdiffs
2162 set n [gets $df line]
2163 if {$n < 0} {
2164 if {[eof $df]} {
2165 donefilediff
2166 if {[catch {close $df} err]} {
2167 stopfindproc
2168 bell
2169 error_popup "Error in git-diff-tree: $err"
2170 } elseif {[info exists findid]} {
2171 set id $findid
2172 stopfindproc
2173 bell
2174 error_popup "Couldn't find diffs for $id"
2177 return
2179 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2180 # start of a new string of diffs
2181 donefilediff
2182 set fdiffid $id
2183 set fdiffs {}
2184 } elseif {[string match ":*" $line]} {
2185 lappend fdiffs [lindex $line 5]
2189 proc donefilediff {} {
2190 global fdiffid fdiffs treediffs findid
2191 global fdiffsneeded fdiffpos
2193 if {[info exists fdiffid]} {
2194 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2195 && $fdiffpos < [llength $fdiffsneeded]} {
2196 # git-diff-tree doesn't output anything for a commit
2197 # which doesn't change anything
2198 set nullid [lindex $fdiffsneeded $fdiffpos]
2199 set treediffs($nullid) {}
2200 if {[info exists findid] && $nullid eq $findid} {
2201 unset findid
2202 findcont
2204 incr fdiffpos
2206 incr fdiffpos
2208 if {![info exists treediffs($fdiffid)]} {
2209 set treediffs($fdiffid) $fdiffs
2211 if {[info exists findid] && $fdiffid eq $findid} {
2212 unset findid
2213 findcont
2218 proc findcont {} {
2219 global findid treediffs parentlist
2220 global ffileline findstartline finddidsel
2221 global displayorder numcommits matchinglines findinprogress
2222 global findmergefiles
2224 set l $ffileline
2225 while {1} {
2226 set id [lindex $displayorder $l]
2227 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2228 if {![info exists treediffs($id)]} {
2229 set findid $id
2230 set ffileline $l
2231 return
2233 set doesmatch 0
2234 foreach f $treediffs($id) {
2235 set x [findmatches $f]
2236 if {$x != {}} {
2237 set doesmatch 1
2238 break
2241 if {$doesmatch} {
2242 insertmatch $l $id
2245 if {[incr l] >= $numcommits} {
2246 set l 0
2248 if {$l == $findstartline} break
2250 stopfindproc
2251 if {!$finddidsel} {
2252 bell
2256 # mark a commit as matching by putting a yellow background
2257 # behind the headline
2258 proc markheadline {l id} {
2259 global canv mainfont linehtag
2261 drawcmitrow $l
2262 set bbox [$canv bbox $linehtag($l)]
2263 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2264 $canv lower $t
2267 # mark the bits of a headline, author or date that match a find string
2268 proc markmatches {canv l str tag matches font} {
2269 set bbox [$canv bbox $tag]
2270 set x0 [lindex $bbox 0]
2271 set y0 [lindex $bbox 1]
2272 set y1 [lindex $bbox 3]
2273 foreach match $matches {
2274 set start [lindex $match 0]
2275 set end [lindex $match 1]
2276 if {$start > $end} continue
2277 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2278 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2279 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2280 [expr {$x0+$xlen+2}] $y1 \
2281 -outline {} -tags matches -fill yellow]
2282 $canv lower $t
2286 proc unmarkmatches {} {
2287 global matchinglines findids
2288 allcanvs delete matches
2289 catch {unset matchinglines}
2290 catch {unset findids}
2293 proc selcanvline {w x y} {
2294 global canv canvy0 ctext linespc
2295 global rowtextx
2296 set ymax [lindex [$canv cget -scrollregion] 3]
2297 if {$ymax == {}} return
2298 set yfrac [lindex [$canv yview] 0]
2299 set y [expr {$y + $yfrac * $ymax}]
2300 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2301 if {$l < 0} {
2302 set l 0
2304 if {$w eq $canv} {
2305 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2307 unmarkmatches
2308 selectline $l 1
2311 proc commit_descriptor {p} {
2312 global commitinfo
2313 set l "..."
2314 if {[info exists commitinfo($p)]} {
2315 set l [lindex $commitinfo($p) 0]
2317 return "$p ($l)"
2320 # append some text to the ctext widget, and make any SHA1 ID
2321 # that we know about be a clickable link.
2322 proc appendwithlinks {text} {
2323 global ctext commitrow linknum
2325 set start [$ctext index "end - 1c"]
2326 $ctext insert end $text
2327 $ctext insert end "\n"
2328 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2329 foreach l $links {
2330 set s [lindex $l 0]
2331 set e [lindex $l 1]
2332 set linkid [string range $text $s $e]
2333 if {![info exists commitrow($linkid)]} continue
2334 incr e
2335 $ctext tag add link "$start + $s c" "$start + $e c"
2336 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2337 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2338 incr linknum
2340 $ctext tag conf link -foreground blue -underline 1
2341 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2342 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2345 proc viewnextline {dir} {
2346 global canv linespc
2348 $canv delete hover
2349 set ymax [lindex [$canv cget -scrollregion] 3]
2350 set wnow [$canv yview]
2351 set wtop [expr {[lindex $wnow 0] * $ymax}]
2352 set newtop [expr {$wtop + $dir * $linespc}]
2353 if {$newtop < 0} {
2354 set newtop 0
2355 } elseif {$newtop > $ymax} {
2356 set newtop $ymax
2358 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2361 proc selectline {l isnew} {
2362 global canv canv2 canv3 ctext commitinfo selectedline
2363 global displayorder linehtag linentag linedtag
2364 global canvy0 linespc parentlist childlist
2365 global cflist currentid sha1entry
2366 global commentend idtags linknum
2367 global mergemax numcommits
2369 $canv delete hover
2370 normalline
2371 if {$l < 0 || $l >= $numcommits} return
2372 set y [expr {$canvy0 + $l * $linespc}]
2373 set ymax [lindex [$canv cget -scrollregion] 3]
2374 set ytop [expr {$y - $linespc - 1}]
2375 set ybot [expr {$y + $linespc + 1}]
2376 set wnow [$canv yview]
2377 set wtop [expr {[lindex $wnow 0] * $ymax}]
2378 set wbot [expr {[lindex $wnow 1] * $ymax}]
2379 set wh [expr {$wbot - $wtop}]
2380 set newtop $wtop
2381 if {$ytop < $wtop} {
2382 if {$ybot < $wtop} {
2383 set newtop [expr {$y - $wh / 2.0}]
2384 } else {
2385 set newtop $ytop
2386 if {$newtop > $wtop - $linespc} {
2387 set newtop [expr {$wtop - $linespc}]
2390 } elseif {$ybot > $wbot} {
2391 if {$ytop > $wbot} {
2392 set newtop [expr {$y - $wh / 2.0}]
2393 } else {
2394 set newtop [expr {$ybot - $wh}]
2395 if {$newtop < $wtop + $linespc} {
2396 set newtop [expr {$wtop + $linespc}]
2400 if {$newtop != $wtop} {
2401 if {$newtop < 0} {
2402 set newtop 0
2404 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2405 drawvisible
2408 if {![info exists linehtag($l)]} return
2409 $canv delete secsel
2410 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2411 -tags secsel -fill [$canv cget -selectbackground]]
2412 $canv lower $t
2413 $canv2 delete secsel
2414 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2415 -tags secsel -fill [$canv2 cget -selectbackground]]
2416 $canv2 lower $t
2417 $canv3 delete secsel
2418 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2419 -tags secsel -fill [$canv3 cget -selectbackground]]
2420 $canv3 lower $t
2422 if {$isnew} {
2423 addtohistory [list selectline $l 0]
2426 set selectedline $l
2428 set id [lindex $displayorder $l]
2429 set currentid $id
2430 $sha1entry delete 0 end
2431 $sha1entry insert 0 $id
2432 $sha1entry selection from 0
2433 $sha1entry selection to end
2435 $ctext conf -state normal
2436 $ctext delete 0.0 end
2437 set linknum 0
2438 $ctext mark set fmark.0 0.0
2439 $ctext mark gravity fmark.0 left
2440 set info $commitinfo($id)
2441 set date [formatdate [lindex $info 2]]
2442 $ctext insert end "Author: [lindex $info 1] $date\n"
2443 set date [formatdate [lindex $info 4]]
2444 $ctext insert end "Committer: [lindex $info 3] $date\n"
2445 if {[info exists idtags($id)]} {
2446 $ctext insert end "Tags:"
2447 foreach tag $idtags($id) {
2448 $ctext insert end " $tag"
2450 $ctext insert end "\n"
2453 set comment {}
2454 set olds [lindex $parentlist $l]
2455 if {[llength $olds] > 1} {
2456 set np 0
2457 foreach p $olds {
2458 if {$np >= $mergemax} {
2459 set tag mmax
2460 } else {
2461 set tag m$np
2463 $ctext insert end "Parent: " $tag
2464 appendwithlinks [commit_descriptor $p]
2465 incr np
2467 } else {
2468 foreach p $olds {
2469 append comment "Parent: [commit_descriptor $p]\n"
2473 foreach c [lindex $childlist $l] {
2474 append comment "Child: [commit_descriptor $c]\n"
2476 append comment "\n"
2477 append comment [lindex $info 5]
2479 # make anything that looks like a SHA1 ID be a clickable link
2480 appendwithlinks $comment
2482 $ctext tag delete Comments
2483 $ctext tag remove found 1.0 end
2484 $ctext conf -state disabled
2485 set commentend [$ctext index "end - 1c"]
2487 $cflist delete 0 end
2488 $cflist insert end "Comments"
2489 if {[llength $olds] <= 1} {
2490 startdiff $id
2491 } else {
2492 mergediff $id $l
2496 proc selfirstline {} {
2497 unmarkmatches
2498 selectline 0 1
2501 proc sellastline {} {
2502 global numcommits
2503 unmarkmatches
2504 set l [expr {$numcommits - 1}]
2505 selectline $l 1
2508 proc selnextline {dir} {
2509 global selectedline
2510 if {![info exists selectedline]} return
2511 set l [expr {$selectedline + $dir}]
2512 unmarkmatches
2513 selectline $l 1
2516 proc selnextpage {dir} {
2517 global canv linespc selectedline numcommits
2519 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2520 if {$lpp < 1} {
2521 set lpp 1
2523 allcanvs yview scroll [expr {$dir * $lpp}] units
2524 if {![info exists selectedline]} return
2525 set l [expr {$selectedline + $dir * $lpp}]
2526 if {$l < 0} {
2527 set l 0
2528 } elseif {$l >= $numcommits} {
2529 set l [expr $numcommits - 1]
2531 unmarkmatches
2532 selectline $l 1
2535 proc unselectline {} {
2536 global selectedline
2538 catch {unset selectedline}
2539 allcanvs delete secsel
2542 proc addtohistory {cmd} {
2543 global history historyindex
2545 if {$historyindex > 0
2546 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2547 return
2550 if {$historyindex < [llength $history]} {
2551 set history [lreplace $history $historyindex end $cmd]
2552 } else {
2553 lappend history $cmd
2555 incr historyindex
2556 if {$historyindex > 1} {
2557 .ctop.top.bar.leftbut conf -state normal
2558 } else {
2559 .ctop.top.bar.leftbut conf -state disabled
2561 .ctop.top.bar.rightbut conf -state disabled
2564 proc goback {} {
2565 global history historyindex
2567 if {$historyindex > 1} {
2568 incr historyindex -1
2569 set cmd [lindex $history [expr {$historyindex - 1}]]
2570 eval $cmd
2571 .ctop.top.bar.rightbut conf -state normal
2573 if {$historyindex <= 1} {
2574 .ctop.top.bar.leftbut conf -state disabled
2578 proc goforw {} {
2579 global history historyindex
2581 if {$historyindex < [llength $history]} {
2582 set cmd [lindex $history $historyindex]
2583 incr historyindex
2584 eval $cmd
2585 .ctop.top.bar.leftbut conf -state normal
2587 if {$historyindex >= [llength $history]} {
2588 .ctop.top.bar.rightbut conf -state disabled
2592 proc mergediff {id l} {
2593 global diffmergeid diffopts mdifffd
2594 global difffilestart diffids
2595 global parentlist
2597 set diffmergeid $id
2598 set diffids $id
2599 catch {unset difffilestart}
2600 # this doesn't seem to actually affect anything...
2601 set env(GIT_DIFF_OPTS) $diffopts
2602 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2603 if {[catch {set mdf [open $cmd r]} err]} {
2604 error_popup "Error getting merge diffs: $err"
2605 return
2607 fconfigure $mdf -blocking 0
2608 set mdifffd($id) $mdf
2609 set np [llength [lindex $parentlist $l]]
2610 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2611 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2614 proc getmergediffline {mdf id np} {
2615 global diffmergeid ctext cflist nextupdate mergemax
2616 global difffilestart mdifffd
2618 set n [gets $mdf line]
2619 if {$n < 0} {
2620 if {[eof $mdf]} {
2621 close $mdf
2623 return
2625 if {![info exists diffmergeid] || $id != $diffmergeid
2626 || $mdf != $mdifffd($id)} {
2627 return
2629 $ctext conf -state normal
2630 if {[regexp {^diff --cc (.*)} $line match fname]} {
2631 # start of a new file
2632 $ctext insert end "\n"
2633 set here [$ctext index "end - 1c"]
2634 set i [$cflist index end]
2635 $ctext mark set fmark.$i $here
2636 $ctext mark gravity fmark.$i left
2637 set difffilestart([expr {$i-1}]) $here
2638 $cflist insert end $fname
2639 set l [expr {(78 - [string length $fname]) / 2}]
2640 set pad [string range "----------------------------------------" 1 $l]
2641 $ctext insert end "$pad $fname $pad\n" filesep
2642 } elseif {[regexp {^@@} $line]} {
2643 $ctext insert end "$line\n" hunksep
2644 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2645 # do nothing
2646 } else {
2647 # parse the prefix - one ' ', '-' or '+' for each parent
2648 set spaces {}
2649 set minuses {}
2650 set pluses {}
2651 set isbad 0
2652 for {set j 0} {$j < $np} {incr j} {
2653 set c [string range $line $j $j]
2654 if {$c == " "} {
2655 lappend spaces $j
2656 } elseif {$c == "-"} {
2657 lappend minuses $j
2658 } elseif {$c == "+"} {
2659 lappend pluses $j
2660 } else {
2661 set isbad 1
2662 break
2665 set tags {}
2666 set num {}
2667 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2668 # line doesn't appear in result, parents in $minuses have the line
2669 set num [lindex $minuses 0]
2670 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2671 # line appears in result, parents in $pluses don't have the line
2672 lappend tags mresult
2673 set num [lindex $spaces 0]
2675 if {$num ne {}} {
2676 if {$num >= $mergemax} {
2677 set num "max"
2679 lappend tags m$num
2681 $ctext insert end "$line\n" $tags
2683 $ctext conf -state disabled
2684 if {[clock clicks -milliseconds] >= $nextupdate} {
2685 incr nextupdate 100
2686 fileevent $mdf readable {}
2687 update
2688 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2692 proc startdiff {ids} {
2693 global treediffs diffids treepending diffmergeid
2695 set diffids $ids
2696 catch {unset diffmergeid}
2697 if {![info exists treediffs($ids)]} {
2698 if {![info exists treepending]} {
2699 gettreediffs $ids
2701 } else {
2702 addtocflist $ids
2706 proc addtocflist {ids} {
2707 global treediffs cflist
2708 foreach f $treediffs($ids) {
2709 $cflist insert end $f
2711 getblobdiffs $ids
2714 proc gettreediffs {ids} {
2715 global treediff treepending
2716 set treepending $ids
2717 set treediff {}
2718 if {[catch \
2719 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2720 ]} return
2721 fconfigure $gdtf -blocking 0
2722 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2725 proc gettreediffline {gdtf ids} {
2726 global treediff treediffs treepending diffids diffmergeid
2728 set n [gets $gdtf line]
2729 if {$n < 0} {
2730 if {![eof $gdtf]} return
2731 close $gdtf
2732 set treediffs($ids) $treediff
2733 unset treepending
2734 if {$ids != $diffids} {
2735 if {![info exists diffmergeid]} {
2736 gettreediffs $diffids
2738 } else {
2739 addtocflist $ids
2741 return
2743 set file [lindex $line 5]
2744 lappend treediff $file
2747 proc getblobdiffs {ids} {
2748 global diffopts blobdifffd diffids env curdifftag curtagstart
2749 global difffilestart nextupdate diffinhdr treediffs
2751 set env(GIT_DIFF_OPTS) $diffopts
2752 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2753 if {[catch {set bdf [open $cmd r]} err]} {
2754 puts "error getting diffs: $err"
2755 return
2757 set diffinhdr 0
2758 fconfigure $bdf -blocking 0
2759 set blobdifffd($ids) $bdf
2760 set curdifftag Comments
2761 set curtagstart 0.0
2762 catch {unset difffilestart}
2763 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2764 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2767 proc getblobdiffline {bdf ids} {
2768 global diffids blobdifffd ctext curdifftag curtagstart
2769 global diffnexthead diffnextnote difffilestart
2770 global nextupdate diffinhdr treediffs
2772 set n [gets $bdf line]
2773 if {$n < 0} {
2774 if {[eof $bdf]} {
2775 close $bdf
2776 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2777 $ctext tag add $curdifftag $curtagstart end
2780 return
2782 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2783 return
2785 $ctext conf -state normal
2786 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2787 # start of a new file
2788 $ctext insert end "\n"
2789 $ctext tag add $curdifftag $curtagstart end
2790 set curtagstart [$ctext index "end - 1c"]
2791 set header $newname
2792 set here [$ctext index "end - 1c"]
2793 set i [lsearch -exact $treediffs($diffids) $fname]
2794 if {$i >= 0} {
2795 set difffilestart($i) $here
2796 incr i
2797 $ctext mark set fmark.$i $here
2798 $ctext mark gravity fmark.$i left
2800 if {$newname != $fname} {
2801 set i [lsearch -exact $treediffs($diffids) $newname]
2802 if {$i >= 0} {
2803 set difffilestart($i) $here
2804 incr i
2805 $ctext mark set fmark.$i $here
2806 $ctext mark gravity fmark.$i left
2809 set curdifftag "f:$fname"
2810 $ctext tag delete $curdifftag
2811 set l [expr {(78 - [string length $header]) / 2}]
2812 set pad [string range "----------------------------------------" 1 $l]
2813 $ctext insert end "$pad $header $pad\n" filesep
2814 set diffinhdr 1
2815 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2816 # do nothing
2817 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2818 set diffinhdr 0
2819 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2820 $line match f1l f1c f2l f2c rest]} {
2821 $ctext insert end "$line\n" hunksep
2822 set diffinhdr 0
2823 } else {
2824 set x [string range $line 0 0]
2825 if {$x == "-" || $x == "+"} {
2826 set tag [expr {$x == "+"}]
2827 $ctext insert end "$line\n" d$tag
2828 } elseif {$x == " "} {
2829 $ctext insert end "$line\n"
2830 } elseif {$diffinhdr || $x == "\\"} {
2831 # e.g. "\ No newline at end of file"
2832 $ctext insert end "$line\n" filesep
2833 } else {
2834 # Something else we don't recognize
2835 if {$curdifftag != "Comments"} {
2836 $ctext insert end "\n"
2837 $ctext tag add $curdifftag $curtagstart end
2838 set curtagstart [$ctext index "end - 1c"]
2839 set curdifftag Comments
2841 $ctext insert end "$line\n" filesep
2844 $ctext conf -state disabled
2845 if {[clock clicks -milliseconds] >= $nextupdate} {
2846 incr nextupdate 100
2847 fileevent $bdf readable {}
2848 update
2849 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2853 proc nextfile {} {
2854 global difffilestart ctext
2855 set here [$ctext index @0,0]
2856 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2857 if {[$ctext compare $difffilestart($i) > $here]} {
2858 if {![info exists pos]
2859 || [$ctext compare $difffilestart($i) < $pos]} {
2860 set pos $difffilestart($i)
2864 if {[info exists pos]} {
2865 $ctext yview $pos
2869 proc listboxsel {} {
2870 global ctext cflist currentid
2871 if {![info exists currentid]} return
2872 set sel [lsort [$cflist curselection]]
2873 if {$sel eq {}} return
2874 set first [lindex $sel 0]
2875 catch {$ctext yview fmark.$first}
2878 proc setcoords {} {
2879 global linespc charspc canvx0 canvy0 mainfont
2880 global xspc1 xspc2 lthickness
2882 set linespc [font metrics $mainfont -linespace]
2883 set charspc [font measure $mainfont "m"]
2884 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2885 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2886 set lthickness [expr {int($linespc / 9) + 1}]
2887 set xspc1(0) $linespc
2888 set xspc2 $linespc
2891 proc redisplay {} {
2892 global canv
2893 global selectedline
2895 set ymax [lindex [$canv cget -scrollregion] 3]
2896 if {$ymax eq {} || $ymax == 0} return
2897 set span [$canv yview]
2898 clear_display
2899 setcanvscroll
2900 allcanvs yview moveto [lindex $span 0]
2901 drawvisible
2902 if {[info exists selectedline]} {
2903 selectline $selectedline 0
2907 proc incrfont {inc} {
2908 global mainfont namefont textfont ctext canv phase
2909 global stopped entries
2910 unmarkmatches
2911 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2912 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2913 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2914 setcoords
2915 $ctext conf -font $textfont
2916 $ctext tag conf filesep -font [concat $textfont bold]
2917 foreach e $entries {
2918 $e conf -font $mainfont
2920 if {$phase == "getcommits"} {
2921 $canv itemconf textitems -font $mainfont
2923 redisplay
2926 proc clearsha1 {} {
2927 global sha1entry sha1string
2928 if {[string length $sha1string] == 40} {
2929 $sha1entry delete 0 end
2933 proc sha1change {n1 n2 op} {
2934 global sha1string currentid sha1but
2935 if {$sha1string == {}
2936 || ([info exists currentid] && $sha1string == $currentid)} {
2937 set state disabled
2938 } else {
2939 set state normal
2941 if {[$sha1but cget -state] == $state} return
2942 if {$state == "normal"} {
2943 $sha1but conf -state normal -relief raised -text "Goto: "
2944 } else {
2945 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2949 proc gotocommit {} {
2950 global sha1string currentid commitrow tagids headids
2951 global displayorder numcommits
2953 if {$sha1string == {}
2954 || ([info exists currentid] && $sha1string == $currentid)} return
2955 if {[info exists tagids($sha1string)]} {
2956 set id $tagids($sha1string)
2957 } elseif {[info exists headids($sha1string)]} {
2958 set id $headids($sha1string)
2959 } else {
2960 set id [string tolower $sha1string]
2961 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2962 set matches {}
2963 foreach i $displayorder {
2964 if {[string match $id* $i]} {
2965 lappend matches $i
2968 if {$matches ne {}} {
2969 if {[llength $matches] > 1} {
2970 error_popup "Short SHA1 id $id is ambiguous"
2971 return
2973 set id [lindex $matches 0]
2977 if {[info exists commitrow($id)]} {
2978 selectline $commitrow($id) 1
2979 return
2981 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2982 set type "SHA1 id"
2983 } else {
2984 set type "Tag/Head"
2986 error_popup "$type $sha1string is not known"
2989 proc lineenter {x y id} {
2990 global hoverx hovery hoverid hovertimer
2991 global commitinfo canv
2993 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2994 set hoverx $x
2995 set hovery $y
2996 set hoverid $id
2997 if {[info exists hovertimer]} {
2998 after cancel $hovertimer
3000 set hovertimer [after 500 linehover]
3001 $canv delete hover
3004 proc linemotion {x y id} {
3005 global hoverx hovery hoverid hovertimer
3007 if {[info exists hoverid] && $id == $hoverid} {
3008 set hoverx $x
3009 set hovery $y
3010 if {[info exists hovertimer]} {
3011 after cancel $hovertimer
3013 set hovertimer [after 500 linehover]
3017 proc lineleave {id} {
3018 global hoverid hovertimer canv
3020 if {[info exists hoverid] && $id == $hoverid} {
3021 $canv delete hover
3022 if {[info exists hovertimer]} {
3023 after cancel $hovertimer
3024 unset hovertimer
3026 unset hoverid
3030 proc linehover {} {
3031 global hoverx hovery hoverid hovertimer
3032 global canv linespc lthickness
3033 global commitinfo mainfont
3035 set text [lindex $commitinfo($hoverid) 0]
3036 set ymax [lindex [$canv cget -scrollregion] 3]
3037 if {$ymax == {}} return
3038 set yfrac [lindex [$canv yview] 0]
3039 set x [expr {$hoverx + 2 * $linespc}]
3040 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3041 set x0 [expr {$x - 2 * $lthickness}]
3042 set y0 [expr {$y - 2 * $lthickness}]
3043 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3044 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3045 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3046 -fill \#ffff80 -outline black -width 1 -tags hover]
3047 $canv raise $t
3048 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3049 $canv raise $t
3052 proc clickisonarrow {id y} {
3053 global lthickness idrowranges
3055 set thresh [expr {2 * $lthickness + 6}]
3056 set n [expr {[llength $idrowranges($id)] - 1}]
3057 for {set i 1} {$i < $n} {incr i} {
3058 set row [lindex $idrowranges($id) $i]
3059 if {abs([yc $row] - $y) < $thresh} {
3060 return $i
3063 return {}
3066 proc arrowjump {id n y} {
3067 global idrowranges canv
3069 # 1 <-> 2, 3 <-> 4, etc...
3070 set n [expr {(($n - 1) ^ 1) + 1}]
3071 set row [lindex $idrowranges($id) $n]
3072 set yt [yc $row]
3073 set ymax [lindex [$canv cget -scrollregion] 3]
3074 if {$ymax eq {} || $ymax <= 0} return
3075 set view [$canv yview]
3076 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3077 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3078 if {$yfrac < 0} {
3079 set yfrac 0
3081 allcanvs yview moveto $yfrac
3084 proc lineclick {x y id isnew} {
3085 global ctext commitinfo childlist commitrow cflist canv thickerline
3087 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3088 unmarkmatches
3089 unselectline
3090 normalline
3091 $canv delete hover
3092 # draw this line thicker than normal
3093 set thickerline $id
3094 drawlines $id
3095 if {$isnew} {
3096 set ymax [lindex [$canv cget -scrollregion] 3]
3097 if {$ymax eq {}} return
3098 set yfrac [lindex [$canv yview] 0]
3099 set y [expr {$y + $yfrac * $ymax}]
3101 set dirn [clickisonarrow $id $y]
3102 if {$dirn ne {}} {
3103 arrowjump $id $dirn $y
3104 return
3107 if {$isnew} {
3108 addtohistory [list lineclick $x $y $id 0]
3110 # fill the details pane with info about this line
3111 $ctext conf -state normal
3112 $ctext delete 0.0 end
3113 $ctext tag conf link -foreground blue -underline 1
3114 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3115 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3116 $ctext insert end "Parent:\t"
3117 $ctext insert end $id [list link link0]
3118 $ctext tag bind link0 <1> [list selbyid $id]
3119 set info $commitinfo($id)
3120 $ctext insert end "\n\t[lindex $info 0]\n"
3121 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3122 set date [formatdate [lindex $info 2]]
3123 $ctext insert end "\tDate:\t$date\n"
3124 set kids [lindex $childlist $commitrow($id)]
3125 if {$kids ne {}} {
3126 $ctext insert end "\nChildren:"
3127 set i 0
3128 foreach child $kids {
3129 incr i
3130 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3131 set info $commitinfo($child)
3132 $ctext insert end "\n\t"
3133 $ctext insert end $child [list link link$i]
3134 $ctext tag bind link$i <1> [list selbyid $child]
3135 $ctext insert end "\n\t[lindex $info 0]"
3136 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3137 set date [formatdate [lindex $info 2]]
3138 $ctext insert end "\n\tDate:\t$date\n"
3141 $ctext conf -state disabled
3143 $cflist delete 0 end
3146 proc normalline {} {
3147 global thickerline
3148 if {[info exists thickerline]} {
3149 set id $thickerline
3150 unset thickerline
3151 drawlines $id
3155 proc selbyid {id} {
3156 global commitrow
3157 if {[info exists commitrow($id)]} {
3158 selectline $commitrow($id) 1
3162 proc mstime {} {
3163 global startmstime
3164 if {![info exists startmstime]} {
3165 set startmstime [clock clicks -milliseconds]
3167 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3170 proc rowmenu {x y id} {
3171 global rowctxmenu commitrow selectedline rowmenuid
3173 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3174 set state disabled
3175 } else {
3176 set state normal
3178 $rowctxmenu entryconfigure 0 -state $state
3179 $rowctxmenu entryconfigure 1 -state $state
3180 $rowctxmenu entryconfigure 2 -state $state
3181 set rowmenuid $id
3182 tk_popup $rowctxmenu $x $y
3185 proc diffvssel {dirn} {
3186 global rowmenuid selectedline displayorder
3188 if {![info exists selectedline]} return
3189 if {$dirn} {
3190 set oldid [lindex $displayorder $selectedline]
3191 set newid $rowmenuid
3192 } else {
3193 set oldid $rowmenuid
3194 set newid [lindex $displayorder $selectedline]
3196 addtohistory [list doseldiff $oldid $newid]
3197 doseldiff $oldid $newid
3200 proc doseldiff {oldid newid} {
3201 global ctext cflist
3202 global commitinfo
3204 $ctext conf -state normal
3205 $ctext delete 0.0 end
3206 $ctext mark set fmark.0 0.0
3207 $ctext mark gravity fmark.0 left
3208 $cflist delete 0 end
3209 $cflist insert end "Top"
3210 $ctext insert end "From "
3211 $ctext tag conf link -foreground blue -underline 1
3212 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3213 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3214 $ctext tag bind link0 <1> [list selbyid $oldid]
3215 $ctext insert end $oldid [list link link0]
3216 $ctext insert end "\n "
3217 $ctext insert end [lindex $commitinfo($oldid) 0]
3218 $ctext insert end "\n\nTo "
3219 $ctext tag bind link1 <1> [list selbyid $newid]
3220 $ctext insert end $newid [list link link1]
3221 $ctext insert end "\n "
3222 $ctext insert end [lindex $commitinfo($newid) 0]
3223 $ctext insert end "\n"
3224 $ctext conf -state disabled
3225 $ctext tag delete Comments
3226 $ctext tag remove found 1.0 end
3227 startdiff [list $oldid $newid]
3230 proc mkpatch {} {
3231 global rowmenuid currentid commitinfo patchtop patchnum
3233 if {![info exists currentid]} return
3234 set oldid $currentid
3235 set oldhead [lindex $commitinfo($oldid) 0]
3236 set newid $rowmenuid
3237 set newhead [lindex $commitinfo($newid) 0]
3238 set top .patch
3239 set patchtop $top
3240 catch {destroy $top}
3241 toplevel $top
3242 label $top.title -text "Generate patch"
3243 grid $top.title - -pady 10
3244 label $top.from -text "From:"
3245 entry $top.fromsha1 -width 40 -relief flat
3246 $top.fromsha1 insert 0 $oldid
3247 $top.fromsha1 conf -state readonly
3248 grid $top.from $top.fromsha1 -sticky w
3249 entry $top.fromhead -width 60 -relief flat
3250 $top.fromhead insert 0 $oldhead
3251 $top.fromhead conf -state readonly
3252 grid x $top.fromhead -sticky w
3253 label $top.to -text "To:"
3254 entry $top.tosha1 -width 40 -relief flat
3255 $top.tosha1 insert 0 $newid
3256 $top.tosha1 conf -state readonly
3257 grid $top.to $top.tosha1 -sticky w
3258 entry $top.tohead -width 60 -relief flat
3259 $top.tohead insert 0 $newhead
3260 $top.tohead conf -state readonly
3261 grid x $top.tohead -sticky w
3262 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3263 grid $top.rev x -pady 10
3264 label $top.flab -text "Output file:"
3265 entry $top.fname -width 60
3266 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3267 incr patchnum
3268 grid $top.flab $top.fname -sticky w
3269 frame $top.buts
3270 button $top.buts.gen -text "Generate" -command mkpatchgo
3271 button $top.buts.can -text "Cancel" -command mkpatchcan
3272 grid $top.buts.gen $top.buts.can
3273 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3274 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3275 grid $top.buts - -pady 10 -sticky ew
3276 focus $top.fname
3279 proc mkpatchrev {} {
3280 global patchtop
3282 set oldid [$patchtop.fromsha1 get]
3283 set oldhead [$patchtop.fromhead get]
3284 set newid [$patchtop.tosha1 get]
3285 set newhead [$patchtop.tohead get]
3286 foreach e [list fromsha1 fromhead tosha1 tohead] \
3287 v [list $newid $newhead $oldid $oldhead] {
3288 $patchtop.$e conf -state normal
3289 $patchtop.$e delete 0 end
3290 $patchtop.$e insert 0 $v
3291 $patchtop.$e conf -state readonly
3295 proc mkpatchgo {} {
3296 global patchtop
3298 set oldid [$patchtop.fromsha1 get]
3299 set newid [$patchtop.tosha1 get]
3300 set fname [$patchtop.fname get]
3301 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3302 error_popup "Error creating patch: $err"
3304 catch {destroy $patchtop}
3305 unset patchtop
3308 proc mkpatchcan {} {
3309 global patchtop
3311 catch {destroy $patchtop}
3312 unset patchtop
3315 proc mktag {} {
3316 global rowmenuid mktagtop commitinfo
3318 set top .maketag
3319 set mktagtop $top
3320 catch {destroy $top}
3321 toplevel $top
3322 label $top.title -text "Create tag"
3323 grid $top.title - -pady 10
3324 label $top.id -text "ID:"
3325 entry $top.sha1 -width 40 -relief flat
3326 $top.sha1 insert 0 $rowmenuid
3327 $top.sha1 conf -state readonly
3328 grid $top.id $top.sha1 -sticky w
3329 entry $top.head -width 60 -relief flat
3330 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3331 $top.head conf -state readonly
3332 grid x $top.head -sticky w
3333 label $top.tlab -text "Tag name:"
3334 entry $top.tag -width 60
3335 grid $top.tlab $top.tag -sticky w
3336 frame $top.buts
3337 button $top.buts.gen -text "Create" -command mktaggo
3338 button $top.buts.can -text "Cancel" -command mktagcan
3339 grid $top.buts.gen $top.buts.can
3340 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3341 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3342 grid $top.buts - -pady 10 -sticky ew
3343 focus $top.tag
3346 proc domktag {} {
3347 global mktagtop env tagids idtags
3349 set id [$mktagtop.sha1 get]
3350 set tag [$mktagtop.tag get]
3351 if {$tag == {}} {
3352 error_popup "No tag name specified"
3353 return
3355 if {[info exists tagids($tag)]} {
3356 error_popup "Tag \"$tag\" already exists"
3357 return
3359 if {[catch {
3360 set dir [gitdir]
3361 set fname [file join $dir "refs/tags" $tag]
3362 set f [open $fname w]
3363 puts $f $id
3364 close $f
3365 } err]} {
3366 error_popup "Error creating tag: $err"
3367 return
3370 set tagids($tag) $id
3371 lappend idtags($id) $tag
3372 redrawtags $id
3375 proc redrawtags {id} {
3376 global canv linehtag commitrow idpos selectedline
3378 if {![info exists commitrow($id)]} return
3379 drawcmitrow $commitrow($id)
3380 $canv delete tag.$id
3381 set xt [eval drawtags $id $idpos($id)]
3382 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3383 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3384 selectline $selectedline 0
3388 proc mktagcan {} {
3389 global mktagtop
3391 catch {destroy $mktagtop}
3392 unset mktagtop
3395 proc mktaggo {} {
3396 domktag
3397 mktagcan
3400 proc writecommit {} {
3401 global rowmenuid wrcomtop commitinfo wrcomcmd
3403 set top .writecommit
3404 set wrcomtop $top
3405 catch {destroy $top}
3406 toplevel $top
3407 label $top.title -text "Write commit to file"
3408 grid $top.title - -pady 10
3409 label $top.id -text "ID:"
3410 entry $top.sha1 -width 40 -relief flat
3411 $top.sha1 insert 0 $rowmenuid
3412 $top.sha1 conf -state readonly
3413 grid $top.id $top.sha1 -sticky w
3414 entry $top.head -width 60 -relief flat
3415 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3416 $top.head conf -state readonly
3417 grid x $top.head -sticky w
3418 label $top.clab -text "Command:"
3419 entry $top.cmd -width 60 -textvariable wrcomcmd
3420 grid $top.clab $top.cmd -sticky w -pady 10
3421 label $top.flab -text "Output file:"
3422 entry $top.fname -width 60
3423 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3424 grid $top.flab $top.fname -sticky w
3425 frame $top.buts
3426 button $top.buts.gen -text "Write" -command wrcomgo
3427 button $top.buts.can -text "Cancel" -command wrcomcan
3428 grid $top.buts.gen $top.buts.can
3429 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3430 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3431 grid $top.buts - -pady 10 -sticky ew
3432 focus $top.fname
3435 proc wrcomgo {} {
3436 global wrcomtop
3438 set id [$wrcomtop.sha1 get]
3439 set cmd "echo $id | [$wrcomtop.cmd get]"
3440 set fname [$wrcomtop.fname get]
3441 if {[catch {exec sh -c $cmd >$fname &} err]} {
3442 error_popup "Error writing commit: $err"
3444 catch {destroy $wrcomtop}
3445 unset wrcomtop
3448 proc wrcomcan {} {
3449 global wrcomtop
3451 catch {destroy $wrcomtop}
3452 unset wrcomtop
3455 proc listrefs {id} {
3456 global idtags idheads idotherrefs
3458 set x {}
3459 if {[info exists idtags($id)]} {
3460 set x $idtags($id)
3462 set y {}
3463 if {[info exists idheads($id)]} {
3464 set y $idheads($id)
3466 set z {}
3467 if {[info exists idotherrefs($id)]} {
3468 set z $idotherrefs($id)
3470 return [list $x $y $z]
3473 proc rereadrefs {} {
3474 global idtags idheads idotherrefs
3476 set refids [concat [array names idtags] \
3477 [array names idheads] [array names idotherrefs]]
3478 foreach id $refids {
3479 if {![info exists ref($id)]} {
3480 set ref($id) [listrefs $id]
3483 readrefs
3484 set refids [lsort -unique [concat $refids [array names idtags] \
3485 [array names idheads] [array names idotherrefs]]]
3486 foreach id $refids {
3487 set v [listrefs $id]
3488 if {![info exists ref($id)] || $ref($id) != $v} {
3489 redrawtags $id
3494 proc showtag {tag isnew} {
3495 global ctext cflist tagcontents tagids linknum
3497 if {$isnew} {
3498 addtohistory [list showtag $tag 0]
3500 $ctext conf -state normal
3501 $ctext delete 0.0 end
3502 set linknum 0
3503 if {[info exists tagcontents($tag)]} {
3504 set text $tagcontents($tag)
3505 } else {
3506 set text "Tag: $tag\nId: $tagids($tag)"
3508 appendwithlinks $text
3509 $ctext conf -state disabled
3510 $cflist delete 0 end
3513 proc doquit {} {
3514 global stopped
3515 set stopped 100
3516 destroy .
3519 proc doprefs {} {
3520 global maxwidth maxgraphpct diffopts findmergefiles
3521 global oldprefs prefstop
3523 set top .gitkprefs
3524 set prefstop $top
3525 if {[winfo exists $top]} {
3526 raise $top
3527 return
3529 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3530 set oldprefs($v) [set $v]
3532 toplevel $top
3533 wm title $top "Gitk preferences"
3534 label $top.ldisp -text "Commit list display options"
3535 grid $top.ldisp - -sticky w -pady 10
3536 label $top.spacer -text " "
3537 label $top.maxwidthl -text "Maximum graph width (lines)" \
3538 -font optionfont
3539 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3540 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3541 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3542 -font optionfont
3543 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3544 grid x $top.maxpctl $top.maxpct -sticky w
3545 checkbutton $top.findm -variable findmergefiles
3546 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3547 -font optionfont
3548 grid $top.findm $top.findml - -sticky w
3549 label $top.ddisp -text "Diff display options"
3550 grid $top.ddisp - -sticky w -pady 10
3551 label $top.diffoptl -text "Options for diff program" \
3552 -font optionfont
3553 entry $top.diffopt -width 20 -textvariable diffopts
3554 grid x $top.diffoptl $top.diffopt -sticky w
3555 frame $top.buts
3556 button $top.buts.ok -text "OK" -command prefsok
3557 button $top.buts.can -text "Cancel" -command prefscan
3558 grid $top.buts.ok $top.buts.can
3559 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3560 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3561 grid $top.buts - - -pady 10 -sticky ew
3564 proc prefscan {} {
3565 global maxwidth maxgraphpct diffopts findmergefiles
3566 global oldprefs prefstop
3568 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3569 set $v $oldprefs($v)
3571 catch {destroy $prefstop}
3572 unset prefstop
3575 proc prefsok {} {
3576 global maxwidth maxgraphpct
3577 global oldprefs prefstop
3579 catch {destroy $prefstop}
3580 unset prefstop
3581 if {$maxwidth != $oldprefs(maxwidth)
3582 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3583 redisplay
3587 proc formatdate {d} {
3588 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3591 # This list of encoding names and aliases is distilled from
3592 # http://www.iana.org/assignments/character-sets.
3593 # Not all of them are supported by Tcl.
3594 set encoding_aliases {
3595 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3596 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3597 { ISO-10646-UTF-1 csISO10646UTF1 }
3598 { ISO_646.basic:1983 ref csISO646basic1983 }
3599 { INVARIANT csINVARIANT }
3600 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3601 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3602 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3603 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3604 { NATS-DANO iso-ir-9-1 csNATSDANO }
3605 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3606 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3607 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3608 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3609 { ISO-2022-KR csISO2022KR }
3610 { EUC-KR csEUCKR }
3611 { ISO-2022-JP csISO2022JP }
3612 { ISO-2022-JP-2 csISO2022JP2 }
3613 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3614 csISO13JISC6220jp }
3615 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3616 { IT iso-ir-15 ISO646-IT csISO15Italian }
3617 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3618 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3619 { greek7-old iso-ir-18 csISO18Greek7Old }
3620 { latin-greek iso-ir-19 csISO19LatinGreek }
3621 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3622 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3623 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3624 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3625 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3626 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3627 { INIS iso-ir-49 csISO49INIS }
3628 { INIS-8 iso-ir-50 csISO50INIS8 }
3629 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3630 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3631 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3632 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3633 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3634 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3635 csISO60Norwegian1 }
3636 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3637 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3638 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3639 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3640 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3641 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3642 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3643 { greek7 iso-ir-88 csISO88Greek7 }
3644 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3645 { iso-ir-90 csISO90 }
3646 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3647 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3648 csISO92JISC62991984b }
3649 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3650 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3651 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3652 csISO95JIS62291984handadd }
3653 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3654 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3655 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3656 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3657 CP819 csISOLatin1 }
3658 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3659 { T.61-7bit iso-ir-102 csISO102T617bit }
3660 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3661 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3662 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3663 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3664 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3665 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3666 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3667 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3668 arabic csISOLatinArabic }
3669 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3670 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3671 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3672 greek greek8 csISOLatinGreek }
3673 { T.101-G2 iso-ir-128 csISO128T101G2 }
3674 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3675 csISOLatinHebrew }
3676 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3677 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3678 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3679 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3680 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3681 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3682 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3683 csISOLatinCyrillic }
3684 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3685 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3686 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3687 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3688 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3689 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3690 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3691 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3692 { ISO_10367-box iso-ir-155 csISO10367Box }
3693 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3694 { latin-lap lap iso-ir-158 csISO158Lap }
3695 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3696 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3697 { us-dk csUSDK }
3698 { dk-us csDKUS }
3699 { JIS_X0201 X0201 csHalfWidthKatakana }
3700 { KSC5636 ISO646-KR csKSC5636 }
3701 { ISO-10646-UCS-2 csUnicode }
3702 { ISO-10646-UCS-4 csUCS4 }
3703 { DEC-MCS dec csDECMCS }
3704 { hp-roman8 roman8 r8 csHPRoman8 }
3705 { macintosh mac csMacintosh }
3706 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3707 csIBM037 }
3708 { IBM038 EBCDIC-INT cp038 csIBM038 }
3709 { IBM273 CP273 csIBM273 }
3710 { IBM274 EBCDIC-BE CP274 csIBM274 }
3711 { IBM275 EBCDIC-BR cp275 csIBM275 }
3712 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3713 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3714 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3715 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3716 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3717 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3718 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3719 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3720 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3721 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3722 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3723 { IBM437 cp437 437 csPC8CodePage437 }
3724 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3725 { IBM775 cp775 csPC775Baltic }
3726 { IBM850 cp850 850 csPC850Multilingual }
3727 { IBM851 cp851 851 csIBM851 }
3728 { IBM852 cp852 852 csPCp852 }
3729 { IBM855 cp855 855 csIBM855 }
3730 { IBM857 cp857 857 csIBM857 }
3731 { IBM860 cp860 860 csIBM860 }
3732 { IBM861 cp861 861 cp-is csIBM861 }
3733 { IBM862 cp862 862 csPC862LatinHebrew }
3734 { IBM863 cp863 863 csIBM863 }
3735 { IBM864 cp864 csIBM864 }
3736 { IBM865 cp865 865 csIBM865 }
3737 { IBM866 cp866 866 csIBM866 }
3738 { IBM868 CP868 cp-ar csIBM868 }
3739 { IBM869 cp869 869 cp-gr csIBM869 }
3740 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3741 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3742 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3743 { IBM891 cp891 csIBM891 }
3744 { IBM903 cp903 csIBM903 }
3745 { IBM904 cp904 904 csIBBM904 }
3746 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3747 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3748 { IBM1026 CP1026 csIBM1026 }
3749 { EBCDIC-AT-DE csIBMEBCDICATDE }
3750 { EBCDIC-AT-DE-A csEBCDICATDEA }
3751 { EBCDIC-CA-FR csEBCDICCAFR }
3752 { EBCDIC-DK-NO csEBCDICDKNO }
3753 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3754 { EBCDIC-FI-SE csEBCDICFISE }
3755 { EBCDIC-FI-SE-A csEBCDICFISEA }
3756 { EBCDIC-FR csEBCDICFR }
3757 { EBCDIC-IT csEBCDICIT }
3758 { EBCDIC-PT csEBCDICPT }
3759 { EBCDIC-ES csEBCDICES }
3760 { EBCDIC-ES-A csEBCDICESA }
3761 { EBCDIC-ES-S csEBCDICESS }
3762 { EBCDIC-UK csEBCDICUK }
3763 { EBCDIC-US csEBCDICUS }
3764 { UNKNOWN-8BIT csUnknown8BiT }
3765 { MNEMONIC csMnemonic }
3766 { MNEM csMnem }
3767 { VISCII csVISCII }
3768 { VIQR csVIQR }
3769 { KOI8-R csKOI8R }
3770 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3771 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3772 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3773 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3774 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3775 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3776 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3777 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3778 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3779 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3780 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3781 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3782 { IBM1047 IBM-1047 }
3783 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3784 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3785 { UNICODE-1-1 csUnicode11 }
3786 { CESU-8 csCESU-8 }
3787 { BOCU-1 csBOCU-1 }
3788 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3789 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3790 l8 }
3791 { ISO-8859-15 ISO_8859-15 Latin-9 }
3792 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3793 { GBK CP936 MS936 windows-936 }
3794 { JIS_Encoding csJISEncoding }
3795 { Shift_JIS MS_Kanji csShiftJIS }
3796 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3797 EUC-JP }
3798 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3799 { ISO-10646-UCS-Basic csUnicodeASCII }
3800 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3801 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3802 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3803 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3804 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3805 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3806 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3807 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3808 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3809 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3810 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3811 { Ventura-US csVenturaUS }
3812 { Ventura-International csVenturaInternational }
3813 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3814 { PC8-Turkish csPC8Turkish }
3815 { IBM-Symbols csIBMSymbols }
3816 { IBM-Thai csIBMThai }
3817 { HP-Legal csHPLegal }
3818 { HP-Pi-font csHPPiFont }
3819 { HP-Math8 csHPMath8 }
3820 { Adobe-Symbol-Encoding csHPPSMath }
3821 { HP-DeskTop csHPDesktop }
3822 { Ventura-Math csVenturaMath }
3823 { Microsoft-Publishing csMicrosoftPublishing }
3824 { Windows-31J csWindows31J }
3825 { GB2312 csGB2312 }
3826 { Big5 csBig5 }
3829 proc tcl_encoding {enc} {
3830 global encoding_aliases
3831 set names [encoding names]
3832 set lcnames [string tolower $names]
3833 set enc [string tolower $enc]
3834 set i [lsearch -exact $lcnames $enc]
3835 if {$i < 0} {
3836 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3837 if {[regsub {^iso[-_]} $enc iso encx]} {
3838 set i [lsearch -exact $lcnames $encx]
3841 if {$i < 0} {
3842 foreach l $encoding_aliases {
3843 set ll [string tolower $l]
3844 if {[lsearch -exact $ll $enc] < 0} continue
3845 # look through the aliases for one that tcl knows about
3846 foreach e $ll {
3847 set i [lsearch -exact $lcnames $e]
3848 if {$i < 0} {
3849 if {[regsub {^iso[-_]} $e iso ex]} {
3850 set i [lsearch -exact $lcnames $ex]
3853 if {$i >= 0} break
3855 break
3858 if {$i >= 0} {
3859 return [lindex $names $i]
3861 return {}
3864 # defaults...
3865 set datemode 0
3866 set diffopts "-U 5 -p"
3867 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3869 set gitencoding {}
3870 catch {
3871 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3873 if {$gitencoding == ""} {
3874 set gitencoding "utf-8"
3876 set tclencoding [tcl_encoding $gitencoding]
3877 if {$tclencoding == {}} {
3878 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3881 set mainfont {Helvetica 9}
3882 set textfont {Courier 9}
3883 set uifont {Helvetica 9 bold}
3884 set findmergefiles 0
3885 set maxgraphpct 50
3886 set maxwidth 16
3887 set revlistorder 0
3888 set fastdate 0
3889 set uparrowlen 7
3890 set downarrowlen 7
3891 set mingaplen 30
3893 set colors {green red blue magenta darkgrey brown orange}
3895 catch {source ~/.gitk}
3897 set namefont $mainfont
3899 font create optionfont -family sans-serif -size -12
3901 set revtreeargs {}
3902 foreach arg $argv {
3903 switch -regexp -- $arg {
3904 "^$" { }
3905 "^-d" { set datemode 1 }
3906 default {
3907 lappend revtreeargs $arg
3912 # check that we can find a .git directory somewhere...
3913 set gitdir [gitdir]
3914 if {![file isdirectory $gitdir]} {
3915 error_popup "Cannot find the git directory \"$gitdir\"."
3916 exit 1
3919 set history {}
3920 set historyindex 0
3922 set optim_delay 16
3924 set stopped 0
3925 set stuffsaved 0
3926 set patchnum 0
3927 setcoords
3928 makewindow $revtreeargs
3929 readrefs
3930 getcommits $revtreeargs