[PATCH] Provide configurable UI font for gitk
[git/mingw.git] / gitk
blob26fa79af7ae5bc673f377a8393d5ab6c39ef54ca
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 mainfont uifont
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 .bar configure -font $uifont
347 menu .bar.file
348 .bar.file add command -label "Update" -command [list updatecommits $rargs]
349 .bar.file add command -label "Reread references" -command rereadrefs
350 .bar.file add command -label "Quit" -command doquit
351 .bar.file configure -font $uifont
352 menu .bar.edit
353 .bar add cascade -label "Edit" -menu .bar.edit
354 .bar.edit add command -label "Preferences" -command doprefs
355 .bar.edit configure -font $uifont
356 menu .bar.help
357 .bar add cascade -label "Help" -menu .bar.help
358 .bar.help add command -label "About gitk" -command about
359 .bar.help add command -label "Key bindings" -command keys
360 .bar.help configure -font $uifont
361 . configure -menu .bar
363 if {![info exists geometry(canv1)]} {
364 set geometry(canv1) [expr {45 * $charspc}]
365 set geometry(canv2) [expr {30 * $charspc}]
366 set geometry(canv3) [expr {15 * $charspc}]
367 set geometry(canvh) [expr {25 * $linespc + 4}]
368 set geometry(ctextw) 80
369 set geometry(ctexth) 30
370 set geometry(cflistw) 30
372 panedwindow .ctop -orient vertical
373 if {[info exists geometry(width)]} {
374 .ctop conf -width $geometry(width) -height $geometry(height)
375 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
376 set geometry(ctexth) [expr {($texth - 8) /
377 [font metrics $textfont -linespace]}]
379 frame .ctop.top
380 frame .ctop.top.bar
381 pack .ctop.top.bar -side bottom -fill x
382 set cscroll .ctop.top.csb
383 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
384 pack $cscroll -side right -fill y
385 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
386 pack .ctop.top.clist -side top -fill both -expand 1
387 .ctop add .ctop.top
388 set canv .ctop.top.clist.canv
389 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
390 -bg white -bd 0 \
391 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
392 .ctop.top.clist add $canv
393 set canv2 .ctop.top.clist.canv2
394 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
395 -bg white -bd 0 -yscrollincr $linespc
396 .ctop.top.clist add $canv2
397 set canv3 .ctop.top.clist.canv3
398 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
399 -bg white -bd 0 -yscrollincr $linespc
400 .ctop.top.clist add $canv3
401 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
403 set sha1entry .ctop.top.bar.sha1
404 set entries $sha1entry
405 set sha1but .ctop.top.bar.sha1label
406 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
407 -command gotocommit -width 8 -font $uifont
408 $sha1but conf -disabledforeground [$sha1but cget -foreground]
409 pack .ctop.top.bar.sha1label -side left
410 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
411 trace add variable sha1string write sha1change
412 pack $sha1entry -side left -pady 2
414 image create bitmap bm-left -data {
415 #define left_width 16
416 #define left_height 16
417 static unsigned char left_bits[] = {
418 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
419 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
420 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
422 image create bitmap bm-right -data {
423 #define right_width 16
424 #define right_height 16
425 static unsigned char right_bits[] = {
426 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
427 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
428 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
430 button .ctop.top.bar.leftbut -image bm-left -command goback \
431 -state disabled -width 26
432 pack .ctop.top.bar.leftbut -side left -fill y
433 button .ctop.top.bar.rightbut -image bm-right -command goforw \
434 -state disabled -width 26
435 pack .ctop.top.bar.rightbut -side left -fill y
437 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
438 pack .ctop.top.bar.findbut -side left
439 set findstring {}
440 set fstring .ctop.top.bar.findstring
441 lappend entries $fstring
442 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
443 pack $fstring -side left -expand 1 -fill x
444 set findtype Exact
445 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
446 findtype Exact IgnCase Regexp]
447 .ctop.top.bar.findtype configure -font $uifont
448 .ctop.top.bar.findtype.menu configure -font $uifont
449 set findloc "All fields"
450 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
451 Comments Author Committer Files Pickaxe
452 .ctop.top.bar.findloc configure -font $uifont
453 .ctop.top.bar.findloc.menu configure -font $uifont
455 pack .ctop.top.bar.findloc -side right
456 pack .ctop.top.bar.findtype -side right
457 # for making sure type==Exact whenever loc==Pickaxe
458 trace add variable findloc write findlocchange
460 panedwindow .ctop.cdet -orient horizontal
461 .ctop add .ctop.cdet
462 frame .ctop.cdet.left
463 set ctext .ctop.cdet.left.ctext
464 text $ctext -bg white -state disabled -font $textfont \
465 -width $geometry(ctextw) -height $geometry(ctexth) \
466 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
467 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
468 pack .ctop.cdet.left.sb -side right -fill y
469 pack $ctext -side left -fill both -expand 1
470 .ctop.cdet add .ctop.cdet.left
472 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
473 $ctext tag conf hunksep -fore blue
474 $ctext tag conf d0 -fore red
475 $ctext tag conf d1 -fore "#00a000"
476 $ctext tag conf m0 -fore red
477 $ctext tag conf m1 -fore blue
478 $ctext tag conf m2 -fore green
479 $ctext tag conf m3 -fore purple
480 $ctext tag conf m4 -fore brown
481 $ctext tag conf m5 -fore "#009090"
482 $ctext tag conf m6 -fore magenta
483 $ctext tag conf m7 -fore "#808000"
484 $ctext tag conf m8 -fore "#009000"
485 $ctext tag conf m9 -fore "#ff0080"
486 $ctext tag conf m10 -fore cyan
487 $ctext tag conf m11 -fore "#b07070"
488 $ctext tag conf m12 -fore "#70b0f0"
489 $ctext tag conf m13 -fore "#70f0b0"
490 $ctext tag conf m14 -fore "#f0b070"
491 $ctext tag conf m15 -fore "#ff70b0"
492 $ctext tag conf mmax -fore darkgrey
493 set mergemax 16
494 $ctext tag conf mresult -font [concat $textfont bold]
495 $ctext tag conf msep -font [concat $textfont bold]
496 $ctext tag conf found -back yellow
498 frame .ctop.cdet.right
499 set cflist .ctop.cdet.right.cfiles
500 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
501 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
502 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
503 pack .ctop.cdet.right.sb -side right -fill y
504 pack $cflist -side left -fill both -expand 1
505 .ctop.cdet add .ctop.cdet.right
506 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
508 pack .ctop -side top -fill both -expand 1
510 bindall <1> {selcanvline %W %x %y}
511 #bindall <B1-Motion> {selcanvline %W %x %y}
512 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
513 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
514 bindall <2> "canvscan mark %W %x %y"
515 bindall <B2-Motion> "canvscan dragto %W %x %y"
516 bindkey <Home> selfirstline
517 bindkey <End> sellastline
518 bind . <Key-Up> "selnextline -1"
519 bind . <Key-Down> "selnextline 1"
520 bindkey <Key-Right> "goforw"
521 bindkey <Key-Left> "goback"
522 bind . <Key-Prior> "selnextpage -1"
523 bind . <Key-Next> "selnextpage 1"
524 bind . <Control-Home> "allcanvs yview moveto 0.0"
525 bind . <Control-End> "allcanvs yview moveto 1.0"
526 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
527 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
528 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
529 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
530 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
531 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
532 bindkey <Key-space> "$ctext yview scroll 1 pages"
533 bindkey p "selnextline -1"
534 bindkey n "selnextline 1"
535 bindkey z "goback"
536 bindkey x "goforw"
537 bindkey i "selnextline -1"
538 bindkey k "selnextline 1"
539 bindkey j "goback"
540 bindkey l "goforw"
541 bindkey b "$ctext yview scroll -1 pages"
542 bindkey d "$ctext yview scroll 18 units"
543 bindkey u "$ctext yview scroll -18 units"
544 bindkey / {findnext 1}
545 bindkey <Key-Return> {findnext 0}
546 bindkey ? findprev
547 bindkey f nextfile
548 bind . <Control-q> doquit
549 bind . <Control-f> dofind
550 bind . <Control-g> {findnext 0}
551 bind . <Control-r> findprev
552 bind . <Control-equal> {incrfont 1}
553 bind . <Control-KP_Add> {incrfont 1}
554 bind . <Control-minus> {incrfont -1}
555 bind . <Control-KP_Subtract> {incrfont -1}
556 bind $cflist <<ListboxSelect>> listboxsel
557 bind . <Destroy> {savestuff %W}
558 bind . <Button-1> "click %W"
559 bind $fstring <Key-Return> dofind
560 bind $sha1entry <Key-Return> gotocommit
561 bind $sha1entry <<PasteSelection>> clearsha1
563 set maincursor [. cget -cursor]
564 set textcursor [$ctext cget -cursor]
565 set curtextcursor $textcursor
567 set rowctxmenu .rowctxmenu
568 menu $rowctxmenu -tearoff 0
569 $rowctxmenu add command -label "Diff this -> selected" \
570 -command {diffvssel 0}
571 $rowctxmenu add command -label "Diff selected -> this" \
572 -command {diffvssel 1}
573 $rowctxmenu add command -label "Make patch" -command mkpatch
574 $rowctxmenu add command -label "Create tag" -command mktag
575 $rowctxmenu add command -label "Write commit to file" -command writecommit
578 # mouse-2 makes all windows scan vertically, but only the one
579 # the cursor is in scans horizontally
580 proc canvscan {op w x y} {
581 global canv canv2 canv3
582 foreach c [list $canv $canv2 $canv3] {
583 if {$c == $w} {
584 $c scan $op $x $y
585 } else {
586 $c scan $op 0 $y
591 proc scrollcanv {cscroll f0 f1} {
592 $cscroll set $f0 $f1
593 drawfrac $f0 $f1
596 # when we make a key binding for the toplevel, make sure
597 # it doesn't get triggered when that key is pressed in the
598 # find string entry widget.
599 proc bindkey {ev script} {
600 global entries
601 bind . $ev $script
602 set escript [bind Entry $ev]
603 if {$escript == {}} {
604 set escript [bind Entry <Key>]
606 foreach e $entries {
607 bind $e $ev "$escript; break"
611 # set the focus back to the toplevel for any click outside
612 # the entry widgets
613 proc click {w} {
614 global entries
615 foreach e $entries {
616 if {$w == $e} return
618 focus .
621 proc savestuff {w} {
622 global canv canv2 canv3 ctext cflist mainfont textfont uifont
623 global stuffsaved findmergefiles maxgraphpct
624 global maxwidth
626 if {$stuffsaved} return
627 if {![winfo viewable .]} return
628 catch {
629 set f [open "~/.gitk-new" w]
630 puts $f [list set mainfont $mainfont]
631 puts $f [list set textfont $textfont]
632 puts $f [list set uifont $uifont]
633 puts $f [list set findmergefiles $findmergefiles]
634 puts $f [list set maxgraphpct $maxgraphpct]
635 puts $f [list set maxwidth $maxwidth]
636 puts $f "set geometry(width) [winfo width .ctop]"
637 puts $f "set geometry(height) [winfo height .ctop]"
638 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
639 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
640 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
641 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
642 set wid [expr {([winfo width $ctext] - 8) \
643 / [font measure $textfont "0"]}]
644 puts $f "set geometry(ctextw) $wid"
645 set wid [expr {([winfo width $cflist] - 11) \
646 / [font measure [$cflist cget -font] "0"]}]
647 puts $f "set geometry(cflistw) $wid"
648 close $f
649 file rename -force "~/.gitk-new" "~/.gitk"
651 set stuffsaved 1
654 proc resizeclistpanes {win w} {
655 global oldwidth
656 if {[info exists oldwidth($win)]} {
657 set s0 [$win sash coord 0]
658 set s1 [$win sash coord 1]
659 if {$w < 60} {
660 set sash0 [expr {int($w/2 - 2)}]
661 set sash1 [expr {int($w*5/6 - 2)}]
662 } else {
663 set factor [expr {1.0 * $w / $oldwidth($win)}]
664 set sash0 [expr {int($factor * [lindex $s0 0])}]
665 set sash1 [expr {int($factor * [lindex $s1 0])}]
666 if {$sash0 < 30} {
667 set sash0 30
669 if {$sash1 < $sash0 + 20} {
670 set sash1 [expr {$sash0 + 20}]
672 if {$sash1 > $w - 10} {
673 set sash1 [expr {$w - 10}]
674 if {$sash0 > $sash1 - 20} {
675 set sash0 [expr {$sash1 - 20}]
679 $win sash place 0 $sash0 [lindex $s0 1]
680 $win sash place 1 $sash1 [lindex $s1 1]
682 set oldwidth($win) $w
685 proc resizecdetpanes {win w} {
686 global oldwidth
687 if {[info exists oldwidth($win)]} {
688 set s0 [$win sash coord 0]
689 if {$w < 60} {
690 set sash0 [expr {int($w*3/4 - 2)}]
691 } else {
692 set factor [expr {1.0 * $w / $oldwidth($win)}]
693 set sash0 [expr {int($factor * [lindex $s0 0])}]
694 if {$sash0 < 45} {
695 set sash0 45
697 if {$sash0 > $w - 15} {
698 set sash0 [expr {$w - 15}]
701 $win sash place 0 $sash0 [lindex $s0 1]
703 set oldwidth($win) $w
706 proc allcanvs args {
707 global canv canv2 canv3
708 eval $canv $args
709 eval $canv2 $args
710 eval $canv3 $args
713 proc bindall {event action} {
714 global canv canv2 canv3
715 bind $canv $event $action
716 bind $canv2 $event $action
717 bind $canv3 $event $action
720 proc about {} {
721 set w .about
722 if {[winfo exists $w]} {
723 raise $w
724 return
726 toplevel $w
727 wm title $w "About gitk"
728 message $w.m -text {
729 Gitk - a commit viewer for git
731 Copyright © 2005-2006 Paul Mackerras
733 Use and redistribute under the terms of the GNU General Public License} \
734 -justify center -aspect 400
735 pack $w.m -side top -fill x -padx 20 -pady 20
736 button $w.ok -text Close -command "destroy $w"
737 pack $w.ok -side bottom
740 proc keys {} {
741 set w .keys
742 if {[winfo exists $w]} {
743 raise $w
744 return
746 toplevel $w
747 wm title $w "Gitk key bindings"
748 message $w.m -text {
749 Gitk key bindings:
751 <Ctrl-Q> Quit
752 <Home> Move to first commit
753 <End> Move to last commit
754 <Up>, p, i Move up one commit
755 <Down>, n, k Move down one commit
756 <Left>, z, j Go back in history list
757 <Right>, x, l Go forward in history list
758 <PageUp> Move up one page in commit list
759 <PageDown> Move down one page in commit list
760 <Ctrl-Home> Scroll to top of commit list
761 <Ctrl-End> Scroll to bottom of commit list
762 <Ctrl-Up> Scroll commit list up one line
763 <Ctrl-Down> Scroll commit list down one line
764 <Ctrl-PageUp> Scroll commit list up one page
765 <Ctrl-PageDown> Scroll commit list down one page
766 <Delete>, b Scroll diff view up one page
767 <Backspace> Scroll diff view up one page
768 <Space> Scroll diff view down one page
769 u Scroll diff view up 18 lines
770 d Scroll diff view down 18 lines
771 <Ctrl-F> Find
772 <Ctrl-G> Move to next find hit
773 <Ctrl-R> Move to previous find hit
774 <Return> Move to next find hit
775 / Move to next find hit, or redo find
776 ? Move to previous find hit
777 f Scroll diff view to next file
778 <Ctrl-KP+> Increase font size
779 <Ctrl-plus> Increase font size
780 <Ctrl-KP-> Decrease font size
781 <Ctrl-minus> Decrease font size
783 -justify left -bg white -border 2 -relief sunken
784 pack $w.m -side top -fill both
785 button $w.ok -text Close -command "destroy $w"
786 pack $w.ok -side bottom
789 proc shortids {ids} {
790 set res {}
791 foreach id $ids {
792 if {[llength $id] > 1} {
793 lappend res [shortids $id]
794 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
795 lappend res [string range $id 0 7]
796 } else {
797 lappend res $id
800 return $res
803 proc incrange {l x o} {
804 set n [llength $l]
805 while {$x < $n} {
806 set e [lindex $l $x]
807 if {$e ne {}} {
808 lset l $x [expr {$e + $o}]
810 incr x
812 return $l
815 proc ntimes {n o} {
816 set ret {}
817 for {} {$n > 0} {incr n -1} {
818 lappend ret $o
820 return $ret
823 proc usedinrange {id l1 l2} {
824 global children commitrow
826 if {[info exists commitrow($id)]} {
827 set r $commitrow($id)
828 if {$l1 <= $r && $r <= $l2} {
829 return [expr {$r - $l1 + 1}]
832 foreach c $children($id) {
833 if {[info exists commitrow($c)]} {
834 set r $commitrow($c)
835 if {$l1 <= $r && $r <= $l2} {
836 return [expr {$r - $l1 + 1}]
840 return 0
843 proc sanity {row {full 0}} {
844 global rowidlist rowoffsets
846 set col -1
847 set ids [lindex $rowidlist $row]
848 foreach id $ids {
849 incr col
850 if {$id eq {}} continue
851 if {$col < [llength $ids] - 1 &&
852 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
853 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
855 set o [lindex $rowoffsets $row $col]
856 set y $row
857 set x $col
858 while {$o ne {}} {
859 incr y -1
860 incr x $o
861 if {[lindex $rowidlist $y $x] != $id} {
862 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
863 puts " id=[shortids $id] check started at row $row"
864 for {set i $row} {$i >= $y} {incr i -1} {
865 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
867 break
869 if {!$full} break
870 set o [lindex $rowoffsets $y $x]
875 proc makeuparrow {oid x y z} {
876 global rowidlist rowoffsets uparrowlen idrowranges
878 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
879 incr y -1
880 incr x $z
881 set off0 [lindex $rowoffsets $y]
882 for {set x0 $x} {1} {incr x0} {
883 if {$x0 >= [llength $off0]} {
884 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
885 break
887 set z [lindex $off0 $x0]
888 if {$z ne {}} {
889 incr x0 $z
890 break
893 set z [expr {$x0 - $x}]
894 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
895 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
897 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
898 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
899 lappend idrowranges($oid) $y
902 proc initlayout {} {
903 global rowidlist rowoffsets displayorder commitlisted
904 global rowlaidout rowoptim
905 global idinlist rowchk
906 global commitidx numcommits canvxmax canv
907 global nextcolor
908 global parentlist childlist children
910 set commitidx 0
911 set numcommits 0
912 set displayorder {}
913 set commitlisted {}
914 set parentlist {}
915 set childlist {}
916 catch {unset children}
917 set nextcolor 0
918 set rowidlist {{}}
919 set rowoffsets {{}}
920 catch {unset idinlist}
921 catch {unset rowchk}
922 set rowlaidout 0
923 set rowoptim 0
924 set canvxmax [$canv cget -width]
927 proc setcanvscroll {} {
928 global canv canv2 canv3 numcommits linespc canvxmax canvy0
930 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
931 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
932 $canv2 conf -scrollregion [list 0 0 0 $ymax]
933 $canv3 conf -scrollregion [list 0 0 0 $ymax]
936 proc visiblerows {} {
937 global canv numcommits linespc
939 set ymax [lindex [$canv cget -scrollregion] 3]
940 if {$ymax eq {} || $ymax == 0} return
941 set f [$canv yview]
942 set y0 [expr {int([lindex $f 0] * $ymax)}]
943 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
944 if {$r0 < 0} {
945 set r0 0
947 set y1 [expr {int([lindex $f 1] * $ymax)}]
948 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
949 if {$r1 >= $numcommits} {
950 set r1 [expr {$numcommits - 1}]
952 return [list $r0 $r1]
955 proc layoutmore {} {
956 global rowlaidout rowoptim commitidx numcommits optim_delay
957 global uparrowlen
959 set row $rowlaidout
960 set rowlaidout [layoutrows $row $commitidx 0]
961 set orow [expr {$rowlaidout - $uparrowlen - 1}]
962 if {$orow > $rowoptim} {
963 checkcrossings $rowoptim $orow
964 optimize_rows $rowoptim 0 $orow
965 set rowoptim $orow
967 set canshow [expr {$rowoptim - $optim_delay}]
968 if {$canshow > $numcommits} {
969 showstuff $canshow
973 proc showstuff {canshow} {
974 global numcommits
975 global linesegends idrowranges idrangedrawn
977 if {$numcommits == 0} {
978 global phase
979 set phase "incrdraw"
980 allcanvs delete all
982 set row $numcommits
983 set numcommits $canshow
984 setcanvscroll
985 set rows [visiblerows]
986 set r0 [lindex $rows 0]
987 set r1 [lindex $rows 1]
988 for {set r $row} {$r < $canshow} {incr r} {
989 if {[info exists linesegends($r)]} {
990 foreach id $linesegends($r) {
991 set i -1
992 foreach {s e} $idrowranges($id) {
993 incr i
994 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
995 && ![info exists idrangedrawn($id,$i)]} {
996 drawlineseg $id $i
997 set idrangedrawn($id,$i) 1
1003 if {$canshow > $r1} {
1004 set canshow $r1
1006 while {$row < $canshow} {
1007 drawcmitrow $row
1008 incr row
1012 proc layoutrows {row endrow last} {
1013 global rowidlist rowoffsets displayorder
1014 global uparrowlen downarrowlen maxwidth mingaplen
1015 global childlist parentlist
1016 global idrowranges linesegends
1017 global commitidx
1018 global idinlist rowchk
1020 set idlist [lindex $rowidlist $row]
1021 set offs [lindex $rowoffsets $row]
1022 while {$row < $endrow} {
1023 set id [lindex $displayorder $row]
1024 set oldolds {}
1025 set newolds {}
1026 foreach p [lindex $parentlist $row] {
1027 if {![info exists idinlist($p)]} {
1028 lappend newolds $p
1029 } elseif {!$idinlist($p)} {
1030 lappend oldolds $p
1033 set nev [expr {[llength $idlist] + [llength $newolds]
1034 + [llength $oldolds] - $maxwidth + 1}]
1035 if {$nev > 0} {
1036 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1037 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1038 set i [lindex $idlist $x]
1039 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1040 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1041 [expr {$row + $uparrowlen + $mingaplen}]]
1042 if {$r == 0} {
1043 set idlist [lreplace $idlist $x $x]
1044 set offs [lreplace $offs $x $x]
1045 set offs [incrange $offs $x 1]
1046 set idinlist($i) 0
1047 set rm1 [expr {$row - 1}]
1048 lappend linesegends($rm1) $i
1049 lappend idrowranges($i) $rm1
1050 if {[incr nev -1] <= 0} break
1051 continue
1053 set rowchk($id) [expr {$row + $r}]
1056 lset rowidlist $row $idlist
1057 lset rowoffsets $row $offs
1059 set col [lsearch -exact $idlist $id]
1060 if {$col < 0} {
1061 set col [llength $idlist]
1062 lappend idlist $id
1063 lset rowidlist $row $idlist
1064 set z {}
1065 if {[lindex $childlist $row] ne {}} {
1066 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1067 unset idinlist($id)
1069 lappend offs $z
1070 lset rowoffsets $row $offs
1071 if {$z ne {}} {
1072 makeuparrow $id $col $row $z
1074 } else {
1075 unset idinlist($id)
1077 if {[info exists idrowranges($id)]} {
1078 lappend idrowranges($id) $row
1080 incr row
1081 set offs [ntimes [llength $idlist] 0]
1082 set l [llength $newolds]
1083 set idlist [eval lreplace \$idlist $col $col $newolds]
1084 set o 0
1085 if {$l != 1} {
1086 set offs [lrange $offs 0 [expr {$col - 1}]]
1087 foreach x $newolds {
1088 lappend offs {}
1089 incr o -1
1091 incr o
1092 set tmp [expr {[llength $idlist] - [llength $offs]}]
1093 if {$tmp > 0} {
1094 set offs [concat $offs [ntimes $tmp $o]]
1096 } else {
1097 lset offs $col {}
1099 foreach i $newolds {
1100 set idinlist($i) 1
1101 set idrowranges($i) $row
1103 incr col $l
1104 foreach oid $oldolds {
1105 set idinlist($oid) 1
1106 set idlist [linsert $idlist $col $oid]
1107 set offs [linsert $offs $col $o]
1108 makeuparrow $oid $col $row $o
1109 incr col
1111 lappend rowidlist $idlist
1112 lappend rowoffsets $offs
1114 return $row
1117 proc addextraid {id row} {
1118 global displayorder commitrow commitinfo
1119 global commitidx
1120 global parentlist childlist children
1122 incr commitidx
1123 lappend displayorder $id
1124 lappend parentlist {}
1125 set commitrow($id) $row
1126 readcommit $id
1127 if {![info exists commitinfo($id)]} {
1128 set commitinfo($id) {"No commit information available"}
1130 if {[info exists children($id)]} {
1131 lappend childlist $children($id)
1132 } else {
1133 lappend childlist {}
1137 proc layouttail {} {
1138 global rowidlist rowoffsets idinlist commitidx
1139 global idrowranges
1141 set row $commitidx
1142 set idlist [lindex $rowidlist $row]
1143 while {$idlist ne {}} {
1144 set col [expr {[llength $idlist] - 1}]
1145 set id [lindex $idlist $col]
1146 addextraid $id $row
1147 unset idinlist($id)
1148 lappend idrowranges($id) $row
1149 incr row
1150 set offs [ntimes $col 0]
1151 set idlist [lreplace $idlist $col $col]
1152 lappend rowidlist $idlist
1153 lappend rowoffsets $offs
1156 foreach id [array names idinlist] {
1157 addextraid $id $row
1158 lset rowidlist $row [list $id]
1159 lset rowoffsets $row 0
1160 makeuparrow $id 0 $row 0
1161 lappend idrowranges($id) $row
1162 incr row
1163 lappend rowidlist {}
1164 lappend rowoffsets {}
1168 proc insert_pad {row col npad} {
1169 global rowidlist rowoffsets
1171 set pad [ntimes $npad {}]
1172 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1173 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1174 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1177 proc optimize_rows {row col endrow} {
1178 global rowidlist rowoffsets idrowranges linesegends displayorder
1180 for {} {$row < $endrow} {incr row} {
1181 set idlist [lindex $rowidlist $row]
1182 set offs [lindex $rowoffsets $row]
1183 set haspad 0
1184 for {} {$col < [llength $offs]} {incr col} {
1185 if {[lindex $idlist $col] eq {}} {
1186 set haspad 1
1187 continue
1189 set z [lindex $offs $col]
1190 if {$z eq {}} continue
1191 set isarrow 0
1192 set x0 [expr {$col + $z}]
1193 set y0 [expr {$row - 1}]
1194 set z0 [lindex $rowoffsets $y0 $x0]
1195 if {$z0 eq {}} {
1196 set id [lindex $idlist $col]
1197 if {[info exists idrowranges($id)] &&
1198 $y0 > [lindex $idrowranges($id) 0]} {
1199 set isarrow 1
1202 if {$z < -1 || ($z < 0 && $isarrow)} {
1203 set npad [expr {-1 - $z + $isarrow}]
1204 set offs [incrange $offs $col $npad]
1205 insert_pad $y0 $x0 $npad
1206 if {$y0 > 0} {
1207 optimize_rows $y0 $x0 $row
1209 set z [lindex $offs $col]
1210 set x0 [expr {$col + $z}]
1211 set z0 [lindex $rowoffsets $y0 $x0]
1212 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1213 set npad [expr {$z - 1 + $isarrow}]
1214 set y1 [expr {$row + 1}]
1215 set offs2 [lindex $rowoffsets $y1]
1216 set x1 -1
1217 foreach z $offs2 {
1218 incr x1
1219 if {$z eq {} || $x1 + $z < $col} continue
1220 if {$x1 + $z > $col} {
1221 incr npad
1223 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1224 break
1226 set pad [ntimes $npad {}]
1227 set idlist [eval linsert \$idlist $col $pad]
1228 set tmp [eval linsert \$offs $col $pad]
1229 incr col $npad
1230 set offs [incrange $tmp $col [expr {-$npad}]]
1231 set z [lindex $offs $col]
1232 set haspad 1
1234 if {$z0 eq {} && !$isarrow} {
1235 # this line links to its first child on row $row-2
1236 set rm2 [expr {$row - 2}]
1237 set id [lindex $displayorder $rm2]
1238 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1239 if {$xc >= 0} {
1240 set z0 [expr {$xc - $x0}]
1243 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1244 insert_pad $y0 $x0 1
1245 set offs [incrange $offs $col 1]
1246 optimize_rows $y0 [expr {$x0 + 1}] $row
1249 if {!$haspad} {
1250 set o {}
1251 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1252 set o [lindex $offs $col]
1253 if {$o eq {}} {
1254 # check if this is the link to the first child
1255 set id [lindex $idlist $col]
1256 if {[info exists idrowranges($id)] &&
1257 $row == [lindex $idrowranges($id) 0]} {
1258 # it is, work out offset to child
1259 set y0 [expr {$row - 1}]
1260 set id [lindex $displayorder $y0]
1261 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1262 if {$x0 >= 0} {
1263 set o [expr {$x0 - $col}]
1267 if {$o eq {} || $o <= 0} break
1269 if {$o ne {} && [incr col] < [llength $idlist]} {
1270 set y1 [expr {$row + 1}]
1271 set offs2 [lindex $rowoffsets $y1]
1272 set x1 -1
1273 foreach z $offs2 {
1274 incr x1
1275 if {$z eq {} || $x1 + $z < $col} continue
1276 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1277 break
1279 set idlist [linsert $idlist $col {}]
1280 set tmp [linsert $offs $col {}]
1281 incr col
1282 set offs [incrange $tmp $col -1]
1285 lset rowidlist $row $idlist
1286 lset rowoffsets $row $offs
1287 set col 0
1291 proc xc {row col} {
1292 global canvx0 linespc
1293 return [expr {$canvx0 + $col * $linespc}]
1296 proc yc {row} {
1297 global canvy0 linespc
1298 return [expr {$canvy0 + $row * $linespc}]
1301 proc linewidth {id} {
1302 global thickerline lthickness
1304 set wid $lthickness
1305 if {[info exists thickerline] && $id eq $thickerline} {
1306 set wid [expr {2 * $lthickness}]
1308 return $wid
1311 proc drawlineseg {id i} {
1312 global rowoffsets rowidlist idrowranges
1313 global displayorder
1314 global canv colormap linespc
1316 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1317 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1318 if {$startrow == $row} return
1319 assigncolor $id
1320 set coords {}
1321 set col [lsearch -exact [lindex $rowidlist $row] $id]
1322 if {$col < 0} {
1323 puts "oops: drawline: id $id not on row $row"
1324 return
1326 set lasto {}
1327 set ns 0
1328 while {1} {
1329 set o [lindex $rowoffsets $row $col]
1330 if {$o eq {}} break
1331 if {$o ne $lasto} {
1332 # changing direction
1333 set x [xc $row $col]
1334 set y [yc $row]
1335 lappend coords $x $y
1336 set lasto $o
1338 incr col $o
1339 incr row -1
1341 set x [xc $row $col]
1342 set y [yc $row]
1343 lappend coords $x $y
1344 if {$i == 0} {
1345 # draw the link to the first child as part of this line
1346 incr row -1
1347 set child [lindex $displayorder $row]
1348 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1349 if {$ccol >= 0} {
1350 set x [xc $row $ccol]
1351 set y [yc $row]
1352 if {$ccol < $col - 1} {
1353 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1354 } elseif {$ccol > $col + 1} {
1355 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1357 lappend coords $x $y
1360 if {[llength $coords] < 4} return
1361 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1362 if {$i < $last} {
1363 # This line has an arrow at the lower end: check if the arrow is
1364 # on a diagonal segment, and if so, work around the Tk 8.4
1365 # refusal to draw arrows on diagonal lines.
1366 set x0 [lindex $coords 0]
1367 set x1 [lindex $coords 2]
1368 if {$x0 != $x1} {
1369 set y0 [lindex $coords 1]
1370 set y1 [lindex $coords 3]
1371 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1372 # we have a nearby vertical segment, just trim off the diag bit
1373 set coords [lrange $coords 2 end]
1374 } else {
1375 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1376 set xi [expr {$x0 - $slope * $linespc / 2}]
1377 set yi [expr {$y0 - $linespc / 2}]
1378 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1382 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1383 set arrow [lindex {none first last both} $arrow]
1384 set t [$canv create line $coords -width [linewidth $id] \
1385 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1386 $canv lower $t
1387 bindline $t $id
1390 proc drawparentlinks {id row col olds} {
1391 global rowidlist canv colormap idrowranges
1393 set row2 [expr {$row + 1}]
1394 set x [xc $row $col]
1395 set y [yc $row]
1396 set y2 [yc $row2]
1397 set ids [lindex $rowidlist $row2]
1398 # rmx = right-most X coord used
1399 set rmx 0
1400 foreach p $olds {
1401 set i [lsearch -exact $ids $p]
1402 if {$i < 0} {
1403 puts "oops, parent $p of $id not in list"
1404 continue
1406 set x2 [xc $row2 $i]
1407 if {$x2 > $rmx} {
1408 set rmx $x2
1410 if {[info exists idrowranges($p)] &&
1411 $row2 == [lindex $idrowranges($p) 0] &&
1412 $row2 < [lindex $idrowranges($p) 1]} {
1413 # drawlineseg will do this one for us
1414 continue
1416 assigncolor $p
1417 # should handle duplicated parents here...
1418 set coords [list $x $y]
1419 if {$i < $col - 1} {
1420 lappend coords [xc $row [expr {$i + 1}]] $y
1421 } elseif {$i > $col + 1} {
1422 lappend coords [xc $row [expr {$i - 1}]] $y
1424 lappend coords $x2 $y2
1425 set t [$canv create line $coords -width [linewidth $p] \
1426 -fill $colormap($p) -tags lines.$p]
1427 $canv lower $t
1428 bindline $t $p
1430 return $rmx
1433 proc drawlines {id} {
1434 global colormap canv
1435 global idrowranges idrangedrawn
1436 global childlist iddrawn commitrow rowidlist
1438 $canv delete lines.$id
1439 set nr [expr {[llength $idrowranges($id)] / 2}]
1440 for {set i 0} {$i < $nr} {incr i} {
1441 if {[info exists idrangedrawn($id,$i)]} {
1442 drawlineseg $id $i
1445 foreach child [lindex $childlist $commitrow($id)] {
1446 if {[info exists iddrawn($child)]} {
1447 set row $commitrow($child)
1448 set col [lsearch -exact [lindex $rowidlist $row] $child]
1449 if {$col >= 0} {
1450 drawparentlinks $child $row $col [list $id]
1456 proc drawcmittext {id row col rmx} {
1457 global linespc canv canv2 canv3 canvy0
1458 global commitlisted commitinfo rowidlist
1459 global rowtextx idpos idtags idheads idotherrefs
1460 global linehtag linentag linedtag
1461 global mainfont namefont canvxmax
1463 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1464 set x [xc $row $col]
1465 set y [yc $row]
1466 set orad [expr {$linespc / 3}]
1467 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1468 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1469 -fill $ofill -outline black -width 1]
1470 $canv raise $t
1471 $canv bind $t <1> {selcanvline {} %x %y}
1472 set xt [xc $row [llength [lindex $rowidlist $row]]]
1473 if {$xt < $rmx} {
1474 set xt $rmx
1476 set rowtextx($row) $xt
1477 set idpos($id) [list $x $xt $y]
1478 if {[info exists idtags($id)] || [info exists idheads($id)]
1479 || [info exists idotherrefs($id)]} {
1480 set xt [drawtags $id $x $xt $y]
1482 set headline [lindex $commitinfo($id) 0]
1483 set name [lindex $commitinfo($id) 1]
1484 set date [lindex $commitinfo($id) 2]
1485 set date [formatdate $date]
1486 set linehtag($row) [$canv create text $xt $y -anchor w \
1487 -text $headline -font $mainfont ]
1488 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1489 set linentag($row) [$canv2 create text 3 $y -anchor w \
1490 -text $name -font $namefont]
1491 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1492 -text $date -font $mainfont]
1493 set xr [expr {$xt + [font measure $mainfont $headline]}]
1494 if {$xr > $canvxmax} {
1495 set canvxmax $xr
1496 setcanvscroll
1500 proc drawcmitrow {row} {
1501 global displayorder rowidlist
1502 global idrowranges idrangedrawn iddrawn
1503 global commitinfo commitlisted parentlist numcommits
1505 if {$row >= $numcommits} return
1506 foreach id [lindex $rowidlist $row] {
1507 if {![info exists idrowranges($id)]} continue
1508 set i -1
1509 foreach {s e} $idrowranges($id) {
1510 incr i
1511 if {$row < $s} continue
1512 if {$e eq {}} break
1513 if {$row <= $e} {
1514 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1515 drawlineseg $id $i
1516 set idrangedrawn($id,$i) 1
1518 break
1523 set id [lindex $displayorder $row]
1524 if {[info exists iddrawn($id)]} return
1525 set col [lsearch -exact [lindex $rowidlist $row] $id]
1526 if {$col < 0} {
1527 puts "oops, row $row id $id not in list"
1528 return
1530 if {![info exists commitinfo($id)]} {
1531 getcommit $id
1533 assigncolor $id
1534 set olds [lindex $parentlist $row]
1535 if {$olds ne {}} {
1536 set rmx [drawparentlinks $id $row $col $olds]
1537 } else {
1538 set rmx 0
1540 drawcmittext $id $row $col $rmx
1541 set iddrawn($id) 1
1544 proc drawfrac {f0 f1} {
1545 global numcommits canv
1546 global linespc
1548 set ymax [lindex [$canv cget -scrollregion] 3]
1549 if {$ymax eq {} || $ymax == 0} return
1550 set y0 [expr {int($f0 * $ymax)}]
1551 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1552 if {$row < 0} {
1553 set row 0
1555 set y1 [expr {int($f1 * $ymax)}]
1556 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1557 if {$endrow >= $numcommits} {
1558 set endrow [expr {$numcommits - 1}]
1560 for {} {$row <= $endrow} {incr row} {
1561 drawcmitrow $row
1565 proc drawvisible {} {
1566 global canv
1567 eval drawfrac [$canv yview]
1570 proc clear_display {} {
1571 global iddrawn idrangedrawn
1573 allcanvs delete all
1574 catch {unset iddrawn}
1575 catch {unset idrangedrawn}
1578 proc assigncolor {id} {
1579 global colormap colors nextcolor
1580 global commitrow parentlist children childlist
1581 global cornercrossings crossings
1583 if {[info exists colormap($id)]} return
1584 set ncolors [llength $colors]
1585 if {[info exists commitrow($id)]} {
1586 set kids [lindex $childlist $commitrow($id)]
1587 } elseif {[info exists children($id)]} {
1588 set kids $children($id)
1589 } else {
1590 set kids {}
1592 if {[llength $kids] == 1} {
1593 set child [lindex $kids 0]
1594 if {[info exists colormap($child)]
1595 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1596 set colormap($id) $colormap($child)
1597 return
1600 set badcolors {}
1601 if {[info exists cornercrossings($id)]} {
1602 foreach x $cornercrossings($id) {
1603 if {[info exists colormap($x)]
1604 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1605 lappend badcolors $colormap($x)
1608 if {[llength $badcolors] >= $ncolors} {
1609 set badcolors {}
1612 set origbad $badcolors
1613 if {[llength $badcolors] < $ncolors - 1} {
1614 if {[info exists crossings($id)]} {
1615 foreach x $crossings($id) {
1616 if {[info exists colormap($x)]
1617 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1618 lappend badcolors $colormap($x)
1621 if {[llength $badcolors] >= $ncolors} {
1622 set badcolors $origbad
1625 set origbad $badcolors
1627 if {[llength $badcolors] < $ncolors - 1} {
1628 foreach child $kids {
1629 if {[info exists colormap($child)]
1630 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1631 lappend badcolors $colormap($child)
1633 foreach p [lindex $parentlist $commitrow($child)] {
1634 if {[info exists colormap($p)]
1635 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1636 lappend badcolors $colormap($p)
1640 if {[llength $badcolors] >= $ncolors} {
1641 set badcolors $origbad
1644 for {set i 0} {$i <= $ncolors} {incr i} {
1645 set c [lindex $colors $nextcolor]
1646 if {[incr nextcolor] >= $ncolors} {
1647 set nextcolor 0
1649 if {[lsearch -exact $badcolors $c]} break
1651 set colormap($id) $c
1654 proc bindline {t id} {
1655 global canv
1657 $canv bind $t <Enter> "lineenter %x %y $id"
1658 $canv bind $t <Motion> "linemotion %x %y $id"
1659 $canv bind $t <Leave> "lineleave $id"
1660 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1663 proc drawtags {id x xt y1} {
1664 global idtags idheads idotherrefs
1665 global linespc lthickness
1666 global canv mainfont commitrow rowtextx
1668 set marks {}
1669 set ntags 0
1670 set nheads 0
1671 if {[info exists idtags($id)]} {
1672 set marks $idtags($id)
1673 set ntags [llength $marks]
1675 if {[info exists idheads($id)]} {
1676 set marks [concat $marks $idheads($id)]
1677 set nheads [llength $idheads($id)]
1679 if {[info exists idotherrefs($id)]} {
1680 set marks [concat $marks $idotherrefs($id)]
1682 if {$marks eq {}} {
1683 return $xt
1686 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1687 set yt [expr {$y1 - 0.5 * $linespc}]
1688 set yb [expr {$yt + $linespc - 1}]
1689 set xvals {}
1690 set wvals {}
1691 foreach tag $marks {
1692 set wid [font measure $mainfont $tag]
1693 lappend xvals $xt
1694 lappend wvals $wid
1695 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1697 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1698 -width $lthickness -fill black -tags tag.$id]
1699 $canv lower $t
1700 foreach tag $marks x $xvals wid $wvals {
1701 set xl [expr {$x + $delta}]
1702 set xr [expr {$x + $delta + $wid + $lthickness}]
1703 if {[incr ntags -1] >= 0} {
1704 # draw a tag
1705 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1706 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1707 -width 1 -outline black -fill yellow -tags tag.$id]
1708 $canv bind $t <1> [list showtag $tag 1]
1709 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1710 } else {
1711 # draw a head or other ref
1712 if {[incr nheads -1] >= 0} {
1713 set col green
1714 } else {
1715 set col "#ddddff"
1717 set xl [expr {$xl - $delta/2}]
1718 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1719 -width 1 -outline black -fill $col -tags tag.$id
1721 set t [$canv create text $xl $y1 -anchor w -text $tag \
1722 -font $mainfont -tags tag.$id]
1723 if {$ntags >= 0} {
1724 $canv bind $t <1> [list showtag $tag 1]
1727 return $xt
1730 proc checkcrossings {row endrow} {
1731 global displayorder parentlist rowidlist
1733 for {} {$row < $endrow} {incr row} {
1734 set id [lindex $displayorder $row]
1735 set i [lsearch -exact [lindex $rowidlist $row] $id]
1736 if {$i < 0} continue
1737 set idlist [lindex $rowidlist [expr {$row+1}]]
1738 foreach p [lindex $parentlist $row] {
1739 set j [lsearch -exact $idlist $p]
1740 if {$j > 0} {
1741 if {$j < $i - 1} {
1742 notecrossings $row $p $j $i [expr {$j+1}]
1743 } elseif {$j > $i + 1} {
1744 notecrossings $row $p $i $j [expr {$j-1}]
1751 proc notecrossings {row id lo hi corner} {
1752 global rowidlist crossings cornercrossings
1754 for {set i $lo} {[incr i] < $hi} {} {
1755 set p [lindex [lindex $rowidlist $row] $i]
1756 if {$p == {}} continue
1757 if {$i == $corner} {
1758 if {![info exists cornercrossings($id)]
1759 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1760 lappend cornercrossings($id) $p
1762 if {![info exists cornercrossings($p)]
1763 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1764 lappend cornercrossings($p) $id
1766 } else {
1767 if {![info exists crossings($id)]
1768 || [lsearch -exact $crossings($id) $p] < 0} {
1769 lappend crossings($id) $p
1771 if {![info exists crossings($p)]
1772 || [lsearch -exact $crossings($p) $id] < 0} {
1773 lappend crossings($p) $id
1779 proc xcoord {i level ln} {
1780 global canvx0 xspc1 xspc2
1782 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1783 if {$i > 0 && $i == $level} {
1784 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1785 } elseif {$i > $level} {
1786 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1788 return $x
1791 proc finishcommits {} {
1792 global commitidx phase
1793 global canv mainfont ctext maincursor textcursor
1794 global findinprogress
1796 if {$commitidx > 0} {
1797 drawrest
1798 } else {
1799 $canv delete all
1800 $canv create text 3 3 -anchor nw -text "No commits selected" \
1801 -font $mainfont -tags textitems
1803 if {![info exists findinprogress]} {
1804 . config -cursor $maincursor
1805 settextcursor $textcursor
1807 set phase {}
1810 # Don't change the text pane cursor if it is currently the hand cursor,
1811 # showing that we are over a sha1 ID link.
1812 proc settextcursor {c} {
1813 global ctext curtextcursor
1815 if {[$ctext cget -cursor] == $curtextcursor} {
1816 $ctext config -cursor $c
1818 set curtextcursor $c
1821 proc drawrest {} {
1822 global numcommits
1823 global startmsecs
1824 global canvy0 numcommits linespc
1825 global rowlaidout commitidx
1827 set row $rowlaidout
1828 layoutrows $rowlaidout $commitidx 1
1829 layouttail
1830 optimize_rows $row 0 $commitidx
1831 showstuff $commitidx
1833 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1834 #puts "overall $drawmsecs ms for $numcommits commits"
1837 proc findmatches {f} {
1838 global findtype foundstring foundstrlen
1839 if {$findtype == "Regexp"} {
1840 set matches [regexp -indices -all -inline $foundstring $f]
1841 } else {
1842 if {$findtype == "IgnCase"} {
1843 set str [string tolower $f]
1844 } else {
1845 set str $f
1847 set matches {}
1848 set i 0
1849 while {[set j [string first $foundstring $str $i]] >= 0} {
1850 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1851 set i [expr {$j + $foundstrlen}]
1854 return $matches
1857 proc dofind {} {
1858 global findtype findloc findstring markedmatches commitinfo
1859 global numcommits displayorder linehtag linentag linedtag
1860 global mainfont namefont canv canv2 canv3 selectedline
1861 global matchinglines foundstring foundstrlen matchstring
1862 global commitdata
1864 stopfindproc
1865 unmarkmatches
1866 focus .
1867 set matchinglines {}
1868 if {$findloc == "Pickaxe"} {
1869 findpatches
1870 return
1872 if {$findtype == "IgnCase"} {
1873 set foundstring [string tolower $findstring]
1874 } else {
1875 set foundstring $findstring
1877 set foundstrlen [string length $findstring]
1878 if {$foundstrlen == 0} return
1879 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1880 set matchstring "*$matchstring*"
1881 if {$findloc == "Files"} {
1882 findfiles
1883 return
1885 if {![info exists selectedline]} {
1886 set oldsel -1
1887 } else {
1888 set oldsel $selectedline
1890 set didsel 0
1891 set fldtypes {Headline Author Date Committer CDate Comment}
1892 set l -1
1893 foreach id $displayorder {
1894 set d $commitdata($id)
1895 incr l
1896 if {$findtype == "Regexp"} {
1897 set doesmatch [regexp $foundstring $d]
1898 } elseif {$findtype == "IgnCase"} {
1899 set doesmatch [string match -nocase $matchstring $d]
1900 } else {
1901 set doesmatch [string match $matchstring $d]
1903 if {!$doesmatch} continue
1904 if {![info exists commitinfo($id)]} {
1905 getcommit $id
1907 set info $commitinfo($id)
1908 set doesmatch 0
1909 foreach f $info ty $fldtypes {
1910 if {$findloc != "All fields" && $findloc != $ty} {
1911 continue
1913 set matches [findmatches $f]
1914 if {$matches == {}} continue
1915 set doesmatch 1
1916 if {$ty == "Headline"} {
1917 drawcmitrow $l
1918 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1919 } elseif {$ty == "Author"} {
1920 drawcmitrow $l
1921 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1922 } elseif {$ty == "Date"} {
1923 drawcmitrow $l
1924 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1927 if {$doesmatch} {
1928 lappend matchinglines $l
1929 if {!$didsel && $l > $oldsel} {
1930 findselectline $l
1931 set didsel 1
1935 if {$matchinglines == {}} {
1936 bell
1937 } elseif {!$didsel} {
1938 findselectline [lindex $matchinglines 0]
1942 proc findselectline {l} {
1943 global findloc commentend ctext
1944 selectline $l 1
1945 if {$findloc == "All fields" || $findloc == "Comments"} {
1946 # highlight the matches in the comments
1947 set f [$ctext get 1.0 $commentend]
1948 set matches [findmatches $f]
1949 foreach match $matches {
1950 set start [lindex $match 0]
1951 set end [expr {[lindex $match 1] + 1}]
1952 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1957 proc findnext {restart} {
1958 global matchinglines selectedline
1959 if {![info exists matchinglines]} {
1960 if {$restart} {
1961 dofind
1963 return
1965 if {![info exists selectedline]} return
1966 foreach l $matchinglines {
1967 if {$l > $selectedline} {
1968 findselectline $l
1969 return
1972 bell
1975 proc findprev {} {
1976 global matchinglines selectedline
1977 if {![info exists matchinglines]} {
1978 dofind
1979 return
1981 if {![info exists selectedline]} return
1982 set prev {}
1983 foreach l $matchinglines {
1984 if {$l >= $selectedline} break
1985 set prev $l
1987 if {$prev != {}} {
1988 findselectline $prev
1989 } else {
1990 bell
1994 proc findlocchange {name ix op} {
1995 global findloc findtype findtypemenu
1996 if {$findloc == "Pickaxe"} {
1997 set findtype Exact
1998 set state disabled
1999 } else {
2000 set state normal
2002 $findtypemenu entryconf 1 -state $state
2003 $findtypemenu entryconf 2 -state $state
2006 proc stopfindproc {{done 0}} {
2007 global findprocpid findprocfile findids
2008 global ctext findoldcursor phase maincursor textcursor
2009 global findinprogress
2011 catch {unset findids}
2012 if {[info exists findprocpid]} {
2013 if {!$done} {
2014 catch {exec kill $findprocpid}
2016 catch {close $findprocfile}
2017 unset findprocpid
2019 if {[info exists findinprogress]} {
2020 unset findinprogress
2021 if {$phase != "incrdraw"} {
2022 . config -cursor $maincursor
2023 settextcursor $textcursor
2028 proc findpatches {} {
2029 global findstring selectedline numcommits
2030 global findprocpid findprocfile
2031 global finddidsel ctext displayorder findinprogress
2032 global findinsertpos
2034 if {$numcommits == 0} return
2036 # make a list of all the ids to search, starting at the one
2037 # after the selected line (if any)
2038 if {[info exists selectedline]} {
2039 set l $selectedline
2040 } else {
2041 set l -1
2043 set inputids {}
2044 for {set i 0} {$i < $numcommits} {incr i} {
2045 if {[incr l] >= $numcommits} {
2046 set l 0
2048 append inputids [lindex $displayorder $l] "\n"
2051 if {[catch {
2052 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2053 << $inputids] r]
2054 } err]} {
2055 error_popup "Error starting search process: $err"
2056 return
2059 set findinsertpos end
2060 set findprocfile $f
2061 set findprocpid [pid $f]
2062 fconfigure $f -blocking 0
2063 fileevent $f readable readfindproc
2064 set finddidsel 0
2065 . config -cursor watch
2066 settextcursor watch
2067 set findinprogress 1
2070 proc readfindproc {} {
2071 global findprocfile finddidsel
2072 global commitrow matchinglines findinsertpos
2074 set n [gets $findprocfile line]
2075 if {$n < 0} {
2076 if {[eof $findprocfile]} {
2077 stopfindproc 1
2078 if {!$finddidsel} {
2079 bell
2082 return
2084 if {![regexp {^[0-9a-f]{40}} $line id]} {
2085 error_popup "Can't parse git-diff-tree output: $line"
2086 stopfindproc
2087 return
2089 if {![info exists commitrow($id)]} {
2090 puts stderr "spurious id: $id"
2091 return
2093 set l $commitrow($id)
2094 insertmatch $l $id
2097 proc insertmatch {l id} {
2098 global matchinglines findinsertpos finddidsel
2100 if {$findinsertpos == "end"} {
2101 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2102 set matchinglines [linsert $matchinglines 0 $l]
2103 set findinsertpos 1
2104 } else {
2105 lappend matchinglines $l
2107 } else {
2108 set matchinglines [linsert $matchinglines $findinsertpos $l]
2109 incr findinsertpos
2111 markheadline $l $id
2112 if {!$finddidsel} {
2113 findselectline $l
2114 set finddidsel 1
2118 proc findfiles {} {
2119 global selectedline numcommits displayorder ctext
2120 global ffileline finddidsel parentlist
2121 global findinprogress findstartline findinsertpos
2122 global treediffs fdiffid fdiffsneeded fdiffpos
2123 global findmergefiles
2125 if {$numcommits == 0} return
2127 if {[info exists selectedline]} {
2128 set l [expr {$selectedline + 1}]
2129 } else {
2130 set l 0
2132 set ffileline $l
2133 set findstartline $l
2134 set diffsneeded {}
2135 set fdiffsneeded {}
2136 while 1 {
2137 set id [lindex $displayorder $l]
2138 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2139 if {![info exists treediffs($id)]} {
2140 append diffsneeded "$id\n"
2141 lappend fdiffsneeded $id
2144 if {[incr l] >= $numcommits} {
2145 set l 0
2147 if {$l == $findstartline} break
2150 # start off a git-diff-tree process if needed
2151 if {$diffsneeded ne {}} {
2152 if {[catch {
2153 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2154 } err ]} {
2155 error_popup "Error starting search process: $err"
2156 return
2158 catch {unset fdiffid}
2159 set fdiffpos 0
2160 fconfigure $df -blocking 0
2161 fileevent $df readable [list readfilediffs $df]
2164 set finddidsel 0
2165 set findinsertpos end
2166 set id [lindex $displayorder $l]
2167 . config -cursor watch
2168 settextcursor watch
2169 set findinprogress 1
2170 findcont
2171 update
2174 proc readfilediffs {df} {
2175 global findid fdiffid fdiffs
2177 set n [gets $df line]
2178 if {$n < 0} {
2179 if {[eof $df]} {
2180 donefilediff
2181 if {[catch {close $df} err]} {
2182 stopfindproc
2183 bell
2184 error_popup "Error in git-diff-tree: $err"
2185 } elseif {[info exists findid]} {
2186 set id $findid
2187 stopfindproc
2188 bell
2189 error_popup "Couldn't find diffs for $id"
2192 return
2194 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2195 # start of a new string of diffs
2196 donefilediff
2197 set fdiffid $id
2198 set fdiffs {}
2199 } elseif {[string match ":*" $line]} {
2200 lappend fdiffs [lindex $line 5]
2204 proc donefilediff {} {
2205 global fdiffid fdiffs treediffs findid
2206 global fdiffsneeded fdiffpos
2208 if {[info exists fdiffid]} {
2209 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2210 && $fdiffpos < [llength $fdiffsneeded]} {
2211 # git-diff-tree doesn't output anything for a commit
2212 # which doesn't change anything
2213 set nullid [lindex $fdiffsneeded $fdiffpos]
2214 set treediffs($nullid) {}
2215 if {[info exists findid] && $nullid eq $findid} {
2216 unset findid
2217 findcont
2219 incr fdiffpos
2221 incr fdiffpos
2223 if {![info exists treediffs($fdiffid)]} {
2224 set treediffs($fdiffid) $fdiffs
2226 if {[info exists findid] && $fdiffid eq $findid} {
2227 unset findid
2228 findcont
2233 proc findcont {id} {
2234 global findid treediffs parentlist
2235 global ffileline findstartline finddidsel
2236 global displayorder numcommits matchinglines findinprogress
2237 global findmergefiles
2239 set l $ffileline
2240 while {1} {
2241 set id [lindex $displayorder $l]
2242 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2243 if {![info exists treediffs($id)]} {
2244 set findid $id
2245 set ffileline $l
2246 return
2248 set doesmatch 0
2249 foreach f $treediffs($id) {
2250 set x [findmatches $f]
2251 if {$x != {}} {
2252 set doesmatch 1
2253 break
2256 if {$doesmatch} {
2257 insertmatch $l $id
2260 if {[incr l] >= $numcommits} {
2261 set l 0
2263 if {$l == $findstartline} break
2265 stopfindproc
2266 if {!$finddidsel} {
2267 bell
2271 # mark a commit as matching by putting a yellow background
2272 # behind the headline
2273 proc markheadline {l id} {
2274 global canv mainfont linehtag
2276 drawcmitrow $l
2277 set bbox [$canv bbox $linehtag($l)]
2278 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2279 $canv lower $t
2282 # mark the bits of a headline, author or date that match a find string
2283 proc markmatches {canv l str tag matches font} {
2284 set bbox [$canv bbox $tag]
2285 set x0 [lindex $bbox 0]
2286 set y0 [lindex $bbox 1]
2287 set y1 [lindex $bbox 3]
2288 foreach match $matches {
2289 set start [lindex $match 0]
2290 set end [lindex $match 1]
2291 if {$start > $end} continue
2292 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2293 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2294 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2295 [expr {$x0+$xlen+2}] $y1 \
2296 -outline {} -tags matches -fill yellow]
2297 $canv lower $t
2301 proc unmarkmatches {} {
2302 global matchinglines findids
2303 allcanvs delete matches
2304 catch {unset matchinglines}
2305 catch {unset findids}
2308 proc selcanvline {w x y} {
2309 global canv canvy0 ctext linespc
2310 global rowtextx
2311 set ymax [lindex [$canv cget -scrollregion] 3]
2312 if {$ymax == {}} return
2313 set yfrac [lindex [$canv yview] 0]
2314 set y [expr {$y + $yfrac * $ymax}]
2315 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2316 if {$l < 0} {
2317 set l 0
2319 if {$w eq $canv} {
2320 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2322 unmarkmatches
2323 selectline $l 1
2326 proc commit_descriptor {p} {
2327 global commitinfo
2328 set l "..."
2329 if {[info exists commitinfo($p)]} {
2330 set l [lindex $commitinfo($p) 0]
2332 return "$p ($l)"
2335 # append some text to the ctext widget, and make any SHA1 ID
2336 # that we know about be a clickable link.
2337 proc appendwithlinks {text} {
2338 global ctext commitrow linknum
2340 set start [$ctext index "end - 1c"]
2341 $ctext insert end $text
2342 $ctext insert end "\n"
2343 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2344 foreach l $links {
2345 set s [lindex $l 0]
2346 set e [lindex $l 1]
2347 set linkid [string range $text $s $e]
2348 if {![info exists commitrow($linkid)]} continue
2349 incr e
2350 $ctext tag add link "$start + $s c" "$start + $e c"
2351 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2352 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2353 incr linknum
2355 $ctext tag conf link -foreground blue -underline 1
2356 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2357 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2360 proc viewnextline {dir} {
2361 global canv linespc
2363 $canv delete hover
2364 set ymax [lindex [$canv cget -scrollregion] 3]
2365 set wnow [$canv yview]
2366 set wtop [expr {[lindex $wnow 0] * $ymax}]
2367 set newtop [expr {$wtop + $dir * $linespc}]
2368 if {$newtop < 0} {
2369 set newtop 0
2370 } elseif {$newtop > $ymax} {
2371 set newtop $ymax
2373 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2376 proc selectline {l isnew} {
2377 global canv canv2 canv3 ctext commitinfo selectedline
2378 global displayorder linehtag linentag linedtag
2379 global canvy0 linespc parentlist childlist
2380 global cflist currentid sha1entry
2381 global commentend idtags linknum
2382 global mergemax numcommits
2384 $canv delete hover
2385 normalline
2386 if {$l < 0 || $l >= $numcommits} return
2387 set y [expr {$canvy0 + $l * $linespc}]
2388 set ymax [lindex [$canv cget -scrollregion] 3]
2389 set ytop [expr {$y - $linespc - 1}]
2390 set ybot [expr {$y + $linespc + 1}]
2391 set wnow [$canv yview]
2392 set wtop [expr {[lindex $wnow 0] * $ymax}]
2393 set wbot [expr {[lindex $wnow 1] * $ymax}]
2394 set wh [expr {$wbot - $wtop}]
2395 set newtop $wtop
2396 if {$ytop < $wtop} {
2397 if {$ybot < $wtop} {
2398 set newtop [expr {$y - $wh / 2.0}]
2399 } else {
2400 set newtop $ytop
2401 if {$newtop > $wtop - $linespc} {
2402 set newtop [expr {$wtop - $linespc}]
2405 } elseif {$ybot > $wbot} {
2406 if {$ytop > $wbot} {
2407 set newtop [expr {$y - $wh / 2.0}]
2408 } else {
2409 set newtop [expr {$ybot - $wh}]
2410 if {$newtop < $wtop + $linespc} {
2411 set newtop [expr {$wtop + $linespc}]
2415 if {$newtop != $wtop} {
2416 if {$newtop < 0} {
2417 set newtop 0
2419 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2420 drawvisible
2423 if {![info exists linehtag($l)]} return
2424 $canv delete secsel
2425 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2426 -tags secsel -fill [$canv cget -selectbackground]]
2427 $canv lower $t
2428 $canv2 delete secsel
2429 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2430 -tags secsel -fill [$canv2 cget -selectbackground]]
2431 $canv2 lower $t
2432 $canv3 delete secsel
2433 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2434 -tags secsel -fill [$canv3 cget -selectbackground]]
2435 $canv3 lower $t
2437 if {$isnew} {
2438 addtohistory [list selectline $l 0]
2441 set selectedline $l
2443 set id [lindex $displayorder $l]
2444 set currentid $id
2445 $sha1entry delete 0 end
2446 $sha1entry insert 0 $id
2447 $sha1entry selection from 0
2448 $sha1entry selection to end
2450 $ctext conf -state normal
2451 $ctext delete 0.0 end
2452 set linknum 0
2453 $ctext mark set fmark.0 0.0
2454 $ctext mark gravity fmark.0 left
2455 set info $commitinfo($id)
2456 set date [formatdate [lindex $info 2]]
2457 $ctext insert end "Author: [lindex $info 1] $date\n"
2458 set date [formatdate [lindex $info 4]]
2459 $ctext insert end "Committer: [lindex $info 3] $date\n"
2460 if {[info exists idtags($id)]} {
2461 $ctext insert end "Tags:"
2462 foreach tag $idtags($id) {
2463 $ctext insert end " $tag"
2465 $ctext insert end "\n"
2468 set comment {}
2469 set olds [lindex $parentlist $l]
2470 if {[llength $olds] > 1} {
2471 set np 0
2472 foreach p $olds {
2473 if {$np >= $mergemax} {
2474 set tag mmax
2475 } else {
2476 set tag m$np
2478 $ctext insert end "Parent: " $tag
2479 appendwithlinks [commit_descriptor $p]
2480 incr np
2482 } else {
2483 foreach p $olds {
2484 append comment "Parent: [commit_descriptor $p]\n"
2488 foreach c [lindex $childlist $l] {
2489 append comment "Child: [commit_descriptor $c]\n"
2491 append comment "\n"
2492 append comment [lindex $info 5]
2494 # make anything that looks like a SHA1 ID be a clickable link
2495 appendwithlinks $comment
2497 $ctext tag delete Comments
2498 $ctext tag remove found 1.0 end
2499 $ctext conf -state disabled
2500 set commentend [$ctext index "end - 1c"]
2502 $cflist delete 0 end
2503 $cflist insert end "Comments"
2504 if {[llength $olds] <= 1} {
2505 startdiff $id
2506 } else {
2507 mergediff $id $l
2511 proc selfirstline {} {
2512 unmarkmatches
2513 selectline 0 1
2516 proc sellastline {} {
2517 global numcommits
2518 unmarkmatches
2519 set l [expr {$numcommits - 1}]
2520 selectline $l 1
2523 proc selnextline {dir} {
2524 global selectedline
2525 if {![info exists selectedline]} return
2526 set l [expr {$selectedline + $dir}]
2527 unmarkmatches
2528 selectline $l 1
2531 proc selnextpage {dir} {
2532 global canv linespc selectedline numcommits
2534 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2535 if {$lpp < 1} {
2536 set lpp 1
2538 allcanvs yview scroll [expr {$dir * $lpp}] units
2539 if {![info exists selectedline]} return
2540 set l [expr {$selectedline + $dir * $lpp}]
2541 if {$l < 0} {
2542 set l 0
2543 } elseif {$l >= $numcommits} {
2544 set l [expr $numcommits - 1]
2546 unmarkmatches
2547 selectline $l 1
2550 proc unselectline {} {
2551 global selectedline
2553 catch {unset selectedline}
2554 allcanvs delete secsel
2557 proc addtohistory {cmd} {
2558 global history historyindex
2560 if {$historyindex > 0
2561 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2562 return
2565 if {$historyindex < [llength $history]} {
2566 set history [lreplace $history $historyindex end $cmd]
2567 } else {
2568 lappend history $cmd
2570 incr historyindex
2571 if {$historyindex > 1} {
2572 .ctop.top.bar.leftbut conf -state normal
2573 } else {
2574 .ctop.top.bar.leftbut conf -state disabled
2576 .ctop.top.bar.rightbut conf -state disabled
2579 proc goback {} {
2580 global history historyindex
2582 if {$historyindex > 1} {
2583 incr historyindex -1
2584 set cmd [lindex $history [expr {$historyindex - 1}]]
2585 eval $cmd
2586 .ctop.top.bar.rightbut conf -state normal
2588 if {$historyindex <= 1} {
2589 .ctop.top.bar.leftbut conf -state disabled
2593 proc goforw {} {
2594 global history historyindex
2596 if {$historyindex < [llength $history]} {
2597 set cmd [lindex $history $historyindex]
2598 incr historyindex
2599 eval $cmd
2600 .ctop.top.bar.leftbut conf -state normal
2602 if {$historyindex >= [llength $history]} {
2603 .ctop.top.bar.rightbut conf -state disabled
2607 proc mergediff {id l} {
2608 global diffmergeid diffopts mdifffd
2609 global difffilestart diffids
2610 global parentlist
2612 set diffmergeid $id
2613 set diffids $id
2614 catch {unset difffilestart}
2615 # this doesn't seem to actually affect anything...
2616 set env(GIT_DIFF_OPTS) $diffopts
2617 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2618 if {[catch {set mdf [open $cmd r]} err]} {
2619 error_popup "Error getting merge diffs: $err"
2620 return
2622 fconfigure $mdf -blocking 0
2623 set mdifffd($id) $mdf
2624 set np [llength [lindex $parentlist $l]]
2625 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2626 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2629 proc getmergediffline {mdf id np} {
2630 global diffmergeid ctext cflist nextupdate mergemax
2631 global difffilestart mdifffd
2633 set n [gets $mdf line]
2634 if {$n < 0} {
2635 if {[eof $mdf]} {
2636 close $mdf
2638 return
2640 if {![info exists diffmergeid] || $id != $diffmergeid
2641 || $mdf != $mdifffd($id)} {
2642 return
2644 $ctext conf -state normal
2645 if {[regexp {^diff --cc (.*)} $line match fname]} {
2646 # start of a new file
2647 $ctext insert end "\n"
2648 set here [$ctext index "end - 1c"]
2649 set i [$cflist index end]
2650 $ctext mark set fmark.$i $here
2651 $ctext mark gravity fmark.$i left
2652 set difffilestart([expr {$i-1}]) $here
2653 $cflist insert end $fname
2654 set l [expr {(78 - [string length $fname]) / 2}]
2655 set pad [string range "----------------------------------------" 1 $l]
2656 $ctext insert end "$pad $fname $pad\n" filesep
2657 } elseif {[regexp {^@@} $line]} {
2658 $ctext insert end "$line\n" hunksep
2659 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2660 # do nothing
2661 } else {
2662 # parse the prefix - one ' ', '-' or '+' for each parent
2663 set spaces {}
2664 set minuses {}
2665 set pluses {}
2666 set isbad 0
2667 for {set j 0} {$j < $np} {incr j} {
2668 set c [string range $line $j $j]
2669 if {$c == " "} {
2670 lappend spaces $j
2671 } elseif {$c == "-"} {
2672 lappend minuses $j
2673 } elseif {$c == "+"} {
2674 lappend pluses $j
2675 } else {
2676 set isbad 1
2677 break
2680 set tags {}
2681 set num {}
2682 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2683 # line doesn't appear in result, parents in $minuses have the line
2684 set num [lindex $minuses 0]
2685 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2686 # line appears in result, parents in $pluses don't have the line
2687 lappend tags mresult
2688 set num [lindex $spaces 0]
2690 if {$num ne {}} {
2691 if {$num >= $mergemax} {
2692 set num "max"
2694 lappend tags m$num
2696 $ctext insert end "$line\n" $tags
2698 $ctext conf -state disabled
2699 if {[clock clicks -milliseconds] >= $nextupdate} {
2700 incr nextupdate 100
2701 fileevent $mdf readable {}
2702 update
2703 fileevent $mdf readable [list getmergediffline $mdf $id]
2707 proc startdiff {ids} {
2708 global treediffs diffids treepending diffmergeid
2710 set diffids $ids
2711 catch {unset diffmergeid}
2712 if {![info exists treediffs($ids)]} {
2713 if {![info exists treepending]} {
2714 gettreediffs $ids
2716 } else {
2717 addtocflist $ids
2721 proc addtocflist {ids} {
2722 global treediffs cflist
2723 foreach f $treediffs($ids) {
2724 $cflist insert end $f
2726 getblobdiffs $ids
2729 proc gettreediffs {ids} {
2730 global treediff treepending
2731 set treepending $ids
2732 set treediff {}
2733 if {[catch \
2734 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2735 ]} return
2736 fconfigure $gdtf -blocking 0
2737 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2740 proc gettreediffline {gdtf ids} {
2741 global treediff treediffs treepending diffids diffmergeid
2743 set n [gets $gdtf line]
2744 if {$n < 0} {
2745 if {![eof $gdtf]} return
2746 close $gdtf
2747 set treediffs($ids) $treediff
2748 unset treepending
2749 if {$ids != $diffids} {
2750 if {![info exists diffmergeid]} {
2751 gettreediffs $diffids
2753 } else {
2754 addtocflist $ids
2756 return
2758 set file [lindex $line 5]
2759 lappend treediff $file
2762 proc getblobdiffs {ids} {
2763 global diffopts blobdifffd diffids env curdifftag curtagstart
2764 global difffilestart nextupdate diffinhdr treediffs
2766 set env(GIT_DIFF_OPTS) $diffopts
2767 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2768 if {[catch {set bdf [open $cmd r]} err]} {
2769 puts "error getting diffs: $err"
2770 return
2772 set diffinhdr 0
2773 fconfigure $bdf -blocking 0
2774 set blobdifffd($ids) $bdf
2775 set curdifftag Comments
2776 set curtagstart 0.0
2777 catch {unset difffilestart}
2778 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2779 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2782 proc getblobdiffline {bdf ids} {
2783 global diffids blobdifffd ctext curdifftag curtagstart
2784 global diffnexthead diffnextnote difffilestart
2785 global nextupdate diffinhdr treediffs
2787 set n [gets $bdf line]
2788 if {$n < 0} {
2789 if {[eof $bdf]} {
2790 close $bdf
2791 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2792 $ctext tag add $curdifftag $curtagstart end
2795 return
2797 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2798 return
2800 $ctext conf -state normal
2801 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2802 # start of a new file
2803 $ctext insert end "\n"
2804 $ctext tag add $curdifftag $curtagstart end
2805 set curtagstart [$ctext index "end - 1c"]
2806 set header $newname
2807 set here [$ctext index "end - 1c"]
2808 set i [lsearch -exact $treediffs($diffids) $fname]
2809 if {$i >= 0} {
2810 set difffilestart($i) $here
2811 incr i
2812 $ctext mark set fmark.$i $here
2813 $ctext mark gravity fmark.$i left
2815 if {$newname != $fname} {
2816 set i [lsearch -exact $treediffs($diffids) $newname]
2817 if {$i >= 0} {
2818 set difffilestart($i) $here
2819 incr i
2820 $ctext mark set fmark.$i $here
2821 $ctext mark gravity fmark.$i left
2824 set curdifftag "f:$fname"
2825 $ctext tag delete $curdifftag
2826 set l [expr {(78 - [string length $header]) / 2}]
2827 set pad [string range "----------------------------------------" 1 $l]
2828 $ctext insert end "$pad $header $pad\n" filesep
2829 set diffinhdr 1
2830 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2831 # do nothing
2832 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2833 set diffinhdr 0
2834 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2835 $line match f1l f1c f2l f2c rest]} {
2836 $ctext insert end "$line\n" hunksep
2837 set diffinhdr 0
2838 } else {
2839 set x [string range $line 0 0]
2840 if {$x == "-" || $x == "+"} {
2841 set tag [expr {$x == "+"}]
2842 $ctext insert end "$line\n" d$tag
2843 } elseif {$x == " "} {
2844 $ctext insert end "$line\n"
2845 } elseif {$diffinhdr || $x == "\\"} {
2846 # e.g. "\ No newline at end of file"
2847 $ctext insert end "$line\n" filesep
2848 } else {
2849 # Something else we don't recognize
2850 if {$curdifftag != "Comments"} {
2851 $ctext insert end "\n"
2852 $ctext tag add $curdifftag $curtagstart end
2853 set curtagstart [$ctext index "end - 1c"]
2854 set curdifftag Comments
2856 $ctext insert end "$line\n" filesep
2859 $ctext conf -state disabled
2860 if {[clock clicks -milliseconds] >= $nextupdate} {
2861 incr nextupdate 100
2862 fileevent $bdf readable {}
2863 update
2864 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2868 proc nextfile {} {
2869 global difffilestart ctext
2870 set here [$ctext index @0,0]
2871 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2872 if {[$ctext compare $difffilestart($i) > $here]} {
2873 if {![info exists pos]
2874 || [$ctext compare $difffilestart($i) < $pos]} {
2875 set pos $difffilestart($i)
2879 if {[info exists pos]} {
2880 $ctext yview $pos
2884 proc listboxsel {} {
2885 global ctext cflist currentid
2886 if {![info exists currentid]} return
2887 set sel [lsort [$cflist curselection]]
2888 if {$sel eq {}} return
2889 set first [lindex $sel 0]
2890 catch {$ctext yview fmark.$first}
2893 proc setcoords {} {
2894 global linespc charspc canvx0 canvy0 mainfont
2895 global xspc1 xspc2 lthickness
2897 set linespc [font metrics $mainfont -linespace]
2898 set charspc [font measure $mainfont "m"]
2899 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2900 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2901 set lthickness [expr {int($linespc / 9) + 1}]
2902 set xspc1(0) $linespc
2903 set xspc2 $linespc
2906 proc redisplay {} {
2907 global canv
2908 global selectedline
2910 set ymax [lindex [$canv cget -scrollregion] 3]
2911 if {$ymax eq {} || $ymax == 0} return
2912 set span [$canv yview]
2913 clear_display
2914 setcanvscroll
2915 allcanvs yview moveto [lindex $span 0]
2916 drawvisible
2917 if {[info exists selectedline]} {
2918 selectline $selectedline 0
2922 proc incrfont {inc} {
2923 global mainfont namefont textfont ctext canv phase
2924 global stopped entries
2925 unmarkmatches
2926 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2927 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2928 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2929 setcoords
2930 $ctext conf -font $textfont
2931 $ctext tag conf filesep -font [concat $textfont bold]
2932 foreach e $entries {
2933 $e conf -font $mainfont
2935 if {$phase == "getcommits"} {
2936 $canv itemconf textitems -font $mainfont
2938 redisplay
2941 proc clearsha1 {} {
2942 global sha1entry sha1string
2943 if {[string length $sha1string] == 40} {
2944 $sha1entry delete 0 end
2948 proc sha1change {n1 n2 op} {
2949 global sha1string currentid sha1but
2950 if {$sha1string == {}
2951 || ([info exists currentid] && $sha1string == $currentid)} {
2952 set state disabled
2953 } else {
2954 set state normal
2956 if {[$sha1but cget -state] == $state} return
2957 if {$state == "normal"} {
2958 $sha1but conf -state normal -relief raised -text "Goto: "
2959 } else {
2960 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2964 proc gotocommit {} {
2965 global sha1string currentid commitrow tagids headids
2966 global displayorder numcommits
2968 if {$sha1string == {}
2969 || ([info exists currentid] && $sha1string == $currentid)} return
2970 if {[info exists tagids($sha1string)]} {
2971 set id $tagids($sha1string)
2972 } elseif {[info exists headids($sha1string)]} {
2973 set id $headids($sha1string)
2974 } else {
2975 set id [string tolower $sha1string]
2976 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2977 set matches {}
2978 foreach i $displayorder {
2979 if {[string match $id* $i]} {
2980 lappend matches $i
2983 if {$matches ne {}} {
2984 if {[llength $matches] > 1} {
2985 error_popup "Short SHA1 id $id is ambiguous"
2986 return
2988 set id [lindex $matches 0]
2992 if {[info exists commitrow($id)]} {
2993 selectline $commitrow($id) 1
2994 return
2996 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2997 set type "SHA1 id"
2998 } else {
2999 set type "Tag/Head"
3001 error_popup "$type $sha1string is not known"
3004 proc lineenter {x y id} {
3005 global hoverx hovery hoverid hovertimer
3006 global commitinfo canv
3008 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3009 set hoverx $x
3010 set hovery $y
3011 set hoverid $id
3012 if {[info exists hovertimer]} {
3013 after cancel $hovertimer
3015 set hovertimer [after 500 linehover]
3016 $canv delete hover
3019 proc linemotion {x y id} {
3020 global hoverx hovery hoverid hovertimer
3022 if {[info exists hoverid] && $id == $hoverid} {
3023 set hoverx $x
3024 set hovery $y
3025 if {[info exists hovertimer]} {
3026 after cancel $hovertimer
3028 set hovertimer [after 500 linehover]
3032 proc lineleave {id} {
3033 global hoverid hovertimer canv
3035 if {[info exists hoverid] && $id == $hoverid} {
3036 $canv delete hover
3037 if {[info exists hovertimer]} {
3038 after cancel $hovertimer
3039 unset hovertimer
3041 unset hoverid
3045 proc linehover {} {
3046 global hoverx hovery hoverid hovertimer
3047 global canv linespc lthickness
3048 global commitinfo mainfont
3050 set text [lindex $commitinfo($hoverid) 0]
3051 set ymax [lindex [$canv cget -scrollregion] 3]
3052 if {$ymax == {}} return
3053 set yfrac [lindex [$canv yview] 0]
3054 set x [expr {$hoverx + 2 * $linespc}]
3055 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3056 set x0 [expr {$x - 2 * $lthickness}]
3057 set y0 [expr {$y - 2 * $lthickness}]
3058 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3059 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3060 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3061 -fill \#ffff80 -outline black -width 1 -tags hover]
3062 $canv raise $t
3063 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3064 $canv raise $t
3067 proc clickisonarrow {id y} {
3068 global lthickness idrowranges
3070 set thresh [expr {2 * $lthickness + 6}]
3071 set n [expr {[llength $idrowranges($id)] - 1}]
3072 for {set i 1} {$i < $n} {incr i} {
3073 set row [lindex $idrowranges($id) $i]
3074 if {abs([yc $row] - $y) < $thresh} {
3075 return $i
3078 return {}
3081 proc arrowjump {id n y} {
3082 global idrowranges canv
3084 # 1 <-> 2, 3 <-> 4, etc...
3085 set n [expr {(($n - 1) ^ 1) + 1}]
3086 set row [lindex $idrowranges($id) $n]
3087 set yt [yc $row]
3088 set ymax [lindex [$canv cget -scrollregion] 3]
3089 if {$ymax eq {} || $ymax <= 0} return
3090 set view [$canv yview]
3091 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3092 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3093 if {$yfrac < 0} {
3094 set yfrac 0
3096 allcanvs yview moveto $yfrac
3099 proc lineclick {x y id isnew} {
3100 global ctext commitinfo childlist commitrow cflist canv thickerline
3102 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3103 unmarkmatches
3104 unselectline
3105 normalline
3106 $canv delete hover
3107 # draw this line thicker than normal
3108 set thickerline $id
3109 drawlines $id
3110 if {$isnew} {
3111 set ymax [lindex [$canv cget -scrollregion] 3]
3112 if {$ymax eq {}} return
3113 set yfrac [lindex [$canv yview] 0]
3114 set y [expr {$y + $yfrac * $ymax}]
3116 set dirn [clickisonarrow $id $y]
3117 if {$dirn ne {}} {
3118 arrowjump $id $dirn $y
3119 return
3122 if {$isnew} {
3123 addtohistory [list lineclick $x $y $id 0]
3125 # fill the details pane with info about this line
3126 $ctext conf -state normal
3127 $ctext delete 0.0 end
3128 $ctext tag conf link -foreground blue -underline 1
3129 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3130 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3131 $ctext insert end "Parent:\t"
3132 $ctext insert end $id [list link link0]
3133 $ctext tag bind link0 <1> [list selbyid $id]
3134 set info $commitinfo($id)
3135 $ctext insert end "\n\t[lindex $info 0]\n"
3136 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3137 set date [formatdate [lindex $info 2]]
3138 $ctext insert end "\tDate:\t$date\n"
3139 set kids [lindex $childlist $commitrow($id)]
3140 if {$kids ne {}} {
3141 $ctext insert end "\nChildren:"
3142 set i 0
3143 foreach child $kids {
3144 incr i
3145 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3146 set info $commitinfo($child)
3147 $ctext insert end "\n\t"
3148 $ctext insert end $child [list link link$i]
3149 $ctext tag bind link$i <1> [list selbyid $child]
3150 $ctext insert end "\n\t[lindex $info 0]"
3151 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3152 set date [formatdate [lindex $info 2]]
3153 $ctext insert end "\n\tDate:\t$date\n"
3156 $ctext conf -state disabled
3158 $cflist delete 0 end
3161 proc normalline {} {
3162 global thickerline
3163 if {[info exists thickerline]} {
3164 set id $thickerline
3165 unset thickerline
3166 drawlines $id
3170 proc selbyid {id} {
3171 global commitrow
3172 if {[info exists commitrow($id)]} {
3173 selectline $commitrow($id) 1
3177 proc mstime {} {
3178 global startmstime
3179 if {![info exists startmstime]} {
3180 set startmstime [clock clicks -milliseconds]
3182 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3185 proc rowmenu {x y id} {
3186 global rowctxmenu commitrow selectedline rowmenuid
3188 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3189 set state disabled
3190 } else {
3191 set state normal
3193 $rowctxmenu entryconfigure 0 -state $state
3194 $rowctxmenu entryconfigure 1 -state $state
3195 $rowctxmenu entryconfigure 2 -state $state
3196 set rowmenuid $id
3197 tk_popup $rowctxmenu $x $y
3200 proc diffvssel {dirn} {
3201 global rowmenuid selectedline displayorder
3203 if {![info exists selectedline]} return
3204 if {$dirn} {
3205 set oldid [lindex $displayorder $selectedline]
3206 set newid $rowmenuid
3207 } else {
3208 set oldid $rowmenuid
3209 set newid [lindex $displayorder $selectedline]
3211 addtohistory [list doseldiff $oldid $newid]
3212 doseldiff $oldid $newid
3215 proc doseldiff {oldid newid} {
3216 global ctext cflist
3217 global commitinfo
3219 $ctext conf -state normal
3220 $ctext delete 0.0 end
3221 $ctext mark set fmark.0 0.0
3222 $ctext mark gravity fmark.0 left
3223 $cflist delete 0 end
3224 $cflist insert end "Top"
3225 $ctext insert end "From "
3226 $ctext tag conf link -foreground blue -underline 1
3227 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3228 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3229 $ctext tag bind link0 <1> [list selbyid $oldid]
3230 $ctext insert end $oldid [list link link0]
3231 $ctext insert end "\n "
3232 $ctext insert end [lindex $commitinfo($oldid) 0]
3233 $ctext insert end "\n\nTo "
3234 $ctext tag bind link1 <1> [list selbyid $newid]
3235 $ctext insert end $newid [list link link1]
3236 $ctext insert end "\n "
3237 $ctext insert end [lindex $commitinfo($newid) 0]
3238 $ctext insert end "\n"
3239 $ctext conf -state disabled
3240 $ctext tag delete Comments
3241 $ctext tag remove found 1.0 end
3242 startdiff [list $oldid $newid]
3245 proc mkpatch {} {
3246 global rowmenuid currentid commitinfo patchtop patchnum
3248 if {![info exists currentid]} return
3249 set oldid $currentid
3250 set oldhead [lindex $commitinfo($oldid) 0]
3251 set newid $rowmenuid
3252 set newhead [lindex $commitinfo($newid) 0]
3253 set top .patch
3254 set patchtop $top
3255 catch {destroy $top}
3256 toplevel $top
3257 label $top.title -text "Generate patch"
3258 grid $top.title - -pady 10
3259 label $top.from -text "From:"
3260 entry $top.fromsha1 -width 40 -relief flat
3261 $top.fromsha1 insert 0 $oldid
3262 $top.fromsha1 conf -state readonly
3263 grid $top.from $top.fromsha1 -sticky w
3264 entry $top.fromhead -width 60 -relief flat
3265 $top.fromhead insert 0 $oldhead
3266 $top.fromhead conf -state readonly
3267 grid x $top.fromhead -sticky w
3268 label $top.to -text "To:"
3269 entry $top.tosha1 -width 40 -relief flat
3270 $top.tosha1 insert 0 $newid
3271 $top.tosha1 conf -state readonly
3272 grid $top.to $top.tosha1 -sticky w
3273 entry $top.tohead -width 60 -relief flat
3274 $top.tohead insert 0 $newhead
3275 $top.tohead conf -state readonly
3276 grid x $top.tohead -sticky w
3277 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3278 grid $top.rev x -pady 10
3279 label $top.flab -text "Output file:"
3280 entry $top.fname -width 60
3281 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3282 incr patchnum
3283 grid $top.flab $top.fname -sticky w
3284 frame $top.buts
3285 button $top.buts.gen -text "Generate" -command mkpatchgo
3286 button $top.buts.can -text "Cancel" -command mkpatchcan
3287 grid $top.buts.gen $top.buts.can
3288 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3289 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3290 grid $top.buts - -pady 10 -sticky ew
3291 focus $top.fname
3294 proc mkpatchrev {} {
3295 global patchtop
3297 set oldid [$patchtop.fromsha1 get]
3298 set oldhead [$patchtop.fromhead get]
3299 set newid [$patchtop.tosha1 get]
3300 set newhead [$patchtop.tohead get]
3301 foreach e [list fromsha1 fromhead tosha1 tohead] \
3302 v [list $newid $newhead $oldid $oldhead] {
3303 $patchtop.$e conf -state normal
3304 $patchtop.$e delete 0 end
3305 $patchtop.$e insert 0 $v
3306 $patchtop.$e conf -state readonly
3310 proc mkpatchgo {} {
3311 global patchtop
3313 set oldid [$patchtop.fromsha1 get]
3314 set newid [$patchtop.tosha1 get]
3315 set fname [$patchtop.fname get]
3316 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3317 error_popup "Error creating patch: $err"
3319 catch {destroy $patchtop}
3320 unset patchtop
3323 proc mkpatchcan {} {
3324 global patchtop
3326 catch {destroy $patchtop}
3327 unset patchtop
3330 proc mktag {} {
3331 global rowmenuid mktagtop commitinfo
3333 set top .maketag
3334 set mktagtop $top
3335 catch {destroy $top}
3336 toplevel $top
3337 label $top.title -text "Create tag"
3338 grid $top.title - -pady 10
3339 label $top.id -text "ID:"
3340 entry $top.sha1 -width 40 -relief flat
3341 $top.sha1 insert 0 $rowmenuid
3342 $top.sha1 conf -state readonly
3343 grid $top.id $top.sha1 -sticky w
3344 entry $top.head -width 60 -relief flat
3345 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3346 $top.head conf -state readonly
3347 grid x $top.head -sticky w
3348 label $top.tlab -text "Tag name:"
3349 entry $top.tag -width 60
3350 grid $top.tlab $top.tag -sticky w
3351 frame $top.buts
3352 button $top.buts.gen -text "Create" -command mktaggo
3353 button $top.buts.can -text "Cancel" -command mktagcan
3354 grid $top.buts.gen $top.buts.can
3355 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3356 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3357 grid $top.buts - -pady 10 -sticky ew
3358 focus $top.tag
3361 proc domktag {} {
3362 global mktagtop env tagids idtags
3364 set id [$mktagtop.sha1 get]
3365 set tag [$mktagtop.tag get]
3366 if {$tag == {}} {
3367 error_popup "No tag name specified"
3368 return
3370 if {[info exists tagids($tag)]} {
3371 error_popup "Tag \"$tag\" already exists"
3372 return
3374 if {[catch {
3375 set dir [gitdir]
3376 set fname [file join $dir "refs/tags" $tag]
3377 set f [open $fname w]
3378 puts $f $id
3379 close $f
3380 } err]} {
3381 error_popup "Error creating tag: $err"
3382 return
3385 set tagids($tag) $id
3386 lappend idtags($id) $tag
3387 redrawtags $id
3390 proc redrawtags {id} {
3391 global canv linehtag commitrow idpos selectedline
3393 if {![info exists commitrow($id)]} return
3394 drawcmitrow $commitrow($id)
3395 $canv delete tag.$id
3396 set xt [eval drawtags $id $idpos($id)]
3397 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3398 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3399 selectline $selectedline 0
3403 proc mktagcan {} {
3404 global mktagtop
3406 catch {destroy $mktagtop}
3407 unset mktagtop
3410 proc mktaggo {} {
3411 domktag
3412 mktagcan
3415 proc writecommit {} {
3416 global rowmenuid wrcomtop commitinfo wrcomcmd
3418 set top .writecommit
3419 set wrcomtop $top
3420 catch {destroy $top}
3421 toplevel $top
3422 label $top.title -text "Write commit to file"
3423 grid $top.title - -pady 10
3424 label $top.id -text "ID:"
3425 entry $top.sha1 -width 40 -relief flat
3426 $top.sha1 insert 0 $rowmenuid
3427 $top.sha1 conf -state readonly
3428 grid $top.id $top.sha1 -sticky w
3429 entry $top.head -width 60 -relief flat
3430 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3431 $top.head conf -state readonly
3432 grid x $top.head -sticky w
3433 label $top.clab -text "Command:"
3434 entry $top.cmd -width 60 -textvariable wrcomcmd
3435 grid $top.clab $top.cmd -sticky w -pady 10
3436 label $top.flab -text "Output file:"
3437 entry $top.fname -width 60
3438 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3439 grid $top.flab $top.fname -sticky w
3440 frame $top.buts
3441 button $top.buts.gen -text "Write" -command wrcomgo
3442 button $top.buts.can -text "Cancel" -command wrcomcan
3443 grid $top.buts.gen $top.buts.can
3444 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3445 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3446 grid $top.buts - -pady 10 -sticky ew
3447 focus $top.fname
3450 proc wrcomgo {} {
3451 global wrcomtop
3453 set id [$wrcomtop.sha1 get]
3454 set cmd "echo $id | [$wrcomtop.cmd get]"
3455 set fname [$wrcomtop.fname get]
3456 if {[catch {exec sh -c $cmd >$fname &} err]} {
3457 error_popup "Error writing commit: $err"
3459 catch {destroy $wrcomtop}
3460 unset wrcomtop
3463 proc wrcomcan {} {
3464 global wrcomtop
3466 catch {destroy $wrcomtop}
3467 unset wrcomtop
3470 proc listrefs {id} {
3471 global idtags idheads idotherrefs
3473 set x {}
3474 if {[info exists idtags($id)]} {
3475 set x $idtags($id)
3477 set y {}
3478 if {[info exists idheads($id)]} {
3479 set y $idheads($id)
3481 set z {}
3482 if {[info exists idotherrefs($id)]} {
3483 set z $idotherrefs($id)
3485 return [list $x $y $z]
3488 proc rereadrefs {} {
3489 global idtags idheads idotherrefs
3491 set refids [concat [array names idtags] \
3492 [array names idheads] [array names idotherrefs]]
3493 foreach id $refids {
3494 if {![info exists ref($id)]} {
3495 set ref($id) [listrefs $id]
3498 readrefs
3499 set refids [lsort -unique [concat $refids [array names idtags] \
3500 [array names idheads] [array names idotherrefs]]]
3501 foreach id $refids {
3502 set v [listrefs $id]
3503 if {![info exists ref($id)] || $ref($id) != $v} {
3504 redrawtags $id
3509 proc showtag {tag isnew} {
3510 global ctext cflist tagcontents tagids linknum
3512 if {$isnew} {
3513 addtohistory [list showtag $tag 0]
3515 $ctext conf -state normal
3516 $ctext delete 0.0 end
3517 set linknum 0
3518 if {[info exists tagcontents($tag)]} {
3519 set text $tagcontents($tag)
3520 } else {
3521 set text "Tag: $tag\nId: $tagids($tag)"
3523 appendwithlinks $text
3524 $ctext conf -state disabled
3525 $cflist delete 0 end
3528 proc doquit {} {
3529 global stopped
3530 set stopped 100
3531 destroy .
3534 proc doprefs {} {
3535 global maxwidth maxgraphpct diffopts findmergefiles
3536 global oldprefs prefstop
3538 set top .gitkprefs
3539 set prefstop $top
3540 if {[winfo exists $top]} {
3541 raise $top
3542 return
3544 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3545 set oldprefs($v) [set $v]
3547 toplevel $top
3548 wm title $top "Gitk preferences"
3549 label $top.ldisp -text "Commit list display options"
3550 grid $top.ldisp - -sticky w -pady 10
3551 label $top.spacer -text " "
3552 label $top.maxwidthl -text "Maximum graph width (lines)" \
3553 -font optionfont
3554 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3555 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3556 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3557 -font optionfont
3558 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3559 grid x $top.maxpctl $top.maxpct -sticky w
3560 checkbutton $top.findm -variable findmergefiles
3561 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3562 -font optionfont
3563 grid $top.findm $top.findml - -sticky w
3564 label $top.ddisp -text "Diff display options"
3565 grid $top.ddisp - -sticky w -pady 10
3566 label $top.diffoptl -text "Options for diff program" \
3567 -font optionfont
3568 entry $top.diffopt -width 20 -textvariable diffopts
3569 grid x $top.diffoptl $top.diffopt -sticky w
3570 frame $top.buts
3571 button $top.buts.ok -text "OK" -command prefsok
3572 button $top.buts.can -text "Cancel" -command prefscan
3573 grid $top.buts.ok $top.buts.can
3574 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3575 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3576 grid $top.buts - - -pady 10 -sticky ew
3579 proc prefscan {} {
3580 global maxwidth maxgraphpct diffopts findmergefiles
3581 global oldprefs prefstop
3583 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3584 set $v $oldprefs($v)
3586 catch {destroy $prefstop}
3587 unset prefstop
3590 proc prefsok {} {
3591 global maxwidth maxgraphpct
3592 global oldprefs prefstop
3594 catch {destroy $prefstop}
3595 unset prefstop
3596 if {$maxwidth != $oldprefs(maxwidth)
3597 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3598 redisplay
3602 proc formatdate {d} {
3603 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3606 # This list of encoding names and aliases is distilled from
3607 # http://www.iana.org/assignments/character-sets.
3608 # Not all of them are supported by Tcl.
3609 set encoding_aliases {
3610 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3611 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3612 { ISO-10646-UTF-1 csISO10646UTF1 }
3613 { ISO_646.basic:1983 ref csISO646basic1983 }
3614 { INVARIANT csINVARIANT }
3615 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3616 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3617 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3618 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3619 { NATS-DANO iso-ir-9-1 csNATSDANO }
3620 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3621 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3622 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3623 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3624 { ISO-2022-KR csISO2022KR }
3625 { EUC-KR csEUCKR }
3626 { ISO-2022-JP csISO2022JP }
3627 { ISO-2022-JP-2 csISO2022JP2 }
3628 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3629 csISO13JISC6220jp }
3630 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3631 { IT iso-ir-15 ISO646-IT csISO15Italian }
3632 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3633 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3634 { greek7-old iso-ir-18 csISO18Greek7Old }
3635 { latin-greek iso-ir-19 csISO19LatinGreek }
3636 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3637 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3638 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3639 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3640 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3641 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3642 { INIS iso-ir-49 csISO49INIS }
3643 { INIS-8 iso-ir-50 csISO50INIS8 }
3644 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3645 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3646 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3647 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3648 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3649 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3650 csISO60Norwegian1 }
3651 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3652 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3653 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3654 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3655 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3656 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3657 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3658 { greek7 iso-ir-88 csISO88Greek7 }
3659 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3660 { iso-ir-90 csISO90 }
3661 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3662 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3663 csISO92JISC62991984b }
3664 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3665 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3666 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3667 csISO95JIS62291984handadd }
3668 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3669 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3670 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3671 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3672 CP819 csISOLatin1 }
3673 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3674 { T.61-7bit iso-ir-102 csISO102T617bit }
3675 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3676 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3677 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3678 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3679 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3680 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3681 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3682 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3683 arabic csISOLatinArabic }
3684 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3685 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3686 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3687 greek greek8 csISOLatinGreek }
3688 { T.101-G2 iso-ir-128 csISO128T101G2 }
3689 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3690 csISOLatinHebrew }
3691 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3692 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3693 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3694 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3695 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3696 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3697 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3698 csISOLatinCyrillic }
3699 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3700 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3701 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3702 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3703 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3704 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3705 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3706 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3707 { ISO_10367-box iso-ir-155 csISO10367Box }
3708 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3709 { latin-lap lap iso-ir-158 csISO158Lap }
3710 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3711 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3712 { us-dk csUSDK }
3713 { dk-us csDKUS }
3714 { JIS_X0201 X0201 csHalfWidthKatakana }
3715 { KSC5636 ISO646-KR csKSC5636 }
3716 { ISO-10646-UCS-2 csUnicode }
3717 { ISO-10646-UCS-4 csUCS4 }
3718 { DEC-MCS dec csDECMCS }
3719 { hp-roman8 roman8 r8 csHPRoman8 }
3720 { macintosh mac csMacintosh }
3721 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3722 csIBM037 }
3723 { IBM038 EBCDIC-INT cp038 csIBM038 }
3724 { IBM273 CP273 csIBM273 }
3725 { IBM274 EBCDIC-BE CP274 csIBM274 }
3726 { IBM275 EBCDIC-BR cp275 csIBM275 }
3727 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3728 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3729 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3730 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3731 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3732 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3733 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3734 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3735 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3736 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3737 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3738 { IBM437 cp437 437 csPC8CodePage437 }
3739 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3740 { IBM775 cp775 csPC775Baltic }
3741 { IBM850 cp850 850 csPC850Multilingual }
3742 { IBM851 cp851 851 csIBM851 }
3743 { IBM852 cp852 852 csPCp852 }
3744 { IBM855 cp855 855 csIBM855 }
3745 { IBM857 cp857 857 csIBM857 }
3746 { IBM860 cp860 860 csIBM860 }
3747 { IBM861 cp861 861 cp-is csIBM861 }
3748 { IBM862 cp862 862 csPC862LatinHebrew }
3749 { IBM863 cp863 863 csIBM863 }
3750 { IBM864 cp864 csIBM864 }
3751 { IBM865 cp865 865 csIBM865 }
3752 { IBM866 cp866 866 csIBM866 }
3753 { IBM868 CP868 cp-ar csIBM868 }
3754 { IBM869 cp869 869 cp-gr csIBM869 }
3755 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3756 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3757 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3758 { IBM891 cp891 csIBM891 }
3759 { IBM903 cp903 csIBM903 }
3760 { IBM904 cp904 904 csIBBM904 }
3761 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3762 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3763 { IBM1026 CP1026 csIBM1026 }
3764 { EBCDIC-AT-DE csIBMEBCDICATDE }
3765 { EBCDIC-AT-DE-A csEBCDICATDEA }
3766 { EBCDIC-CA-FR csEBCDICCAFR }
3767 { EBCDIC-DK-NO csEBCDICDKNO }
3768 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3769 { EBCDIC-FI-SE csEBCDICFISE }
3770 { EBCDIC-FI-SE-A csEBCDICFISEA }
3771 { EBCDIC-FR csEBCDICFR }
3772 { EBCDIC-IT csEBCDICIT }
3773 { EBCDIC-PT csEBCDICPT }
3774 { EBCDIC-ES csEBCDICES }
3775 { EBCDIC-ES-A csEBCDICESA }
3776 { EBCDIC-ES-S csEBCDICESS }
3777 { EBCDIC-UK csEBCDICUK }
3778 { EBCDIC-US csEBCDICUS }
3779 { UNKNOWN-8BIT csUnknown8BiT }
3780 { MNEMONIC csMnemonic }
3781 { MNEM csMnem }
3782 { VISCII csVISCII }
3783 { VIQR csVIQR }
3784 { KOI8-R csKOI8R }
3785 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3786 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3787 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3788 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3789 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3790 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3791 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3792 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3793 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3794 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3795 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3796 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3797 { IBM1047 IBM-1047 }
3798 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3799 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3800 { UNICODE-1-1 csUnicode11 }
3801 { CESU-8 csCESU-8 }
3802 { BOCU-1 csBOCU-1 }
3803 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3804 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3805 l8 }
3806 { ISO-8859-15 ISO_8859-15 Latin-9 }
3807 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3808 { GBK CP936 MS936 windows-936 }
3809 { JIS_Encoding csJISEncoding }
3810 { Shift_JIS MS_Kanji csShiftJIS }
3811 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3812 EUC-JP }
3813 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3814 { ISO-10646-UCS-Basic csUnicodeASCII }
3815 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3816 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3817 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3818 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3819 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3820 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3821 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3822 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3823 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3824 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3825 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3826 { Ventura-US csVenturaUS }
3827 { Ventura-International csVenturaInternational }
3828 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3829 { PC8-Turkish csPC8Turkish }
3830 { IBM-Symbols csIBMSymbols }
3831 { IBM-Thai csIBMThai }
3832 { HP-Legal csHPLegal }
3833 { HP-Pi-font csHPPiFont }
3834 { HP-Math8 csHPMath8 }
3835 { Adobe-Symbol-Encoding csHPPSMath }
3836 { HP-DeskTop csHPDesktop }
3837 { Ventura-Math csVenturaMath }
3838 { Microsoft-Publishing csMicrosoftPublishing }
3839 { Windows-31J csWindows31J }
3840 { GB2312 csGB2312 }
3841 { Big5 csBig5 }
3844 proc tcl_encoding {enc} {
3845 global encoding_aliases
3846 set names [encoding names]
3847 set lcnames [string tolower $names]
3848 set enc [string tolower $enc]
3849 set i [lsearch -exact $lcnames $enc]
3850 if {$i < 0} {
3851 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3852 if {[regsub {^iso[-_]} $enc iso encx]} {
3853 set i [lsearch -exact $lcnames $encx]
3856 if {$i < 0} {
3857 foreach l $encoding_aliases {
3858 set ll [string tolower $l]
3859 if {[lsearch -exact $ll $enc] < 0} continue
3860 # look through the aliases for one that tcl knows about
3861 foreach e $ll {
3862 set i [lsearch -exact $lcnames $e]
3863 if {$i < 0} {
3864 if {[regsub {^iso[-_]} $e iso ex]} {
3865 set i [lsearch -exact $lcnames $ex]
3868 if {$i >= 0} break
3870 break
3873 if {$i >= 0} {
3874 return [lindex $names $i]
3876 return {}
3879 # defaults...
3880 set datemode 0
3881 set diffopts "-U 5 -p"
3882 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3884 set gitencoding {}
3885 catch {
3886 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3888 if {$gitencoding == ""} {
3889 set gitencoding "utf-8"
3891 set tclencoding [tcl_encoding $gitencoding]
3892 if {$tclencoding == {}} {
3893 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3896 set mainfont {Helvetica 9}
3897 set textfont {Courier 9}
3898 set uifont {Helvetica 9 bold}
3899 set findmergefiles 0
3900 set maxgraphpct 50
3901 set maxwidth 16
3902 set revlistorder 0
3903 set fastdate 0
3904 set uparrowlen 7
3905 set downarrowlen 7
3906 set mingaplen 30
3908 set colors {green red blue magenta darkgrey brown orange}
3910 catch {source ~/.gitk}
3912 set namefont $mainfont
3914 font create optionfont -family sans-serif -size -12
3916 set revtreeargs {}
3917 foreach arg $argv {
3918 switch -regexp -- $arg {
3919 "^$" { }
3920 "^-d" { set datemode 1 }
3921 default {
3922 lappend revtreeargs $arg
3927 # check that we can find a .git directory somewhere...
3928 set gitdir [gitdir]
3929 if {![file isdirectory $gitdir]} {
3930 error_popup "Cannot find the git directory \"$gitdir\"."
3931 exit 1
3934 set history {}
3935 set historyindex 0
3937 set optim_delay 16
3939 set stopped 0
3940 set stuffsaved 0
3941 set patchnum 0
3942 setcoords
3943 makewindow $revtreeargs
3944 readrefs
3945 getcommits $revtreeargs