repo-config: trim white-space before comment
[git/dscho.git] / gitk
blob87e71629afd4b2eca8d1c768bea0a20815405b2b
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 commitlisted
1120 global parentlist childlist children
1122 incr commitidx
1123 lappend displayorder $id
1124 lappend commitlisted 0
1125 lappend parentlist {}
1126 set commitrow($id) $row
1127 readcommit $id
1128 if {![info exists commitinfo($id)]} {
1129 set commitinfo($id) {"No commit information available"}
1131 if {[info exists children($id)]} {
1132 lappend childlist $children($id)
1133 } else {
1134 lappend childlist {}
1138 proc layouttail {} {
1139 global rowidlist rowoffsets idinlist commitidx
1140 global idrowranges
1142 set row $commitidx
1143 set idlist [lindex $rowidlist $row]
1144 while {$idlist ne {}} {
1145 set col [expr {[llength $idlist] - 1}]
1146 set id [lindex $idlist $col]
1147 addextraid $id $row
1148 unset idinlist($id)
1149 lappend idrowranges($id) $row
1150 incr row
1151 set offs [ntimes $col 0]
1152 set idlist [lreplace $idlist $col $col]
1153 lappend rowidlist $idlist
1154 lappend rowoffsets $offs
1157 foreach id [array names idinlist] {
1158 addextraid $id $row
1159 lset rowidlist $row [list $id]
1160 lset rowoffsets $row 0
1161 makeuparrow $id 0 $row 0
1162 lappend idrowranges($id) $row
1163 incr row
1164 lappend rowidlist {}
1165 lappend rowoffsets {}
1169 proc insert_pad {row col npad} {
1170 global rowidlist rowoffsets
1172 set pad [ntimes $npad {}]
1173 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1174 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1175 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1178 proc optimize_rows {row col endrow} {
1179 global rowidlist rowoffsets idrowranges linesegends displayorder
1181 for {} {$row < $endrow} {incr row} {
1182 set idlist [lindex $rowidlist $row]
1183 set offs [lindex $rowoffsets $row]
1184 set haspad 0
1185 for {} {$col < [llength $offs]} {incr col} {
1186 if {[lindex $idlist $col] eq {}} {
1187 set haspad 1
1188 continue
1190 set z [lindex $offs $col]
1191 if {$z eq {}} continue
1192 set isarrow 0
1193 set x0 [expr {$col + $z}]
1194 set y0 [expr {$row - 1}]
1195 set z0 [lindex $rowoffsets $y0 $x0]
1196 if {$z0 eq {}} {
1197 set id [lindex $idlist $col]
1198 if {[info exists idrowranges($id)] &&
1199 $y0 > [lindex $idrowranges($id) 0]} {
1200 set isarrow 1
1203 if {$z < -1 || ($z < 0 && $isarrow)} {
1204 set npad [expr {-1 - $z + $isarrow}]
1205 set offs [incrange $offs $col $npad]
1206 insert_pad $y0 $x0 $npad
1207 if {$y0 > 0} {
1208 optimize_rows $y0 $x0 $row
1210 set z [lindex $offs $col]
1211 set x0 [expr {$col + $z}]
1212 set z0 [lindex $rowoffsets $y0 $x0]
1213 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1214 set npad [expr {$z - 1 + $isarrow}]
1215 set y1 [expr {$row + 1}]
1216 set offs2 [lindex $rowoffsets $y1]
1217 set x1 -1
1218 foreach z $offs2 {
1219 incr x1
1220 if {$z eq {} || $x1 + $z < $col} continue
1221 if {$x1 + $z > $col} {
1222 incr npad
1224 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1225 break
1227 set pad [ntimes $npad {}]
1228 set idlist [eval linsert \$idlist $col $pad]
1229 set tmp [eval linsert \$offs $col $pad]
1230 incr col $npad
1231 set offs [incrange $tmp $col [expr {-$npad}]]
1232 set z [lindex $offs $col]
1233 set haspad 1
1235 if {$z0 eq {} && !$isarrow} {
1236 # this line links to its first child on row $row-2
1237 set rm2 [expr {$row - 2}]
1238 set id [lindex $displayorder $rm2]
1239 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1240 if {$xc >= 0} {
1241 set z0 [expr {$xc - $x0}]
1244 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1245 insert_pad $y0 $x0 1
1246 set offs [incrange $offs $col 1]
1247 optimize_rows $y0 [expr {$x0 + 1}] $row
1250 if {!$haspad} {
1251 set o {}
1252 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1253 set o [lindex $offs $col]
1254 if {$o eq {}} {
1255 # check if this is the link to the first child
1256 set id [lindex $idlist $col]
1257 if {[info exists idrowranges($id)] &&
1258 $row == [lindex $idrowranges($id) 0]} {
1259 # it is, work out offset to child
1260 set y0 [expr {$row - 1}]
1261 set id [lindex $displayorder $y0]
1262 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1263 if {$x0 >= 0} {
1264 set o [expr {$x0 - $col}]
1268 if {$o eq {} || $o <= 0} break
1270 if {$o ne {} && [incr col] < [llength $idlist]} {
1271 set y1 [expr {$row + 1}]
1272 set offs2 [lindex $rowoffsets $y1]
1273 set x1 -1
1274 foreach z $offs2 {
1275 incr x1
1276 if {$z eq {} || $x1 + $z < $col} continue
1277 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1278 break
1280 set idlist [linsert $idlist $col {}]
1281 set tmp [linsert $offs $col {}]
1282 incr col
1283 set offs [incrange $tmp $col -1]
1286 lset rowidlist $row $idlist
1287 lset rowoffsets $row $offs
1288 set col 0
1292 proc xc {row col} {
1293 global canvx0 linespc
1294 return [expr {$canvx0 + $col * $linespc}]
1297 proc yc {row} {
1298 global canvy0 linespc
1299 return [expr {$canvy0 + $row * $linespc}]
1302 proc linewidth {id} {
1303 global thickerline lthickness
1305 set wid $lthickness
1306 if {[info exists thickerline] && $id eq $thickerline} {
1307 set wid [expr {2 * $lthickness}]
1309 return $wid
1312 proc drawlineseg {id i} {
1313 global rowoffsets rowidlist idrowranges
1314 global displayorder
1315 global canv colormap linespc
1317 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1318 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1319 if {$startrow == $row} return
1320 assigncolor $id
1321 set coords {}
1322 set col [lsearch -exact [lindex $rowidlist $row] $id]
1323 if {$col < 0} {
1324 puts "oops: drawline: id $id not on row $row"
1325 return
1327 set lasto {}
1328 set ns 0
1329 while {1} {
1330 set o [lindex $rowoffsets $row $col]
1331 if {$o eq {}} break
1332 if {$o ne $lasto} {
1333 # changing direction
1334 set x [xc $row $col]
1335 set y [yc $row]
1336 lappend coords $x $y
1337 set lasto $o
1339 incr col $o
1340 incr row -1
1342 set x [xc $row $col]
1343 set y [yc $row]
1344 lappend coords $x $y
1345 if {$i == 0} {
1346 # draw the link to the first child as part of this line
1347 incr row -1
1348 set child [lindex $displayorder $row]
1349 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1350 if {$ccol >= 0} {
1351 set x [xc $row $ccol]
1352 set y [yc $row]
1353 if {$ccol < $col - 1} {
1354 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1355 } elseif {$ccol > $col + 1} {
1356 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1358 lappend coords $x $y
1361 if {[llength $coords] < 4} return
1362 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1363 if {$i < $last} {
1364 # This line has an arrow at the lower end: check if the arrow is
1365 # on a diagonal segment, and if so, work around the Tk 8.4
1366 # refusal to draw arrows on diagonal lines.
1367 set x0 [lindex $coords 0]
1368 set x1 [lindex $coords 2]
1369 if {$x0 != $x1} {
1370 set y0 [lindex $coords 1]
1371 set y1 [lindex $coords 3]
1372 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1373 # we have a nearby vertical segment, just trim off the diag bit
1374 set coords [lrange $coords 2 end]
1375 } else {
1376 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1377 set xi [expr {$x0 - $slope * $linespc / 2}]
1378 set yi [expr {$y0 - $linespc / 2}]
1379 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1383 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1384 set arrow [lindex {none first last both} $arrow]
1385 set t [$canv create line $coords -width [linewidth $id] \
1386 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1387 $canv lower $t
1388 bindline $t $id
1391 proc drawparentlinks {id row col olds} {
1392 global rowidlist canv colormap idrowranges
1394 set row2 [expr {$row + 1}]
1395 set x [xc $row $col]
1396 set y [yc $row]
1397 set y2 [yc $row2]
1398 set ids [lindex $rowidlist $row2]
1399 # rmx = right-most X coord used
1400 set rmx 0
1401 foreach p $olds {
1402 set i [lsearch -exact $ids $p]
1403 if {$i < 0} {
1404 puts "oops, parent $p of $id not in list"
1405 continue
1407 set x2 [xc $row2 $i]
1408 if {$x2 > $rmx} {
1409 set rmx $x2
1411 if {[info exists idrowranges($p)] &&
1412 $row2 == [lindex $idrowranges($p) 0] &&
1413 $row2 < [lindex $idrowranges($p) 1]} {
1414 # drawlineseg will do this one for us
1415 continue
1417 assigncolor $p
1418 # should handle duplicated parents here...
1419 set coords [list $x $y]
1420 if {$i < $col - 1} {
1421 lappend coords [xc $row [expr {$i + 1}]] $y
1422 } elseif {$i > $col + 1} {
1423 lappend coords [xc $row [expr {$i - 1}]] $y
1425 lappend coords $x2 $y2
1426 set t [$canv create line $coords -width [linewidth $p] \
1427 -fill $colormap($p) -tags lines.$p]
1428 $canv lower $t
1429 bindline $t $p
1431 return $rmx
1434 proc drawlines {id} {
1435 global colormap canv
1436 global idrowranges idrangedrawn
1437 global childlist iddrawn commitrow rowidlist
1439 $canv delete lines.$id
1440 set nr [expr {[llength $idrowranges($id)] / 2}]
1441 for {set i 0} {$i < $nr} {incr i} {
1442 if {[info exists idrangedrawn($id,$i)]} {
1443 drawlineseg $id $i
1446 foreach child [lindex $childlist $commitrow($id)] {
1447 if {[info exists iddrawn($child)]} {
1448 set row $commitrow($child)
1449 set col [lsearch -exact [lindex $rowidlist $row] $child]
1450 if {$col >= 0} {
1451 drawparentlinks $child $row $col [list $id]
1457 proc drawcmittext {id row col rmx} {
1458 global linespc canv canv2 canv3 canvy0
1459 global commitlisted commitinfo rowidlist
1460 global rowtextx idpos idtags idheads idotherrefs
1461 global linehtag linentag linedtag
1462 global mainfont namefont canvxmax
1464 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1465 set x [xc $row $col]
1466 set y [yc $row]
1467 set orad [expr {$linespc / 3}]
1468 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1469 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1470 -fill $ofill -outline black -width 1]
1471 $canv raise $t
1472 $canv bind $t <1> {selcanvline {} %x %y}
1473 set xt [xc $row [llength [lindex $rowidlist $row]]]
1474 if {$xt < $rmx} {
1475 set xt $rmx
1477 set rowtextx($row) $xt
1478 set idpos($id) [list $x $xt $y]
1479 if {[info exists idtags($id)] || [info exists idheads($id)]
1480 || [info exists idotherrefs($id)]} {
1481 set xt [drawtags $id $x $xt $y]
1483 set headline [lindex $commitinfo($id) 0]
1484 set name [lindex $commitinfo($id) 1]
1485 set date [lindex $commitinfo($id) 2]
1486 set date [formatdate $date]
1487 set linehtag($row) [$canv create text $xt $y -anchor w \
1488 -text $headline -font $mainfont ]
1489 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1490 set linentag($row) [$canv2 create text 3 $y -anchor w \
1491 -text $name -font $namefont]
1492 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1493 -text $date -font $mainfont]
1494 set xr [expr {$xt + [font measure $mainfont $headline]}]
1495 if {$xr > $canvxmax} {
1496 set canvxmax $xr
1497 setcanvscroll
1501 proc drawcmitrow {row} {
1502 global displayorder rowidlist
1503 global idrowranges idrangedrawn iddrawn
1504 global commitinfo parentlist numcommits
1506 if {$row >= $numcommits} return
1507 foreach id [lindex $rowidlist $row] {
1508 if {![info exists idrowranges($id)]} continue
1509 set i -1
1510 foreach {s e} $idrowranges($id) {
1511 incr i
1512 if {$row < $s} continue
1513 if {$e eq {}} break
1514 if {$row <= $e} {
1515 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1516 drawlineseg $id $i
1517 set idrangedrawn($id,$i) 1
1519 break
1524 set id [lindex $displayorder $row]
1525 if {[info exists iddrawn($id)]} return
1526 set col [lsearch -exact [lindex $rowidlist $row] $id]
1527 if {$col < 0} {
1528 puts "oops, row $row id $id not in list"
1529 return
1531 if {![info exists commitinfo($id)]} {
1532 getcommit $id
1534 assigncolor $id
1535 set olds [lindex $parentlist $row]
1536 if {$olds ne {}} {
1537 set rmx [drawparentlinks $id $row $col $olds]
1538 } else {
1539 set rmx 0
1541 drawcmittext $id $row $col $rmx
1542 set iddrawn($id) 1
1545 proc drawfrac {f0 f1} {
1546 global numcommits canv
1547 global linespc
1549 set ymax [lindex [$canv cget -scrollregion] 3]
1550 if {$ymax eq {} || $ymax == 0} return
1551 set y0 [expr {int($f0 * $ymax)}]
1552 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1553 if {$row < 0} {
1554 set row 0
1556 set y1 [expr {int($f1 * $ymax)}]
1557 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1558 if {$endrow >= $numcommits} {
1559 set endrow [expr {$numcommits - 1}]
1561 for {} {$row <= $endrow} {incr row} {
1562 drawcmitrow $row
1566 proc drawvisible {} {
1567 global canv
1568 eval drawfrac [$canv yview]
1571 proc clear_display {} {
1572 global iddrawn idrangedrawn
1574 allcanvs delete all
1575 catch {unset iddrawn}
1576 catch {unset idrangedrawn}
1579 proc assigncolor {id} {
1580 global colormap colors nextcolor
1581 global commitrow parentlist children childlist
1582 global cornercrossings crossings
1584 if {[info exists colormap($id)]} return
1585 set ncolors [llength $colors]
1586 if {[info exists commitrow($id)]} {
1587 set kids [lindex $childlist $commitrow($id)]
1588 } elseif {[info exists children($id)]} {
1589 set kids $children($id)
1590 } else {
1591 set kids {}
1593 if {[llength $kids] == 1} {
1594 set child [lindex $kids 0]
1595 if {[info exists colormap($child)]
1596 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1597 set colormap($id) $colormap($child)
1598 return
1601 set badcolors {}
1602 if {[info exists cornercrossings($id)]} {
1603 foreach x $cornercrossings($id) {
1604 if {[info exists colormap($x)]
1605 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1606 lappend badcolors $colormap($x)
1609 if {[llength $badcolors] >= $ncolors} {
1610 set badcolors {}
1613 set origbad $badcolors
1614 if {[llength $badcolors] < $ncolors - 1} {
1615 if {[info exists crossings($id)]} {
1616 foreach x $crossings($id) {
1617 if {[info exists colormap($x)]
1618 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1619 lappend badcolors $colormap($x)
1622 if {[llength $badcolors] >= $ncolors} {
1623 set badcolors $origbad
1626 set origbad $badcolors
1628 if {[llength $badcolors] < $ncolors - 1} {
1629 foreach child $kids {
1630 if {[info exists colormap($child)]
1631 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1632 lappend badcolors $colormap($child)
1634 foreach p [lindex $parentlist $commitrow($child)] {
1635 if {[info exists colormap($p)]
1636 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1637 lappend badcolors $colormap($p)
1641 if {[llength $badcolors] >= $ncolors} {
1642 set badcolors $origbad
1645 for {set i 0} {$i <= $ncolors} {incr i} {
1646 set c [lindex $colors $nextcolor]
1647 if {[incr nextcolor] >= $ncolors} {
1648 set nextcolor 0
1650 if {[lsearch -exact $badcolors $c]} break
1652 set colormap($id) $c
1655 proc bindline {t id} {
1656 global canv
1658 $canv bind $t <Enter> "lineenter %x %y $id"
1659 $canv bind $t <Motion> "linemotion %x %y $id"
1660 $canv bind $t <Leave> "lineleave $id"
1661 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1664 proc drawtags {id x xt y1} {
1665 global idtags idheads idotherrefs
1666 global linespc lthickness
1667 global canv mainfont commitrow rowtextx
1669 set marks {}
1670 set ntags 0
1671 set nheads 0
1672 if {[info exists idtags($id)]} {
1673 set marks $idtags($id)
1674 set ntags [llength $marks]
1676 if {[info exists idheads($id)]} {
1677 set marks [concat $marks $idheads($id)]
1678 set nheads [llength $idheads($id)]
1680 if {[info exists idotherrefs($id)]} {
1681 set marks [concat $marks $idotherrefs($id)]
1683 if {$marks eq {}} {
1684 return $xt
1687 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1688 set yt [expr {$y1 - 0.5 * $linespc}]
1689 set yb [expr {$yt + $linespc - 1}]
1690 set xvals {}
1691 set wvals {}
1692 foreach tag $marks {
1693 set wid [font measure $mainfont $tag]
1694 lappend xvals $xt
1695 lappend wvals $wid
1696 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1698 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1699 -width $lthickness -fill black -tags tag.$id]
1700 $canv lower $t
1701 foreach tag $marks x $xvals wid $wvals {
1702 set xl [expr {$x + $delta}]
1703 set xr [expr {$x + $delta + $wid + $lthickness}]
1704 if {[incr ntags -1] >= 0} {
1705 # draw a tag
1706 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1707 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1708 -width 1 -outline black -fill yellow -tags tag.$id]
1709 $canv bind $t <1> [list showtag $tag 1]
1710 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1711 } else {
1712 # draw a head or other ref
1713 if {[incr nheads -1] >= 0} {
1714 set col green
1715 } else {
1716 set col "#ddddff"
1718 set xl [expr {$xl - $delta/2}]
1719 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1720 -width 1 -outline black -fill $col -tags tag.$id
1722 set t [$canv create text $xl $y1 -anchor w -text $tag \
1723 -font $mainfont -tags tag.$id]
1724 if {$ntags >= 0} {
1725 $canv bind $t <1> [list showtag $tag 1]
1728 return $xt
1731 proc checkcrossings {row endrow} {
1732 global displayorder parentlist rowidlist
1734 for {} {$row < $endrow} {incr row} {
1735 set id [lindex $displayorder $row]
1736 set i [lsearch -exact [lindex $rowidlist $row] $id]
1737 if {$i < 0} continue
1738 set idlist [lindex $rowidlist [expr {$row+1}]]
1739 foreach p [lindex $parentlist $row] {
1740 set j [lsearch -exact $idlist $p]
1741 if {$j > 0} {
1742 if {$j < $i - 1} {
1743 notecrossings $row $p $j $i [expr {$j+1}]
1744 } elseif {$j > $i + 1} {
1745 notecrossings $row $p $i $j [expr {$j-1}]
1752 proc notecrossings {row id lo hi corner} {
1753 global rowidlist crossings cornercrossings
1755 for {set i $lo} {[incr i] < $hi} {} {
1756 set p [lindex [lindex $rowidlist $row] $i]
1757 if {$p == {}} continue
1758 if {$i == $corner} {
1759 if {![info exists cornercrossings($id)]
1760 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1761 lappend cornercrossings($id) $p
1763 if {![info exists cornercrossings($p)]
1764 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1765 lappend cornercrossings($p) $id
1767 } else {
1768 if {![info exists crossings($id)]
1769 || [lsearch -exact $crossings($id) $p] < 0} {
1770 lappend crossings($id) $p
1772 if {![info exists crossings($p)]
1773 || [lsearch -exact $crossings($p) $id] < 0} {
1774 lappend crossings($p) $id
1780 proc xcoord {i level ln} {
1781 global canvx0 xspc1 xspc2
1783 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1784 if {$i > 0 && $i == $level} {
1785 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1786 } elseif {$i > $level} {
1787 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1789 return $x
1792 proc finishcommits {} {
1793 global commitidx phase
1794 global canv mainfont ctext maincursor textcursor
1795 global findinprogress
1797 if {$commitidx > 0} {
1798 drawrest
1799 } else {
1800 $canv delete all
1801 $canv create text 3 3 -anchor nw -text "No commits selected" \
1802 -font $mainfont -tags textitems
1804 if {![info exists findinprogress]} {
1805 . config -cursor $maincursor
1806 settextcursor $textcursor
1808 set phase {}
1811 # Don't change the text pane cursor if it is currently the hand cursor,
1812 # showing that we are over a sha1 ID link.
1813 proc settextcursor {c} {
1814 global ctext curtextcursor
1816 if {[$ctext cget -cursor] == $curtextcursor} {
1817 $ctext config -cursor $c
1819 set curtextcursor $c
1822 proc drawrest {} {
1823 global numcommits
1824 global startmsecs
1825 global canvy0 numcommits linespc
1826 global rowlaidout commitidx
1828 set row $rowlaidout
1829 layoutrows $rowlaidout $commitidx 1
1830 layouttail
1831 optimize_rows $row 0 $commitidx
1832 showstuff $commitidx
1834 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1835 #puts "overall $drawmsecs ms for $numcommits commits"
1838 proc findmatches {f} {
1839 global findtype foundstring foundstrlen
1840 if {$findtype == "Regexp"} {
1841 set matches [regexp -indices -all -inline $foundstring $f]
1842 } else {
1843 if {$findtype == "IgnCase"} {
1844 set str [string tolower $f]
1845 } else {
1846 set str $f
1848 set matches {}
1849 set i 0
1850 while {[set j [string first $foundstring $str $i]] >= 0} {
1851 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1852 set i [expr {$j + $foundstrlen}]
1855 return $matches
1858 proc dofind {} {
1859 global findtype findloc findstring markedmatches commitinfo
1860 global numcommits displayorder linehtag linentag linedtag
1861 global mainfont namefont canv canv2 canv3 selectedline
1862 global matchinglines foundstring foundstrlen matchstring
1863 global commitdata
1865 stopfindproc
1866 unmarkmatches
1867 focus .
1868 set matchinglines {}
1869 if {$findloc == "Pickaxe"} {
1870 findpatches
1871 return
1873 if {$findtype == "IgnCase"} {
1874 set foundstring [string tolower $findstring]
1875 } else {
1876 set foundstring $findstring
1878 set foundstrlen [string length $findstring]
1879 if {$foundstrlen == 0} return
1880 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1881 set matchstring "*$matchstring*"
1882 if {$findloc == "Files"} {
1883 findfiles
1884 return
1886 if {![info exists selectedline]} {
1887 set oldsel -1
1888 } else {
1889 set oldsel $selectedline
1891 set didsel 0
1892 set fldtypes {Headline Author Date Committer CDate Comment}
1893 set l -1
1894 foreach id $displayorder {
1895 set d $commitdata($id)
1896 incr l
1897 if {$findtype == "Regexp"} {
1898 set doesmatch [regexp $foundstring $d]
1899 } elseif {$findtype == "IgnCase"} {
1900 set doesmatch [string match -nocase $matchstring $d]
1901 } else {
1902 set doesmatch [string match $matchstring $d]
1904 if {!$doesmatch} continue
1905 if {![info exists commitinfo($id)]} {
1906 getcommit $id
1908 set info $commitinfo($id)
1909 set doesmatch 0
1910 foreach f $info ty $fldtypes {
1911 if {$findloc != "All fields" && $findloc != $ty} {
1912 continue
1914 set matches [findmatches $f]
1915 if {$matches == {}} continue
1916 set doesmatch 1
1917 if {$ty == "Headline"} {
1918 drawcmitrow $l
1919 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1920 } elseif {$ty == "Author"} {
1921 drawcmitrow $l
1922 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1923 } elseif {$ty == "Date"} {
1924 drawcmitrow $l
1925 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1928 if {$doesmatch} {
1929 lappend matchinglines $l
1930 if {!$didsel && $l > $oldsel} {
1931 findselectline $l
1932 set didsel 1
1936 if {$matchinglines == {}} {
1937 bell
1938 } elseif {!$didsel} {
1939 findselectline [lindex $matchinglines 0]
1943 proc findselectline {l} {
1944 global findloc commentend ctext
1945 selectline $l 1
1946 if {$findloc == "All fields" || $findloc == "Comments"} {
1947 # highlight the matches in the comments
1948 set f [$ctext get 1.0 $commentend]
1949 set matches [findmatches $f]
1950 foreach match $matches {
1951 set start [lindex $match 0]
1952 set end [expr {[lindex $match 1] + 1}]
1953 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1958 proc findnext {restart} {
1959 global matchinglines selectedline
1960 if {![info exists matchinglines]} {
1961 if {$restart} {
1962 dofind
1964 return
1966 if {![info exists selectedline]} return
1967 foreach l $matchinglines {
1968 if {$l > $selectedline} {
1969 findselectline $l
1970 return
1973 bell
1976 proc findprev {} {
1977 global matchinglines selectedline
1978 if {![info exists matchinglines]} {
1979 dofind
1980 return
1982 if {![info exists selectedline]} return
1983 set prev {}
1984 foreach l $matchinglines {
1985 if {$l >= $selectedline} break
1986 set prev $l
1988 if {$prev != {}} {
1989 findselectline $prev
1990 } else {
1991 bell
1995 proc findlocchange {name ix op} {
1996 global findloc findtype findtypemenu
1997 if {$findloc == "Pickaxe"} {
1998 set findtype Exact
1999 set state disabled
2000 } else {
2001 set state normal
2003 $findtypemenu entryconf 1 -state $state
2004 $findtypemenu entryconf 2 -state $state
2007 proc stopfindproc {{done 0}} {
2008 global findprocpid findprocfile findids
2009 global ctext findoldcursor phase maincursor textcursor
2010 global findinprogress
2012 catch {unset findids}
2013 if {[info exists findprocpid]} {
2014 if {!$done} {
2015 catch {exec kill $findprocpid}
2017 catch {close $findprocfile}
2018 unset findprocpid
2020 if {[info exists findinprogress]} {
2021 unset findinprogress
2022 if {$phase != "incrdraw"} {
2023 . config -cursor $maincursor
2024 settextcursor $textcursor
2029 proc findpatches {} {
2030 global findstring selectedline numcommits
2031 global findprocpid findprocfile
2032 global finddidsel ctext displayorder findinprogress
2033 global findinsertpos
2035 if {$numcommits == 0} return
2037 # make a list of all the ids to search, starting at the one
2038 # after the selected line (if any)
2039 if {[info exists selectedline]} {
2040 set l $selectedline
2041 } else {
2042 set l -1
2044 set inputids {}
2045 for {set i 0} {$i < $numcommits} {incr i} {
2046 if {[incr l] >= $numcommits} {
2047 set l 0
2049 append inputids [lindex $displayorder $l] "\n"
2052 if {[catch {
2053 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2054 << $inputids] r]
2055 } err]} {
2056 error_popup "Error starting search process: $err"
2057 return
2060 set findinsertpos end
2061 set findprocfile $f
2062 set findprocpid [pid $f]
2063 fconfigure $f -blocking 0
2064 fileevent $f readable readfindproc
2065 set finddidsel 0
2066 . config -cursor watch
2067 settextcursor watch
2068 set findinprogress 1
2071 proc readfindproc {} {
2072 global findprocfile finddidsel
2073 global commitrow matchinglines findinsertpos
2075 set n [gets $findprocfile line]
2076 if {$n < 0} {
2077 if {[eof $findprocfile]} {
2078 stopfindproc 1
2079 if {!$finddidsel} {
2080 bell
2083 return
2085 if {![regexp {^[0-9a-f]{40}} $line id]} {
2086 error_popup "Can't parse git-diff-tree output: $line"
2087 stopfindproc
2088 return
2090 if {![info exists commitrow($id)]} {
2091 puts stderr "spurious id: $id"
2092 return
2094 set l $commitrow($id)
2095 insertmatch $l $id
2098 proc insertmatch {l id} {
2099 global matchinglines findinsertpos finddidsel
2101 if {$findinsertpos == "end"} {
2102 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2103 set matchinglines [linsert $matchinglines 0 $l]
2104 set findinsertpos 1
2105 } else {
2106 lappend matchinglines $l
2108 } else {
2109 set matchinglines [linsert $matchinglines $findinsertpos $l]
2110 incr findinsertpos
2112 markheadline $l $id
2113 if {!$finddidsel} {
2114 findselectline $l
2115 set finddidsel 1
2119 proc findfiles {} {
2120 global selectedline numcommits displayorder ctext
2121 global ffileline finddidsel parentlist
2122 global findinprogress findstartline findinsertpos
2123 global treediffs fdiffid fdiffsneeded fdiffpos
2124 global findmergefiles
2126 if {$numcommits == 0} return
2128 if {[info exists selectedline]} {
2129 set l [expr {$selectedline + 1}]
2130 } else {
2131 set l 0
2133 set ffileline $l
2134 set findstartline $l
2135 set diffsneeded {}
2136 set fdiffsneeded {}
2137 while 1 {
2138 set id [lindex $displayorder $l]
2139 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2140 if {![info exists treediffs($id)]} {
2141 append diffsneeded "$id\n"
2142 lappend fdiffsneeded $id
2145 if {[incr l] >= $numcommits} {
2146 set l 0
2148 if {$l == $findstartline} break
2151 # start off a git-diff-tree process if needed
2152 if {$diffsneeded ne {}} {
2153 if {[catch {
2154 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2155 } err ]} {
2156 error_popup "Error starting search process: $err"
2157 return
2159 catch {unset fdiffid}
2160 set fdiffpos 0
2161 fconfigure $df -blocking 0
2162 fileevent $df readable [list readfilediffs $df]
2165 set finddidsel 0
2166 set findinsertpos end
2167 set id [lindex $displayorder $l]
2168 . config -cursor watch
2169 settextcursor watch
2170 set findinprogress 1
2171 findcont
2172 update
2175 proc readfilediffs {df} {
2176 global findid fdiffid fdiffs
2178 set n [gets $df line]
2179 if {$n < 0} {
2180 if {[eof $df]} {
2181 donefilediff
2182 if {[catch {close $df} err]} {
2183 stopfindproc
2184 bell
2185 error_popup "Error in git-diff-tree: $err"
2186 } elseif {[info exists findid]} {
2187 set id $findid
2188 stopfindproc
2189 bell
2190 error_popup "Couldn't find diffs for $id"
2193 return
2195 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2196 # start of a new string of diffs
2197 donefilediff
2198 set fdiffid $id
2199 set fdiffs {}
2200 } elseif {[string match ":*" $line]} {
2201 lappend fdiffs [lindex $line 5]
2205 proc donefilediff {} {
2206 global fdiffid fdiffs treediffs findid
2207 global fdiffsneeded fdiffpos
2209 if {[info exists fdiffid]} {
2210 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2211 && $fdiffpos < [llength $fdiffsneeded]} {
2212 # git-diff-tree doesn't output anything for a commit
2213 # which doesn't change anything
2214 set nullid [lindex $fdiffsneeded $fdiffpos]
2215 set treediffs($nullid) {}
2216 if {[info exists findid] && $nullid eq $findid} {
2217 unset findid
2218 findcont
2220 incr fdiffpos
2222 incr fdiffpos
2224 if {![info exists treediffs($fdiffid)]} {
2225 set treediffs($fdiffid) $fdiffs
2227 if {[info exists findid] && $fdiffid eq $findid} {
2228 unset findid
2229 findcont
2234 proc findcont {} {
2235 global findid treediffs parentlist
2236 global ffileline findstartline finddidsel
2237 global displayorder numcommits matchinglines findinprogress
2238 global findmergefiles
2240 set l $ffileline
2241 while {1} {
2242 set id [lindex $displayorder $l]
2243 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2244 if {![info exists treediffs($id)]} {
2245 set findid $id
2246 set ffileline $l
2247 return
2249 set doesmatch 0
2250 foreach f $treediffs($id) {
2251 set x [findmatches $f]
2252 if {$x != {}} {
2253 set doesmatch 1
2254 break
2257 if {$doesmatch} {
2258 insertmatch $l $id
2261 if {[incr l] >= $numcommits} {
2262 set l 0
2264 if {$l == $findstartline} break
2266 stopfindproc
2267 if {!$finddidsel} {
2268 bell
2272 # mark a commit as matching by putting a yellow background
2273 # behind the headline
2274 proc markheadline {l id} {
2275 global canv mainfont linehtag
2277 drawcmitrow $l
2278 set bbox [$canv bbox $linehtag($l)]
2279 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2280 $canv lower $t
2283 # mark the bits of a headline, author or date that match a find string
2284 proc markmatches {canv l str tag matches font} {
2285 set bbox [$canv bbox $tag]
2286 set x0 [lindex $bbox 0]
2287 set y0 [lindex $bbox 1]
2288 set y1 [lindex $bbox 3]
2289 foreach match $matches {
2290 set start [lindex $match 0]
2291 set end [lindex $match 1]
2292 if {$start > $end} continue
2293 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2294 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2295 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2296 [expr {$x0+$xlen+2}] $y1 \
2297 -outline {} -tags matches -fill yellow]
2298 $canv lower $t
2302 proc unmarkmatches {} {
2303 global matchinglines findids
2304 allcanvs delete matches
2305 catch {unset matchinglines}
2306 catch {unset findids}
2309 proc selcanvline {w x y} {
2310 global canv canvy0 ctext linespc
2311 global rowtextx
2312 set ymax [lindex [$canv cget -scrollregion] 3]
2313 if {$ymax == {}} return
2314 set yfrac [lindex [$canv yview] 0]
2315 set y [expr {$y + $yfrac * $ymax}]
2316 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2317 if {$l < 0} {
2318 set l 0
2320 if {$w eq $canv} {
2321 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2323 unmarkmatches
2324 selectline $l 1
2327 proc commit_descriptor {p} {
2328 global commitinfo
2329 set l "..."
2330 if {[info exists commitinfo($p)]} {
2331 set l [lindex $commitinfo($p) 0]
2333 return "$p ($l)"
2336 # append some text to the ctext widget, and make any SHA1 ID
2337 # that we know about be a clickable link.
2338 proc appendwithlinks {text} {
2339 global ctext commitrow linknum
2341 set start [$ctext index "end - 1c"]
2342 $ctext insert end $text
2343 $ctext insert end "\n"
2344 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2345 foreach l $links {
2346 set s [lindex $l 0]
2347 set e [lindex $l 1]
2348 set linkid [string range $text $s $e]
2349 if {![info exists commitrow($linkid)]} continue
2350 incr e
2351 $ctext tag add link "$start + $s c" "$start + $e c"
2352 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2353 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2354 incr linknum
2356 $ctext tag conf link -foreground blue -underline 1
2357 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2358 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2361 proc viewnextline {dir} {
2362 global canv linespc
2364 $canv delete hover
2365 set ymax [lindex [$canv cget -scrollregion] 3]
2366 set wnow [$canv yview]
2367 set wtop [expr {[lindex $wnow 0] * $ymax}]
2368 set newtop [expr {$wtop + $dir * $linespc}]
2369 if {$newtop < 0} {
2370 set newtop 0
2371 } elseif {$newtop > $ymax} {
2372 set newtop $ymax
2374 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2377 proc selectline {l isnew} {
2378 global canv canv2 canv3 ctext commitinfo selectedline
2379 global displayorder linehtag linentag linedtag
2380 global canvy0 linespc parentlist childlist
2381 global cflist currentid sha1entry
2382 global commentend idtags linknum
2383 global mergemax numcommits
2385 $canv delete hover
2386 normalline
2387 if {$l < 0 || $l >= $numcommits} return
2388 set y [expr {$canvy0 + $l * $linespc}]
2389 set ymax [lindex [$canv cget -scrollregion] 3]
2390 set ytop [expr {$y - $linespc - 1}]
2391 set ybot [expr {$y + $linespc + 1}]
2392 set wnow [$canv yview]
2393 set wtop [expr {[lindex $wnow 0] * $ymax}]
2394 set wbot [expr {[lindex $wnow 1] * $ymax}]
2395 set wh [expr {$wbot - $wtop}]
2396 set newtop $wtop
2397 if {$ytop < $wtop} {
2398 if {$ybot < $wtop} {
2399 set newtop [expr {$y - $wh / 2.0}]
2400 } else {
2401 set newtop $ytop
2402 if {$newtop > $wtop - $linespc} {
2403 set newtop [expr {$wtop - $linespc}]
2406 } elseif {$ybot > $wbot} {
2407 if {$ytop > $wbot} {
2408 set newtop [expr {$y - $wh / 2.0}]
2409 } else {
2410 set newtop [expr {$ybot - $wh}]
2411 if {$newtop < $wtop + $linespc} {
2412 set newtop [expr {$wtop + $linespc}]
2416 if {$newtop != $wtop} {
2417 if {$newtop < 0} {
2418 set newtop 0
2420 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2421 drawvisible
2424 if {![info exists linehtag($l)]} return
2425 $canv delete secsel
2426 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2427 -tags secsel -fill [$canv cget -selectbackground]]
2428 $canv lower $t
2429 $canv2 delete secsel
2430 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2431 -tags secsel -fill [$canv2 cget -selectbackground]]
2432 $canv2 lower $t
2433 $canv3 delete secsel
2434 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2435 -tags secsel -fill [$canv3 cget -selectbackground]]
2436 $canv3 lower $t
2438 if {$isnew} {
2439 addtohistory [list selectline $l 0]
2442 set selectedline $l
2444 set id [lindex $displayorder $l]
2445 set currentid $id
2446 $sha1entry delete 0 end
2447 $sha1entry insert 0 $id
2448 $sha1entry selection from 0
2449 $sha1entry selection to end
2451 $ctext conf -state normal
2452 $ctext delete 0.0 end
2453 set linknum 0
2454 $ctext mark set fmark.0 0.0
2455 $ctext mark gravity fmark.0 left
2456 set info $commitinfo($id)
2457 set date [formatdate [lindex $info 2]]
2458 $ctext insert end "Author: [lindex $info 1] $date\n"
2459 set date [formatdate [lindex $info 4]]
2460 $ctext insert end "Committer: [lindex $info 3] $date\n"
2461 if {[info exists idtags($id)]} {
2462 $ctext insert end "Tags:"
2463 foreach tag $idtags($id) {
2464 $ctext insert end " $tag"
2466 $ctext insert end "\n"
2469 set comment {}
2470 set olds [lindex $parentlist $l]
2471 if {[llength $olds] > 1} {
2472 set np 0
2473 foreach p $olds {
2474 if {$np >= $mergemax} {
2475 set tag mmax
2476 } else {
2477 set tag m$np
2479 $ctext insert end "Parent: " $tag
2480 appendwithlinks [commit_descriptor $p]
2481 incr np
2483 } else {
2484 foreach p $olds {
2485 append comment "Parent: [commit_descriptor $p]\n"
2489 foreach c [lindex $childlist $l] {
2490 append comment "Child: [commit_descriptor $c]\n"
2492 append comment "\n"
2493 append comment [lindex $info 5]
2495 # make anything that looks like a SHA1 ID be a clickable link
2496 appendwithlinks $comment
2498 $ctext tag delete Comments
2499 $ctext tag remove found 1.0 end
2500 $ctext conf -state disabled
2501 set commentend [$ctext index "end - 1c"]
2503 $cflist delete 0 end
2504 $cflist insert end "Comments"
2505 if {[llength $olds] <= 1} {
2506 startdiff $id
2507 } else {
2508 mergediff $id $l
2512 proc selfirstline {} {
2513 unmarkmatches
2514 selectline 0 1
2517 proc sellastline {} {
2518 global numcommits
2519 unmarkmatches
2520 set l [expr {$numcommits - 1}]
2521 selectline $l 1
2524 proc selnextline {dir} {
2525 global selectedline
2526 if {![info exists selectedline]} return
2527 set l [expr {$selectedline + $dir}]
2528 unmarkmatches
2529 selectline $l 1
2532 proc selnextpage {dir} {
2533 global canv linespc selectedline numcommits
2535 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2536 if {$lpp < 1} {
2537 set lpp 1
2539 allcanvs yview scroll [expr {$dir * $lpp}] units
2540 if {![info exists selectedline]} return
2541 set l [expr {$selectedline + $dir * $lpp}]
2542 if {$l < 0} {
2543 set l 0
2544 } elseif {$l >= $numcommits} {
2545 set l [expr $numcommits - 1]
2547 unmarkmatches
2548 selectline $l 1
2551 proc unselectline {} {
2552 global selectedline
2554 catch {unset selectedline}
2555 allcanvs delete secsel
2558 proc addtohistory {cmd} {
2559 global history historyindex
2561 if {$historyindex > 0
2562 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2563 return
2566 if {$historyindex < [llength $history]} {
2567 set history [lreplace $history $historyindex end $cmd]
2568 } else {
2569 lappend history $cmd
2571 incr historyindex
2572 if {$historyindex > 1} {
2573 .ctop.top.bar.leftbut conf -state normal
2574 } else {
2575 .ctop.top.bar.leftbut conf -state disabled
2577 .ctop.top.bar.rightbut conf -state disabled
2580 proc goback {} {
2581 global history historyindex
2583 if {$historyindex > 1} {
2584 incr historyindex -1
2585 set cmd [lindex $history [expr {$historyindex - 1}]]
2586 eval $cmd
2587 .ctop.top.bar.rightbut conf -state normal
2589 if {$historyindex <= 1} {
2590 .ctop.top.bar.leftbut conf -state disabled
2594 proc goforw {} {
2595 global history historyindex
2597 if {$historyindex < [llength $history]} {
2598 set cmd [lindex $history $historyindex]
2599 incr historyindex
2600 eval $cmd
2601 .ctop.top.bar.leftbut conf -state normal
2603 if {$historyindex >= [llength $history]} {
2604 .ctop.top.bar.rightbut conf -state disabled
2608 proc mergediff {id l} {
2609 global diffmergeid diffopts mdifffd
2610 global difffilestart diffids
2611 global parentlist
2613 set diffmergeid $id
2614 set diffids $id
2615 catch {unset difffilestart}
2616 # this doesn't seem to actually affect anything...
2617 set env(GIT_DIFF_OPTS) $diffopts
2618 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2619 if {[catch {set mdf [open $cmd r]} err]} {
2620 error_popup "Error getting merge diffs: $err"
2621 return
2623 fconfigure $mdf -blocking 0
2624 set mdifffd($id) $mdf
2625 set np [llength [lindex $parentlist $l]]
2626 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2627 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2630 proc getmergediffline {mdf id np} {
2631 global diffmergeid ctext cflist nextupdate mergemax
2632 global difffilestart mdifffd
2634 set n [gets $mdf line]
2635 if {$n < 0} {
2636 if {[eof $mdf]} {
2637 close $mdf
2639 return
2641 if {![info exists diffmergeid] || $id != $diffmergeid
2642 || $mdf != $mdifffd($id)} {
2643 return
2645 $ctext conf -state normal
2646 if {[regexp {^diff --cc (.*)} $line match fname]} {
2647 # start of a new file
2648 $ctext insert end "\n"
2649 set here [$ctext index "end - 1c"]
2650 set i [$cflist index end]
2651 $ctext mark set fmark.$i $here
2652 $ctext mark gravity fmark.$i left
2653 set difffilestart([expr {$i-1}]) $here
2654 $cflist insert end $fname
2655 set l [expr {(78 - [string length $fname]) / 2}]
2656 set pad [string range "----------------------------------------" 1 $l]
2657 $ctext insert end "$pad $fname $pad\n" filesep
2658 } elseif {[regexp {^@@} $line]} {
2659 $ctext insert end "$line\n" hunksep
2660 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2661 # do nothing
2662 } else {
2663 # parse the prefix - one ' ', '-' or '+' for each parent
2664 set spaces {}
2665 set minuses {}
2666 set pluses {}
2667 set isbad 0
2668 for {set j 0} {$j < $np} {incr j} {
2669 set c [string range $line $j $j]
2670 if {$c == " "} {
2671 lappend spaces $j
2672 } elseif {$c == "-"} {
2673 lappend minuses $j
2674 } elseif {$c == "+"} {
2675 lappend pluses $j
2676 } else {
2677 set isbad 1
2678 break
2681 set tags {}
2682 set num {}
2683 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2684 # line doesn't appear in result, parents in $minuses have the line
2685 set num [lindex $minuses 0]
2686 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2687 # line appears in result, parents in $pluses don't have the line
2688 lappend tags mresult
2689 set num [lindex $spaces 0]
2691 if {$num ne {}} {
2692 if {$num >= $mergemax} {
2693 set num "max"
2695 lappend tags m$num
2697 $ctext insert end "$line\n" $tags
2699 $ctext conf -state disabled
2700 if {[clock clicks -milliseconds] >= $nextupdate} {
2701 incr nextupdate 100
2702 fileevent $mdf readable {}
2703 update
2704 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2708 proc startdiff {ids} {
2709 global treediffs diffids treepending diffmergeid
2711 set diffids $ids
2712 catch {unset diffmergeid}
2713 if {![info exists treediffs($ids)]} {
2714 if {![info exists treepending]} {
2715 gettreediffs $ids
2717 } else {
2718 addtocflist $ids
2722 proc addtocflist {ids} {
2723 global treediffs cflist
2724 foreach f $treediffs($ids) {
2725 $cflist insert end $f
2727 getblobdiffs $ids
2730 proc gettreediffs {ids} {
2731 global treediff treepending
2732 set treepending $ids
2733 set treediff {}
2734 if {[catch \
2735 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2736 ]} return
2737 fconfigure $gdtf -blocking 0
2738 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2741 proc gettreediffline {gdtf ids} {
2742 global treediff treediffs treepending diffids diffmergeid
2744 set n [gets $gdtf line]
2745 if {$n < 0} {
2746 if {![eof $gdtf]} return
2747 close $gdtf
2748 set treediffs($ids) $treediff
2749 unset treepending
2750 if {$ids != $diffids} {
2751 if {![info exists diffmergeid]} {
2752 gettreediffs $diffids
2754 } else {
2755 addtocflist $ids
2757 return
2759 set file [lindex $line 5]
2760 lappend treediff $file
2763 proc getblobdiffs {ids} {
2764 global diffopts blobdifffd diffids env curdifftag curtagstart
2765 global difffilestart nextupdate diffinhdr treediffs
2767 set env(GIT_DIFF_OPTS) $diffopts
2768 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2769 if {[catch {set bdf [open $cmd r]} err]} {
2770 puts "error getting diffs: $err"
2771 return
2773 set diffinhdr 0
2774 fconfigure $bdf -blocking 0
2775 set blobdifffd($ids) $bdf
2776 set curdifftag Comments
2777 set curtagstart 0.0
2778 catch {unset difffilestart}
2779 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2780 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2783 proc getblobdiffline {bdf ids} {
2784 global diffids blobdifffd ctext curdifftag curtagstart
2785 global diffnexthead diffnextnote difffilestart
2786 global nextupdate diffinhdr treediffs
2788 set n [gets $bdf line]
2789 if {$n < 0} {
2790 if {[eof $bdf]} {
2791 close $bdf
2792 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2793 $ctext tag add $curdifftag $curtagstart end
2796 return
2798 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2799 return
2801 $ctext conf -state normal
2802 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2803 # start of a new file
2804 $ctext insert end "\n"
2805 $ctext tag add $curdifftag $curtagstart end
2806 set curtagstart [$ctext index "end - 1c"]
2807 set header $newname
2808 set here [$ctext index "end - 1c"]
2809 set i [lsearch -exact $treediffs($diffids) $fname]
2810 if {$i >= 0} {
2811 set difffilestart($i) $here
2812 incr i
2813 $ctext mark set fmark.$i $here
2814 $ctext mark gravity fmark.$i left
2816 if {$newname != $fname} {
2817 set i [lsearch -exact $treediffs($diffids) $newname]
2818 if {$i >= 0} {
2819 set difffilestart($i) $here
2820 incr i
2821 $ctext mark set fmark.$i $here
2822 $ctext mark gravity fmark.$i left
2825 set curdifftag "f:$fname"
2826 $ctext tag delete $curdifftag
2827 set l [expr {(78 - [string length $header]) / 2}]
2828 set pad [string range "----------------------------------------" 1 $l]
2829 $ctext insert end "$pad $header $pad\n" filesep
2830 set diffinhdr 1
2831 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2832 # do nothing
2833 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2834 set diffinhdr 0
2835 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2836 $line match f1l f1c f2l f2c rest]} {
2837 $ctext insert end "$line\n" hunksep
2838 set diffinhdr 0
2839 } else {
2840 set x [string range $line 0 0]
2841 if {$x == "-" || $x == "+"} {
2842 set tag [expr {$x == "+"}]
2843 $ctext insert end "$line\n" d$tag
2844 } elseif {$x == " "} {
2845 $ctext insert end "$line\n"
2846 } elseif {$diffinhdr || $x == "\\"} {
2847 # e.g. "\ No newline at end of file"
2848 $ctext insert end "$line\n" filesep
2849 } else {
2850 # Something else we don't recognize
2851 if {$curdifftag != "Comments"} {
2852 $ctext insert end "\n"
2853 $ctext tag add $curdifftag $curtagstart end
2854 set curtagstart [$ctext index "end - 1c"]
2855 set curdifftag Comments
2857 $ctext insert end "$line\n" filesep
2860 $ctext conf -state disabled
2861 if {[clock clicks -milliseconds] >= $nextupdate} {
2862 incr nextupdate 100
2863 fileevent $bdf readable {}
2864 update
2865 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2869 proc nextfile {} {
2870 global difffilestart ctext
2871 set here [$ctext index @0,0]
2872 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2873 if {[$ctext compare $difffilestart($i) > $here]} {
2874 if {![info exists pos]
2875 || [$ctext compare $difffilestart($i) < $pos]} {
2876 set pos $difffilestart($i)
2880 if {[info exists pos]} {
2881 $ctext yview $pos
2885 proc listboxsel {} {
2886 global ctext cflist currentid
2887 if {![info exists currentid]} return
2888 set sel [lsort [$cflist curselection]]
2889 if {$sel eq {}} return
2890 set first [lindex $sel 0]
2891 catch {$ctext yview fmark.$first}
2894 proc setcoords {} {
2895 global linespc charspc canvx0 canvy0 mainfont
2896 global xspc1 xspc2 lthickness
2898 set linespc [font metrics $mainfont -linespace]
2899 set charspc [font measure $mainfont "m"]
2900 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2901 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2902 set lthickness [expr {int($linespc / 9) + 1}]
2903 set xspc1(0) $linespc
2904 set xspc2 $linespc
2907 proc redisplay {} {
2908 global canv
2909 global selectedline
2911 set ymax [lindex [$canv cget -scrollregion] 3]
2912 if {$ymax eq {} || $ymax == 0} return
2913 set span [$canv yview]
2914 clear_display
2915 setcanvscroll
2916 allcanvs yview moveto [lindex $span 0]
2917 drawvisible
2918 if {[info exists selectedline]} {
2919 selectline $selectedline 0
2923 proc incrfont {inc} {
2924 global mainfont namefont textfont ctext canv phase
2925 global stopped entries
2926 unmarkmatches
2927 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2928 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2929 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2930 setcoords
2931 $ctext conf -font $textfont
2932 $ctext tag conf filesep -font [concat $textfont bold]
2933 foreach e $entries {
2934 $e conf -font $mainfont
2936 if {$phase == "getcommits"} {
2937 $canv itemconf textitems -font $mainfont
2939 redisplay
2942 proc clearsha1 {} {
2943 global sha1entry sha1string
2944 if {[string length $sha1string] == 40} {
2945 $sha1entry delete 0 end
2949 proc sha1change {n1 n2 op} {
2950 global sha1string currentid sha1but
2951 if {$sha1string == {}
2952 || ([info exists currentid] && $sha1string == $currentid)} {
2953 set state disabled
2954 } else {
2955 set state normal
2957 if {[$sha1but cget -state] == $state} return
2958 if {$state == "normal"} {
2959 $sha1but conf -state normal -relief raised -text "Goto: "
2960 } else {
2961 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2965 proc gotocommit {} {
2966 global sha1string currentid commitrow tagids headids
2967 global displayorder numcommits
2969 if {$sha1string == {}
2970 || ([info exists currentid] && $sha1string == $currentid)} return
2971 if {[info exists tagids($sha1string)]} {
2972 set id $tagids($sha1string)
2973 } elseif {[info exists headids($sha1string)]} {
2974 set id $headids($sha1string)
2975 } else {
2976 set id [string tolower $sha1string]
2977 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2978 set matches {}
2979 foreach i $displayorder {
2980 if {[string match $id* $i]} {
2981 lappend matches $i
2984 if {$matches ne {}} {
2985 if {[llength $matches] > 1} {
2986 error_popup "Short SHA1 id $id is ambiguous"
2987 return
2989 set id [lindex $matches 0]
2993 if {[info exists commitrow($id)]} {
2994 selectline $commitrow($id) 1
2995 return
2997 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2998 set type "SHA1 id"
2999 } else {
3000 set type "Tag/Head"
3002 error_popup "$type $sha1string is not known"
3005 proc lineenter {x y id} {
3006 global hoverx hovery hoverid hovertimer
3007 global commitinfo canv
3009 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3010 set hoverx $x
3011 set hovery $y
3012 set hoverid $id
3013 if {[info exists hovertimer]} {
3014 after cancel $hovertimer
3016 set hovertimer [after 500 linehover]
3017 $canv delete hover
3020 proc linemotion {x y id} {
3021 global hoverx hovery hoverid hovertimer
3023 if {[info exists hoverid] && $id == $hoverid} {
3024 set hoverx $x
3025 set hovery $y
3026 if {[info exists hovertimer]} {
3027 after cancel $hovertimer
3029 set hovertimer [after 500 linehover]
3033 proc lineleave {id} {
3034 global hoverid hovertimer canv
3036 if {[info exists hoverid] && $id == $hoverid} {
3037 $canv delete hover
3038 if {[info exists hovertimer]} {
3039 after cancel $hovertimer
3040 unset hovertimer
3042 unset hoverid
3046 proc linehover {} {
3047 global hoverx hovery hoverid hovertimer
3048 global canv linespc lthickness
3049 global commitinfo mainfont
3051 set text [lindex $commitinfo($hoverid) 0]
3052 set ymax [lindex [$canv cget -scrollregion] 3]
3053 if {$ymax == {}} return
3054 set yfrac [lindex [$canv yview] 0]
3055 set x [expr {$hoverx + 2 * $linespc}]
3056 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3057 set x0 [expr {$x - 2 * $lthickness}]
3058 set y0 [expr {$y - 2 * $lthickness}]
3059 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3060 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3061 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3062 -fill \#ffff80 -outline black -width 1 -tags hover]
3063 $canv raise $t
3064 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3065 $canv raise $t
3068 proc clickisonarrow {id y} {
3069 global lthickness idrowranges
3071 set thresh [expr {2 * $lthickness + 6}]
3072 set n [expr {[llength $idrowranges($id)] - 1}]
3073 for {set i 1} {$i < $n} {incr i} {
3074 set row [lindex $idrowranges($id) $i]
3075 if {abs([yc $row] - $y) < $thresh} {
3076 return $i
3079 return {}
3082 proc arrowjump {id n y} {
3083 global idrowranges canv
3085 # 1 <-> 2, 3 <-> 4, etc...
3086 set n [expr {(($n - 1) ^ 1) + 1}]
3087 set row [lindex $idrowranges($id) $n]
3088 set yt [yc $row]
3089 set ymax [lindex [$canv cget -scrollregion] 3]
3090 if {$ymax eq {} || $ymax <= 0} return
3091 set view [$canv yview]
3092 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3093 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3094 if {$yfrac < 0} {
3095 set yfrac 0
3097 allcanvs yview moveto $yfrac
3100 proc lineclick {x y id isnew} {
3101 global ctext commitinfo childlist commitrow cflist canv thickerline
3103 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3104 unmarkmatches
3105 unselectline
3106 normalline
3107 $canv delete hover
3108 # draw this line thicker than normal
3109 set thickerline $id
3110 drawlines $id
3111 if {$isnew} {
3112 set ymax [lindex [$canv cget -scrollregion] 3]
3113 if {$ymax eq {}} return
3114 set yfrac [lindex [$canv yview] 0]
3115 set y [expr {$y + $yfrac * $ymax}]
3117 set dirn [clickisonarrow $id $y]
3118 if {$dirn ne {}} {
3119 arrowjump $id $dirn $y
3120 return
3123 if {$isnew} {
3124 addtohistory [list lineclick $x $y $id 0]
3126 # fill the details pane with info about this line
3127 $ctext conf -state normal
3128 $ctext delete 0.0 end
3129 $ctext tag conf link -foreground blue -underline 1
3130 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3131 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3132 $ctext insert end "Parent:\t"
3133 $ctext insert end $id [list link link0]
3134 $ctext tag bind link0 <1> [list selbyid $id]
3135 set info $commitinfo($id)
3136 $ctext insert end "\n\t[lindex $info 0]\n"
3137 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3138 set date [formatdate [lindex $info 2]]
3139 $ctext insert end "\tDate:\t$date\n"
3140 set kids [lindex $childlist $commitrow($id)]
3141 if {$kids ne {}} {
3142 $ctext insert end "\nChildren:"
3143 set i 0
3144 foreach child $kids {
3145 incr i
3146 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3147 set info $commitinfo($child)
3148 $ctext insert end "\n\t"
3149 $ctext insert end $child [list link link$i]
3150 $ctext tag bind link$i <1> [list selbyid $child]
3151 $ctext insert end "\n\t[lindex $info 0]"
3152 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3153 set date [formatdate [lindex $info 2]]
3154 $ctext insert end "\n\tDate:\t$date\n"
3157 $ctext conf -state disabled
3159 $cflist delete 0 end
3162 proc normalline {} {
3163 global thickerline
3164 if {[info exists thickerline]} {
3165 set id $thickerline
3166 unset thickerline
3167 drawlines $id
3171 proc selbyid {id} {
3172 global commitrow
3173 if {[info exists commitrow($id)]} {
3174 selectline $commitrow($id) 1
3178 proc mstime {} {
3179 global startmstime
3180 if {![info exists startmstime]} {
3181 set startmstime [clock clicks -milliseconds]
3183 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3186 proc rowmenu {x y id} {
3187 global rowctxmenu commitrow selectedline rowmenuid
3189 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3190 set state disabled
3191 } else {
3192 set state normal
3194 $rowctxmenu entryconfigure 0 -state $state
3195 $rowctxmenu entryconfigure 1 -state $state
3196 $rowctxmenu entryconfigure 2 -state $state
3197 set rowmenuid $id
3198 tk_popup $rowctxmenu $x $y
3201 proc diffvssel {dirn} {
3202 global rowmenuid selectedline displayorder
3204 if {![info exists selectedline]} return
3205 if {$dirn} {
3206 set oldid [lindex $displayorder $selectedline]
3207 set newid $rowmenuid
3208 } else {
3209 set oldid $rowmenuid
3210 set newid [lindex $displayorder $selectedline]
3212 addtohistory [list doseldiff $oldid $newid]
3213 doseldiff $oldid $newid
3216 proc doseldiff {oldid newid} {
3217 global ctext cflist
3218 global commitinfo
3220 $ctext conf -state normal
3221 $ctext delete 0.0 end
3222 $ctext mark set fmark.0 0.0
3223 $ctext mark gravity fmark.0 left
3224 $cflist delete 0 end
3225 $cflist insert end "Top"
3226 $ctext insert end "From "
3227 $ctext tag conf link -foreground blue -underline 1
3228 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3229 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3230 $ctext tag bind link0 <1> [list selbyid $oldid]
3231 $ctext insert end $oldid [list link link0]
3232 $ctext insert end "\n "
3233 $ctext insert end [lindex $commitinfo($oldid) 0]
3234 $ctext insert end "\n\nTo "
3235 $ctext tag bind link1 <1> [list selbyid $newid]
3236 $ctext insert end $newid [list link link1]
3237 $ctext insert end "\n "
3238 $ctext insert end [lindex $commitinfo($newid) 0]
3239 $ctext insert end "\n"
3240 $ctext conf -state disabled
3241 $ctext tag delete Comments
3242 $ctext tag remove found 1.0 end
3243 startdiff [list $oldid $newid]
3246 proc mkpatch {} {
3247 global rowmenuid currentid commitinfo patchtop patchnum
3249 if {![info exists currentid]} return
3250 set oldid $currentid
3251 set oldhead [lindex $commitinfo($oldid) 0]
3252 set newid $rowmenuid
3253 set newhead [lindex $commitinfo($newid) 0]
3254 set top .patch
3255 set patchtop $top
3256 catch {destroy $top}
3257 toplevel $top
3258 label $top.title -text "Generate patch"
3259 grid $top.title - -pady 10
3260 label $top.from -text "From:"
3261 entry $top.fromsha1 -width 40 -relief flat
3262 $top.fromsha1 insert 0 $oldid
3263 $top.fromsha1 conf -state readonly
3264 grid $top.from $top.fromsha1 -sticky w
3265 entry $top.fromhead -width 60 -relief flat
3266 $top.fromhead insert 0 $oldhead
3267 $top.fromhead conf -state readonly
3268 grid x $top.fromhead -sticky w
3269 label $top.to -text "To:"
3270 entry $top.tosha1 -width 40 -relief flat
3271 $top.tosha1 insert 0 $newid
3272 $top.tosha1 conf -state readonly
3273 grid $top.to $top.tosha1 -sticky w
3274 entry $top.tohead -width 60 -relief flat
3275 $top.tohead insert 0 $newhead
3276 $top.tohead conf -state readonly
3277 grid x $top.tohead -sticky w
3278 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3279 grid $top.rev x -pady 10
3280 label $top.flab -text "Output file:"
3281 entry $top.fname -width 60
3282 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3283 incr patchnum
3284 grid $top.flab $top.fname -sticky w
3285 frame $top.buts
3286 button $top.buts.gen -text "Generate" -command mkpatchgo
3287 button $top.buts.can -text "Cancel" -command mkpatchcan
3288 grid $top.buts.gen $top.buts.can
3289 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3290 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3291 grid $top.buts - -pady 10 -sticky ew
3292 focus $top.fname
3295 proc mkpatchrev {} {
3296 global patchtop
3298 set oldid [$patchtop.fromsha1 get]
3299 set oldhead [$patchtop.fromhead get]
3300 set newid [$patchtop.tosha1 get]
3301 set newhead [$patchtop.tohead get]
3302 foreach e [list fromsha1 fromhead tosha1 tohead] \
3303 v [list $newid $newhead $oldid $oldhead] {
3304 $patchtop.$e conf -state normal
3305 $patchtop.$e delete 0 end
3306 $patchtop.$e insert 0 $v
3307 $patchtop.$e conf -state readonly
3311 proc mkpatchgo {} {
3312 global patchtop
3314 set oldid [$patchtop.fromsha1 get]
3315 set newid [$patchtop.tosha1 get]
3316 set fname [$patchtop.fname get]
3317 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3318 error_popup "Error creating patch: $err"
3320 catch {destroy $patchtop}
3321 unset patchtop
3324 proc mkpatchcan {} {
3325 global patchtop
3327 catch {destroy $patchtop}
3328 unset patchtop
3331 proc mktag {} {
3332 global rowmenuid mktagtop commitinfo
3334 set top .maketag
3335 set mktagtop $top
3336 catch {destroy $top}
3337 toplevel $top
3338 label $top.title -text "Create tag"
3339 grid $top.title - -pady 10
3340 label $top.id -text "ID:"
3341 entry $top.sha1 -width 40 -relief flat
3342 $top.sha1 insert 0 $rowmenuid
3343 $top.sha1 conf -state readonly
3344 grid $top.id $top.sha1 -sticky w
3345 entry $top.head -width 60 -relief flat
3346 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3347 $top.head conf -state readonly
3348 grid x $top.head -sticky w
3349 label $top.tlab -text "Tag name:"
3350 entry $top.tag -width 60
3351 grid $top.tlab $top.tag -sticky w
3352 frame $top.buts
3353 button $top.buts.gen -text "Create" -command mktaggo
3354 button $top.buts.can -text "Cancel" -command mktagcan
3355 grid $top.buts.gen $top.buts.can
3356 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3357 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3358 grid $top.buts - -pady 10 -sticky ew
3359 focus $top.tag
3362 proc domktag {} {
3363 global mktagtop env tagids idtags
3365 set id [$mktagtop.sha1 get]
3366 set tag [$mktagtop.tag get]
3367 if {$tag == {}} {
3368 error_popup "No tag name specified"
3369 return
3371 if {[info exists tagids($tag)]} {
3372 error_popup "Tag \"$tag\" already exists"
3373 return
3375 if {[catch {
3376 set dir [gitdir]
3377 set fname [file join $dir "refs/tags" $tag]
3378 set f [open $fname w]
3379 puts $f $id
3380 close $f
3381 } err]} {
3382 error_popup "Error creating tag: $err"
3383 return
3386 set tagids($tag) $id
3387 lappend idtags($id) $tag
3388 redrawtags $id
3391 proc redrawtags {id} {
3392 global canv linehtag commitrow idpos selectedline
3394 if {![info exists commitrow($id)]} return
3395 drawcmitrow $commitrow($id)
3396 $canv delete tag.$id
3397 set xt [eval drawtags $id $idpos($id)]
3398 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3399 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3400 selectline $selectedline 0
3404 proc mktagcan {} {
3405 global mktagtop
3407 catch {destroy $mktagtop}
3408 unset mktagtop
3411 proc mktaggo {} {
3412 domktag
3413 mktagcan
3416 proc writecommit {} {
3417 global rowmenuid wrcomtop commitinfo wrcomcmd
3419 set top .writecommit
3420 set wrcomtop $top
3421 catch {destroy $top}
3422 toplevel $top
3423 label $top.title -text "Write commit to file"
3424 grid $top.title - -pady 10
3425 label $top.id -text "ID:"
3426 entry $top.sha1 -width 40 -relief flat
3427 $top.sha1 insert 0 $rowmenuid
3428 $top.sha1 conf -state readonly
3429 grid $top.id $top.sha1 -sticky w
3430 entry $top.head -width 60 -relief flat
3431 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3432 $top.head conf -state readonly
3433 grid x $top.head -sticky w
3434 label $top.clab -text "Command:"
3435 entry $top.cmd -width 60 -textvariable wrcomcmd
3436 grid $top.clab $top.cmd -sticky w -pady 10
3437 label $top.flab -text "Output file:"
3438 entry $top.fname -width 60
3439 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3440 grid $top.flab $top.fname -sticky w
3441 frame $top.buts
3442 button $top.buts.gen -text "Write" -command wrcomgo
3443 button $top.buts.can -text "Cancel" -command wrcomcan
3444 grid $top.buts.gen $top.buts.can
3445 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3446 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3447 grid $top.buts - -pady 10 -sticky ew
3448 focus $top.fname
3451 proc wrcomgo {} {
3452 global wrcomtop
3454 set id [$wrcomtop.sha1 get]
3455 set cmd "echo $id | [$wrcomtop.cmd get]"
3456 set fname [$wrcomtop.fname get]
3457 if {[catch {exec sh -c $cmd >$fname &} err]} {
3458 error_popup "Error writing commit: $err"
3460 catch {destroy $wrcomtop}
3461 unset wrcomtop
3464 proc wrcomcan {} {
3465 global wrcomtop
3467 catch {destroy $wrcomtop}
3468 unset wrcomtop
3471 proc listrefs {id} {
3472 global idtags idheads idotherrefs
3474 set x {}
3475 if {[info exists idtags($id)]} {
3476 set x $idtags($id)
3478 set y {}
3479 if {[info exists idheads($id)]} {
3480 set y $idheads($id)
3482 set z {}
3483 if {[info exists idotherrefs($id)]} {
3484 set z $idotherrefs($id)
3486 return [list $x $y $z]
3489 proc rereadrefs {} {
3490 global idtags idheads idotherrefs
3492 set refids [concat [array names idtags] \
3493 [array names idheads] [array names idotherrefs]]
3494 foreach id $refids {
3495 if {![info exists ref($id)]} {
3496 set ref($id) [listrefs $id]
3499 readrefs
3500 set refids [lsort -unique [concat $refids [array names idtags] \
3501 [array names idheads] [array names idotherrefs]]]
3502 foreach id $refids {
3503 set v [listrefs $id]
3504 if {![info exists ref($id)] || $ref($id) != $v} {
3505 redrawtags $id
3510 proc showtag {tag isnew} {
3511 global ctext cflist tagcontents tagids linknum
3513 if {$isnew} {
3514 addtohistory [list showtag $tag 0]
3516 $ctext conf -state normal
3517 $ctext delete 0.0 end
3518 set linknum 0
3519 if {[info exists tagcontents($tag)]} {
3520 set text $tagcontents($tag)
3521 } else {
3522 set text "Tag: $tag\nId: $tagids($tag)"
3524 appendwithlinks $text
3525 $ctext conf -state disabled
3526 $cflist delete 0 end
3529 proc doquit {} {
3530 global stopped
3531 set stopped 100
3532 destroy .
3535 proc doprefs {} {
3536 global maxwidth maxgraphpct diffopts findmergefiles
3537 global oldprefs prefstop
3539 set top .gitkprefs
3540 set prefstop $top
3541 if {[winfo exists $top]} {
3542 raise $top
3543 return
3545 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3546 set oldprefs($v) [set $v]
3548 toplevel $top
3549 wm title $top "Gitk preferences"
3550 label $top.ldisp -text "Commit list display options"
3551 grid $top.ldisp - -sticky w -pady 10
3552 label $top.spacer -text " "
3553 label $top.maxwidthl -text "Maximum graph width (lines)" \
3554 -font optionfont
3555 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3556 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3557 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3558 -font optionfont
3559 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3560 grid x $top.maxpctl $top.maxpct -sticky w
3561 checkbutton $top.findm -variable findmergefiles
3562 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3563 -font optionfont
3564 grid $top.findm $top.findml - -sticky w
3565 label $top.ddisp -text "Diff display options"
3566 grid $top.ddisp - -sticky w -pady 10
3567 label $top.diffoptl -text "Options for diff program" \
3568 -font optionfont
3569 entry $top.diffopt -width 20 -textvariable diffopts
3570 grid x $top.diffoptl $top.diffopt -sticky w
3571 frame $top.buts
3572 button $top.buts.ok -text "OK" -command prefsok
3573 button $top.buts.can -text "Cancel" -command prefscan
3574 grid $top.buts.ok $top.buts.can
3575 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3576 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3577 grid $top.buts - - -pady 10 -sticky ew
3580 proc prefscan {} {
3581 global maxwidth maxgraphpct diffopts findmergefiles
3582 global oldprefs prefstop
3584 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3585 set $v $oldprefs($v)
3587 catch {destroy $prefstop}
3588 unset prefstop
3591 proc prefsok {} {
3592 global maxwidth maxgraphpct
3593 global oldprefs prefstop
3595 catch {destroy $prefstop}
3596 unset prefstop
3597 if {$maxwidth != $oldprefs(maxwidth)
3598 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3599 redisplay
3603 proc formatdate {d} {
3604 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3607 # This list of encoding names and aliases is distilled from
3608 # http://www.iana.org/assignments/character-sets.
3609 # Not all of them are supported by Tcl.
3610 set encoding_aliases {
3611 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3612 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3613 { ISO-10646-UTF-1 csISO10646UTF1 }
3614 { ISO_646.basic:1983 ref csISO646basic1983 }
3615 { INVARIANT csINVARIANT }
3616 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3617 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3618 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3619 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3620 { NATS-DANO iso-ir-9-1 csNATSDANO }
3621 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3622 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3623 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3624 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3625 { ISO-2022-KR csISO2022KR }
3626 { EUC-KR csEUCKR }
3627 { ISO-2022-JP csISO2022JP }
3628 { ISO-2022-JP-2 csISO2022JP2 }
3629 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3630 csISO13JISC6220jp }
3631 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3632 { IT iso-ir-15 ISO646-IT csISO15Italian }
3633 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3634 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3635 { greek7-old iso-ir-18 csISO18Greek7Old }
3636 { latin-greek iso-ir-19 csISO19LatinGreek }
3637 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3638 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3639 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3640 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3641 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3642 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3643 { INIS iso-ir-49 csISO49INIS }
3644 { INIS-8 iso-ir-50 csISO50INIS8 }
3645 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3646 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3647 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3648 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3649 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3650 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3651 csISO60Norwegian1 }
3652 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3653 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3654 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3655 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3656 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3657 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3658 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3659 { greek7 iso-ir-88 csISO88Greek7 }
3660 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3661 { iso-ir-90 csISO90 }
3662 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3663 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3664 csISO92JISC62991984b }
3665 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3666 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3667 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3668 csISO95JIS62291984handadd }
3669 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3670 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3671 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3672 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3673 CP819 csISOLatin1 }
3674 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3675 { T.61-7bit iso-ir-102 csISO102T617bit }
3676 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3677 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3678 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3679 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3680 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3681 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3682 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3683 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3684 arabic csISOLatinArabic }
3685 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3686 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3687 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3688 greek greek8 csISOLatinGreek }
3689 { T.101-G2 iso-ir-128 csISO128T101G2 }
3690 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3691 csISOLatinHebrew }
3692 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3693 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3694 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3695 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3696 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3697 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3698 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3699 csISOLatinCyrillic }
3700 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3701 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3702 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3703 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3704 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3705 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3706 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3707 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3708 { ISO_10367-box iso-ir-155 csISO10367Box }
3709 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3710 { latin-lap lap iso-ir-158 csISO158Lap }
3711 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3712 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3713 { us-dk csUSDK }
3714 { dk-us csDKUS }
3715 { JIS_X0201 X0201 csHalfWidthKatakana }
3716 { KSC5636 ISO646-KR csKSC5636 }
3717 { ISO-10646-UCS-2 csUnicode }
3718 { ISO-10646-UCS-4 csUCS4 }
3719 { DEC-MCS dec csDECMCS }
3720 { hp-roman8 roman8 r8 csHPRoman8 }
3721 { macintosh mac csMacintosh }
3722 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3723 csIBM037 }
3724 { IBM038 EBCDIC-INT cp038 csIBM038 }
3725 { IBM273 CP273 csIBM273 }
3726 { IBM274 EBCDIC-BE CP274 csIBM274 }
3727 { IBM275 EBCDIC-BR cp275 csIBM275 }
3728 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3729 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3730 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3731 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3732 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3733 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3734 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3735 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3736 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3737 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3738 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3739 { IBM437 cp437 437 csPC8CodePage437 }
3740 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3741 { IBM775 cp775 csPC775Baltic }
3742 { IBM850 cp850 850 csPC850Multilingual }
3743 { IBM851 cp851 851 csIBM851 }
3744 { IBM852 cp852 852 csPCp852 }
3745 { IBM855 cp855 855 csIBM855 }
3746 { IBM857 cp857 857 csIBM857 }
3747 { IBM860 cp860 860 csIBM860 }
3748 { IBM861 cp861 861 cp-is csIBM861 }
3749 { IBM862 cp862 862 csPC862LatinHebrew }
3750 { IBM863 cp863 863 csIBM863 }
3751 { IBM864 cp864 csIBM864 }
3752 { IBM865 cp865 865 csIBM865 }
3753 { IBM866 cp866 866 csIBM866 }
3754 { IBM868 CP868 cp-ar csIBM868 }
3755 { IBM869 cp869 869 cp-gr csIBM869 }
3756 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3757 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3758 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3759 { IBM891 cp891 csIBM891 }
3760 { IBM903 cp903 csIBM903 }
3761 { IBM904 cp904 904 csIBBM904 }
3762 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3763 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3764 { IBM1026 CP1026 csIBM1026 }
3765 { EBCDIC-AT-DE csIBMEBCDICATDE }
3766 { EBCDIC-AT-DE-A csEBCDICATDEA }
3767 { EBCDIC-CA-FR csEBCDICCAFR }
3768 { EBCDIC-DK-NO csEBCDICDKNO }
3769 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3770 { EBCDIC-FI-SE csEBCDICFISE }
3771 { EBCDIC-FI-SE-A csEBCDICFISEA }
3772 { EBCDIC-FR csEBCDICFR }
3773 { EBCDIC-IT csEBCDICIT }
3774 { EBCDIC-PT csEBCDICPT }
3775 { EBCDIC-ES csEBCDICES }
3776 { EBCDIC-ES-A csEBCDICESA }
3777 { EBCDIC-ES-S csEBCDICESS }
3778 { EBCDIC-UK csEBCDICUK }
3779 { EBCDIC-US csEBCDICUS }
3780 { UNKNOWN-8BIT csUnknown8BiT }
3781 { MNEMONIC csMnemonic }
3782 { MNEM csMnem }
3783 { VISCII csVISCII }
3784 { VIQR csVIQR }
3785 { KOI8-R csKOI8R }
3786 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3787 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3788 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3789 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3790 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3791 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3792 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3793 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3794 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3795 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3796 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3797 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3798 { IBM1047 IBM-1047 }
3799 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3800 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3801 { UNICODE-1-1 csUnicode11 }
3802 { CESU-8 csCESU-8 }
3803 { BOCU-1 csBOCU-1 }
3804 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3805 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3806 l8 }
3807 { ISO-8859-15 ISO_8859-15 Latin-9 }
3808 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3809 { GBK CP936 MS936 windows-936 }
3810 { JIS_Encoding csJISEncoding }
3811 { Shift_JIS MS_Kanji csShiftJIS }
3812 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3813 EUC-JP }
3814 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3815 { ISO-10646-UCS-Basic csUnicodeASCII }
3816 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3817 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3818 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3819 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3820 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3821 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3822 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3823 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3824 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3825 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3826 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3827 { Ventura-US csVenturaUS }
3828 { Ventura-International csVenturaInternational }
3829 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3830 { PC8-Turkish csPC8Turkish }
3831 { IBM-Symbols csIBMSymbols }
3832 { IBM-Thai csIBMThai }
3833 { HP-Legal csHPLegal }
3834 { HP-Pi-font csHPPiFont }
3835 { HP-Math8 csHPMath8 }
3836 { Adobe-Symbol-Encoding csHPPSMath }
3837 { HP-DeskTop csHPDesktop }
3838 { Ventura-Math csVenturaMath }
3839 { Microsoft-Publishing csMicrosoftPublishing }
3840 { Windows-31J csWindows31J }
3841 { GB2312 csGB2312 }
3842 { Big5 csBig5 }
3845 proc tcl_encoding {enc} {
3846 global encoding_aliases
3847 set names [encoding names]
3848 set lcnames [string tolower $names]
3849 set enc [string tolower $enc]
3850 set i [lsearch -exact $lcnames $enc]
3851 if {$i < 0} {
3852 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3853 if {[regsub {^iso[-_]} $enc iso encx]} {
3854 set i [lsearch -exact $lcnames $encx]
3857 if {$i < 0} {
3858 foreach l $encoding_aliases {
3859 set ll [string tolower $l]
3860 if {[lsearch -exact $ll $enc] < 0} continue
3861 # look through the aliases for one that tcl knows about
3862 foreach e $ll {
3863 set i [lsearch -exact $lcnames $e]
3864 if {$i < 0} {
3865 if {[regsub {^iso[-_]} $e iso ex]} {
3866 set i [lsearch -exact $lcnames $ex]
3869 if {$i >= 0} break
3871 break
3874 if {$i >= 0} {
3875 return [lindex $names $i]
3877 return {}
3880 # defaults...
3881 set datemode 0
3882 set diffopts "-U 5 -p"
3883 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3885 set gitencoding {}
3886 catch {
3887 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3889 if {$gitencoding == ""} {
3890 set gitencoding "utf-8"
3892 set tclencoding [tcl_encoding $gitencoding]
3893 if {$tclencoding == {}} {
3894 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3897 set mainfont {Helvetica 9}
3898 set textfont {Courier 9}
3899 set uifont {Helvetica 9 bold}
3900 set findmergefiles 0
3901 set maxgraphpct 50
3902 set maxwidth 16
3903 set revlistorder 0
3904 set fastdate 0
3905 set uparrowlen 7
3906 set downarrowlen 7
3907 set mingaplen 30
3909 set colors {green red blue magenta darkgrey brown orange}
3911 catch {source ~/.gitk}
3913 set namefont $mainfont
3915 font create optionfont -family sans-serif -size -12
3917 set revtreeargs {}
3918 foreach arg $argv {
3919 switch -regexp -- $arg {
3920 "^$" { }
3921 "^-d" { set datemode 1 }
3922 default {
3923 lappend revtreeargs $arg
3928 # check that we can find a .git directory somewhere...
3929 set gitdir [gitdir]
3930 if {![file isdirectory $gitdir]} {
3931 error_popup "Cannot find the git directory \"$gitdir\"."
3932 exit 1
3935 set history {}
3936 set historyindex 0
3938 set optim_delay 16
3940 set stopped 0
3941 set stuffsaved 0
3942 set patchnum 0
3943 setcoords
3944 makewindow $revtreeargs
3945 readrefs
3946 getcommits $revtreeargs