gitk: Add a help menu item to display key bindings
[git/dscho.git] / gitk
blob472c12afcb27edcbd2d60c217ee8223374435e1a
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 parse_args {rargs} {
20 global parsed_args
22 if {[catch {
23 set parse_args [concat --default HEAD $rargs]
24 set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
25 }]} {
26 # if git-rev-parse failed for some reason...
27 if {$rargs == {}} {
28 set rargs HEAD
30 set parsed_args $rargs
32 return $parsed_args
35 proc start_rev_list {rlargs} {
36 global startmsecs nextupdate ncmupdate
37 global commfd leftover tclencoding datemode
39 set startmsecs [clock clicks -milliseconds]
40 set nextupdate [expr {$startmsecs + 100}]
41 set ncmupdate 1
42 initlayout
43 set order "--topo-order"
44 if {$datemode} {
45 set order "--date-order"
47 if {[catch {
48 set commfd [open [concat | git-rev-list --header $order \
49 --parents --boundary $rlargs] r]
50 } err]} {
51 puts stderr "Error executing git-rev-list: $err"
52 exit 1
54 set leftover {}
55 fconfigure $commfd -blocking 0 -translation lf
56 if {$tclencoding != {}} {
57 fconfigure $commfd -encoding $tclencoding
59 fileevent $commfd readable [list getcommitlines $commfd]
60 . config -cursor watch
61 settextcursor watch
64 proc getcommits {rargs} {
65 global phase canv mainfont
67 set phase getcommits
68 start_rev_list [parse_args $rargs]
69 $canv delete all
70 $canv create text 3 3 -anchor nw -text "Reading commits..." \
71 -font $mainfont -tags textitems
74 proc getcommitlines {commfd} {
75 global commitlisted nextupdate
76 global leftover
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children
80 set stuff [read $commfd]
81 if {$stuff == {}} {
82 if {![eof $commfd]} return
83 # set it blocking so we wait for the process to terminate
84 fconfigure $commfd -blocking 1
85 if {![catch {close $commfd} err]} {
86 after idle finishcommits
87 return
89 if {[string range $err 0 4] == "usage"} {
90 set err \
91 "Gitk: error reading commits: bad arguments to git-rev-list.\
92 (Note: arguments to gitk are passed to git-rev-list\
93 to allow selection of commits to be displayed.)"
94 } else {
95 set err "Error reading commits: $err"
97 error_popup $err
98 exit 1
100 set start 0
101 set gotsome 0
102 while 1 {
103 set i [string first "\0" $stuff $start]
104 if {$i < 0} {
105 append leftover [string range $stuff $start end]
106 break
108 if {$start == 0} {
109 set cmit $leftover
110 append cmit [string range $stuff 0 [expr {$i - 1}]]
111 set leftover {}
112 } else {
113 set cmit [string range $stuff $start [expr {$i - 1}]]
115 set start [expr {$i + 1}]
116 set j [string first "\n" $cmit]
117 set ok 0
118 set listed 1
119 if {$j >= 0} {
120 set ids [string range $cmit 0 [expr {$j - 1}]]
121 if {[string range $ids 0 0] == "-"} {
122 set listed 0
123 set ids [string range $ids 1 end]
125 set ok 1
126 foreach id $ids {
127 if {[string length $id] != 40} {
128 set ok 0
129 break
133 if {!$ok} {
134 set shortcmit $cmit
135 if {[string length $shortcmit] > 80} {
136 set shortcmit "[string range $shortcmit 0 80]..."
138 error_popup "Can't parse git-rev-list output: {$shortcmit}"
139 exit 1
141 set id [lindex $ids 0]
142 if {$listed} {
143 set olds [lrange $ids 1 end]
144 if {[llength $olds] > 1} {
145 set olds [lsort -unique $olds]
147 foreach p $olds {
148 lappend children($p) $id
150 } else {
151 set olds {}
153 lappend parentlist $olds
154 if {[info exists children($id)]} {
155 lappend childlist $children($id)
156 } else {
157 lappend childlist {}
159 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
160 set commitrow($id) $commitidx
161 incr commitidx
162 lappend displayorder $id
163 lappend commitlisted $listed
164 set gotsome 1
166 if {$gotsome} {
167 layoutmore
169 if {[clock clicks -milliseconds] >= $nextupdate} {
170 doupdate 1
174 proc doupdate {reading} {
175 global commfd nextupdate numcommits ncmupdate
177 if {$reading} {
178 fileevent $commfd readable {}
180 update
181 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
182 if {$numcommits < 100} {
183 set ncmupdate [expr {$numcommits + 1}]
184 } elseif {$numcommits < 10000} {
185 set ncmupdate [expr {$numcommits + 10}]
186 } else {
187 set ncmupdate [expr {$numcommits + 100}]
189 if {$reading} {
190 fileevent $commfd readable [list getcommitlines $commfd]
194 proc readcommit {id} {
195 if {[catch {set contents [exec git-cat-file commit $id]}]} return
196 parsecommit $id $contents 0
199 proc updatecommits {rargs} {
200 stopfindproc
201 foreach v {colormap selectedline matchinglines treediffs
202 mergefilelist currentid rowtextx commitrow
203 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
204 linesegends crossings cornercrossings} {
205 global $v
206 catch {unset $v}
208 allcanvs delete all
209 readrefs
210 getcommits $rargs
213 proc parsecommit {id contents listed} {
214 global commitinfo cdate
216 set inhdr 1
217 set comment {}
218 set headline {}
219 set auname {}
220 set audate {}
221 set comname {}
222 set comdate {}
223 set hdrend [string first "\n\n" $contents]
224 if {$hdrend < 0} {
225 # should never happen...
226 set hdrend [string length $contents]
228 set header [string range $contents 0 [expr {$hdrend - 1}]]
229 set comment [string range $contents [expr {$hdrend + 2}] end]
230 foreach line [split $header "\n"] {
231 set tag [lindex $line 0]
232 if {$tag == "author"} {
233 set audate [lindex $line end-1]
234 set auname [lrange $line 1 end-2]
235 } elseif {$tag == "committer"} {
236 set comdate [lindex $line end-1]
237 set comname [lrange $line 1 end-2]
240 set headline {}
241 # take the first line of the comment as the headline
242 set i [string first "\n" $comment]
243 if {$i >= 0} {
244 set headline [string trim [string range $comment 0 $i]]
245 } else {
246 set headline $comment
248 if {!$listed} {
249 # git-rev-list indents the comment by 4 spaces;
250 # if we got this via git-cat-file, add the indentation
251 set newcomment {}
252 foreach line [split $comment "\n"] {
253 append newcomment " "
254 append newcomment $line
255 append newcomment "\n"
257 set comment $newcomment
259 if {$comdate != {}} {
260 set cdate($id) $comdate
262 set commitinfo($id) [list $headline $auname $audate \
263 $comname $comdate $comment]
266 proc getcommit {id} {
267 global commitdata commitinfo
269 if {[info exists commitdata($id)]} {
270 parsecommit $id $commitdata($id) 1
271 } else {
272 readcommit $id
273 if {![info exists commitinfo($id)]} {
274 set commitinfo($id) {"No commit information available"}
277 return 1
280 proc readrefs {} {
281 global tagids idtags headids idheads tagcontents
282 global otherrefids idotherrefs
284 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
285 catch {unset $v}
287 set refd [open [list | git-ls-remote [gitdir]] r]
288 while {0 <= [set n [gets $refd line]]} {
289 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
290 match id path]} {
291 continue
293 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
294 set type others
295 set name $path
297 if {$type == "tags"} {
298 set tagids($name) $id
299 lappend idtags($id) $name
300 set obj {}
301 set type {}
302 set tag {}
303 catch {
304 set commit [exec git-rev-parse "$id^0"]
305 if {"$commit" != "$id"} {
306 set tagids($name) $commit
307 lappend idtags($commit) $name
310 catch {
311 set tagcontents($name) [exec git-cat-file tag "$id"]
313 } elseif { $type == "heads" } {
314 set headids($name) $id
315 lappend idheads($id) $name
316 } else {
317 set otherrefids($name) $id
318 lappend idotherrefs($id) $name
321 close $refd
324 proc error_popup msg {
325 set w .error
326 toplevel $w
327 wm transient $w .
328 message $w.m -text $msg -justify center -aspect 400
329 pack $w.m -side top -fill x -padx 20 -pady 20
330 button $w.ok -text OK -command "destroy $w"
331 pack $w.ok -side bottom -fill x
332 bind $w <Visibility> "grab $w; focus $w"
333 bind $w <Key-Return> "destroy $w"
334 tkwait window $w
337 proc makewindow {rargs} {
338 global canv canv2 canv3 linespc charspc ctext cflist textfont
339 global findtype findtypemenu findloc findstring fstring geometry
340 global entries sha1entry sha1string sha1but
341 global maincursor textcursor curtextcursor
342 global rowctxmenu mergemax
344 menu .bar
345 .bar add cascade -label "File" -menu .bar.file
346 menu .bar.file
347 .bar.file add command -label "Update" -command [list updatecommits $rargs]
348 .bar.file add command -label "Reread references" -command rereadrefs
349 .bar.file add command -label "Quit" -command doquit
350 menu .bar.edit
351 .bar add cascade -label "Edit" -menu .bar.edit
352 .bar.edit add command -label "Preferences" -command doprefs
353 menu .bar.help
354 .bar add cascade -label "Help" -menu .bar.help
355 .bar.help add command -label "About gitk" -command about
356 .bar.help add command -label "Key bindings" -command keys
357 . configure -menu .bar
359 if {![info exists geometry(canv1)]} {
360 set geometry(canv1) [expr {45 * $charspc}]
361 set geometry(canv2) [expr {30 * $charspc}]
362 set geometry(canv3) [expr {15 * $charspc}]
363 set geometry(canvh) [expr {25 * $linespc + 4}]
364 set geometry(ctextw) 80
365 set geometry(ctexth) 30
366 set geometry(cflistw) 30
368 panedwindow .ctop -orient vertical
369 if {[info exists geometry(width)]} {
370 .ctop conf -width $geometry(width) -height $geometry(height)
371 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
372 set geometry(ctexth) [expr {($texth - 8) /
373 [font metrics $textfont -linespace]}]
375 frame .ctop.top
376 frame .ctop.top.bar
377 pack .ctop.top.bar -side bottom -fill x
378 set cscroll .ctop.top.csb
379 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
380 pack $cscroll -side right -fill y
381 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
382 pack .ctop.top.clist -side top -fill both -expand 1
383 .ctop add .ctop.top
384 set canv .ctop.top.clist.canv
385 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
386 -bg white -bd 0 \
387 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
388 .ctop.top.clist add $canv
389 set canv2 .ctop.top.clist.canv2
390 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
391 -bg white -bd 0 -yscrollincr $linespc
392 .ctop.top.clist add $canv2
393 set canv3 .ctop.top.clist.canv3
394 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
395 -bg white -bd 0 -yscrollincr $linespc
396 .ctop.top.clist add $canv3
397 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
399 set sha1entry .ctop.top.bar.sha1
400 set entries $sha1entry
401 set sha1but .ctop.top.bar.sha1label
402 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
403 -command gotocommit -width 8
404 $sha1but conf -disabledforeground [$sha1but cget -foreground]
405 pack .ctop.top.bar.sha1label -side left
406 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
407 trace add variable sha1string write sha1change
408 pack $sha1entry -side left -pady 2
410 image create bitmap bm-left -data {
411 #define left_width 16
412 #define left_height 16
413 static unsigned char left_bits[] = {
414 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
415 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
416 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
418 image create bitmap bm-right -data {
419 #define right_width 16
420 #define right_height 16
421 static unsigned char right_bits[] = {
422 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
423 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
424 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
426 button .ctop.top.bar.leftbut -image bm-left -command goback \
427 -state disabled -width 26
428 pack .ctop.top.bar.leftbut -side left -fill y
429 button .ctop.top.bar.rightbut -image bm-right -command goforw \
430 -state disabled -width 26
431 pack .ctop.top.bar.rightbut -side left -fill y
433 button .ctop.top.bar.findbut -text "Find" -command dofind
434 pack .ctop.top.bar.findbut -side left
435 set findstring {}
436 set fstring .ctop.top.bar.findstring
437 lappend entries $fstring
438 entry $fstring -width 30 -font $textfont -textvariable findstring
439 pack $fstring -side left -expand 1 -fill x
440 set findtype Exact
441 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
442 findtype Exact IgnCase Regexp]
443 set findloc "All fields"
444 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
445 Comments Author Committer Files Pickaxe
446 pack .ctop.top.bar.findloc -side right
447 pack .ctop.top.bar.findtype -side right
448 # for making sure type==Exact whenever loc==Pickaxe
449 trace add variable findloc write findlocchange
451 panedwindow .ctop.cdet -orient horizontal
452 .ctop add .ctop.cdet
453 frame .ctop.cdet.left
454 set ctext .ctop.cdet.left.ctext
455 text $ctext -bg white -state disabled -font $textfont \
456 -width $geometry(ctextw) -height $geometry(ctexth) \
457 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
458 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
459 pack .ctop.cdet.left.sb -side right -fill y
460 pack $ctext -side left -fill both -expand 1
461 .ctop.cdet add .ctop.cdet.left
463 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
464 $ctext tag conf hunksep -fore blue
465 $ctext tag conf d0 -fore red
466 $ctext tag conf d1 -fore "#00a000"
467 $ctext tag conf m0 -fore red
468 $ctext tag conf m1 -fore blue
469 $ctext tag conf m2 -fore green
470 $ctext tag conf m3 -fore purple
471 $ctext tag conf m4 -fore brown
472 $ctext tag conf m5 -fore "#009090"
473 $ctext tag conf m6 -fore magenta
474 $ctext tag conf m7 -fore "#808000"
475 $ctext tag conf m8 -fore "#009000"
476 $ctext tag conf m9 -fore "#ff0080"
477 $ctext tag conf m10 -fore cyan
478 $ctext tag conf m11 -fore "#b07070"
479 $ctext tag conf m12 -fore "#70b0f0"
480 $ctext tag conf m13 -fore "#70f0b0"
481 $ctext tag conf m14 -fore "#f0b070"
482 $ctext tag conf m15 -fore "#ff70b0"
483 $ctext tag conf mmax -fore darkgrey
484 set mergemax 16
485 $ctext tag conf mresult -font [concat $textfont bold]
486 $ctext tag conf msep -font [concat $textfont bold]
487 $ctext tag conf found -back yellow
489 frame .ctop.cdet.right
490 set cflist .ctop.cdet.right.cfiles
491 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
492 -yscrollcommand ".ctop.cdet.right.sb set"
493 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
494 pack .ctop.cdet.right.sb -side right -fill y
495 pack $cflist -side left -fill both -expand 1
496 .ctop.cdet add .ctop.cdet.right
497 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
499 pack .ctop -side top -fill both -expand 1
501 bindall <1> {selcanvline %W %x %y}
502 #bindall <B1-Motion> {selcanvline %W %x %y}
503 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
504 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
505 bindall <2> "canvscan mark %W %x %y"
506 bindall <B2-Motion> "canvscan dragto %W %x %y"
507 bind . <Key-Up> "selnextline -1"
508 bind . <Key-Down> "selnextline 1"
509 bind . <Key-Right> "goforw"
510 bind . <Key-Left> "goback"
511 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
512 bind . <Key-Next> "allcanvs yview scroll 1 pages"
513 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
514 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
515 bindkey <Key-space> "$ctext yview scroll 1 pages"
516 bindkey p "selnextline -1"
517 bindkey n "selnextline 1"
518 bindkey z "goback"
519 bindkey x "goforw"
520 bindkey i "selnextline -1"
521 bindkey k "selnextline 1"
522 bindkey j "goback"
523 bindkey l "goforw"
524 bindkey b "$ctext yview scroll -1 pages"
525 bindkey d "$ctext yview scroll 18 units"
526 bindkey u "$ctext yview scroll -18 units"
527 bindkey / {findnext 1}
528 bindkey <Key-Return> {findnext 0}
529 bindkey ? findprev
530 bindkey f nextfile
531 bind . <Control-q> doquit
532 bind . <Control-f> dofind
533 bind . <Control-g> {findnext 0}
534 bind . <Control-r> findprev
535 bind . <Control-equal> {incrfont 1}
536 bind . <Control-KP_Add> {incrfont 1}
537 bind . <Control-minus> {incrfont -1}
538 bind . <Control-KP_Subtract> {incrfont -1}
539 bind $cflist <<ListboxSelect>> listboxsel
540 bind . <Destroy> {savestuff %W}
541 bind . <Button-1> "click %W"
542 bind $fstring <Key-Return> dofind
543 bind $sha1entry <Key-Return> gotocommit
544 bind $sha1entry <<PasteSelection>> clearsha1
546 set maincursor [. cget -cursor]
547 set textcursor [$ctext cget -cursor]
548 set curtextcursor $textcursor
550 set rowctxmenu .rowctxmenu
551 menu $rowctxmenu -tearoff 0
552 $rowctxmenu add command -label "Diff this -> selected" \
553 -command {diffvssel 0}
554 $rowctxmenu add command -label "Diff selected -> this" \
555 -command {diffvssel 1}
556 $rowctxmenu add command -label "Make patch" -command mkpatch
557 $rowctxmenu add command -label "Create tag" -command mktag
558 $rowctxmenu add command -label "Write commit to file" -command writecommit
561 # mouse-2 makes all windows scan vertically, but only the one
562 # the cursor is in scans horizontally
563 proc canvscan {op w x y} {
564 global canv canv2 canv3
565 foreach c [list $canv $canv2 $canv3] {
566 if {$c == $w} {
567 $c scan $op $x $y
568 } else {
569 $c scan $op 0 $y
574 proc scrollcanv {cscroll f0 f1} {
575 $cscroll set $f0 $f1
576 drawfrac $f0 $f1
579 # when we make a key binding for the toplevel, make sure
580 # it doesn't get triggered when that key is pressed in the
581 # find string entry widget.
582 proc bindkey {ev script} {
583 global entries
584 bind . $ev $script
585 set escript [bind Entry $ev]
586 if {$escript == {}} {
587 set escript [bind Entry <Key>]
589 foreach e $entries {
590 bind $e $ev "$escript; break"
594 # set the focus back to the toplevel for any click outside
595 # the entry widgets
596 proc click {w} {
597 global entries
598 foreach e $entries {
599 if {$w == $e} return
601 focus .
604 proc savestuff {w} {
605 global canv canv2 canv3 ctext cflist mainfont textfont
606 global stuffsaved findmergefiles maxgraphpct
607 global maxwidth
609 if {$stuffsaved} return
610 if {![winfo viewable .]} return
611 catch {
612 set f [open "~/.gitk-new" w]
613 puts $f [list set mainfont $mainfont]
614 puts $f [list set textfont $textfont]
615 puts $f [list set findmergefiles $findmergefiles]
616 puts $f [list set maxgraphpct $maxgraphpct]
617 puts $f [list set maxwidth $maxwidth]
618 puts $f "set geometry(width) [winfo width .ctop]"
619 puts $f "set geometry(height) [winfo height .ctop]"
620 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
621 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
622 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
623 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
624 set wid [expr {([winfo width $ctext] - 8) \
625 / [font measure $textfont "0"]}]
626 puts $f "set geometry(ctextw) $wid"
627 set wid [expr {([winfo width $cflist] - 11) \
628 / [font measure [$cflist cget -font] "0"]}]
629 puts $f "set geometry(cflistw) $wid"
630 close $f
631 file rename -force "~/.gitk-new" "~/.gitk"
633 set stuffsaved 1
636 proc resizeclistpanes {win w} {
637 global oldwidth
638 if {[info exists oldwidth($win)]} {
639 set s0 [$win sash coord 0]
640 set s1 [$win sash coord 1]
641 if {$w < 60} {
642 set sash0 [expr {int($w/2 - 2)}]
643 set sash1 [expr {int($w*5/6 - 2)}]
644 } else {
645 set factor [expr {1.0 * $w / $oldwidth($win)}]
646 set sash0 [expr {int($factor * [lindex $s0 0])}]
647 set sash1 [expr {int($factor * [lindex $s1 0])}]
648 if {$sash0 < 30} {
649 set sash0 30
651 if {$sash1 < $sash0 + 20} {
652 set sash1 [expr {$sash0 + 20}]
654 if {$sash1 > $w - 10} {
655 set sash1 [expr {$w - 10}]
656 if {$sash0 > $sash1 - 20} {
657 set sash0 [expr {$sash1 - 20}]
661 $win sash place 0 $sash0 [lindex $s0 1]
662 $win sash place 1 $sash1 [lindex $s1 1]
664 set oldwidth($win) $w
667 proc resizecdetpanes {win w} {
668 global oldwidth
669 if {[info exists oldwidth($win)]} {
670 set s0 [$win sash coord 0]
671 if {$w < 60} {
672 set sash0 [expr {int($w*3/4 - 2)}]
673 } else {
674 set factor [expr {1.0 * $w / $oldwidth($win)}]
675 set sash0 [expr {int($factor * [lindex $s0 0])}]
676 if {$sash0 < 45} {
677 set sash0 45
679 if {$sash0 > $w - 15} {
680 set sash0 [expr {$w - 15}]
683 $win sash place 0 $sash0 [lindex $s0 1]
685 set oldwidth($win) $w
688 proc allcanvs args {
689 global canv canv2 canv3
690 eval $canv $args
691 eval $canv2 $args
692 eval $canv3 $args
695 proc bindall {event action} {
696 global canv canv2 canv3
697 bind $canv $event $action
698 bind $canv2 $event $action
699 bind $canv3 $event $action
702 proc about {} {
703 set w .about
704 if {[winfo exists $w]} {
705 raise $w
706 return
708 toplevel $w
709 wm title $w "About gitk"
710 message $w.m -text {
711 Gitk - a commit viewer for git
713 Copyright © 2005-2006 Paul Mackerras
715 Use and redistribute under the terms of the GNU General Public License} \
716 -justify center -aspect 400
717 pack $w.m -side top -fill x -padx 20 -pady 20
718 button $w.ok -text Close -command "destroy $w"
719 pack $w.ok -side bottom
722 proc keys {} {
723 set w .keys
724 if {[winfo exists $w]} {
725 raise $w
726 return
728 toplevel $w
729 wm title $w "Gitk key bindings"
730 message $w.m -text {
731 Gitk key bindings:
733 <Ctrl-Q> Quit
734 <Up>, p, i Move up one commit
735 <Down>, n, k Move down one commit
736 <Left>, z, j Go back in history list
737 <Right>, x, l Go forward in history list
738 <Page up> Scroll commit list up one page
739 <Page down> Scroll commit list down one page
740 <Delete>, b Scroll diff view up one page
741 <Backspace> Scroll diff view up one page
742 <Space> Scroll diff view down one page
743 u Scroll diff view up 18 lines
744 d Scroll diff view down 18 lines
745 <Ctrl-F> Find
746 <Ctrl-G> Move to next find hit
747 <Ctrl-R> Move to previous find hit
748 <Return> Move to next find hit
749 / Move to next find hit, or redo find
750 ? Move to previous find hit
751 f Scroll diff view to next file
752 <Ctrl-KP+> Increase font size
753 <Ctrl-plus> Increase font size
754 <Ctrl-KP-> Decrease font size
755 <Ctrl-minus> Decrease font size
757 -justify left -bg white -border 2 -relief sunken
758 pack $w.m -side top -fill both
759 button $w.ok -text Close -command "destroy $w"
760 pack $w.ok -side bottom
763 proc shortids {ids} {
764 set res {}
765 foreach id $ids {
766 if {[llength $id] > 1} {
767 lappend res [shortids $id]
768 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
769 lappend res [string range $id 0 7]
770 } else {
771 lappend res $id
774 return $res
777 proc incrange {l x o} {
778 set n [llength $l]
779 while {$x < $n} {
780 set e [lindex $l $x]
781 if {$e ne {}} {
782 lset l $x [expr {$e + $o}]
784 incr x
786 return $l
789 proc ntimes {n o} {
790 set ret {}
791 for {} {$n > 0} {incr n -1} {
792 lappend ret $o
794 return $ret
797 proc usedinrange {id l1 l2} {
798 global children commitrow
800 if {[info exists commitrow($id)]} {
801 set r $commitrow($id)
802 if {$l1 <= $r && $r <= $l2} {
803 return [expr {$r - $l1 + 1}]
806 foreach c $children($id) {
807 if {[info exists commitrow($c)]} {
808 set r $commitrow($c)
809 if {$l1 <= $r && $r <= $l2} {
810 return [expr {$r - $l1 + 1}]
814 return 0
817 proc sanity {row {full 0}} {
818 global rowidlist rowoffsets
820 set col -1
821 set ids [lindex $rowidlist $row]
822 foreach id $ids {
823 incr col
824 if {$id eq {}} continue
825 if {$col < [llength $ids] - 1 &&
826 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
827 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
829 set o [lindex $rowoffsets $row $col]
830 set y $row
831 set x $col
832 while {$o ne {}} {
833 incr y -1
834 incr x $o
835 if {[lindex $rowidlist $y $x] != $id} {
836 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
837 puts " id=[shortids $id] check started at row $row"
838 for {set i $row} {$i >= $y} {incr i -1} {
839 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
841 break
843 if {!$full} break
844 set o [lindex $rowoffsets $y $x]
849 proc makeuparrow {oid x y z} {
850 global rowidlist rowoffsets uparrowlen idrowranges
852 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
853 incr y -1
854 incr x $z
855 set off0 [lindex $rowoffsets $y]
856 for {set x0 $x} {1} {incr x0} {
857 if {$x0 >= [llength $off0]} {
858 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
859 break
861 set z [lindex $off0 $x0]
862 if {$z ne {}} {
863 incr x0 $z
864 break
867 set z [expr {$x0 - $x}]
868 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
869 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
871 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
872 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
873 lappend idrowranges($oid) $y
876 proc initlayout {} {
877 global rowidlist rowoffsets displayorder commitlisted
878 global rowlaidout rowoptim
879 global idinlist rowchk
880 global commitidx numcommits canvxmax canv
881 global nextcolor
882 global parentlist childlist children
884 set commitidx 0
885 set numcommits 0
886 set displayorder {}
887 set commitlisted {}
888 set parentlist {}
889 set childlist {}
890 catch {unset children}
891 set nextcolor 0
892 set rowidlist {{}}
893 set rowoffsets {{}}
894 catch {unset idinlist}
895 catch {unset rowchk}
896 set rowlaidout 0
897 set rowoptim 0
898 set canvxmax [$canv cget -width]
901 proc setcanvscroll {} {
902 global canv canv2 canv3 numcommits linespc canvxmax canvy0
904 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
905 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
906 $canv2 conf -scrollregion [list 0 0 0 $ymax]
907 $canv3 conf -scrollregion [list 0 0 0 $ymax]
910 proc visiblerows {} {
911 global canv numcommits linespc
913 set ymax [lindex [$canv cget -scrollregion] 3]
914 if {$ymax eq {} || $ymax == 0} return
915 set f [$canv yview]
916 set y0 [expr {int([lindex $f 0] * $ymax)}]
917 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
918 if {$r0 < 0} {
919 set r0 0
921 set y1 [expr {int([lindex $f 1] * $ymax)}]
922 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
923 if {$r1 >= $numcommits} {
924 set r1 [expr {$numcommits - 1}]
926 return [list $r0 $r1]
929 proc layoutmore {} {
930 global rowlaidout rowoptim commitidx numcommits optim_delay
931 global uparrowlen
933 set row $rowlaidout
934 set rowlaidout [layoutrows $row $commitidx 0]
935 set orow [expr {$rowlaidout - $uparrowlen - 1}]
936 if {$orow > $rowoptim} {
937 checkcrossings $rowoptim $orow
938 optimize_rows $rowoptim 0 $orow
939 set rowoptim $orow
941 set canshow [expr {$rowoptim - $optim_delay}]
942 if {$canshow > $numcommits} {
943 showstuff $canshow
947 proc showstuff {canshow} {
948 global numcommits
949 global linesegends idrowranges idrangedrawn
951 if {$numcommits == 0} {
952 global phase
953 set phase "incrdraw"
954 allcanvs delete all
956 set row $numcommits
957 set numcommits $canshow
958 setcanvscroll
959 set rows [visiblerows]
960 set r0 [lindex $rows 0]
961 set r1 [lindex $rows 1]
962 for {set r $row} {$r < $canshow} {incr r} {
963 if {[info exists linesegends($r)]} {
964 foreach id $linesegends($r) {
965 set i -1
966 foreach {s e} $idrowranges($id) {
967 incr i
968 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
969 && ![info exists idrangedrawn($id,$i)]} {
970 drawlineseg $id $i
971 set idrangedrawn($id,$i) 1
977 if {$canshow > $r1} {
978 set canshow $r1
980 while {$row < $canshow} {
981 drawcmitrow $row
982 incr row
986 proc layoutrows {row endrow last} {
987 global rowidlist rowoffsets displayorder
988 global uparrowlen downarrowlen maxwidth mingaplen
989 global childlist parentlist
990 global idrowranges linesegends
991 global commitidx
992 global idinlist rowchk
994 set idlist [lindex $rowidlist $row]
995 set offs [lindex $rowoffsets $row]
996 while {$row < $endrow} {
997 set id [lindex $displayorder $row]
998 set oldolds {}
999 set newolds {}
1000 foreach p [lindex $parentlist $row] {
1001 if {![info exists idinlist($p)]} {
1002 lappend newolds $p
1003 } elseif {!$idinlist($p)} {
1004 lappend oldolds $p
1007 set nev [expr {[llength $idlist] + [llength $newolds]
1008 + [llength $oldolds] - $maxwidth + 1}]
1009 if {$nev > 0} {
1010 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1011 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1012 set i [lindex $idlist $x]
1013 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1014 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1015 [expr {$row + $uparrowlen + $mingaplen}]]
1016 if {$r == 0} {
1017 set idlist [lreplace $idlist $x $x]
1018 set offs [lreplace $offs $x $x]
1019 set offs [incrange $offs $x 1]
1020 set idinlist($i) 0
1021 set rm1 [expr {$row - 1}]
1022 lappend linesegends($rm1) $i
1023 lappend idrowranges($i) $rm1
1024 if {[incr nev -1] <= 0} break
1025 continue
1027 set rowchk($id) [expr {$row + $r}]
1030 lset rowidlist $row $idlist
1031 lset rowoffsets $row $offs
1033 set col [lsearch -exact $idlist $id]
1034 if {$col < 0} {
1035 set col [llength $idlist]
1036 lappend idlist $id
1037 lset rowidlist $row $idlist
1038 set z {}
1039 if {[lindex $childlist $row] ne {}} {
1040 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1041 unset idinlist($id)
1043 lappend offs $z
1044 lset rowoffsets $row $offs
1045 if {$z ne {}} {
1046 makeuparrow $id $col $row $z
1048 } else {
1049 unset idinlist($id)
1051 if {[info exists idrowranges($id)]} {
1052 lappend idrowranges($id) $row
1054 incr row
1055 set offs [ntimes [llength $idlist] 0]
1056 set l [llength $newolds]
1057 set idlist [eval lreplace \$idlist $col $col $newolds]
1058 set o 0
1059 if {$l != 1} {
1060 set offs [lrange $offs 0 [expr {$col - 1}]]
1061 foreach x $newolds {
1062 lappend offs {}
1063 incr o -1
1065 incr o
1066 set tmp [expr {[llength $idlist] - [llength $offs]}]
1067 if {$tmp > 0} {
1068 set offs [concat $offs [ntimes $tmp $o]]
1070 } else {
1071 lset offs $col {}
1073 foreach i $newolds {
1074 set idinlist($i) 1
1075 set idrowranges($i) $row
1077 incr col $l
1078 foreach oid $oldolds {
1079 set idinlist($oid) 1
1080 set idlist [linsert $idlist $col $oid]
1081 set offs [linsert $offs $col $o]
1082 makeuparrow $oid $col $row $o
1083 incr col
1085 lappend rowidlist $idlist
1086 lappend rowoffsets $offs
1088 return $row
1091 proc addextraid {id row} {
1092 global displayorder commitrow commitinfo
1093 global commitidx
1094 global parentlist childlist children
1096 incr commitidx
1097 lappend displayorder $id
1098 lappend parentlist {}
1099 set commitrow($id) $row
1100 readcommit $id
1101 if {![info exists commitinfo($id)]} {
1102 set commitinfo($id) {"No commit information available"}
1104 if {[info exists children($id)]} {
1105 lappend childlist $children($id)
1106 } else {
1107 lappend childlist {}
1111 proc layouttail {} {
1112 global rowidlist rowoffsets idinlist commitidx
1113 global idrowranges
1115 set row $commitidx
1116 set idlist [lindex $rowidlist $row]
1117 while {$idlist ne {}} {
1118 set col [expr {[llength $idlist] - 1}]
1119 set id [lindex $idlist $col]
1120 addextraid $id $row
1121 unset idinlist($id)
1122 lappend idrowranges($id) $row
1123 incr row
1124 set offs [ntimes $col 0]
1125 set idlist [lreplace $idlist $col $col]
1126 lappend rowidlist $idlist
1127 lappend rowoffsets $offs
1130 foreach id [array names idinlist] {
1131 addextraid $id $row
1132 lset rowidlist $row [list $id]
1133 lset rowoffsets $row 0
1134 makeuparrow $id 0 $row 0
1135 lappend idrowranges($id) $row
1136 incr row
1137 lappend rowidlist {}
1138 lappend rowoffsets {}
1142 proc insert_pad {row col npad} {
1143 global rowidlist rowoffsets
1145 set pad [ntimes $npad {}]
1146 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1147 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1148 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1151 proc optimize_rows {row col endrow} {
1152 global rowidlist rowoffsets idrowranges linesegends displayorder
1154 for {} {$row < $endrow} {incr row} {
1155 set idlist [lindex $rowidlist $row]
1156 set offs [lindex $rowoffsets $row]
1157 set haspad 0
1158 for {} {$col < [llength $offs]} {incr col} {
1159 if {[lindex $idlist $col] eq {}} {
1160 set haspad 1
1161 continue
1163 set z [lindex $offs $col]
1164 if {$z eq {}} continue
1165 set isarrow 0
1166 set x0 [expr {$col + $z}]
1167 set y0 [expr {$row - 1}]
1168 set z0 [lindex $rowoffsets $y0 $x0]
1169 if {$z0 eq {}} {
1170 set id [lindex $idlist $col]
1171 if {[info exists idrowranges($id)] &&
1172 $y0 > [lindex $idrowranges($id) 0]} {
1173 set isarrow 1
1176 if {$z < -1 || ($z < 0 && $isarrow)} {
1177 set npad [expr {-1 - $z + $isarrow}]
1178 set offs [incrange $offs $col $npad]
1179 insert_pad $y0 $x0 $npad
1180 if {$y0 > 0} {
1181 optimize_rows $y0 $x0 $row
1183 set z [lindex $offs $col]
1184 set x0 [expr {$col + $z}]
1185 set z0 [lindex $rowoffsets $y0 $x0]
1186 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1187 set npad [expr {$z - 1 + $isarrow}]
1188 set y1 [expr {$row + 1}]
1189 set offs2 [lindex $rowoffsets $y1]
1190 set x1 -1
1191 foreach z $offs2 {
1192 incr x1
1193 if {$z eq {} || $x1 + $z < $col} continue
1194 if {$x1 + $z > $col} {
1195 incr npad
1197 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1198 break
1200 set pad [ntimes $npad {}]
1201 set idlist [eval linsert \$idlist $col $pad]
1202 set tmp [eval linsert \$offs $col $pad]
1203 incr col $npad
1204 set offs [incrange $tmp $col [expr {-$npad}]]
1205 set z [lindex $offs $col]
1206 set haspad 1
1208 if {$z0 eq {} && !$isarrow} {
1209 # this line links to its first child on row $row-2
1210 set rm2 [expr {$row - 2}]
1211 set id [lindex $displayorder $rm2]
1212 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1213 if {$xc >= 0} {
1214 set z0 [expr {$xc - $x0}]
1217 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1218 insert_pad $y0 $x0 1
1219 set offs [incrange $offs $col 1]
1220 optimize_rows $y0 [expr {$x0 + 1}] $row
1223 if {!$haspad} {
1224 set o {}
1225 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1226 set o [lindex $offs $col]
1227 if {$o eq {}} {
1228 # check if this is the link to the first child
1229 set id [lindex $idlist $col]
1230 if {[info exists idrowranges($id)] &&
1231 $row == [lindex $idrowranges($id) 0]} {
1232 # it is, work out offset to child
1233 set y0 [expr {$row - 1}]
1234 set id [lindex $displayorder $y0]
1235 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1236 if {$x0 >= 0} {
1237 set o [expr {$x0 - $col}]
1241 if {$o eq {} || $o <= 0} break
1243 if {$o ne {} && [incr col] < [llength $idlist]} {
1244 set y1 [expr {$row + 1}]
1245 set offs2 [lindex $rowoffsets $y1]
1246 set x1 -1
1247 foreach z $offs2 {
1248 incr x1
1249 if {$z eq {} || $x1 + $z < $col} continue
1250 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1251 break
1253 set idlist [linsert $idlist $col {}]
1254 set tmp [linsert $offs $col {}]
1255 incr col
1256 set offs [incrange $tmp $col -1]
1259 lset rowidlist $row $idlist
1260 lset rowoffsets $row $offs
1261 set col 0
1265 proc xc {row col} {
1266 global canvx0 linespc
1267 return [expr {$canvx0 + $col * $linespc}]
1270 proc yc {row} {
1271 global canvy0 linespc
1272 return [expr {$canvy0 + $row * $linespc}]
1275 proc linewidth {id} {
1276 global thickerline lthickness
1278 set wid $lthickness
1279 if {[info exists thickerline] && $id eq $thickerline} {
1280 set wid [expr {2 * $lthickness}]
1282 return $wid
1285 proc drawlineseg {id i} {
1286 global rowoffsets rowidlist idrowranges
1287 global displayorder
1288 global canv colormap linespc
1290 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1291 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1292 if {$startrow == $row} return
1293 assigncolor $id
1294 set coords {}
1295 set col [lsearch -exact [lindex $rowidlist $row] $id]
1296 if {$col < 0} {
1297 puts "oops: drawline: id $id not on row $row"
1298 return
1300 set lasto {}
1301 set ns 0
1302 while {1} {
1303 set o [lindex $rowoffsets $row $col]
1304 if {$o eq {}} break
1305 if {$o ne $lasto} {
1306 # changing direction
1307 set x [xc $row $col]
1308 set y [yc $row]
1309 lappend coords $x $y
1310 set lasto $o
1312 incr col $o
1313 incr row -1
1315 set x [xc $row $col]
1316 set y [yc $row]
1317 lappend coords $x $y
1318 if {$i == 0} {
1319 # draw the link to the first child as part of this line
1320 incr row -1
1321 set child [lindex $displayorder $row]
1322 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1323 if {$ccol >= 0} {
1324 set x [xc $row $ccol]
1325 set y [yc $row]
1326 if {$ccol < $col - 1} {
1327 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1328 } elseif {$ccol > $col + 1} {
1329 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1331 lappend coords $x $y
1334 if {[llength $coords] < 4} return
1335 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1336 if {$i < $last} {
1337 # This line has an arrow at the lower end: check if the arrow is
1338 # on a diagonal segment, and if so, work around the Tk 8.4
1339 # refusal to draw arrows on diagonal lines.
1340 set x0 [lindex $coords 0]
1341 set x1 [lindex $coords 2]
1342 if {$x0 != $x1} {
1343 set y0 [lindex $coords 1]
1344 set y1 [lindex $coords 3]
1345 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1346 # we have a nearby vertical segment, just trim off the diag bit
1347 set coords [lrange $coords 2 end]
1348 } else {
1349 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1350 set xi [expr {$x0 - $slope * $linespc / 2}]
1351 set yi [expr {$y0 - $linespc / 2}]
1352 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1356 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1357 set arrow [lindex {none first last both} $arrow]
1358 set t [$canv create line $coords -width [linewidth $id] \
1359 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1360 $canv lower $t
1361 bindline $t $id
1364 proc drawparentlinks {id row col olds} {
1365 global rowidlist canv colormap idrowranges
1367 set row2 [expr {$row + 1}]
1368 set x [xc $row $col]
1369 set y [yc $row]
1370 set y2 [yc $row2]
1371 set ids [lindex $rowidlist $row2]
1372 # rmx = right-most X coord used
1373 set rmx 0
1374 foreach p $olds {
1375 set i [lsearch -exact $ids $p]
1376 if {$i < 0} {
1377 puts "oops, parent $p of $id not in list"
1378 continue
1380 set x2 [xc $row2 $i]
1381 if {$x2 > $rmx} {
1382 set rmx $x2
1384 if {[info exists idrowranges($p)] &&
1385 $row2 == [lindex $idrowranges($p) 0] &&
1386 $row2 < [lindex $idrowranges($p) 1]} {
1387 # drawlineseg will do this one for us
1388 continue
1390 assigncolor $p
1391 # should handle duplicated parents here...
1392 set coords [list $x $y]
1393 if {$i < $col - 1} {
1394 lappend coords [xc $row [expr {$i + 1}]] $y
1395 } elseif {$i > $col + 1} {
1396 lappend coords [xc $row [expr {$i - 1}]] $y
1398 lappend coords $x2 $y2
1399 set t [$canv create line $coords -width [linewidth $p] \
1400 -fill $colormap($p) -tags lines.$p]
1401 $canv lower $t
1402 bindline $t $p
1404 return $rmx
1407 proc drawlines {id} {
1408 global colormap canv
1409 global idrowranges idrangedrawn
1410 global childlist iddrawn commitrow rowidlist
1412 $canv delete lines.$id
1413 set nr [expr {[llength $idrowranges($id)] / 2}]
1414 for {set i 0} {$i < $nr} {incr i} {
1415 if {[info exists idrangedrawn($id,$i)]} {
1416 drawlineseg $id $i
1419 foreach child [lindex $childlist $commitrow($id)] {
1420 if {[info exists iddrawn($child)]} {
1421 set row $commitrow($child)
1422 set col [lsearch -exact [lindex $rowidlist $row] $child]
1423 if {$col >= 0} {
1424 drawparentlinks $child $row $col [list $id]
1430 proc drawcmittext {id row col rmx} {
1431 global linespc canv canv2 canv3 canvy0
1432 global commitlisted commitinfo rowidlist
1433 global rowtextx idpos idtags idheads idotherrefs
1434 global linehtag linentag linedtag
1435 global mainfont namefont canvxmax
1437 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1438 set x [xc $row $col]
1439 set y [yc $row]
1440 set orad [expr {$linespc / 3}]
1441 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1442 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1443 -fill $ofill -outline black -width 1]
1444 $canv raise $t
1445 $canv bind $t <1> {selcanvline {} %x %y}
1446 set xt [xc $row [llength [lindex $rowidlist $row]]]
1447 if {$xt < $rmx} {
1448 set xt $rmx
1450 set rowtextx($row) $xt
1451 set idpos($id) [list $x $xt $y]
1452 if {[info exists idtags($id)] || [info exists idheads($id)]
1453 || [info exists idotherrefs($id)]} {
1454 set xt [drawtags $id $x $xt $y]
1456 set headline [lindex $commitinfo($id) 0]
1457 set name [lindex $commitinfo($id) 1]
1458 set date [lindex $commitinfo($id) 2]
1459 set date [formatdate $date]
1460 set linehtag($row) [$canv create text $xt $y -anchor w \
1461 -text $headline -font $mainfont ]
1462 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1463 set linentag($row) [$canv2 create text 3 $y -anchor w \
1464 -text $name -font $namefont]
1465 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1466 -text $date -font $mainfont]
1467 set xr [expr {$xt + [font measure $mainfont $headline]}]
1468 if {$xr > $canvxmax} {
1469 set canvxmax $xr
1470 setcanvscroll
1474 proc drawcmitrow {row} {
1475 global displayorder rowidlist
1476 global idrowranges idrangedrawn iddrawn
1477 global commitinfo commitlisted parentlist numcommits
1479 if {$row >= $numcommits} return
1480 foreach id [lindex $rowidlist $row] {
1481 if {![info exists idrowranges($id)]} continue
1482 set i -1
1483 foreach {s e} $idrowranges($id) {
1484 incr i
1485 if {$row < $s} continue
1486 if {$e eq {}} break
1487 if {$row <= $e} {
1488 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1489 drawlineseg $id $i
1490 set idrangedrawn($id,$i) 1
1492 break
1497 set id [lindex $displayorder $row]
1498 if {[info exists iddrawn($id)]} return
1499 set col [lsearch -exact [lindex $rowidlist $row] $id]
1500 if {$col < 0} {
1501 puts "oops, row $row id $id not in list"
1502 return
1504 if {![info exists commitinfo($id)]} {
1505 getcommit $id
1507 assigncolor $id
1508 set olds [lindex $parentlist $row]
1509 if {$olds ne {}} {
1510 set rmx [drawparentlinks $id $row $col $olds]
1511 } else {
1512 set rmx 0
1514 drawcmittext $id $row $col $rmx
1515 set iddrawn($id) 1
1518 proc drawfrac {f0 f1} {
1519 global numcommits canv
1520 global linespc
1522 set ymax [lindex [$canv cget -scrollregion] 3]
1523 if {$ymax eq {} || $ymax == 0} return
1524 set y0 [expr {int($f0 * $ymax)}]
1525 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1526 if {$row < 0} {
1527 set row 0
1529 set y1 [expr {int($f1 * $ymax)}]
1530 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1531 if {$endrow >= $numcommits} {
1532 set endrow [expr {$numcommits - 1}]
1534 for {} {$row <= $endrow} {incr row} {
1535 drawcmitrow $row
1539 proc drawvisible {} {
1540 global canv
1541 eval drawfrac [$canv yview]
1544 proc clear_display {} {
1545 global iddrawn idrangedrawn
1547 allcanvs delete all
1548 catch {unset iddrawn}
1549 catch {unset idrangedrawn}
1552 proc assigncolor {id} {
1553 global colormap colors nextcolor
1554 global commitrow parentlist children childlist
1555 global cornercrossings crossings
1557 if {[info exists colormap($id)]} return
1558 set ncolors [llength $colors]
1559 if {[info exists commitrow($id)]} {
1560 set kids [lindex $childlist $commitrow($id)]
1561 } elseif {[info exists children($id)]} {
1562 set kids $children($id)
1563 } else {
1564 set kids {}
1566 if {[llength $kids] == 1} {
1567 set child [lindex $kids 0]
1568 if {[info exists colormap($child)]
1569 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1570 set colormap($id) $colormap($child)
1571 return
1574 set badcolors {}
1575 if {[info exists cornercrossings($id)]} {
1576 foreach x $cornercrossings($id) {
1577 if {[info exists colormap($x)]
1578 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1579 lappend badcolors $colormap($x)
1582 if {[llength $badcolors] >= $ncolors} {
1583 set badcolors {}
1586 set origbad $badcolors
1587 if {[llength $badcolors] < $ncolors - 1} {
1588 if {[info exists crossings($id)]} {
1589 foreach x $crossings($id) {
1590 if {[info exists colormap($x)]
1591 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1592 lappend badcolors $colormap($x)
1595 if {[llength $badcolors] >= $ncolors} {
1596 set badcolors $origbad
1599 set origbad $badcolors
1601 if {[llength $badcolors] < $ncolors - 1} {
1602 foreach child $kids {
1603 if {[info exists colormap($child)]
1604 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1605 lappend badcolors $colormap($child)
1607 foreach p [lindex $parentlist $commitrow($child)] {
1608 if {[info exists colormap($p)]
1609 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1610 lappend badcolors $colormap($p)
1614 if {[llength $badcolors] >= $ncolors} {
1615 set badcolors $origbad
1618 for {set i 0} {$i <= $ncolors} {incr i} {
1619 set c [lindex $colors $nextcolor]
1620 if {[incr nextcolor] >= $ncolors} {
1621 set nextcolor 0
1623 if {[lsearch -exact $badcolors $c]} break
1625 set colormap($id) $c
1628 proc bindline {t id} {
1629 global canv
1631 $canv bind $t <Enter> "lineenter %x %y $id"
1632 $canv bind $t <Motion> "linemotion %x %y $id"
1633 $canv bind $t <Leave> "lineleave $id"
1634 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1637 proc drawtags {id x xt y1} {
1638 global idtags idheads idotherrefs
1639 global linespc lthickness
1640 global canv mainfont commitrow rowtextx
1642 set marks {}
1643 set ntags 0
1644 set nheads 0
1645 if {[info exists idtags($id)]} {
1646 set marks $idtags($id)
1647 set ntags [llength $marks]
1649 if {[info exists idheads($id)]} {
1650 set marks [concat $marks $idheads($id)]
1651 set nheads [llength $idheads($id)]
1653 if {[info exists idotherrefs($id)]} {
1654 set marks [concat $marks $idotherrefs($id)]
1656 if {$marks eq {}} {
1657 return $xt
1660 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1661 set yt [expr {$y1 - 0.5 * $linespc}]
1662 set yb [expr {$yt + $linespc - 1}]
1663 set xvals {}
1664 set wvals {}
1665 foreach tag $marks {
1666 set wid [font measure $mainfont $tag]
1667 lappend xvals $xt
1668 lappend wvals $wid
1669 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1671 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1672 -width $lthickness -fill black -tags tag.$id]
1673 $canv lower $t
1674 foreach tag $marks x $xvals wid $wvals {
1675 set xl [expr {$x + $delta}]
1676 set xr [expr {$x + $delta + $wid + $lthickness}]
1677 if {[incr ntags -1] >= 0} {
1678 # draw a tag
1679 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1680 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1681 -width 1 -outline black -fill yellow -tags tag.$id]
1682 $canv bind $t <1> [list showtag $tag 1]
1683 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1684 } else {
1685 # draw a head or other ref
1686 if {[incr nheads -1] >= 0} {
1687 set col green
1688 } else {
1689 set col "#ddddff"
1691 set xl [expr {$xl - $delta/2}]
1692 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1693 -width 1 -outline black -fill $col -tags tag.$id
1695 set t [$canv create text $xl $y1 -anchor w -text $tag \
1696 -font $mainfont -tags tag.$id]
1697 if {$ntags >= 0} {
1698 $canv bind $t <1> [list showtag $tag 1]
1701 return $xt
1704 proc checkcrossings {row endrow} {
1705 global displayorder parentlist rowidlist
1707 for {} {$row < $endrow} {incr row} {
1708 set id [lindex $displayorder $row]
1709 set i [lsearch -exact [lindex $rowidlist $row] $id]
1710 if {$i < 0} continue
1711 set idlist [lindex $rowidlist [expr {$row+1}]]
1712 foreach p [lindex $parentlist $row] {
1713 set j [lsearch -exact $idlist $p]
1714 if {$j > 0} {
1715 if {$j < $i - 1} {
1716 notecrossings $row $p $j $i [expr {$j+1}]
1717 } elseif {$j > $i + 1} {
1718 notecrossings $row $p $i $j [expr {$j-1}]
1725 proc notecrossings {row id lo hi corner} {
1726 global rowidlist crossings cornercrossings
1728 for {set i $lo} {[incr i] < $hi} {} {
1729 set p [lindex [lindex $rowidlist $row] $i]
1730 if {$p == {}} continue
1731 if {$i == $corner} {
1732 if {![info exists cornercrossings($id)]
1733 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1734 lappend cornercrossings($id) $p
1736 if {![info exists cornercrossings($p)]
1737 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1738 lappend cornercrossings($p) $id
1740 } else {
1741 if {![info exists crossings($id)]
1742 || [lsearch -exact $crossings($id) $p] < 0} {
1743 lappend crossings($id) $p
1745 if {![info exists crossings($p)]
1746 || [lsearch -exact $crossings($p) $id] < 0} {
1747 lappend crossings($p) $id
1753 proc xcoord {i level ln} {
1754 global canvx0 xspc1 xspc2
1756 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1757 if {$i > 0 && $i == $level} {
1758 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1759 } elseif {$i > $level} {
1760 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1762 return $x
1765 proc finishcommits {} {
1766 global commitidx phase
1767 global canv mainfont ctext maincursor textcursor
1768 global findinprogress
1770 if {$commitidx > 0} {
1771 drawrest
1772 } else {
1773 $canv delete all
1774 $canv create text 3 3 -anchor nw -text "No commits selected" \
1775 -font $mainfont -tags textitems
1777 if {![info exists findinprogress]} {
1778 . config -cursor $maincursor
1779 settextcursor $textcursor
1781 set phase {}
1784 # Don't change the text pane cursor if it is currently the hand cursor,
1785 # showing that we are over a sha1 ID link.
1786 proc settextcursor {c} {
1787 global ctext curtextcursor
1789 if {[$ctext cget -cursor] == $curtextcursor} {
1790 $ctext config -cursor $c
1792 set curtextcursor $c
1795 proc drawrest {} {
1796 global numcommits
1797 global startmsecs
1798 global canvy0 numcommits linespc
1799 global rowlaidout commitidx
1801 set row $rowlaidout
1802 layoutrows $rowlaidout $commitidx 1
1803 layouttail
1804 optimize_rows $row 0 $commitidx
1805 showstuff $commitidx
1807 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1808 #puts "overall $drawmsecs ms for $numcommits commits"
1811 proc findmatches {f} {
1812 global findtype foundstring foundstrlen
1813 if {$findtype == "Regexp"} {
1814 set matches [regexp -indices -all -inline $foundstring $f]
1815 } else {
1816 if {$findtype == "IgnCase"} {
1817 set str [string tolower $f]
1818 } else {
1819 set str $f
1821 set matches {}
1822 set i 0
1823 while {[set j [string first $foundstring $str $i]] >= 0} {
1824 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1825 set i [expr {$j + $foundstrlen}]
1828 return $matches
1831 proc dofind {} {
1832 global findtype findloc findstring markedmatches commitinfo
1833 global numcommits displayorder linehtag linentag linedtag
1834 global mainfont namefont canv canv2 canv3 selectedline
1835 global matchinglines foundstring foundstrlen matchstring
1836 global commitdata
1838 stopfindproc
1839 unmarkmatches
1840 focus .
1841 set matchinglines {}
1842 if {$findloc == "Pickaxe"} {
1843 findpatches
1844 return
1846 if {$findtype == "IgnCase"} {
1847 set foundstring [string tolower $findstring]
1848 } else {
1849 set foundstring $findstring
1851 set foundstrlen [string length $findstring]
1852 if {$foundstrlen == 0} return
1853 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1854 set matchstring "*$matchstring*"
1855 if {$findloc == "Files"} {
1856 findfiles
1857 return
1859 if {![info exists selectedline]} {
1860 set oldsel -1
1861 } else {
1862 set oldsel $selectedline
1864 set didsel 0
1865 set fldtypes {Headline Author Date Committer CDate Comment}
1866 set l -1
1867 foreach id $displayorder {
1868 set d $commitdata($id)
1869 incr l
1870 if {$findtype == "Regexp"} {
1871 set doesmatch [regexp $foundstring $d]
1872 } elseif {$findtype == "IgnCase"} {
1873 set doesmatch [string match -nocase $matchstring $d]
1874 } else {
1875 set doesmatch [string match $matchstring $d]
1877 if {!$doesmatch} continue
1878 if {![info exists commitinfo($id)]} {
1879 getcommit $id
1881 set info $commitinfo($id)
1882 set doesmatch 0
1883 foreach f $info ty $fldtypes {
1884 if {$findloc != "All fields" && $findloc != $ty} {
1885 continue
1887 set matches [findmatches $f]
1888 if {$matches == {}} continue
1889 set doesmatch 1
1890 if {$ty == "Headline"} {
1891 drawcmitrow $l
1892 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1893 } elseif {$ty == "Author"} {
1894 drawcmitrow $l
1895 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1896 } elseif {$ty == "Date"} {
1897 drawcmitrow $l
1898 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1901 if {$doesmatch} {
1902 lappend matchinglines $l
1903 if {!$didsel && $l > $oldsel} {
1904 findselectline $l
1905 set didsel 1
1909 if {$matchinglines == {}} {
1910 bell
1911 } elseif {!$didsel} {
1912 findselectline [lindex $matchinglines 0]
1916 proc findselectline {l} {
1917 global findloc commentend ctext
1918 selectline $l 1
1919 if {$findloc == "All fields" || $findloc == "Comments"} {
1920 # highlight the matches in the comments
1921 set f [$ctext get 1.0 $commentend]
1922 set matches [findmatches $f]
1923 foreach match $matches {
1924 set start [lindex $match 0]
1925 set end [expr {[lindex $match 1] + 1}]
1926 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1931 proc findnext {restart} {
1932 global matchinglines selectedline
1933 if {![info exists matchinglines]} {
1934 if {$restart} {
1935 dofind
1937 return
1939 if {![info exists selectedline]} return
1940 foreach l $matchinglines {
1941 if {$l > $selectedline} {
1942 findselectline $l
1943 return
1946 bell
1949 proc findprev {} {
1950 global matchinglines selectedline
1951 if {![info exists matchinglines]} {
1952 dofind
1953 return
1955 if {![info exists selectedline]} return
1956 set prev {}
1957 foreach l $matchinglines {
1958 if {$l >= $selectedline} break
1959 set prev $l
1961 if {$prev != {}} {
1962 findselectline $prev
1963 } else {
1964 bell
1968 proc findlocchange {name ix op} {
1969 global findloc findtype findtypemenu
1970 if {$findloc == "Pickaxe"} {
1971 set findtype Exact
1972 set state disabled
1973 } else {
1974 set state normal
1976 $findtypemenu entryconf 1 -state $state
1977 $findtypemenu entryconf 2 -state $state
1980 proc stopfindproc {{done 0}} {
1981 global findprocpid findprocfile findids
1982 global ctext findoldcursor phase maincursor textcursor
1983 global findinprogress
1985 catch {unset findids}
1986 if {[info exists findprocpid]} {
1987 if {!$done} {
1988 catch {exec kill $findprocpid}
1990 catch {close $findprocfile}
1991 unset findprocpid
1993 if {[info exists findinprogress]} {
1994 unset findinprogress
1995 if {$phase != "incrdraw"} {
1996 . config -cursor $maincursor
1997 settextcursor $textcursor
2002 proc findpatches {} {
2003 global findstring selectedline numcommits
2004 global findprocpid findprocfile
2005 global finddidsel ctext displayorder findinprogress
2006 global findinsertpos
2008 if {$numcommits == 0} return
2010 # make a list of all the ids to search, starting at the one
2011 # after the selected line (if any)
2012 if {[info exists selectedline]} {
2013 set l $selectedline
2014 } else {
2015 set l -1
2017 set inputids {}
2018 for {set i 0} {$i < $numcommits} {incr i} {
2019 if {[incr l] >= $numcommits} {
2020 set l 0
2022 append inputids [lindex $displayorder $l] "\n"
2025 if {[catch {
2026 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2027 << $inputids] r]
2028 } err]} {
2029 error_popup "Error starting search process: $err"
2030 return
2033 set findinsertpos end
2034 set findprocfile $f
2035 set findprocpid [pid $f]
2036 fconfigure $f -blocking 0
2037 fileevent $f readable readfindproc
2038 set finddidsel 0
2039 . config -cursor watch
2040 settextcursor watch
2041 set findinprogress 1
2044 proc readfindproc {} {
2045 global findprocfile finddidsel
2046 global commitrow matchinglines findinsertpos
2048 set n [gets $findprocfile line]
2049 if {$n < 0} {
2050 if {[eof $findprocfile]} {
2051 stopfindproc 1
2052 if {!$finddidsel} {
2053 bell
2056 return
2058 if {![regexp {^[0-9a-f]{40}} $line id]} {
2059 error_popup "Can't parse git-diff-tree output: $line"
2060 stopfindproc
2061 return
2063 if {![info exists commitrow($id)]} {
2064 puts stderr "spurious id: $id"
2065 return
2067 set l $commitrow($id)
2068 insertmatch $l $id
2071 proc insertmatch {l id} {
2072 global matchinglines findinsertpos finddidsel
2074 if {$findinsertpos == "end"} {
2075 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2076 set matchinglines [linsert $matchinglines 0 $l]
2077 set findinsertpos 1
2078 } else {
2079 lappend matchinglines $l
2081 } else {
2082 set matchinglines [linsert $matchinglines $findinsertpos $l]
2083 incr findinsertpos
2085 markheadline $l $id
2086 if {!$finddidsel} {
2087 findselectline $l
2088 set finddidsel 1
2092 proc findfiles {} {
2093 global selectedline numcommits displayorder ctext
2094 global ffileline finddidsel parentlist
2095 global findinprogress findstartline findinsertpos
2096 global treediffs fdiffid fdiffsneeded fdiffpos
2097 global findmergefiles
2099 if {$numcommits == 0} return
2101 if {[info exists selectedline]} {
2102 set l [expr {$selectedline + 1}]
2103 } else {
2104 set l 0
2106 set ffileline $l
2107 set findstartline $l
2108 set diffsneeded {}
2109 set fdiffsneeded {}
2110 while 1 {
2111 set id [lindex $displayorder $l]
2112 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2113 if {![info exists treediffs($id)]} {
2114 append diffsneeded "$id\n"
2115 lappend fdiffsneeded $id
2118 if {[incr l] >= $numcommits} {
2119 set l 0
2121 if {$l == $findstartline} break
2124 # start off a git-diff-tree process if needed
2125 if {$diffsneeded ne {}} {
2126 if {[catch {
2127 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2128 } err ]} {
2129 error_popup "Error starting search process: $err"
2130 return
2132 catch {unset fdiffid}
2133 set fdiffpos 0
2134 fconfigure $df -blocking 0
2135 fileevent $df readable [list readfilediffs $df]
2138 set finddidsel 0
2139 set findinsertpos end
2140 set id [lindex $displayorder $l]
2141 . config -cursor watch
2142 settextcursor watch
2143 set findinprogress 1
2144 findcont
2145 update
2148 proc readfilediffs {df} {
2149 global findid fdiffid fdiffs
2151 set n [gets $df line]
2152 if {$n < 0} {
2153 if {[eof $df]} {
2154 donefilediff
2155 if {[catch {close $df} err]} {
2156 stopfindproc
2157 bell
2158 error_popup "Error in git-diff-tree: $err"
2159 } elseif {[info exists findid]} {
2160 set id $findid
2161 stopfindproc
2162 bell
2163 error_popup "Couldn't find diffs for $id"
2166 return
2168 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2169 # start of a new string of diffs
2170 donefilediff
2171 set fdiffid $id
2172 set fdiffs {}
2173 } elseif {[string match ":*" $line]} {
2174 lappend fdiffs [lindex $line 5]
2178 proc donefilediff {} {
2179 global fdiffid fdiffs treediffs findid
2180 global fdiffsneeded fdiffpos
2182 if {[info exists fdiffid]} {
2183 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2184 && $fdiffpos < [llength $fdiffsneeded]} {
2185 # git-diff-tree doesn't output anything for a commit
2186 # which doesn't change anything
2187 set nullid [lindex $fdiffsneeded $fdiffpos]
2188 set treediffs($nullid) {}
2189 if {[info exists findid] && $nullid eq $findid} {
2190 unset findid
2191 findcont
2193 incr fdiffpos
2195 incr fdiffpos
2197 if {![info exists treediffs($fdiffid)]} {
2198 set treediffs($fdiffid) $fdiffs
2200 if {[info exists findid] && $fdiffid eq $findid} {
2201 unset findid
2202 findcont
2207 proc findcont {id} {
2208 global findid treediffs parentlist
2209 global ffileline findstartline finddidsel
2210 global displayorder numcommits matchinglines findinprogress
2211 global findmergefiles
2213 set l $ffileline
2214 while {1} {
2215 set id [lindex $displayorder $l]
2216 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2217 if {![info exists treediffs($id)]} {
2218 set findid $id
2219 set ffileline $l
2220 return
2222 set doesmatch 0
2223 foreach f $treediffs($id) {
2224 set x [findmatches $f]
2225 if {$x != {}} {
2226 set doesmatch 1
2227 break
2230 if {$doesmatch} {
2231 insertmatch $l $id
2234 if {[incr l] >= $numcommits} {
2235 set l 0
2237 if {$l == $findstartline} break
2239 stopfindproc
2240 if {!$finddidsel} {
2241 bell
2245 # mark a commit as matching by putting a yellow background
2246 # behind the headline
2247 proc markheadline {l id} {
2248 global canv mainfont linehtag
2250 drawcmitrow $l
2251 set bbox [$canv bbox $linehtag($l)]
2252 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2253 $canv lower $t
2256 # mark the bits of a headline, author or date that match a find string
2257 proc markmatches {canv l str tag matches font} {
2258 set bbox [$canv bbox $tag]
2259 set x0 [lindex $bbox 0]
2260 set y0 [lindex $bbox 1]
2261 set y1 [lindex $bbox 3]
2262 foreach match $matches {
2263 set start [lindex $match 0]
2264 set end [lindex $match 1]
2265 if {$start > $end} continue
2266 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2267 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2268 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2269 [expr {$x0+$xlen+2}] $y1 \
2270 -outline {} -tags matches -fill yellow]
2271 $canv lower $t
2275 proc unmarkmatches {} {
2276 global matchinglines findids
2277 allcanvs delete matches
2278 catch {unset matchinglines}
2279 catch {unset findids}
2282 proc selcanvline {w x y} {
2283 global canv canvy0 ctext linespc
2284 global rowtextx
2285 set ymax [lindex [$canv cget -scrollregion] 3]
2286 if {$ymax == {}} return
2287 set yfrac [lindex [$canv yview] 0]
2288 set y [expr {$y + $yfrac * $ymax}]
2289 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2290 if {$l < 0} {
2291 set l 0
2293 if {$w eq $canv} {
2294 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2296 unmarkmatches
2297 selectline $l 1
2300 proc commit_descriptor {p} {
2301 global commitinfo
2302 set l "..."
2303 if {[info exists commitinfo($p)]} {
2304 set l [lindex $commitinfo($p) 0]
2306 return "$p ($l)"
2309 # append some text to the ctext widget, and make any SHA1 ID
2310 # that we know about be a clickable link.
2311 proc appendwithlinks {text} {
2312 global ctext commitrow linknum
2314 set start [$ctext index "end - 1c"]
2315 $ctext insert end $text
2316 $ctext insert end "\n"
2317 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2318 foreach l $links {
2319 set s [lindex $l 0]
2320 set e [lindex $l 1]
2321 set linkid [string range $text $s $e]
2322 if {![info exists commitrow($linkid)]} continue
2323 incr e
2324 $ctext tag add link "$start + $s c" "$start + $e c"
2325 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2326 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2327 incr linknum
2329 $ctext tag conf link -foreground blue -underline 1
2330 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2331 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2334 proc selectline {l isnew} {
2335 global canv canv2 canv3 ctext commitinfo selectedline
2336 global displayorder linehtag linentag linedtag
2337 global canvy0 linespc parentlist childlist
2338 global cflist currentid sha1entry
2339 global commentend idtags linknum
2340 global mergemax numcommits
2342 $canv delete hover
2343 normalline
2344 if {$l < 0 || $l >= $numcommits} return
2345 set y [expr {$canvy0 + $l * $linespc}]
2346 set ymax [lindex [$canv cget -scrollregion] 3]
2347 set ytop [expr {$y - $linespc - 1}]
2348 set ybot [expr {$y + $linespc + 1}]
2349 set wnow [$canv yview]
2350 set wtop [expr {[lindex $wnow 0] * $ymax}]
2351 set wbot [expr {[lindex $wnow 1] * $ymax}]
2352 set wh [expr {$wbot - $wtop}]
2353 set newtop $wtop
2354 if {$ytop < $wtop} {
2355 if {$ybot < $wtop} {
2356 set newtop [expr {$y - $wh / 2.0}]
2357 } else {
2358 set newtop $ytop
2359 if {$newtop > $wtop - $linespc} {
2360 set newtop [expr {$wtop - $linespc}]
2363 } elseif {$ybot > $wbot} {
2364 if {$ytop > $wbot} {
2365 set newtop [expr {$y - $wh / 2.0}]
2366 } else {
2367 set newtop [expr {$ybot - $wh}]
2368 if {$newtop < $wtop + $linespc} {
2369 set newtop [expr {$wtop + $linespc}]
2373 if {$newtop != $wtop} {
2374 if {$newtop < 0} {
2375 set newtop 0
2377 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2378 drawvisible
2381 if {![info exists linehtag($l)]} return
2382 $canv delete secsel
2383 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2384 -tags secsel -fill [$canv cget -selectbackground]]
2385 $canv lower $t
2386 $canv2 delete secsel
2387 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2388 -tags secsel -fill [$canv2 cget -selectbackground]]
2389 $canv2 lower $t
2390 $canv3 delete secsel
2391 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2392 -tags secsel -fill [$canv3 cget -selectbackground]]
2393 $canv3 lower $t
2395 if {$isnew} {
2396 addtohistory [list selectline $l 0]
2399 set selectedline $l
2401 set id [lindex $displayorder $l]
2402 set currentid $id
2403 $sha1entry delete 0 end
2404 $sha1entry insert 0 $id
2405 $sha1entry selection from 0
2406 $sha1entry selection to end
2408 $ctext conf -state normal
2409 $ctext delete 0.0 end
2410 set linknum 0
2411 $ctext mark set fmark.0 0.0
2412 $ctext mark gravity fmark.0 left
2413 set info $commitinfo($id)
2414 set date [formatdate [lindex $info 2]]
2415 $ctext insert end "Author: [lindex $info 1] $date\n"
2416 set date [formatdate [lindex $info 4]]
2417 $ctext insert end "Committer: [lindex $info 3] $date\n"
2418 if {[info exists idtags($id)]} {
2419 $ctext insert end "Tags:"
2420 foreach tag $idtags($id) {
2421 $ctext insert end " $tag"
2423 $ctext insert end "\n"
2426 set comment {}
2427 set olds [lindex $parentlist $l]
2428 if {[llength $olds] > 1} {
2429 set np 0
2430 foreach p $olds {
2431 if {$np >= $mergemax} {
2432 set tag mmax
2433 } else {
2434 set tag m$np
2436 $ctext insert end "Parent: " $tag
2437 appendwithlinks [commit_descriptor $p]
2438 incr np
2440 } else {
2441 foreach p $olds {
2442 append comment "Parent: [commit_descriptor $p]\n"
2446 foreach c [lindex $childlist $l] {
2447 append comment "Child: [commit_descriptor $c]\n"
2449 append comment "\n"
2450 append comment [lindex $info 5]
2452 # make anything that looks like a SHA1 ID be a clickable link
2453 appendwithlinks $comment
2455 $ctext tag delete Comments
2456 $ctext tag remove found 1.0 end
2457 $ctext conf -state disabled
2458 set commentend [$ctext index "end - 1c"]
2460 $cflist delete 0 end
2461 $cflist insert end "Comments"
2462 if {[llength $olds] <= 1} {
2463 startdiff $id
2464 } else {
2465 mergediff $id $l
2469 proc selnextline {dir} {
2470 global selectedline
2471 if {![info exists selectedline]} return
2472 set l [expr {$selectedline + $dir}]
2473 unmarkmatches
2474 selectline $l 1
2477 proc unselectline {} {
2478 global selectedline
2480 catch {unset selectedline}
2481 allcanvs delete secsel
2484 proc addtohistory {cmd} {
2485 global history historyindex
2487 if {$historyindex > 0
2488 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2489 return
2492 if {$historyindex < [llength $history]} {
2493 set history [lreplace $history $historyindex end $cmd]
2494 } else {
2495 lappend history $cmd
2497 incr historyindex
2498 if {$historyindex > 1} {
2499 .ctop.top.bar.leftbut conf -state normal
2500 } else {
2501 .ctop.top.bar.leftbut conf -state disabled
2503 .ctop.top.bar.rightbut conf -state disabled
2506 proc goback {} {
2507 global history historyindex
2509 if {$historyindex > 1} {
2510 incr historyindex -1
2511 set cmd [lindex $history [expr {$historyindex - 1}]]
2512 eval $cmd
2513 .ctop.top.bar.rightbut conf -state normal
2515 if {$historyindex <= 1} {
2516 .ctop.top.bar.leftbut conf -state disabled
2520 proc goforw {} {
2521 global history historyindex
2523 if {$historyindex < [llength $history]} {
2524 set cmd [lindex $history $historyindex]
2525 incr historyindex
2526 eval $cmd
2527 .ctop.top.bar.leftbut conf -state normal
2529 if {$historyindex >= [llength $history]} {
2530 .ctop.top.bar.rightbut conf -state disabled
2534 proc mergediff {id l} {
2535 global diffmergeid diffopts mdifffd
2536 global difffilestart diffids
2537 global parentlist
2539 set diffmergeid $id
2540 set diffids $id
2541 catch {unset difffilestart}
2542 # this doesn't seem to actually affect anything...
2543 set env(GIT_DIFF_OPTS) $diffopts
2544 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2545 if {[catch {set mdf [open $cmd r]} err]} {
2546 error_popup "Error getting merge diffs: $err"
2547 return
2549 fconfigure $mdf -blocking 0
2550 set mdifffd($id) $mdf
2551 set np [llength [lindex $parentlist $l]]
2552 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2553 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2556 proc getmergediffline {mdf id np} {
2557 global diffmergeid ctext cflist nextupdate mergemax
2558 global difffilestart mdifffd
2560 set n [gets $mdf line]
2561 if {$n < 0} {
2562 if {[eof $mdf]} {
2563 close $mdf
2565 return
2567 if {![info exists diffmergeid] || $id != $diffmergeid
2568 || $mdf != $mdifffd($id)} {
2569 return
2571 $ctext conf -state normal
2572 if {[regexp {^diff --cc (.*)} $line match fname]} {
2573 # start of a new file
2574 $ctext insert end "\n"
2575 set here [$ctext index "end - 1c"]
2576 set i [$cflist index end]
2577 $ctext mark set fmark.$i $here
2578 $ctext mark gravity fmark.$i left
2579 set difffilestart([expr {$i-1}]) $here
2580 $cflist insert end $fname
2581 set l [expr {(78 - [string length $fname]) / 2}]
2582 set pad [string range "----------------------------------------" 1 $l]
2583 $ctext insert end "$pad $fname $pad\n" filesep
2584 } elseif {[regexp {^@@} $line]} {
2585 $ctext insert end "$line\n" hunksep
2586 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2587 # do nothing
2588 } else {
2589 # parse the prefix - one ' ', '-' or '+' for each parent
2590 set spaces {}
2591 set minuses {}
2592 set pluses {}
2593 set isbad 0
2594 for {set j 0} {$j < $np} {incr j} {
2595 set c [string range $line $j $j]
2596 if {$c == " "} {
2597 lappend spaces $j
2598 } elseif {$c == "-"} {
2599 lappend minuses $j
2600 } elseif {$c == "+"} {
2601 lappend pluses $j
2602 } else {
2603 set isbad 1
2604 break
2607 set tags {}
2608 set num {}
2609 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2610 # line doesn't appear in result, parents in $minuses have the line
2611 set num [lindex $minuses 0]
2612 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2613 # line appears in result, parents in $pluses don't have the line
2614 lappend tags mresult
2615 set num [lindex $spaces 0]
2617 if {$num ne {}} {
2618 if {$num >= $mergemax} {
2619 set num "max"
2621 lappend tags m$num
2623 $ctext insert end "$line\n" $tags
2625 $ctext conf -state disabled
2626 if {[clock clicks -milliseconds] >= $nextupdate} {
2627 incr nextupdate 100
2628 fileevent $mdf readable {}
2629 update
2630 fileevent $mdf readable [list getmergediffline $mdf $id]
2634 proc startdiff {ids} {
2635 global treediffs diffids treepending diffmergeid
2637 set diffids $ids
2638 catch {unset diffmergeid}
2639 if {![info exists treediffs($ids)]} {
2640 if {![info exists treepending]} {
2641 gettreediffs $ids
2643 } else {
2644 addtocflist $ids
2648 proc addtocflist {ids} {
2649 global treediffs cflist
2650 foreach f $treediffs($ids) {
2651 $cflist insert end $f
2653 getblobdiffs $ids
2656 proc gettreediffs {ids} {
2657 global treediff treepending
2658 set treepending $ids
2659 set treediff {}
2660 if {[catch \
2661 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2662 ]} return
2663 fconfigure $gdtf -blocking 0
2664 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2667 proc gettreediffline {gdtf ids} {
2668 global treediff treediffs treepending diffids diffmergeid
2670 set n [gets $gdtf line]
2671 if {$n < 0} {
2672 if {![eof $gdtf]} return
2673 close $gdtf
2674 set treediffs($ids) $treediff
2675 unset treepending
2676 if {$ids != $diffids} {
2677 if {![info exists diffmergeid]} {
2678 gettreediffs $diffids
2680 } else {
2681 addtocflist $ids
2683 return
2685 set file [lindex $line 5]
2686 lappend treediff $file
2689 proc getblobdiffs {ids} {
2690 global diffopts blobdifffd diffids env curdifftag curtagstart
2691 global difffilestart nextupdate diffinhdr treediffs
2693 set env(GIT_DIFF_OPTS) $diffopts
2694 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2695 if {[catch {set bdf [open $cmd r]} err]} {
2696 puts "error getting diffs: $err"
2697 return
2699 set diffinhdr 0
2700 fconfigure $bdf -blocking 0
2701 set blobdifffd($ids) $bdf
2702 set curdifftag Comments
2703 set curtagstart 0.0
2704 catch {unset difffilestart}
2705 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2706 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2709 proc getblobdiffline {bdf ids} {
2710 global diffids blobdifffd ctext curdifftag curtagstart
2711 global diffnexthead diffnextnote difffilestart
2712 global nextupdate diffinhdr treediffs
2714 set n [gets $bdf line]
2715 if {$n < 0} {
2716 if {[eof $bdf]} {
2717 close $bdf
2718 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2719 $ctext tag add $curdifftag $curtagstart end
2722 return
2724 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2725 return
2727 $ctext conf -state normal
2728 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2729 # start of a new file
2730 $ctext insert end "\n"
2731 $ctext tag add $curdifftag $curtagstart end
2732 set curtagstart [$ctext index "end - 1c"]
2733 set header $newname
2734 set here [$ctext index "end - 1c"]
2735 set i [lsearch -exact $treediffs($diffids) $fname]
2736 if {$i >= 0} {
2737 set difffilestart($i) $here
2738 incr i
2739 $ctext mark set fmark.$i $here
2740 $ctext mark gravity fmark.$i left
2742 if {$newname != $fname} {
2743 set i [lsearch -exact $treediffs($diffids) $newname]
2744 if {$i >= 0} {
2745 set difffilestart($i) $here
2746 incr i
2747 $ctext mark set fmark.$i $here
2748 $ctext mark gravity fmark.$i left
2751 set curdifftag "f:$fname"
2752 $ctext tag delete $curdifftag
2753 set l [expr {(78 - [string length $header]) / 2}]
2754 set pad [string range "----------------------------------------" 1 $l]
2755 $ctext insert end "$pad $header $pad\n" filesep
2756 set diffinhdr 1
2757 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2758 # do nothing
2759 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2760 set diffinhdr 0
2761 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2762 $line match f1l f1c f2l f2c rest]} {
2763 $ctext insert end "$line\n" hunksep
2764 set diffinhdr 0
2765 } else {
2766 set x [string range $line 0 0]
2767 if {$x == "-" || $x == "+"} {
2768 set tag [expr {$x == "+"}]
2769 $ctext insert end "$line\n" d$tag
2770 } elseif {$x == " "} {
2771 $ctext insert end "$line\n"
2772 } elseif {$diffinhdr || $x == "\\"} {
2773 # e.g. "\ No newline at end of file"
2774 $ctext insert end "$line\n" filesep
2775 } else {
2776 # Something else we don't recognize
2777 if {$curdifftag != "Comments"} {
2778 $ctext insert end "\n"
2779 $ctext tag add $curdifftag $curtagstart end
2780 set curtagstart [$ctext index "end - 1c"]
2781 set curdifftag Comments
2783 $ctext insert end "$line\n" filesep
2786 $ctext conf -state disabled
2787 if {[clock clicks -milliseconds] >= $nextupdate} {
2788 incr nextupdate 100
2789 fileevent $bdf readable {}
2790 update
2791 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2795 proc nextfile {} {
2796 global difffilestart ctext
2797 set here [$ctext index @0,0]
2798 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2799 if {[$ctext compare $difffilestart($i) > $here]} {
2800 if {![info exists pos]
2801 || [$ctext compare $difffilestart($i) < $pos]} {
2802 set pos $difffilestart($i)
2806 if {[info exists pos]} {
2807 $ctext yview $pos
2811 proc listboxsel {} {
2812 global ctext cflist currentid
2813 if {![info exists currentid]} return
2814 set sel [lsort [$cflist curselection]]
2815 if {$sel eq {}} return
2816 set first [lindex $sel 0]
2817 catch {$ctext yview fmark.$first}
2820 proc setcoords {} {
2821 global linespc charspc canvx0 canvy0 mainfont
2822 global xspc1 xspc2 lthickness
2824 set linespc [font metrics $mainfont -linespace]
2825 set charspc [font measure $mainfont "m"]
2826 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2827 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2828 set lthickness [expr {int($linespc / 9) + 1}]
2829 set xspc1(0) $linespc
2830 set xspc2 $linespc
2833 proc redisplay {} {
2834 global canv
2835 global selectedline
2837 set ymax [lindex [$canv cget -scrollregion] 3]
2838 if {$ymax eq {} || $ymax == 0} return
2839 set span [$canv yview]
2840 clear_display
2841 setcanvscroll
2842 allcanvs yview moveto [lindex $span 0]
2843 drawvisible
2844 if {[info exists selectedline]} {
2845 selectline $selectedline 0
2849 proc incrfont {inc} {
2850 global mainfont namefont textfont ctext canv phase
2851 global stopped entries
2852 unmarkmatches
2853 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2854 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2855 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2856 setcoords
2857 $ctext conf -font $textfont
2858 $ctext tag conf filesep -font [concat $textfont bold]
2859 foreach e $entries {
2860 $e conf -font $mainfont
2862 if {$phase == "getcommits"} {
2863 $canv itemconf textitems -font $mainfont
2865 redisplay
2868 proc clearsha1 {} {
2869 global sha1entry sha1string
2870 if {[string length $sha1string] == 40} {
2871 $sha1entry delete 0 end
2875 proc sha1change {n1 n2 op} {
2876 global sha1string currentid sha1but
2877 if {$sha1string == {}
2878 || ([info exists currentid] && $sha1string == $currentid)} {
2879 set state disabled
2880 } else {
2881 set state normal
2883 if {[$sha1but cget -state] == $state} return
2884 if {$state == "normal"} {
2885 $sha1but conf -state normal -relief raised -text "Goto: "
2886 } else {
2887 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2891 proc gotocommit {} {
2892 global sha1string currentid commitrow tagids headids
2893 global displayorder numcommits
2895 if {$sha1string == {}
2896 || ([info exists currentid] && $sha1string == $currentid)} return
2897 if {[info exists tagids($sha1string)]} {
2898 set id $tagids($sha1string)
2899 } elseif {[info exists headids($sha1string)]} {
2900 set id $headids($sha1string)
2901 } else {
2902 set id [string tolower $sha1string]
2903 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2904 set matches {}
2905 foreach i $displayorder {
2906 if {[string match $id* $i]} {
2907 lappend matches $i
2910 if {$matches ne {}} {
2911 if {[llength $matches] > 1} {
2912 error_popup "Short SHA1 id $id is ambiguous"
2913 return
2915 set id [lindex $matches 0]
2919 if {[info exists commitrow($id)]} {
2920 selectline $commitrow($id) 1
2921 return
2923 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2924 set type "SHA1 id"
2925 } else {
2926 set type "Tag/Head"
2928 error_popup "$type $sha1string is not known"
2931 proc lineenter {x y id} {
2932 global hoverx hovery hoverid hovertimer
2933 global commitinfo canv
2935 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2936 set hoverx $x
2937 set hovery $y
2938 set hoverid $id
2939 if {[info exists hovertimer]} {
2940 after cancel $hovertimer
2942 set hovertimer [after 500 linehover]
2943 $canv delete hover
2946 proc linemotion {x y id} {
2947 global hoverx hovery hoverid hovertimer
2949 if {[info exists hoverid] && $id == $hoverid} {
2950 set hoverx $x
2951 set hovery $y
2952 if {[info exists hovertimer]} {
2953 after cancel $hovertimer
2955 set hovertimer [after 500 linehover]
2959 proc lineleave {id} {
2960 global hoverid hovertimer canv
2962 if {[info exists hoverid] && $id == $hoverid} {
2963 $canv delete hover
2964 if {[info exists hovertimer]} {
2965 after cancel $hovertimer
2966 unset hovertimer
2968 unset hoverid
2972 proc linehover {} {
2973 global hoverx hovery hoverid hovertimer
2974 global canv linespc lthickness
2975 global commitinfo mainfont
2977 set text [lindex $commitinfo($hoverid) 0]
2978 set ymax [lindex [$canv cget -scrollregion] 3]
2979 if {$ymax == {}} return
2980 set yfrac [lindex [$canv yview] 0]
2981 set x [expr {$hoverx + 2 * $linespc}]
2982 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2983 set x0 [expr {$x - 2 * $lthickness}]
2984 set y0 [expr {$y - 2 * $lthickness}]
2985 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2986 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2987 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2988 -fill \#ffff80 -outline black -width 1 -tags hover]
2989 $canv raise $t
2990 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2991 $canv raise $t
2994 proc clickisonarrow {id y} {
2995 global lthickness idrowranges
2997 set thresh [expr {2 * $lthickness + 6}]
2998 set n [expr {[llength $idrowranges($id)] - 1}]
2999 for {set i 1} {$i < $n} {incr i} {
3000 set row [lindex $idrowranges($id) $i]
3001 if {abs([yc $row] - $y) < $thresh} {
3002 return $i
3005 return {}
3008 proc arrowjump {id n y} {
3009 global idrowranges canv
3011 # 1 <-> 2, 3 <-> 4, etc...
3012 set n [expr {(($n - 1) ^ 1) + 1}]
3013 set row [lindex $idrowranges($id) $n]
3014 set yt [yc $row]
3015 set ymax [lindex [$canv cget -scrollregion] 3]
3016 if {$ymax eq {} || $ymax <= 0} return
3017 set view [$canv yview]
3018 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3019 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3020 if {$yfrac < 0} {
3021 set yfrac 0
3023 allcanvs yview moveto $yfrac
3026 proc lineclick {x y id isnew} {
3027 global ctext commitinfo childlist commitrow cflist canv thickerline
3029 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3030 unmarkmatches
3031 unselectline
3032 normalline
3033 $canv delete hover
3034 # draw this line thicker than normal
3035 set thickerline $id
3036 drawlines $id
3037 if {$isnew} {
3038 set ymax [lindex [$canv cget -scrollregion] 3]
3039 if {$ymax eq {}} return
3040 set yfrac [lindex [$canv yview] 0]
3041 set y [expr {$y + $yfrac * $ymax}]
3043 set dirn [clickisonarrow $id $y]
3044 if {$dirn ne {}} {
3045 arrowjump $id $dirn $y
3046 return
3049 if {$isnew} {
3050 addtohistory [list lineclick $x $y $id 0]
3052 # fill the details pane with info about this line
3053 $ctext conf -state normal
3054 $ctext delete 0.0 end
3055 $ctext tag conf link -foreground blue -underline 1
3056 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3057 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3058 $ctext insert end "Parent:\t"
3059 $ctext insert end $id [list link link0]
3060 $ctext tag bind link0 <1> [list selbyid $id]
3061 set info $commitinfo($id)
3062 $ctext insert end "\n\t[lindex $info 0]\n"
3063 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3064 set date [formatdate [lindex $info 2]]
3065 $ctext insert end "\tDate:\t$date\n"
3066 set kids [lindex $childlist $commitrow($id)]
3067 if {$kids ne {}} {
3068 $ctext insert end "\nChildren:"
3069 set i 0
3070 foreach child $kids {
3071 incr i
3072 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3073 set info $commitinfo($child)
3074 $ctext insert end "\n\t"
3075 $ctext insert end $child [list link link$i]
3076 $ctext tag bind link$i <1> [list selbyid $child]
3077 $ctext insert end "\n\t[lindex $info 0]"
3078 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3079 set date [formatdate [lindex $info 2]]
3080 $ctext insert end "\n\tDate:\t$date\n"
3083 $ctext conf -state disabled
3085 $cflist delete 0 end
3088 proc normalline {} {
3089 global thickerline
3090 if {[info exists thickerline]} {
3091 set id $thickerline
3092 unset thickerline
3093 drawlines $id
3097 proc selbyid {id} {
3098 global commitrow
3099 if {[info exists commitrow($id)]} {
3100 selectline $commitrow($id) 1
3104 proc mstime {} {
3105 global startmstime
3106 if {![info exists startmstime]} {
3107 set startmstime [clock clicks -milliseconds]
3109 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3112 proc rowmenu {x y id} {
3113 global rowctxmenu commitrow selectedline rowmenuid
3115 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3116 set state disabled
3117 } else {
3118 set state normal
3120 $rowctxmenu entryconfigure 0 -state $state
3121 $rowctxmenu entryconfigure 1 -state $state
3122 $rowctxmenu entryconfigure 2 -state $state
3123 set rowmenuid $id
3124 tk_popup $rowctxmenu $x $y
3127 proc diffvssel {dirn} {
3128 global rowmenuid selectedline displayorder
3130 if {![info exists selectedline]} return
3131 if {$dirn} {
3132 set oldid [lindex $displayorder $selectedline]
3133 set newid $rowmenuid
3134 } else {
3135 set oldid $rowmenuid
3136 set newid [lindex $displayorder $selectedline]
3138 addtohistory [list doseldiff $oldid $newid]
3139 doseldiff $oldid $newid
3142 proc doseldiff {oldid newid} {
3143 global ctext cflist
3144 global commitinfo
3146 $ctext conf -state normal
3147 $ctext delete 0.0 end
3148 $ctext mark set fmark.0 0.0
3149 $ctext mark gravity fmark.0 left
3150 $cflist delete 0 end
3151 $cflist insert end "Top"
3152 $ctext insert end "From "
3153 $ctext tag conf link -foreground blue -underline 1
3154 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3155 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3156 $ctext tag bind link0 <1> [list selbyid $oldid]
3157 $ctext insert end $oldid [list link link0]
3158 $ctext insert end "\n "
3159 $ctext insert end [lindex $commitinfo($oldid) 0]
3160 $ctext insert end "\n\nTo "
3161 $ctext tag bind link1 <1> [list selbyid $newid]
3162 $ctext insert end $newid [list link link1]
3163 $ctext insert end "\n "
3164 $ctext insert end [lindex $commitinfo($newid) 0]
3165 $ctext insert end "\n"
3166 $ctext conf -state disabled
3167 $ctext tag delete Comments
3168 $ctext tag remove found 1.0 end
3169 startdiff [list $oldid $newid]
3172 proc mkpatch {} {
3173 global rowmenuid currentid commitinfo patchtop patchnum
3175 if {![info exists currentid]} return
3176 set oldid $currentid
3177 set oldhead [lindex $commitinfo($oldid) 0]
3178 set newid $rowmenuid
3179 set newhead [lindex $commitinfo($newid) 0]
3180 set top .patch
3181 set patchtop $top
3182 catch {destroy $top}
3183 toplevel $top
3184 label $top.title -text "Generate patch"
3185 grid $top.title - -pady 10
3186 label $top.from -text "From:"
3187 entry $top.fromsha1 -width 40 -relief flat
3188 $top.fromsha1 insert 0 $oldid
3189 $top.fromsha1 conf -state readonly
3190 grid $top.from $top.fromsha1 -sticky w
3191 entry $top.fromhead -width 60 -relief flat
3192 $top.fromhead insert 0 $oldhead
3193 $top.fromhead conf -state readonly
3194 grid x $top.fromhead -sticky w
3195 label $top.to -text "To:"
3196 entry $top.tosha1 -width 40 -relief flat
3197 $top.tosha1 insert 0 $newid
3198 $top.tosha1 conf -state readonly
3199 grid $top.to $top.tosha1 -sticky w
3200 entry $top.tohead -width 60 -relief flat
3201 $top.tohead insert 0 $newhead
3202 $top.tohead conf -state readonly
3203 grid x $top.tohead -sticky w
3204 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3205 grid $top.rev x -pady 10
3206 label $top.flab -text "Output file:"
3207 entry $top.fname -width 60
3208 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3209 incr patchnum
3210 grid $top.flab $top.fname -sticky w
3211 frame $top.buts
3212 button $top.buts.gen -text "Generate" -command mkpatchgo
3213 button $top.buts.can -text "Cancel" -command mkpatchcan
3214 grid $top.buts.gen $top.buts.can
3215 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3216 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3217 grid $top.buts - -pady 10 -sticky ew
3218 focus $top.fname
3221 proc mkpatchrev {} {
3222 global patchtop
3224 set oldid [$patchtop.fromsha1 get]
3225 set oldhead [$patchtop.fromhead get]
3226 set newid [$patchtop.tosha1 get]
3227 set newhead [$patchtop.tohead get]
3228 foreach e [list fromsha1 fromhead tosha1 tohead] \
3229 v [list $newid $newhead $oldid $oldhead] {
3230 $patchtop.$e conf -state normal
3231 $patchtop.$e delete 0 end
3232 $patchtop.$e insert 0 $v
3233 $patchtop.$e conf -state readonly
3237 proc mkpatchgo {} {
3238 global patchtop
3240 set oldid [$patchtop.fromsha1 get]
3241 set newid [$patchtop.tosha1 get]
3242 set fname [$patchtop.fname get]
3243 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3244 error_popup "Error creating patch: $err"
3246 catch {destroy $patchtop}
3247 unset patchtop
3250 proc mkpatchcan {} {
3251 global patchtop
3253 catch {destroy $patchtop}
3254 unset patchtop
3257 proc mktag {} {
3258 global rowmenuid mktagtop commitinfo
3260 set top .maketag
3261 set mktagtop $top
3262 catch {destroy $top}
3263 toplevel $top
3264 label $top.title -text "Create tag"
3265 grid $top.title - -pady 10
3266 label $top.id -text "ID:"
3267 entry $top.sha1 -width 40 -relief flat
3268 $top.sha1 insert 0 $rowmenuid
3269 $top.sha1 conf -state readonly
3270 grid $top.id $top.sha1 -sticky w
3271 entry $top.head -width 60 -relief flat
3272 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3273 $top.head conf -state readonly
3274 grid x $top.head -sticky w
3275 label $top.tlab -text "Tag name:"
3276 entry $top.tag -width 60
3277 grid $top.tlab $top.tag -sticky w
3278 frame $top.buts
3279 button $top.buts.gen -text "Create" -command mktaggo
3280 button $top.buts.can -text "Cancel" -command mktagcan
3281 grid $top.buts.gen $top.buts.can
3282 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3283 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3284 grid $top.buts - -pady 10 -sticky ew
3285 focus $top.tag
3288 proc domktag {} {
3289 global mktagtop env tagids idtags
3291 set id [$mktagtop.sha1 get]
3292 set tag [$mktagtop.tag get]
3293 if {$tag == {}} {
3294 error_popup "No tag name specified"
3295 return
3297 if {[info exists tagids($tag)]} {
3298 error_popup "Tag \"$tag\" already exists"
3299 return
3301 if {[catch {
3302 set dir [gitdir]
3303 set fname [file join $dir "refs/tags" $tag]
3304 set f [open $fname w]
3305 puts $f $id
3306 close $f
3307 } err]} {
3308 error_popup "Error creating tag: $err"
3309 return
3312 set tagids($tag) $id
3313 lappend idtags($id) $tag
3314 redrawtags $id
3317 proc redrawtags {id} {
3318 global canv linehtag commitrow idpos selectedline
3320 if {![info exists commitrow($id)]} return
3321 drawcmitrow $commitrow($id)
3322 $canv delete tag.$id
3323 set xt [eval drawtags $id $idpos($id)]
3324 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3325 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3326 selectline $selectedline 0
3330 proc mktagcan {} {
3331 global mktagtop
3333 catch {destroy $mktagtop}
3334 unset mktagtop
3337 proc mktaggo {} {
3338 domktag
3339 mktagcan
3342 proc writecommit {} {
3343 global rowmenuid wrcomtop commitinfo wrcomcmd
3345 set top .writecommit
3346 set wrcomtop $top
3347 catch {destroy $top}
3348 toplevel $top
3349 label $top.title -text "Write commit to file"
3350 grid $top.title - -pady 10
3351 label $top.id -text "ID:"
3352 entry $top.sha1 -width 40 -relief flat
3353 $top.sha1 insert 0 $rowmenuid
3354 $top.sha1 conf -state readonly
3355 grid $top.id $top.sha1 -sticky w
3356 entry $top.head -width 60 -relief flat
3357 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3358 $top.head conf -state readonly
3359 grid x $top.head -sticky w
3360 label $top.clab -text "Command:"
3361 entry $top.cmd -width 60 -textvariable wrcomcmd
3362 grid $top.clab $top.cmd -sticky w -pady 10
3363 label $top.flab -text "Output file:"
3364 entry $top.fname -width 60
3365 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3366 grid $top.flab $top.fname -sticky w
3367 frame $top.buts
3368 button $top.buts.gen -text "Write" -command wrcomgo
3369 button $top.buts.can -text "Cancel" -command wrcomcan
3370 grid $top.buts.gen $top.buts.can
3371 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3372 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3373 grid $top.buts - -pady 10 -sticky ew
3374 focus $top.fname
3377 proc wrcomgo {} {
3378 global wrcomtop
3380 set id [$wrcomtop.sha1 get]
3381 set cmd "echo $id | [$wrcomtop.cmd get]"
3382 set fname [$wrcomtop.fname get]
3383 if {[catch {exec sh -c $cmd >$fname &} err]} {
3384 error_popup "Error writing commit: $err"
3386 catch {destroy $wrcomtop}
3387 unset wrcomtop
3390 proc wrcomcan {} {
3391 global wrcomtop
3393 catch {destroy $wrcomtop}
3394 unset wrcomtop
3397 proc listrefs {id} {
3398 global idtags idheads idotherrefs
3400 set x {}
3401 if {[info exists idtags($id)]} {
3402 set x $idtags($id)
3404 set y {}
3405 if {[info exists idheads($id)]} {
3406 set y $idheads($id)
3408 set z {}
3409 if {[info exists idotherrefs($id)]} {
3410 set z $idotherrefs($id)
3412 return [list $x $y $z]
3415 proc rereadrefs {} {
3416 global idtags idheads idotherrefs
3418 set refids [concat [array names idtags] \
3419 [array names idheads] [array names idotherrefs]]
3420 foreach id $refids {
3421 if {![info exists ref($id)]} {
3422 set ref($id) [listrefs $id]
3425 readrefs
3426 set refids [lsort -unique [concat $refids [array names idtags] \
3427 [array names idheads] [array names idotherrefs]]]
3428 foreach id $refids {
3429 set v [listrefs $id]
3430 if {![info exists ref($id)] || $ref($id) != $v} {
3431 redrawtags $id
3436 proc showtag {tag isnew} {
3437 global ctext cflist tagcontents tagids linknum
3439 if {$isnew} {
3440 addtohistory [list showtag $tag 0]
3442 $ctext conf -state normal
3443 $ctext delete 0.0 end
3444 set linknum 0
3445 if {[info exists tagcontents($tag)]} {
3446 set text $tagcontents($tag)
3447 } else {
3448 set text "Tag: $tag\nId: $tagids($tag)"
3450 appendwithlinks $text
3451 $ctext conf -state disabled
3452 $cflist delete 0 end
3455 proc doquit {} {
3456 global stopped
3457 set stopped 100
3458 destroy .
3461 proc doprefs {} {
3462 global maxwidth maxgraphpct diffopts findmergefiles
3463 global oldprefs prefstop
3465 set top .gitkprefs
3466 set prefstop $top
3467 if {[winfo exists $top]} {
3468 raise $top
3469 return
3471 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3472 set oldprefs($v) [set $v]
3474 toplevel $top
3475 wm title $top "Gitk preferences"
3476 label $top.ldisp -text "Commit list display options"
3477 grid $top.ldisp - -sticky w -pady 10
3478 label $top.spacer -text " "
3479 label $top.maxwidthl -text "Maximum graph width (lines)" \
3480 -font optionfont
3481 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3482 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3483 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3484 -font optionfont
3485 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3486 grid x $top.maxpctl $top.maxpct -sticky w
3487 checkbutton $top.findm -variable findmergefiles
3488 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3489 -font optionfont
3490 grid $top.findm $top.findml - -sticky w
3491 label $top.ddisp -text "Diff display options"
3492 grid $top.ddisp - -sticky w -pady 10
3493 label $top.diffoptl -text "Options for diff program" \
3494 -font optionfont
3495 entry $top.diffopt -width 20 -textvariable diffopts
3496 grid x $top.diffoptl $top.diffopt -sticky w
3497 frame $top.buts
3498 button $top.buts.ok -text "OK" -command prefsok
3499 button $top.buts.can -text "Cancel" -command prefscan
3500 grid $top.buts.ok $top.buts.can
3501 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3502 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3503 grid $top.buts - - -pady 10 -sticky ew
3506 proc prefscan {} {
3507 global maxwidth maxgraphpct diffopts findmergefiles
3508 global oldprefs prefstop
3510 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3511 set $v $oldprefs($v)
3513 catch {destroy $prefstop}
3514 unset prefstop
3517 proc prefsok {} {
3518 global maxwidth maxgraphpct
3519 global oldprefs prefstop
3521 catch {destroy $prefstop}
3522 unset prefstop
3523 if {$maxwidth != $oldprefs(maxwidth)
3524 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3525 redisplay
3529 proc formatdate {d} {
3530 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3533 # This list of encoding names and aliases is distilled from
3534 # http://www.iana.org/assignments/character-sets.
3535 # Not all of them are supported by Tcl.
3536 set encoding_aliases {
3537 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3538 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3539 { ISO-10646-UTF-1 csISO10646UTF1 }
3540 { ISO_646.basic:1983 ref csISO646basic1983 }
3541 { INVARIANT csINVARIANT }
3542 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3543 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3544 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3545 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3546 { NATS-DANO iso-ir-9-1 csNATSDANO }
3547 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3548 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3549 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3550 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3551 { ISO-2022-KR csISO2022KR }
3552 { EUC-KR csEUCKR }
3553 { ISO-2022-JP csISO2022JP }
3554 { ISO-2022-JP-2 csISO2022JP2 }
3555 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3556 csISO13JISC6220jp }
3557 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3558 { IT iso-ir-15 ISO646-IT csISO15Italian }
3559 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3560 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3561 { greek7-old iso-ir-18 csISO18Greek7Old }
3562 { latin-greek iso-ir-19 csISO19LatinGreek }
3563 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3564 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3565 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3566 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3567 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3568 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3569 { INIS iso-ir-49 csISO49INIS }
3570 { INIS-8 iso-ir-50 csISO50INIS8 }
3571 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3572 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3573 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3574 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3575 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3576 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3577 csISO60Norwegian1 }
3578 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3579 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3580 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3581 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3582 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3583 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3584 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3585 { greek7 iso-ir-88 csISO88Greek7 }
3586 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3587 { iso-ir-90 csISO90 }
3588 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3589 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3590 csISO92JISC62991984b }
3591 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3592 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3593 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3594 csISO95JIS62291984handadd }
3595 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3596 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3597 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3598 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3599 CP819 csISOLatin1 }
3600 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3601 { T.61-7bit iso-ir-102 csISO102T617bit }
3602 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3603 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3604 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3605 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3606 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3607 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3608 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3609 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3610 arabic csISOLatinArabic }
3611 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3612 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3613 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3614 greek greek8 csISOLatinGreek }
3615 { T.101-G2 iso-ir-128 csISO128T101G2 }
3616 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3617 csISOLatinHebrew }
3618 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3619 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3620 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3621 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3622 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3623 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3624 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3625 csISOLatinCyrillic }
3626 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3627 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3628 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3629 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3630 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3631 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3632 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3633 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3634 { ISO_10367-box iso-ir-155 csISO10367Box }
3635 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3636 { latin-lap lap iso-ir-158 csISO158Lap }
3637 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3638 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3639 { us-dk csUSDK }
3640 { dk-us csDKUS }
3641 { JIS_X0201 X0201 csHalfWidthKatakana }
3642 { KSC5636 ISO646-KR csKSC5636 }
3643 { ISO-10646-UCS-2 csUnicode }
3644 { ISO-10646-UCS-4 csUCS4 }
3645 { DEC-MCS dec csDECMCS }
3646 { hp-roman8 roman8 r8 csHPRoman8 }
3647 { macintosh mac csMacintosh }
3648 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3649 csIBM037 }
3650 { IBM038 EBCDIC-INT cp038 csIBM038 }
3651 { IBM273 CP273 csIBM273 }
3652 { IBM274 EBCDIC-BE CP274 csIBM274 }
3653 { IBM275 EBCDIC-BR cp275 csIBM275 }
3654 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3655 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3656 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3657 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3658 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3659 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3660 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3661 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3662 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3663 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3664 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3665 { IBM437 cp437 437 csPC8CodePage437 }
3666 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3667 { IBM775 cp775 csPC775Baltic }
3668 { IBM850 cp850 850 csPC850Multilingual }
3669 { IBM851 cp851 851 csIBM851 }
3670 { IBM852 cp852 852 csPCp852 }
3671 { IBM855 cp855 855 csIBM855 }
3672 { IBM857 cp857 857 csIBM857 }
3673 { IBM860 cp860 860 csIBM860 }
3674 { IBM861 cp861 861 cp-is csIBM861 }
3675 { IBM862 cp862 862 csPC862LatinHebrew }
3676 { IBM863 cp863 863 csIBM863 }
3677 { IBM864 cp864 csIBM864 }
3678 { IBM865 cp865 865 csIBM865 }
3679 { IBM866 cp866 866 csIBM866 }
3680 { IBM868 CP868 cp-ar csIBM868 }
3681 { IBM869 cp869 869 cp-gr csIBM869 }
3682 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3683 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3684 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3685 { IBM891 cp891 csIBM891 }
3686 { IBM903 cp903 csIBM903 }
3687 { IBM904 cp904 904 csIBBM904 }
3688 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3689 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3690 { IBM1026 CP1026 csIBM1026 }
3691 { EBCDIC-AT-DE csIBMEBCDICATDE }
3692 { EBCDIC-AT-DE-A csEBCDICATDEA }
3693 { EBCDIC-CA-FR csEBCDICCAFR }
3694 { EBCDIC-DK-NO csEBCDICDKNO }
3695 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3696 { EBCDIC-FI-SE csEBCDICFISE }
3697 { EBCDIC-FI-SE-A csEBCDICFISEA }
3698 { EBCDIC-FR csEBCDICFR }
3699 { EBCDIC-IT csEBCDICIT }
3700 { EBCDIC-PT csEBCDICPT }
3701 { EBCDIC-ES csEBCDICES }
3702 { EBCDIC-ES-A csEBCDICESA }
3703 { EBCDIC-ES-S csEBCDICESS }
3704 { EBCDIC-UK csEBCDICUK }
3705 { EBCDIC-US csEBCDICUS }
3706 { UNKNOWN-8BIT csUnknown8BiT }
3707 { MNEMONIC csMnemonic }
3708 { MNEM csMnem }
3709 { VISCII csVISCII }
3710 { VIQR csVIQR }
3711 { KOI8-R csKOI8R }
3712 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3713 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3714 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3715 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3716 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3717 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3718 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3719 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3720 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3721 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3722 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3723 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3724 { IBM1047 IBM-1047 }
3725 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3726 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3727 { UNICODE-1-1 csUnicode11 }
3728 { CESU-8 csCESU-8 }
3729 { BOCU-1 csBOCU-1 }
3730 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3731 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3732 l8 }
3733 { ISO-8859-15 ISO_8859-15 Latin-9 }
3734 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3735 { GBK CP936 MS936 windows-936 }
3736 { JIS_Encoding csJISEncoding }
3737 { Shift_JIS MS_Kanji csShiftJIS }
3738 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3739 EUC-JP }
3740 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3741 { ISO-10646-UCS-Basic csUnicodeASCII }
3742 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3743 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3744 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3745 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3746 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3747 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3748 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3749 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3750 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3751 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3752 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3753 { Ventura-US csVenturaUS }
3754 { Ventura-International csVenturaInternational }
3755 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3756 { PC8-Turkish csPC8Turkish }
3757 { IBM-Symbols csIBMSymbols }
3758 { IBM-Thai csIBMThai }
3759 { HP-Legal csHPLegal }
3760 { HP-Pi-font csHPPiFont }
3761 { HP-Math8 csHPMath8 }
3762 { Adobe-Symbol-Encoding csHPPSMath }
3763 { HP-DeskTop csHPDesktop }
3764 { Ventura-Math csVenturaMath }
3765 { Microsoft-Publishing csMicrosoftPublishing }
3766 { Windows-31J csWindows31J }
3767 { GB2312 csGB2312 }
3768 { Big5 csBig5 }
3771 proc tcl_encoding {enc} {
3772 global encoding_aliases
3773 set names [encoding names]
3774 set lcnames [string tolower $names]
3775 set enc [string tolower $enc]
3776 set i [lsearch -exact $lcnames $enc]
3777 if {$i < 0} {
3778 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3779 if {[regsub {^iso[-_]} $enc iso encx]} {
3780 set i [lsearch -exact $lcnames $encx]
3783 if {$i < 0} {
3784 foreach l $encoding_aliases {
3785 set ll [string tolower $l]
3786 if {[lsearch -exact $ll $enc] < 0} continue
3787 # look through the aliases for one that tcl knows about
3788 foreach e $ll {
3789 set i [lsearch -exact $lcnames $e]
3790 if {$i < 0} {
3791 if {[regsub {^iso[-_]} $e iso ex]} {
3792 set i [lsearch -exact $lcnames $ex]
3795 if {$i >= 0} break
3797 break
3800 if {$i >= 0} {
3801 return [lindex $names $i]
3803 return {}
3806 # defaults...
3807 set datemode 0
3808 set diffopts "-U 5 -p"
3809 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3811 set gitencoding {}
3812 catch {
3813 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3815 if {$gitencoding == ""} {
3816 set gitencoding "utf-8"
3818 set tclencoding [tcl_encoding $gitencoding]
3819 if {$tclencoding == {}} {
3820 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3823 set mainfont {Helvetica 9}
3824 set textfont {Courier 9}
3825 set findmergefiles 0
3826 set maxgraphpct 50
3827 set maxwidth 16
3828 set revlistorder 0
3829 set fastdate 0
3830 set uparrowlen 7
3831 set downarrowlen 7
3832 set mingaplen 30
3834 set colors {green red blue magenta darkgrey brown orange}
3836 catch {source ~/.gitk}
3838 set namefont $mainfont
3840 font create optionfont -family sans-serif -size -12
3842 set revtreeargs {}
3843 foreach arg $argv {
3844 switch -regexp -- $arg {
3845 "^$" { }
3846 "^-d" { set datemode 1 }
3847 default {
3848 lappend revtreeargs $arg
3853 # check that we can find a .git directory somewhere...
3854 set gitdir [gitdir]
3855 if {![file isdirectory $gitdir]} {
3856 error_popup "Cannot find the git directory \"$gitdir\"."
3857 exit 1
3860 set history {}
3861 set historyindex 0
3863 set optim_delay 16
3865 set stopped 0
3866 set stuffsaved 0
3867 set patchnum 0
3868 setcoords
3869 makewindow $revtreeargs
3870 readrefs
3871 getcommits $revtreeargs