gitk: Don't change cursor at end of layout if find in progress
[git/trast.git] / gitk
blob34f55bc1ecb4424cd481d5ab316fe6fc7fc56c6e
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 $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
79 set stuff [read $commfd]
80 if {$stuff == {}} {
81 if {![eof $commfd]} return
82 # set it blocking so we wait for the process to terminate
83 fconfigure $commfd -blocking 1
84 if {![catch {close $commfd} err]} {
85 after idle finishcommits
86 return
88 if {[string range $err 0 4] == "usage"} {
89 set err \
90 "Gitk: error reading commits: bad arguments to git-rev-list.\
91 (Note: arguments to gitk are passed to git-rev-list\
92 to allow selection of commits to be displayed.)"
93 } else {
94 set err "Error reading commits: $err"
96 error_popup $err
97 exit 1
99 set start 0
100 set gotsome 0
101 while 1 {
102 set i [string first "\0" $stuff $start]
103 if {$i < 0} {
104 append leftover [string range $stuff $start end]
105 break
107 if {$start == 0} {
108 set cmit $leftover
109 append cmit [string range $stuff 0 [expr {$i - 1}]]
110 set leftover {}
111 } else {
112 set cmit [string range $stuff $start [expr {$i - 1}]]
114 set start [expr {$i + 1}]
115 set j [string first "\n" $cmit]
116 set ok 0
117 if {$j >= 0} {
118 set ids [string range $cmit 0 [expr {$j - 1}]]
119 set ok 1
120 foreach id $ids {
121 if {[string length $id] != 40} {
122 set ok 0
123 break
127 if {!$ok} {
128 set shortcmit $cmit
129 if {[string length $shortcmit] > 80} {
130 set shortcmit "[string range $shortcmit 0 80]..."
132 error_popup "Can't parse git-rev-list output: {$shortcmit}"
133 exit 1
135 set id [lindex $ids 0]
136 set olds [lrange $ids 1 end]
137 set commitlisted($id) 1
138 updatechildren $id $olds
139 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
140 set commitrow($id) $commitidx
141 incr commitidx
142 lappend displayorder $id
143 set gotsome 1
145 if {$gotsome} {
146 layoutmore
148 if {[clock clicks -milliseconds] >= $nextupdate} {
149 doupdate 1
153 proc doupdate {reading} {
154 global commfd nextupdate numcommits ncmupdate
156 if {$reading} {
157 fileevent $commfd readable {}
159 update
160 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
161 if {$numcommits < 100} {
162 set ncmupdate [expr {$numcommits + 1}]
163 } elseif {$numcommits < 10000} {
164 set ncmupdate [expr {$numcommits + 10}]
165 } else {
166 set ncmupdate [expr {$numcommits + 100}]
168 if {$reading} {
169 fileevent $commfd readable [list getcommitlines $commfd]
173 proc readcommit {id} {
174 if {[catch {set contents [exec git-cat-file commit $id]}]} return
175 updatechildren $id {}
176 parsecommit $id $contents 0
179 proc updatecommits {rargs} {
180 stopfindproc
181 foreach v {children nchildren parents nparents commitlisted
182 colormap selectedline matchinglines treediffs
183 mergefilelist currentid rowtextx commitrow
184 rowidlist rowoffsets idrowranges idrangedrawn iddrawn
185 linesegends crossings cornercrossings} {
186 global $v
187 catch {unset $v}
189 allcanvs delete all
190 readrefs
191 getcommits $rargs
194 proc updatechildren {id olds} {
195 global children nchildren parents nparents
197 if {![info exists nchildren($id)]} {
198 set children($id) {}
199 set nchildren($id) 0
201 set parents($id) $olds
202 set nparents($id) [llength $olds]
203 foreach p $olds {
204 if {![info exists nchildren($p)]} {
205 set children($p) [list $id]
206 set nchildren($p) 1
207 } elseif {[lsearch -exact $children($p) $id] < 0} {
208 lappend children($p) $id
209 incr nchildren($p)
214 proc parsecommit {id contents listed} {
215 global commitinfo cdate
217 set inhdr 1
218 set comment {}
219 set headline {}
220 set auname {}
221 set audate {}
222 set comname {}
223 set comdate {}
224 set hdrend [string first "\n\n" $contents]
225 if {$hdrend < 0} {
226 # should never happen...
227 set hdrend [string length $contents]
229 set header [string range $contents 0 [expr {$hdrend - 1}]]
230 set comment [string range $contents [expr {$hdrend + 2}] end]
231 foreach line [split $header "\n"] {
232 set tag [lindex $line 0]
233 if {$tag == "author"} {
234 set audate [lindex $line end-1]
235 set auname [lrange $line 1 end-2]
236 } elseif {$tag == "committer"} {
237 set comdate [lindex $line end-1]
238 set comname [lrange $line 1 end-2]
241 set headline {}
242 # take the first line of the comment as the headline
243 set i [string first "\n" $comment]
244 if {$i >= 0} {
245 set headline [string trim [string range $comment 0 $i]]
246 } else {
247 set headline $comment
249 if {!$listed} {
250 # git-rev-list indents the comment by 4 spaces;
251 # if we got this via git-cat-file, add the indentation
252 set newcomment {}
253 foreach line [split $comment "\n"] {
254 append newcomment " "
255 append newcomment $line
256 append newcomment "\n"
258 set comment $newcomment
260 if {$comdate != {}} {
261 set cdate($id) $comdate
263 set commitinfo($id) [list $headline $auname $audate \
264 $comname $comdate $comment]
267 proc getcommit {id} {
268 global commitdata commitinfo nparents
270 if {[info exists commitdata($id)]} {
271 parsecommit $id $commitdata($id) 1
272 } else {
273 readcommit $id
274 if {![info exists commitinfo($id)]} {
275 set commitinfo($id) {"No commit information available"}
276 set nparents($id) 0
279 return 1
282 proc readrefs {} {
283 global tagids idtags headids idheads tagcontents
284 global otherrefids idotherrefs
286 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
287 catch {unset $v}
289 set refd [open [list | git-ls-remote [gitdir]] r]
290 while {0 <= [set n [gets $refd line]]} {
291 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
292 match id path]} {
293 continue
295 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
296 set type others
297 set name $path
299 if {$type == "tags"} {
300 set tagids($name) $id
301 lappend idtags($id) $name
302 set obj {}
303 set type {}
304 set tag {}
305 catch {
306 set commit [exec git-rev-parse "$id^0"]
307 if {"$commit" != "$id"} {
308 set tagids($name) $commit
309 lappend idtags($commit) $name
312 catch {
313 set tagcontents($name) [exec git-cat-file tag "$id"]
315 } elseif { $type == "heads" } {
316 set headids($name) $id
317 lappend idheads($id) $name
318 } else {
319 set otherrefids($name) $id
320 lappend idotherrefs($id) $name
323 close $refd
326 proc error_popup msg {
327 set w .error
328 toplevel $w
329 wm transient $w .
330 message $w.m -text $msg -justify center -aspect 400
331 pack $w.m -side top -fill x -padx 20 -pady 20
332 button $w.ok -text OK -command "destroy $w"
333 pack $w.ok -side bottom -fill x
334 bind $w <Visibility> "grab $w; focus $w"
335 bind $w <Key-Return> "destroy $w"
336 tkwait window $w
339 proc makewindow {rargs} {
340 global canv canv2 canv3 linespc charspc ctext cflist textfont
341 global findtype findtypemenu findloc findstring fstring geometry
342 global entries sha1entry sha1string sha1but
343 global maincursor textcursor curtextcursor
344 global rowctxmenu mergemax
346 menu .bar
347 .bar add cascade -label "File" -menu .bar.file
348 menu .bar.file
349 .bar.file add command -label "Update" -command [list updatecommits $rargs]
350 .bar.file add command -label "Reread references" -command rereadrefs
351 .bar.file add command -label "Quit" -command doquit
352 menu .bar.edit
353 .bar add cascade -label "Edit" -menu .bar.edit
354 .bar.edit add command -label "Preferences" -command doprefs
355 menu .bar.help
356 .bar add cascade -label "Help" -menu .bar.help
357 .bar.help add command -label "About gitk" -command about
358 . configure -menu .bar
360 if {![info exists geometry(canv1)]} {
361 set geometry(canv1) [expr {45 * $charspc}]
362 set geometry(canv2) [expr {30 * $charspc}]
363 set geometry(canv3) [expr {15 * $charspc}]
364 set geometry(canvh) [expr {25 * $linespc + 4}]
365 set geometry(ctextw) 80
366 set geometry(ctexth) 30
367 set geometry(cflistw) 30
369 panedwindow .ctop -orient vertical
370 if {[info exists geometry(width)]} {
371 .ctop conf -width $geometry(width) -height $geometry(height)
372 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
373 set geometry(ctexth) [expr {($texth - 8) /
374 [font metrics $textfont -linespace]}]
376 frame .ctop.top
377 frame .ctop.top.bar
378 pack .ctop.top.bar -side bottom -fill x
379 set cscroll .ctop.top.csb
380 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
381 pack $cscroll -side right -fill y
382 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
383 pack .ctop.top.clist -side top -fill both -expand 1
384 .ctop add .ctop.top
385 set canv .ctop.top.clist.canv
386 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
387 -bg white -bd 0 \
388 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
389 .ctop.top.clist add $canv
390 set canv2 .ctop.top.clist.canv2
391 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
392 -bg white -bd 0 -yscrollincr $linespc
393 .ctop.top.clist add $canv2
394 set canv3 .ctop.top.clist.canv3
395 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
396 -bg white -bd 0 -yscrollincr $linespc
397 .ctop.top.clist add $canv3
398 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
400 set sha1entry .ctop.top.bar.sha1
401 set entries $sha1entry
402 set sha1but .ctop.top.bar.sha1label
403 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
404 -command gotocommit -width 8
405 $sha1but conf -disabledforeground [$sha1but cget -foreground]
406 pack .ctop.top.bar.sha1label -side left
407 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
408 trace add variable sha1string write sha1change
409 pack $sha1entry -side left -pady 2
411 image create bitmap bm-left -data {
412 #define left_width 16
413 #define left_height 16
414 static unsigned char left_bits[] = {
415 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
416 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
417 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
419 image create bitmap bm-right -data {
420 #define right_width 16
421 #define right_height 16
422 static unsigned char right_bits[] = {
423 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
424 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
425 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
427 button .ctop.top.bar.leftbut -image bm-left -command goback \
428 -state disabled -width 26
429 pack .ctop.top.bar.leftbut -side left -fill y
430 button .ctop.top.bar.rightbut -image bm-right -command goforw \
431 -state disabled -width 26
432 pack .ctop.top.bar.rightbut -side left -fill y
434 button .ctop.top.bar.findbut -text "Find" -command dofind
435 pack .ctop.top.bar.findbut -side left
436 set findstring {}
437 set fstring .ctop.top.bar.findstring
438 lappend entries $fstring
439 entry $fstring -width 30 -font $textfont -textvariable findstring
440 pack $fstring -side left -expand 1 -fill x
441 set findtype Exact
442 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
443 findtype Exact IgnCase Regexp]
444 set findloc "All fields"
445 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
446 Comments Author Committer Files Pickaxe
447 pack .ctop.top.bar.findloc -side right
448 pack .ctop.top.bar.findtype -side right
449 # for making sure type==Exact whenever loc==Pickaxe
450 trace add variable findloc write findlocchange
452 panedwindow .ctop.cdet -orient horizontal
453 .ctop add .ctop.cdet
454 frame .ctop.cdet.left
455 set ctext .ctop.cdet.left.ctext
456 text $ctext -bg white -state disabled -font $textfont \
457 -width $geometry(ctextw) -height $geometry(ctexth) \
458 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
459 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
460 pack .ctop.cdet.left.sb -side right -fill y
461 pack $ctext -side left -fill both -expand 1
462 .ctop.cdet add .ctop.cdet.left
464 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
465 $ctext tag conf hunksep -fore blue
466 $ctext tag conf d0 -fore red
467 $ctext tag conf d1 -fore "#00a000"
468 $ctext tag conf m0 -fore red
469 $ctext tag conf m1 -fore blue
470 $ctext tag conf m2 -fore green
471 $ctext tag conf m3 -fore purple
472 $ctext tag conf m4 -fore brown
473 $ctext tag conf m5 -fore "#009090"
474 $ctext tag conf m6 -fore magenta
475 $ctext tag conf m7 -fore "#808000"
476 $ctext tag conf m8 -fore "#009000"
477 $ctext tag conf m9 -fore "#ff0080"
478 $ctext tag conf m10 -fore cyan
479 $ctext tag conf m11 -fore "#b07070"
480 $ctext tag conf m12 -fore "#70b0f0"
481 $ctext tag conf m13 -fore "#70f0b0"
482 $ctext tag conf m14 -fore "#f0b070"
483 $ctext tag conf m15 -fore "#ff70b0"
484 $ctext tag conf mmax -fore darkgrey
485 set mergemax 16
486 $ctext tag conf mresult -font [concat $textfont bold]
487 $ctext tag conf msep -font [concat $textfont bold]
488 $ctext tag conf found -back yellow
490 frame .ctop.cdet.right
491 set cflist .ctop.cdet.right.cfiles
492 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
493 -yscrollcommand ".ctop.cdet.right.sb set"
494 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
495 pack .ctop.cdet.right.sb -side right -fill y
496 pack $cflist -side left -fill both -expand 1
497 .ctop.cdet add .ctop.cdet.right
498 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
500 pack .ctop -side top -fill both -expand 1
502 bindall <1> {selcanvline %W %x %y}
503 #bindall <B1-Motion> {selcanvline %W %x %y}
504 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
505 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
506 bindall <2> "allcanvs scan mark 0 %y"
507 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
508 bind . <Key-Up> "selnextline -1"
509 bind . <Key-Down> "selnextline 1"
510 bind . <Key-Right> "goforw"
511 bind . <Key-Left> "goback"
512 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
513 bind . <Key-Next> "allcanvs yview scroll 1 pages"
514 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
515 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
516 bindkey <Key-space> "$ctext yview scroll 1 pages"
517 bindkey p "selnextline -1"
518 bindkey n "selnextline 1"
519 bindkey z "goback"
520 bindkey x "goforw"
521 bindkey i "selnextline -1"
522 bindkey k "selnextline 1"
523 bindkey j "goback"
524 bindkey l "goforw"
525 bindkey b "$ctext yview scroll -1 pages"
526 bindkey d "$ctext yview scroll 18 units"
527 bindkey u "$ctext yview scroll -18 units"
528 bindkey / {findnext 1}
529 bindkey <Key-Return> {findnext 0}
530 bindkey ? findprev
531 bindkey f nextfile
532 bind . <Control-q> doquit
533 bind . <Control-f> dofind
534 bind . <Control-g> {findnext 0}
535 bind . <Control-r> findprev
536 bind . <Control-equal> {incrfont 1}
537 bind . <Control-KP_Add> {incrfont 1}
538 bind . <Control-minus> {incrfont -1}
539 bind . <Control-KP_Subtract> {incrfont -1}
540 bind $cflist <<ListboxSelect>> listboxsel
541 bind . <Destroy> {savestuff %W}
542 bind . <Button-1> "click %W"
543 bind $fstring <Key-Return> dofind
544 bind $sha1entry <Key-Return> gotocommit
545 bind $sha1entry <<PasteSelection>> clearsha1
547 set maincursor [. cget -cursor]
548 set textcursor [$ctext cget -cursor]
549 set curtextcursor $textcursor
551 set rowctxmenu .rowctxmenu
552 menu $rowctxmenu -tearoff 0
553 $rowctxmenu add command -label "Diff this -> selected" \
554 -command {diffvssel 0}
555 $rowctxmenu add command -label "Diff selected -> this" \
556 -command {diffvssel 1}
557 $rowctxmenu add command -label "Make patch" -command mkpatch
558 $rowctxmenu add command -label "Create tag" -command mktag
559 $rowctxmenu add command -label "Write commit to file" -command writecommit
562 proc scrollcanv {cscroll f0 f1} {
563 $cscroll set $f0 $f1
564 drawfrac $f0 $f1
567 # when we make a key binding for the toplevel, make sure
568 # it doesn't get triggered when that key is pressed in the
569 # find string entry widget.
570 proc bindkey {ev script} {
571 global entries
572 bind . $ev $script
573 set escript [bind Entry $ev]
574 if {$escript == {}} {
575 set escript [bind Entry <Key>]
577 foreach e $entries {
578 bind $e $ev "$escript; break"
582 # set the focus back to the toplevel for any click outside
583 # the entry widgets
584 proc click {w} {
585 global entries
586 foreach e $entries {
587 if {$w == $e} return
589 focus .
592 proc savestuff {w} {
593 global canv canv2 canv3 ctext cflist mainfont textfont
594 global stuffsaved findmergefiles maxgraphpct
595 global maxwidth
597 if {$stuffsaved} return
598 if {![winfo viewable .]} return
599 catch {
600 set f [open "~/.gitk-new" w]
601 puts $f [list set mainfont $mainfont]
602 puts $f [list set textfont $textfont]
603 puts $f [list set findmergefiles $findmergefiles]
604 puts $f [list set maxgraphpct $maxgraphpct]
605 puts $f [list set maxwidth $maxwidth]
606 puts $f "set geometry(width) [winfo width .ctop]"
607 puts $f "set geometry(height) [winfo height .ctop]"
608 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
609 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
610 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
611 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
612 set wid [expr {([winfo width $ctext] - 8) \
613 / [font measure $textfont "0"]}]
614 puts $f "set geometry(ctextw) $wid"
615 set wid [expr {([winfo width $cflist] - 11) \
616 / [font measure [$cflist cget -font] "0"]}]
617 puts $f "set geometry(cflistw) $wid"
618 close $f
619 file rename -force "~/.gitk-new" "~/.gitk"
621 set stuffsaved 1
624 proc resizeclistpanes {win w} {
625 global oldwidth
626 if {[info exists oldwidth($win)]} {
627 set s0 [$win sash coord 0]
628 set s1 [$win sash coord 1]
629 if {$w < 60} {
630 set sash0 [expr {int($w/2 - 2)}]
631 set sash1 [expr {int($w*5/6 - 2)}]
632 } else {
633 set factor [expr {1.0 * $w / $oldwidth($win)}]
634 set sash0 [expr {int($factor * [lindex $s0 0])}]
635 set sash1 [expr {int($factor * [lindex $s1 0])}]
636 if {$sash0 < 30} {
637 set sash0 30
639 if {$sash1 < $sash0 + 20} {
640 set sash1 [expr {$sash0 + 20}]
642 if {$sash1 > $w - 10} {
643 set sash1 [expr {$w - 10}]
644 if {$sash0 > $sash1 - 20} {
645 set sash0 [expr {$sash1 - 20}]
649 $win sash place 0 $sash0 [lindex $s0 1]
650 $win sash place 1 $sash1 [lindex $s1 1]
652 set oldwidth($win) $w
655 proc resizecdetpanes {win w} {
656 global oldwidth
657 if {[info exists oldwidth($win)]} {
658 set s0 [$win sash coord 0]
659 if {$w < 60} {
660 set sash0 [expr {int($w*3/4 - 2)}]
661 } else {
662 set factor [expr {1.0 * $w / $oldwidth($win)}]
663 set sash0 [expr {int($factor * [lindex $s0 0])}]
664 if {$sash0 < 45} {
665 set sash0 45
667 if {$sash0 > $w - 15} {
668 set sash0 [expr {$w - 15}]
671 $win sash place 0 $sash0 [lindex $s0 1]
673 set oldwidth($win) $w
676 proc allcanvs args {
677 global canv canv2 canv3
678 eval $canv $args
679 eval $canv2 $args
680 eval $canv3 $args
683 proc bindall {event action} {
684 global canv canv2 canv3
685 bind $canv $event $action
686 bind $canv2 $event $action
687 bind $canv3 $event $action
690 proc about {} {
691 set w .about
692 if {[winfo exists $w]} {
693 raise $w
694 return
696 toplevel $w
697 wm title $w "About gitk"
698 message $w.m -text {
699 Gitk - a commit viewer for git
701 Copyright © 2005-2006 Paul Mackerras
703 Use and redistribute under the terms of the GNU General Public License} \
704 -justify center -aspect 400
705 pack $w.m -side top -fill x -padx 20 -pady 20
706 button $w.ok -text Close -command "destroy $w"
707 pack $w.ok -side bottom
710 proc shortids {ids} {
711 set res {}
712 foreach id $ids {
713 if {[llength $id] > 1} {
714 lappend res [shortids $id]
715 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
716 lappend res [string range $id 0 7]
717 } else {
718 lappend res $id
721 return $res
724 proc incrange {l x o} {
725 set n [llength $l]
726 while {$x < $n} {
727 set e [lindex $l $x]
728 if {$e ne {}} {
729 lset l $x [expr {$e + $o}]
731 incr x
733 return $l
736 proc ntimes {n o} {
737 set ret {}
738 for {} {$n > 0} {incr n -1} {
739 lappend ret $o
741 return $ret
744 proc usedinrange {id l1 l2} {
745 global children commitrow
747 if {[info exists commitrow($id)]} {
748 set r $commitrow($id)
749 if {$l1 <= $r && $r <= $l2} {
750 return [expr {$r - $l1 + 1}]
753 foreach c $children($id) {
754 if {[info exists commitrow($c)]} {
755 set r $commitrow($c)
756 if {$l1 <= $r && $r <= $l2} {
757 return [expr {$r - $l1 + 1}]
761 return 0
764 proc sanity {row {full 0}} {
765 global rowidlist rowoffsets
767 set col -1
768 set ids [lindex $rowidlist $row]
769 foreach id $ids {
770 incr col
771 if {$id eq {}} continue
772 if {$col < [llength $ids] - 1 &&
773 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
774 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
776 set o [lindex $rowoffsets $row $col]
777 set y $row
778 set x $col
779 while {$o ne {}} {
780 incr y -1
781 incr x $o
782 if {[lindex $rowidlist $y $x] != $id} {
783 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
784 puts " id=[shortids $id] check started at row $row"
785 for {set i $row} {$i >= $y} {incr i -1} {
786 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
788 break
790 if {!$full} break
791 set o [lindex $rowoffsets $y $x]
796 proc makeuparrow {oid x y z} {
797 global rowidlist rowoffsets uparrowlen idrowranges
799 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
800 incr y -1
801 incr x $z
802 set off0 [lindex $rowoffsets $y]
803 for {set x0 $x} {1} {incr x0} {
804 if {$x0 >= [llength $off0]} {
805 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
806 break
808 set z [lindex $off0 $x0]
809 if {$z ne {}} {
810 incr x0 $z
811 break
814 set z [expr {$x0 - $x}]
815 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
816 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
818 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
819 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
820 lappend idrowranges($oid) $y
823 proc initlayout {} {
824 global rowidlist rowoffsets displayorder
825 global rowlaidout rowoptim
826 global idinlist rowchk
827 global commitidx numcommits
828 global nextcolor
830 set commitidx 0
831 set numcommits 0
832 set displayorder {}
833 set nextcolor 0
834 set rowidlist {{}}
835 set rowoffsets {{}}
836 catch {unset idinlist}
837 catch {unset rowchk}
838 set rowlaidout 0
839 set rowoptim 0
842 proc visiblerows {} {
843 global canv numcommits linespc
845 set ymax [lindex [$canv cget -scrollregion] 3]
846 if {$ymax eq {} || $ymax == 0} return
847 set f [$canv yview]
848 set y0 [expr {int([lindex $f 0] * $ymax)}]
849 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
850 if {$r0 < 0} {
851 set r0 0
853 set y1 [expr {int([lindex $f 1] * $ymax)}]
854 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
855 if {$r1 >= $numcommits} {
856 set r1 [expr {$numcommits - 1}]
858 return [list $r0 $r1]
861 proc layoutmore {} {
862 global rowlaidout rowoptim commitidx numcommits optim_delay
863 global uparrowlen
865 set row $rowlaidout
866 set rowlaidout [layoutrows $row $commitidx 0]
867 set orow [expr {$rowlaidout - $uparrowlen - 1}]
868 if {$orow > $rowoptim} {
869 checkcrossings $rowoptim $orow
870 optimize_rows $rowoptim 0 $orow
871 set rowoptim $orow
873 set canshow [expr {$rowoptim - $optim_delay}]
874 if {$canshow > $numcommits} {
875 showstuff $canshow
879 proc showstuff {canshow} {
880 global numcommits
881 global canvy0 linespc
882 global linesegends idrowranges idrangedrawn
884 if {$numcommits == 0} {
885 global phase
886 set phase "incrdraw"
887 allcanvs delete all
889 set row $numcommits
890 set numcommits $canshow
891 allcanvs conf -scrollregion \
892 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
893 set rows [visiblerows]
894 set r0 [lindex $rows 0]
895 set r1 [lindex $rows 1]
896 for {set r $row} {$r < $canshow} {incr r} {
897 if {[info exists linesegends($r)]} {
898 foreach id $linesegends($r) {
899 set i -1
900 foreach {s e} $idrowranges($id) {
901 incr i
902 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
903 && ![info exists idrangedrawn($id,$i)]} {
904 drawlineseg $id $i
905 set idrangedrawn($id,$i) 1
911 if {$canshow > $r1} {
912 set canshow $r1
914 while {$row < $canshow} {
915 drawcmitrow $row
916 incr row
920 proc layoutrows {row endrow last} {
921 global rowidlist rowoffsets displayorder
922 global uparrowlen downarrowlen maxwidth mingaplen
923 global nchildren parents nparents
924 global idrowranges linesegends
925 global commitidx
926 global idinlist rowchk
928 set idlist [lindex $rowidlist $row]
929 set offs [lindex $rowoffsets $row]
930 while {$row < $endrow} {
931 set id [lindex $displayorder $row]
932 set oldolds {}
933 set newolds {}
934 foreach p $parents($id) {
935 if {![info exists idinlist($p)]} {
936 lappend newolds $p
937 } elseif {!$idinlist($p)} {
938 lappend oldolds $p
941 set nev [expr {[llength $idlist] + [llength $newolds]
942 + [llength $oldolds] - $maxwidth + 1}]
943 if {$nev > 0} {
944 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
945 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
946 set i [lindex $idlist $x]
947 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
948 set r [usedinrange $i [expr {$row - $downarrowlen}] \
949 [expr {$row + $uparrowlen + $mingaplen}]]
950 if {$r == 0} {
951 set idlist [lreplace $idlist $x $x]
952 set offs [lreplace $offs $x $x]
953 set offs [incrange $offs $x 1]
954 set idinlist($i) 0
955 lappend linesegends($row) $i
956 lappend idrowranges($i) [expr {$row-1}]
957 if {[incr nev -1] <= 0} break
958 continue
960 set rowchk($id) [expr {$row + $r}]
963 lset rowidlist $row $idlist
964 lset rowoffsets $row $offs
966 set col [lsearch -exact $idlist $id]
967 if {$col < 0} {
968 set col [llength $idlist]
969 lappend idlist $id
970 lset rowidlist $row $idlist
971 set z {}
972 if {$nchildren($id) > 0} {
973 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
974 unset idinlist($id)
976 lappend offs $z
977 lset rowoffsets $row $offs
978 if {$z ne {}} {
979 makeuparrow $id $col $row $z
981 } else {
982 unset idinlist($id)
984 if {[info exists idrowranges($id)]} {
985 lappend linesegends($row) $id
986 lappend idrowranges($id) $row
988 incr row
989 set offs [ntimes [llength $idlist] 0]
990 set l [llength $newolds]
991 set idlist [eval lreplace \$idlist $col $col $newolds]
992 set o 0
993 if {$l != 1} {
994 set offs [lrange $offs 0 [expr {$col - 1}]]
995 foreach x $newolds {
996 lappend offs {}
997 incr o -1
999 incr o
1000 set tmp [expr {[llength $idlist] - [llength $offs]}]
1001 if {$tmp > 0} {
1002 set offs [concat $offs [ntimes $tmp $o]]
1004 } else {
1005 lset offs $col {}
1007 foreach i $newolds {
1008 set idinlist($i) 1
1009 set idrowranges($i) $row
1011 incr col $l
1012 foreach oid $oldolds {
1013 set idinlist($oid) 1
1014 set idlist [linsert $idlist $col $oid]
1015 set offs [linsert $offs $col $o]
1016 makeuparrow $oid $col $row $o
1017 incr col
1019 lappend rowidlist $idlist
1020 lappend rowoffsets $offs
1022 return $row
1025 proc addextraid {id row} {
1026 global displayorder commitrow commitinfo nparents
1027 global commitidx
1029 incr commitidx
1030 lappend displayorder $id
1031 set commitrow($id) $row
1032 readcommit $id
1033 if {![info exists commitinfo($id)]} {
1034 set commitinfo($id) {"No commit information available"}
1035 set nparents($id) 0
1039 proc layouttail {} {
1040 global rowidlist rowoffsets idinlist commitidx
1041 global idrowranges linesegends
1043 set row $commitidx
1044 set idlist [lindex $rowidlist $row]
1045 while {$idlist ne {}} {
1046 set col [expr {[llength $idlist] - 1}]
1047 set id [lindex $idlist $col]
1048 addextraid $id $row
1049 unset idinlist($id)
1050 lappend linesegends($row) $id
1051 lappend idrowranges($id) $row
1052 incr row
1053 set offs [ntimes $col 0]
1054 set idlist [lreplace $idlist $col $col]
1055 lappend rowidlist $idlist
1056 lappend rowoffsets $offs
1059 foreach id [array names idinlist] {
1060 addextraid $id $row
1061 lset rowidlist $row [list $id]
1062 lset rowoffsets $row 0
1063 makeuparrow $id 0 $row 0
1064 lappend linesegends($row) $id
1065 lappend idrowranges($id) $row
1066 incr row
1067 lappend rowidlist {}
1068 lappend rowoffsets {}
1072 proc insert_pad {row col npad} {
1073 global rowidlist rowoffsets
1075 set pad [ntimes $npad {}]
1076 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1077 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1078 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1081 proc optimize_rows {row col endrow} {
1082 global rowidlist rowoffsets idrowranges
1084 for {} {$row < $endrow} {incr row} {
1085 set idlist [lindex $rowidlist $row]
1086 set offs [lindex $rowoffsets $row]
1087 set haspad 0
1088 for {} {$col < [llength $offs]} {incr col} {
1089 if {[lindex $idlist $col] eq {}} {
1090 set haspad 1
1091 continue
1093 set z [lindex $offs $col]
1094 if {$z eq {}} continue
1095 set isarrow 0
1096 set x0 [expr {$col + $z}]
1097 set y0 [expr {$row - 1}]
1098 set z0 [lindex $rowoffsets $y0 $x0]
1099 if {$z0 eq {}} {
1100 set id [lindex $idlist $col]
1101 if {[info exists idrowranges($id)] &&
1102 $y0 > [lindex $idrowranges($id) 0]} {
1103 set isarrow 1
1106 if {$z < -1 || ($z < 0 && $isarrow)} {
1107 set npad [expr {-1 - $z + $isarrow}]
1108 set offs [incrange $offs $col $npad]
1109 insert_pad $y0 $x0 $npad
1110 if {$y0 > 0} {
1111 optimize_rows $y0 $x0 $row
1113 set z [lindex $offs $col]
1114 set x0 [expr {$col + $z}]
1115 set z0 [lindex $rowoffsets $y0 $x0]
1116 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1117 set npad [expr {$z - 1 + $isarrow}]
1118 set y1 [expr {$row + 1}]
1119 set offs2 [lindex $rowoffsets $y1]
1120 set x1 -1
1121 foreach z $offs2 {
1122 incr x1
1123 if {$z eq {} || $x1 + $z < $col} continue
1124 if {$x1 + $z > $col} {
1125 incr npad
1127 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1128 break
1130 set pad [ntimes $npad {}]
1131 set idlist [eval linsert \$idlist $col $pad]
1132 set tmp [eval linsert \$offs $col $pad]
1133 incr col $npad
1134 set offs [incrange $tmp $col [expr {-$npad}]]
1135 set z [lindex $offs $col]
1136 set haspad 1
1138 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1139 insert_pad $y0 $x0 1
1140 set offs [incrange $offs $col 1]
1141 optimize_rows $y0 [expr {$x0 + 1}] $row
1144 if {!$haspad} {
1145 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1146 set o [lindex $offs $col]
1147 if {$o eq {} || $o <= 0} break
1149 if {[incr col] < [llength $idlist]} {
1150 set y1 [expr {$row + 1}]
1151 set offs2 [lindex $rowoffsets $y1]
1152 set x1 -1
1153 foreach z $offs2 {
1154 incr x1
1155 if {$z eq {} || $x1 + $z < $col} continue
1156 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1157 break
1159 set idlist [linsert $idlist $col {}]
1160 set tmp [linsert $offs $col {}]
1161 incr col
1162 set offs [incrange $tmp $col -1]
1165 lset rowidlist $row $idlist
1166 lset rowoffsets $row $offs
1167 set col 0
1171 proc xc {row col} {
1172 global canvx0 linespc
1173 return [expr {$canvx0 + $col * $linespc}]
1176 proc yc {row} {
1177 global canvy0 linespc
1178 return [expr {$canvy0 + $row * $linespc}]
1181 proc linewidth {id} {
1182 global thickerline lthickness
1184 set wid $lthickness
1185 if {[info exists thickerline] && $id eq $thickerline} {
1186 set wid [expr {2 * $lthickness}]
1188 return $wid
1191 proc drawlineseg {id i} {
1192 global rowoffsets rowidlist idrowranges
1193 global canv colormap
1195 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1196 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1197 if {$startrow == $row} return
1198 assigncolor $id
1199 set coords {}
1200 set col [lsearch -exact [lindex $rowidlist $row] $id]
1201 if {$col < 0} {
1202 puts "oops: drawline: id $id not on row $row"
1203 return
1205 set lasto {}
1206 set ns 0
1207 while {1} {
1208 set o [lindex $rowoffsets $row $col]
1209 if {$o eq {}} break
1210 if {$o ne $lasto} {
1211 # changing direction
1212 set x [xc $row $col]
1213 set y [yc $row]
1214 lappend coords $x $y
1215 set lasto $o
1217 incr col $o
1218 incr row -1
1220 if {$coords eq {}} return
1221 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1222 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1223 set arrow [lindex {none first last both} $arrow]
1224 set x [xc $row $col]
1225 set y [yc $row]
1226 lappend coords $x $y
1227 set t [$canv create line $coords -width [linewidth $id] \
1228 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1229 $canv lower $t
1230 bindline $t $id
1233 proc drawparentlinks {id row col olds} {
1234 global rowidlist canv colormap
1236 set row2 [expr {$row + 1}]
1237 set x [xc $row $col]
1238 set y [yc $row]
1239 set y2 [yc $row2]
1240 set ids [lindex $rowidlist $row2]
1241 # rmx = right-most X coord used
1242 set rmx 0
1243 foreach p $olds {
1244 set i [lsearch -exact $ids $p]
1245 if {$i < 0} {
1246 puts "oops, parent $p of $id not in list"
1247 continue
1249 assigncolor $p
1250 # should handle duplicated parents here...
1251 set coords [list $x $y]
1252 if {$i < $col - 1} {
1253 lappend coords [xc $row [expr {$i + 1}]] $y
1254 } elseif {$i > $col + 1} {
1255 lappend coords [xc $row [expr {$i - 1}]] $y
1257 set x2 [xc $row2 $i]
1258 if {$x2 > $rmx} {
1259 set rmx $x2
1261 lappend coords $x2 $y2
1262 set t [$canv create line $coords -width [linewidth $p] \
1263 -fill $colormap($p) -tags lines.$p]
1264 $canv lower $t
1265 bindline $t $p
1267 return $rmx
1270 proc drawlines {id} {
1271 global colormap canv
1272 global idrowranges idrangedrawn
1273 global children iddrawn commitrow rowidlist
1275 $canv delete lines.$id
1276 set nr [expr {[llength $idrowranges($id)] / 2}]
1277 for {set i 0} {$i < $nr} {incr i} {
1278 if {[info exists idrangedrawn($id,$i)]} {
1279 drawlineseg $id $i
1282 if {[info exists children($id)]} {
1283 foreach child $children($id) {
1284 if {[info exists iddrawn($child)]} {
1285 set row $commitrow($child)
1286 set col [lsearch -exact [lindex $rowidlist $row] $child]
1287 if {$col >= 0} {
1288 drawparentlinks $child $row $col [list $id]
1295 proc drawcmittext {id row col rmx} {
1296 global linespc canv canv2 canv3 canvy0
1297 global commitlisted commitinfo rowidlist
1298 global rowtextx idpos idtags idheads idotherrefs
1299 global linehtag linentag linedtag
1300 global mainfont namefont
1302 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1303 set x [xc $row $col]
1304 set y [yc $row]
1305 set orad [expr {$linespc / 3}]
1306 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1307 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1308 -fill $ofill -outline black -width 1]
1309 $canv raise $t
1310 $canv bind $t <1> {selcanvline {} %x %y}
1311 set xt [xc $row [llength [lindex $rowidlist $row]]]
1312 if {$xt < $rmx} {
1313 set xt $rmx
1315 set rowtextx($row) $xt
1316 set idpos($id) [list $x $xt $y]
1317 if {[info exists idtags($id)] || [info exists idheads($id)]
1318 || [info exists idotherrefs($id)]} {
1319 set xt [drawtags $id $x $xt $y]
1321 set headline [lindex $commitinfo($id) 0]
1322 set name [lindex $commitinfo($id) 1]
1323 set date [lindex $commitinfo($id) 2]
1324 set date [formatdate $date]
1325 set linehtag($row) [$canv create text $xt $y -anchor w \
1326 -text $headline -font $mainfont ]
1327 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1328 set linentag($row) [$canv2 create text 3 $y -anchor w \
1329 -text $name -font $namefont]
1330 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1331 -text $date -font $mainfont]
1334 proc drawcmitrow {row} {
1335 global displayorder rowidlist
1336 global idrowranges idrangedrawn iddrawn
1337 global commitinfo commitlisted parents numcommits
1339 if {$row >= $numcommits} return
1340 foreach id [lindex $rowidlist $row] {
1341 if {![info exists idrowranges($id)]} continue
1342 set i -1
1343 foreach {s e} $idrowranges($id) {
1344 incr i
1345 if {$row < $s} continue
1346 if {$e eq {}} break
1347 if {$row <= $e} {
1348 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1349 drawlineseg $id $i
1350 set idrangedrawn($id,$i) 1
1352 break
1357 set id [lindex $displayorder $row]
1358 if {[info exists iddrawn($id)]} return
1359 set col [lsearch -exact [lindex $rowidlist $row] $id]
1360 if {$col < 0} {
1361 puts "oops, row $row id $id not in list"
1362 return
1364 if {![info exists commitinfo($id)]} {
1365 getcommit $id
1367 assigncolor $id
1368 if {[info exists commitlisted($id)] && [info exists parents($id)]
1369 && $parents($id) ne {}} {
1370 set rmx [drawparentlinks $id $row $col $parents($id)]
1371 } else {
1372 set rmx 0
1374 drawcmittext $id $row $col $rmx
1375 set iddrawn($id) 1
1378 proc drawfrac {f0 f1} {
1379 global numcommits canv
1380 global linespc
1382 set ymax [lindex [$canv cget -scrollregion] 3]
1383 if {$ymax eq {} || $ymax == 0} return
1384 set y0 [expr {int($f0 * $ymax)}]
1385 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1386 if {$row < 0} {
1387 set row 0
1389 set y1 [expr {int($f1 * $ymax)}]
1390 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1391 if {$endrow >= $numcommits} {
1392 set endrow [expr {$numcommits - 1}]
1394 for {} {$row <= $endrow} {incr row} {
1395 drawcmitrow $row
1399 proc drawvisible {} {
1400 global canv
1401 eval drawfrac [$canv yview]
1404 proc clear_display {} {
1405 global iddrawn idrangedrawn
1407 allcanvs delete all
1408 catch {unset iddrawn}
1409 catch {unset idrangedrawn}
1412 proc assigncolor {id} {
1413 global colormap colors nextcolor
1414 global parents nparents children nchildren
1415 global cornercrossings crossings
1417 if {[info exists colormap($id)]} return
1418 set ncolors [llength $colors]
1419 if {$nchildren($id) == 1} {
1420 set child [lindex $children($id) 0]
1421 if {[info exists colormap($child)]
1422 && $nparents($child) == 1} {
1423 set colormap($id) $colormap($child)
1424 return
1427 set badcolors {}
1428 if {[info exists cornercrossings($id)]} {
1429 foreach x $cornercrossings($id) {
1430 if {[info exists colormap($x)]
1431 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1432 lappend badcolors $colormap($x)
1435 if {[llength $badcolors] >= $ncolors} {
1436 set badcolors {}
1439 set origbad $badcolors
1440 if {[llength $badcolors] < $ncolors - 1} {
1441 if {[info exists crossings($id)]} {
1442 foreach x $crossings($id) {
1443 if {[info exists colormap($x)]
1444 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1445 lappend badcolors $colormap($x)
1448 if {[llength $badcolors] >= $ncolors} {
1449 set badcolors $origbad
1452 set origbad $badcolors
1454 if {[llength $badcolors] < $ncolors - 1} {
1455 foreach child $children($id) {
1456 if {[info exists colormap($child)]
1457 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1458 lappend badcolors $colormap($child)
1460 if {[info exists parents($child)]} {
1461 foreach p $parents($child) {
1462 if {[info exists colormap($p)]
1463 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1464 lappend badcolors $colormap($p)
1469 if {[llength $badcolors] >= $ncolors} {
1470 set badcolors $origbad
1473 for {set i 0} {$i <= $ncolors} {incr i} {
1474 set c [lindex $colors $nextcolor]
1475 if {[incr nextcolor] >= $ncolors} {
1476 set nextcolor 0
1478 if {[lsearch -exact $badcolors $c]} break
1480 set colormap($id) $c
1483 proc bindline {t id} {
1484 global canv
1486 $canv bind $t <Enter> "lineenter %x %y $id"
1487 $canv bind $t <Motion> "linemotion %x %y $id"
1488 $canv bind $t <Leave> "lineleave $id"
1489 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1492 proc drawtags {id x xt y1} {
1493 global idtags idheads idotherrefs
1494 global linespc lthickness
1495 global canv mainfont commitrow rowtextx
1497 set marks {}
1498 set ntags 0
1499 set nheads 0
1500 if {[info exists idtags($id)]} {
1501 set marks $idtags($id)
1502 set ntags [llength $marks]
1504 if {[info exists idheads($id)]} {
1505 set marks [concat $marks $idheads($id)]
1506 set nheads [llength $idheads($id)]
1508 if {[info exists idotherrefs($id)]} {
1509 set marks [concat $marks $idotherrefs($id)]
1511 if {$marks eq {}} {
1512 return $xt
1515 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1516 set yt [expr {$y1 - 0.5 * $linespc}]
1517 set yb [expr {$yt + $linespc - 1}]
1518 set xvals {}
1519 set wvals {}
1520 foreach tag $marks {
1521 set wid [font measure $mainfont $tag]
1522 lappend xvals $xt
1523 lappend wvals $wid
1524 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1526 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1527 -width $lthickness -fill black -tags tag.$id]
1528 $canv lower $t
1529 foreach tag $marks x $xvals wid $wvals {
1530 set xl [expr {$x + $delta}]
1531 set xr [expr {$x + $delta + $wid + $lthickness}]
1532 if {[incr ntags -1] >= 0} {
1533 # draw a tag
1534 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1535 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1536 -width 1 -outline black -fill yellow -tags tag.$id]
1537 $canv bind $t <1> [list showtag $tag 1]
1538 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1539 } else {
1540 # draw a head or other ref
1541 if {[incr nheads -1] >= 0} {
1542 set col green
1543 } else {
1544 set col "#ddddff"
1546 set xl [expr {$xl - $delta/2}]
1547 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1548 -width 1 -outline black -fill $col -tags tag.$id
1550 set t [$canv create text $xl $y1 -anchor w -text $tag \
1551 -font $mainfont -tags tag.$id]
1552 if {$ntags >= 0} {
1553 $canv bind $t <1> [list showtag $tag 1]
1556 return $xt
1559 proc checkcrossings {row endrow} {
1560 global displayorder parents rowidlist
1562 for {} {$row < $endrow} {incr row} {
1563 set id [lindex $displayorder $row]
1564 set i [lsearch -exact [lindex $rowidlist $row] $id]
1565 if {$i < 0} continue
1566 set idlist [lindex $rowidlist [expr {$row+1}]]
1567 foreach p $parents($id) {
1568 set j [lsearch -exact $idlist $p]
1569 if {$j > 0} {
1570 if {$j < $i - 1} {
1571 notecrossings $row $p $j $i [expr {$j+1}]
1572 } elseif {$j > $i + 1} {
1573 notecrossings $row $p $i $j [expr {$j-1}]
1580 proc notecrossings {row id lo hi corner} {
1581 global rowidlist crossings cornercrossings
1583 for {set i $lo} {[incr i] < $hi} {} {
1584 set p [lindex [lindex $rowidlist $row] $i]
1585 if {$p == {}} continue
1586 if {$i == $corner} {
1587 if {![info exists cornercrossings($id)]
1588 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1589 lappend cornercrossings($id) $p
1591 if {![info exists cornercrossings($p)]
1592 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1593 lappend cornercrossings($p) $id
1595 } else {
1596 if {![info exists crossings($id)]
1597 || [lsearch -exact $crossings($id) $p] < 0} {
1598 lappend crossings($id) $p
1600 if {![info exists crossings($p)]
1601 || [lsearch -exact $crossings($p) $id] < 0} {
1602 lappend crossings($p) $id
1608 proc xcoord {i level ln} {
1609 global canvx0 xspc1 xspc2
1611 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1612 if {$i > 0 && $i == $level} {
1613 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1614 } elseif {$i > $level} {
1615 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1617 return $x
1620 proc finishcommits {} {
1621 global commitidx phase
1622 global canv mainfont ctext maincursor textcursor
1623 global findinprogress
1625 if {$commitidx > 0} {
1626 drawrest
1627 } else {
1628 $canv delete all
1629 $canv create text 3 3 -anchor nw -text "No commits selected" \
1630 -font $mainfont -tags textitems
1632 if {![info exists findinprogress]} {
1633 . config -cursor $maincursor
1634 settextcursor $textcursor
1636 set phase {}
1639 # Don't change the text pane cursor if it is currently the hand cursor,
1640 # showing that we are over a sha1 ID link.
1641 proc settextcursor {c} {
1642 global ctext curtextcursor
1644 if {[$ctext cget -cursor] == $curtextcursor} {
1645 $ctext config -cursor $c
1647 set curtextcursor $c
1650 proc drawrest {} {
1651 global numcommits
1652 global startmsecs
1653 global canvy0 numcommits linespc
1654 global rowlaidout commitidx
1656 set row $rowlaidout
1657 layoutrows $rowlaidout $commitidx 1
1658 layouttail
1659 optimize_rows $row 0 $commitidx
1660 showstuff $commitidx
1662 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1663 puts "overall $drawmsecs ms for $numcommits commits"
1666 proc findmatches {f} {
1667 global findtype foundstring foundstrlen
1668 if {$findtype == "Regexp"} {
1669 set matches [regexp -indices -all -inline $foundstring $f]
1670 } else {
1671 if {$findtype == "IgnCase"} {
1672 set str [string tolower $f]
1673 } else {
1674 set str $f
1676 set matches {}
1677 set i 0
1678 while {[set j [string first $foundstring $str $i]] >= 0} {
1679 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1680 set i [expr {$j + $foundstrlen}]
1683 return $matches
1686 proc dofind {} {
1687 global findtype findloc findstring markedmatches commitinfo
1688 global numcommits displayorder linehtag linentag linedtag
1689 global mainfont namefont canv canv2 canv3 selectedline
1690 global matchinglines foundstring foundstrlen matchstring
1691 global commitdata
1693 stopfindproc
1694 unmarkmatches
1695 focus .
1696 set matchinglines {}
1697 if {$findloc == "Pickaxe"} {
1698 findpatches
1699 return
1701 if {$findtype == "IgnCase"} {
1702 set foundstring [string tolower $findstring]
1703 } else {
1704 set foundstring $findstring
1706 set foundstrlen [string length $findstring]
1707 if {$foundstrlen == 0} return
1708 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1709 set matchstring "*$matchstring*"
1710 if {$findloc == "Files"} {
1711 findfiles
1712 return
1714 if {![info exists selectedline]} {
1715 set oldsel -1
1716 } else {
1717 set oldsel $selectedline
1719 set didsel 0
1720 set fldtypes {Headline Author Date Committer CDate Comment}
1721 set l -1
1722 foreach id $displayorder {
1723 set d $commitdata($id)
1724 incr l
1725 if {$findtype == "Regexp"} {
1726 set doesmatch [regexp $foundstring $d]
1727 } elseif {$findtype == "IgnCase"} {
1728 set doesmatch [string match -nocase $matchstring $d]
1729 } else {
1730 set doesmatch [string match $matchstring $d]
1732 if {!$doesmatch} continue
1733 if {![info exists commitinfo($id)]} {
1734 getcommit $id
1736 set info $commitinfo($id)
1737 set doesmatch 0
1738 foreach f $info ty $fldtypes {
1739 if {$findloc != "All fields" && $findloc != $ty} {
1740 continue
1742 set matches [findmatches $f]
1743 if {$matches == {}} continue
1744 set doesmatch 1
1745 if {$ty == "Headline"} {
1746 drawcmitrow $l
1747 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1748 } elseif {$ty == "Author"} {
1749 drawcmitrow $l
1750 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1751 } elseif {$ty == "Date"} {
1752 drawcmitrow $l
1753 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1756 if {$doesmatch} {
1757 lappend matchinglines $l
1758 if {!$didsel && $l > $oldsel} {
1759 findselectline $l
1760 set didsel 1
1764 if {$matchinglines == {}} {
1765 bell
1766 } elseif {!$didsel} {
1767 findselectline [lindex $matchinglines 0]
1771 proc findselectline {l} {
1772 global findloc commentend ctext
1773 selectline $l 1
1774 if {$findloc == "All fields" || $findloc == "Comments"} {
1775 # highlight the matches in the comments
1776 set f [$ctext get 1.0 $commentend]
1777 set matches [findmatches $f]
1778 foreach match $matches {
1779 set start [lindex $match 0]
1780 set end [expr {[lindex $match 1] + 1}]
1781 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1786 proc findnext {restart} {
1787 global matchinglines selectedline
1788 if {![info exists matchinglines]} {
1789 if {$restart} {
1790 dofind
1792 return
1794 if {![info exists selectedline]} return
1795 foreach l $matchinglines {
1796 if {$l > $selectedline} {
1797 findselectline $l
1798 return
1801 bell
1804 proc findprev {} {
1805 global matchinglines selectedline
1806 if {![info exists matchinglines]} {
1807 dofind
1808 return
1810 if {![info exists selectedline]} return
1811 set prev {}
1812 foreach l $matchinglines {
1813 if {$l >= $selectedline} break
1814 set prev $l
1816 if {$prev != {}} {
1817 findselectline $prev
1818 } else {
1819 bell
1823 proc findlocchange {name ix op} {
1824 global findloc findtype findtypemenu
1825 if {$findloc == "Pickaxe"} {
1826 set findtype Exact
1827 set state disabled
1828 } else {
1829 set state normal
1831 $findtypemenu entryconf 1 -state $state
1832 $findtypemenu entryconf 2 -state $state
1835 proc stopfindproc {{done 0}} {
1836 global findprocpid findprocfile findids
1837 global ctext findoldcursor phase maincursor textcursor
1838 global findinprogress
1840 catch {unset findids}
1841 if {[info exists findprocpid]} {
1842 if {!$done} {
1843 catch {exec kill $findprocpid}
1845 catch {close $findprocfile}
1846 unset findprocpid
1848 if {[info exists findinprogress]} {
1849 unset findinprogress
1850 if {$phase != "incrdraw"} {
1851 . config -cursor $maincursor
1852 settextcursor $textcursor
1857 proc findpatches {} {
1858 global findstring selectedline numcommits
1859 global findprocpid findprocfile
1860 global finddidsel ctext displayorder findinprogress
1861 global findinsertpos
1863 if {$numcommits == 0} return
1865 # make a list of all the ids to search, starting at the one
1866 # after the selected line (if any)
1867 if {[info exists selectedline]} {
1868 set l $selectedline
1869 } else {
1870 set l -1
1872 set inputids {}
1873 for {set i 0} {$i < $numcommits} {incr i} {
1874 if {[incr l] >= $numcommits} {
1875 set l 0
1877 append inputids [lindex $displayorder $l] "\n"
1880 if {[catch {
1881 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1882 << $inputids] r]
1883 } err]} {
1884 error_popup "Error starting search process: $err"
1885 return
1888 set findinsertpos end
1889 set findprocfile $f
1890 set findprocpid [pid $f]
1891 fconfigure $f -blocking 0
1892 fileevent $f readable readfindproc
1893 set finddidsel 0
1894 . config -cursor watch
1895 settextcursor watch
1896 set findinprogress 1
1899 proc readfindproc {} {
1900 global findprocfile finddidsel
1901 global commitrow matchinglines findinsertpos
1903 set n [gets $findprocfile line]
1904 if {$n < 0} {
1905 if {[eof $findprocfile]} {
1906 stopfindproc 1
1907 if {!$finddidsel} {
1908 bell
1911 return
1913 if {![regexp {^[0-9a-f]{40}} $line id]} {
1914 error_popup "Can't parse git-diff-tree output: $line"
1915 stopfindproc
1916 return
1918 if {![info exists commitrow($id)]} {
1919 puts stderr "spurious id: $id"
1920 return
1922 set l $commitrow($id)
1923 insertmatch $l $id
1926 proc insertmatch {l id} {
1927 global matchinglines findinsertpos finddidsel
1929 if {$findinsertpos == "end"} {
1930 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1931 set matchinglines [linsert $matchinglines 0 $l]
1932 set findinsertpos 1
1933 } else {
1934 lappend matchinglines $l
1936 } else {
1937 set matchinglines [linsert $matchinglines $findinsertpos $l]
1938 incr findinsertpos
1940 markheadline $l $id
1941 if {!$finddidsel} {
1942 findselectline $l
1943 set finddidsel 1
1947 proc findfiles {} {
1948 global selectedline numcommits displayorder ctext
1949 global ffileline finddidsel parents nparents
1950 global findinprogress findstartline findinsertpos
1951 global treediffs fdiffid fdiffsneeded fdiffpos
1952 global findmergefiles
1954 if {$numcommits == 0} return
1956 if {[info exists selectedline]} {
1957 set l [expr {$selectedline + 1}]
1958 } else {
1959 set l 0
1961 set ffileline $l
1962 set findstartline $l
1963 set diffsneeded {}
1964 set fdiffsneeded {}
1965 while 1 {
1966 set id [lindex $displayorder $l]
1967 if {$findmergefiles || $nparents($id) == 1} {
1968 if {![info exists treediffs($id)]} {
1969 append diffsneeded "$id\n"
1970 lappend fdiffsneeded $id
1973 if {[incr l] >= $numcommits} {
1974 set l 0
1976 if {$l == $findstartline} break
1979 # start off a git-diff-tree process if needed
1980 if {$diffsneeded ne {}} {
1981 if {[catch {
1982 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1983 } err ]} {
1984 error_popup "Error starting search process: $err"
1985 return
1987 catch {unset fdiffid}
1988 set fdiffpos 0
1989 fconfigure $df -blocking 0
1990 fileevent $df readable [list readfilediffs $df]
1993 set finddidsel 0
1994 set findinsertpos end
1995 set id [lindex $displayorder $l]
1996 . config -cursor watch
1997 settextcursor watch
1998 set findinprogress 1
1999 findcont $id
2000 update
2003 proc readfilediffs {df} {
2004 global findid fdiffid fdiffs
2006 set n [gets $df line]
2007 if {$n < 0} {
2008 if {[eof $df]} {
2009 donefilediff
2010 if {[catch {close $df} err]} {
2011 stopfindproc
2012 bell
2013 error_popup "Error in git-diff-tree: $err"
2014 } elseif {[info exists findid]} {
2015 set id $findid
2016 stopfindproc
2017 bell
2018 error_popup "Couldn't find diffs for $id"
2021 return
2023 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2024 # start of a new string of diffs
2025 donefilediff
2026 set fdiffid $id
2027 set fdiffs {}
2028 } elseif {[string match ":*" $line]} {
2029 lappend fdiffs [lindex $line 5]
2033 proc donefilediff {} {
2034 global fdiffid fdiffs treediffs findid
2035 global fdiffsneeded fdiffpos
2037 if {[info exists fdiffid]} {
2038 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2039 && $fdiffpos < [llength $fdiffsneeded]} {
2040 # git-diff-tree doesn't output anything for a commit
2041 # which doesn't change anything
2042 set nullid [lindex $fdiffsneeded $fdiffpos]
2043 set treediffs($nullid) {}
2044 if {[info exists findid] && $nullid eq $findid} {
2045 unset findid
2046 findcont $nullid
2048 incr fdiffpos
2050 incr fdiffpos
2052 if {![info exists treediffs($fdiffid)]} {
2053 set treediffs($fdiffid) $fdiffs
2055 if {[info exists findid] && $fdiffid eq $findid} {
2056 unset findid
2057 findcont $fdiffid
2062 proc findcont {id} {
2063 global findid treediffs parents nparents
2064 global ffileline findstartline finddidsel
2065 global displayorder numcommits matchinglines findinprogress
2066 global findmergefiles
2068 set l $ffileline
2069 while 1 {
2070 if {$findmergefiles || $nparents($id) == 1} {
2071 if {![info exists treediffs($id)]} {
2072 set findid $id
2073 set ffileline $l
2074 return
2076 set doesmatch 0
2077 foreach f $treediffs($id) {
2078 set x [findmatches $f]
2079 if {$x != {}} {
2080 set doesmatch 1
2081 break
2084 if {$doesmatch} {
2085 insertmatch $l $id
2088 if {[incr l] >= $numcommits} {
2089 set l 0
2091 if {$l == $findstartline} break
2092 set id [lindex $displayorder $l]
2094 stopfindproc
2095 if {!$finddidsel} {
2096 bell
2100 # mark a commit as matching by putting a yellow background
2101 # behind the headline
2102 proc markheadline {l id} {
2103 global canv mainfont linehtag
2105 drawcmitrow $l
2106 set bbox [$canv bbox $linehtag($l)]
2107 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2108 $canv lower $t
2111 # mark the bits of a headline, author or date that match a find string
2112 proc markmatches {canv l str tag matches font} {
2113 set bbox [$canv bbox $tag]
2114 set x0 [lindex $bbox 0]
2115 set y0 [lindex $bbox 1]
2116 set y1 [lindex $bbox 3]
2117 foreach match $matches {
2118 set start [lindex $match 0]
2119 set end [lindex $match 1]
2120 if {$start > $end} continue
2121 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2122 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2123 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2124 [expr {$x0+$xlen+2}] $y1 \
2125 -outline {} -tags matches -fill yellow]
2126 $canv lower $t
2130 proc unmarkmatches {} {
2131 global matchinglines findids
2132 allcanvs delete matches
2133 catch {unset matchinglines}
2134 catch {unset findids}
2137 proc selcanvline {w x y} {
2138 global canv canvy0 ctext linespc
2139 global rowtextx
2140 set ymax [lindex [$canv cget -scrollregion] 3]
2141 if {$ymax == {}} return
2142 set yfrac [lindex [$canv yview] 0]
2143 set y [expr {$y + $yfrac * $ymax}]
2144 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2145 if {$l < 0} {
2146 set l 0
2148 if {$w eq $canv} {
2149 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2151 unmarkmatches
2152 selectline $l 1
2155 proc commit_descriptor {p} {
2156 global commitinfo
2157 set l "..."
2158 if {[info exists commitinfo($p)]} {
2159 set l [lindex $commitinfo($p) 0]
2161 return "$p ($l)"
2164 # append some text to the ctext widget, and make any SHA1 ID
2165 # that we know about be a clickable link.
2166 proc appendwithlinks {text} {
2167 global ctext commitrow linknum
2169 set start [$ctext index "end - 1c"]
2170 $ctext insert end $text
2171 $ctext insert end "\n"
2172 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2173 foreach l $links {
2174 set s [lindex $l 0]
2175 set e [lindex $l 1]
2176 set linkid [string range $text $s $e]
2177 if {![info exists commitrow($linkid)]} continue
2178 incr e
2179 $ctext tag add link "$start + $s c" "$start + $e c"
2180 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2181 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2182 incr linknum
2184 $ctext tag conf link -foreground blue -underline 1
2185 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2186 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2189 proc selectline {l isnew} {
2190 global canv canv2 canv3 ctext commitinfo selectedline
2191 global displayorder linehtag linentag linedtag
2192 global canvy0 linespc parents nparents children
2193 global cflist currentid sha1entry
2194 global commentend idtags linknum
2195 global mergemax numcommits
2197 $canv delete hover
2198 normalline
2199 if {$l < 0 || $l >= $numcommits} return
2200 set y [expr {$canvy0 + $l * $linespc}]
2201 set ymax [lindex [$canv cget -scrollregion] 3]
2202 set ytop [expr {$y - $linespc - 1}]
2203 set ybot [expr {$y + $linespc + 1}]
2204 set wnow [$canv yview]
2205 set wtop [expr {[lindex $wnow 0] * $ymax}]
2206 set wbot [expr {[lindex $wnow 1] * $ymax}]
2207 set wh [expr {$wbot - $wtop}]
2208 set newtop $wtop
2209 if {$ytop < $wtop} {
2210 if {$ybot < $wtop} {
2211 set newtop [expr {$y - $wh / 2.0}]
2212 } else {
2213 set newtop $ytop
2214 if {$newtop > $wtop - $linespc} {
2215 set newtop [expr {$wtop - $linespc}]
2218 } elseif {$ybot > $wbot} {
2219 if {$ytop > $wbot} {
2220 set newtop [expr {$y - $wh / 2.0}]
2221 } else {
2222 set newtop [expr {$ybot - $wh}]
2223 if {$newtop < $wtop + $linespc} {
2224 set newtop [expr {$wtop + $linespc}]
2228 if {$newtop != $wtop} {
2229 if {$newtop < 0} {
2230 set newtop 0
2232 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2233 drawvisible
2236 if {![info exists linehtag($l)]} return
2237 $canv delete secsel
2238 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2239 -tags secsel -fill [$canv cget -selectbackground]]
2240 $canv lower $t
2241 $canv2 delete secsel
2242 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2243 -tags secsel -fill [$canv2 cget -selectbackground]]
2244 $canv2 lower $t
2245 $canv3 delete secsel
2246 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2247 -tags secsel -fill [$canv3 cget -selectbackground]]
2248 $canv3 lower $t
2250 if {$isnew} {
2251 addtohistory [list selectline $l 0]
2254 set selectedline $l
2256 set id [lindex $displayorder $l]
2257 set currentid $id
2258 $sha1entry delete 0 end
2259 $sha1entry insert 0 $id
2260 $sha1entry selection from 0
2261 $sha1entry selection to end
2263 $ctext conf -state normal
2264 $ctext delete 0.0 end
2265 set linknum 0
2266 $ctext mark set fmark.0 0.0
2267 $ctext mark gravity fmark.0 left
2268 set info $commitinfo($id)
2269 set date [formatdate [lindex $info 2]]
2270 $ctext insert end "Author: [lindex $info 1] $date\n"
2271 set date [formatdate [lindex $info 4]]
2272 $ctext insert end "Committer: [lindex $info 3] $date\n"
2273 if {[info exists idtags($id)]} {
2274 $ctext insert end "Tags:"
2275 foreach tag $idtags($id) {
2276 $ctext insert end " $tag"
2278 $ctext insert end "\n"
2281 set comment {}
2282 if {$nparents($id) > 1} {
2283 set np 0
2284 foreach p $parents($id) {
2285 if {$np >= $mergemax} {
2286 set tag mmax
2287 } else {
2288 set tag m$np
2290 $ctext insert end "Parent: " $tag
2291 appendwithlinks [commit_descriptor $p]
2292 incr np
2294 } else {
2295 if {[info exists parents($id)]} {
2296 foreach p $parents($id) {
2297 append comment "Parent: [commit_descriptor $p]\n"
2302 if {[info exists children($id)]} {
2303 foreach c $children($id) {
2304 append comment "Child: [commit_descriptor $c]\n"
2307 append comment "\n"
2308 append comment [lindex $info 5]
2310 # make anything that looks like a SHA1 ID be a clickable link
2311 appendwithlinks $comment
2313 $ctext tag delete Comments
2314 $ctext tag remove found 1.0 end
2315 $ctext conf -state disabled
2316 set commentend [$ctext index "end - 1c"]
2318 $cflist delete 0 end
2319 $cflist insert end "Comments"
2320 if {$nparents($id) == 1} {
2321 startdiff $id
2322 } elseif {$nparents($id) > 1} {
2323 mergediff $id
2327 proc selnextline {dir} {
2328 global selectedline
2329 if {![info exists selectedline]} return
2330 set l [expr {$selectedline + $dir}]
2331 unmarkmatches
2332 selectline $l 1
2335 proc unselectline {} {
2336 global selectedline
2338 catch {unset selectedline}
2339 allcanvs delete secsel
2342 proc addtohistory {cmd} {
2343 global history historyindex
2345 if {$historyindex > 0
2346 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2347 return
2350 if {$historyindex < [llength $history]} {
2351 set history [lreplace $history $historyindex end $cmd]
2352 } else {
2353 lappend history $cmd
2355 incr historyindex
2356 if {$historyindex > 1} {
2357 .ctop.top.bar.leftbut conf -state normal
2358 } else {
2359 .ctop.top.bar.leftbut conf -state disabled
2361 .ctop.top.bar.rightbut conf -state disabled
2364 proc goback {} {
2365 global history historyindex
2367 if {$historyindex > 1} {
2368 incr historyindex -1
2369 set cmd [lindex $history [expr {$historyindex - 1}]]
2370 eval $cmd
2371 .ctop.top.bar.rightbut conf -state normal
2373 if {$historyindex <= 1} {
2374 .ctop.top.bar.leftbut conf -state disabled
2378 proc goforw {} {
2379 global history historyindex
2381 if {$historyindex < [llength $history]} {
2382 set cmd [lindex $history $historyindex]
2383 incr historyindex
2384 eval $cmd
2385 .ctop.top.bar.leftbut conf -state normal
2387 if {$historyindex >= [llength $history]} {
2388 .ctop.top.bar.rightbut conf -state disabled
2392 proc mergediff {id} {
2393 global parents diffmergeid diffopts mdifffd
2394 global difffilestart
2396 set diffmergeid $id
2397 catch {unset difffilestart}
2398 # this doesn't seem to actually affect anything...
2399 set env(GIT_DIFF_OPTS) $diffopts
2400 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2401 if {[catch {set mdf [open $cmd r]} err]} {
2402 error_popup "Error getting merge diffs: $err"
2403 return
2405 fconfigure $mdf -blocking 0
2406 set mdifffd($id) $mdf
2407 fileevent $mdf readable [list getmergediffline $mdf $id]
2408 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2411 proc getmergediffline {mdf id} {
2412 global diffmergeid ctext cflist nextupdate nparents mergemax
2413 global difffilestart
2415 set n [gets $mdf line]
2416 if {$n < 0} {
2417 if {[eof $mdf]} {
2418 close $mdf
2420 return
2422 if {![info exists diffmergeid] || $id != $diffmergeid} {
2423 return
2425 $ctext conf -state normal
2426 if {[regexp {^diff --cc (.*)} $line match fname]} {
2427 # start of a new file
2428 $ctext insert end "\n"
2429 set here [$ctext index "end - 1c"]
2430 set i [$cflist index end]
2431 $ctext mark set fmark.$i $here
2432 $ctext mark gravity fmark.$i left
2433 set difffilestart([expr {$i-1}]) $here
2434 $cflist insert end $fname
2435 set l [expr {(78 - [string length $fname]) / 2}]
2436 set pad [string range "----------------------------------------" 1 $l]
2437 $ctext insert end "$pad $fname $pad\n" filesep
2438 } elseif {[regexp {^@@} $line]} {
2439 $ctext insert end "$line\n" hunksep
2440 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2441 # do nothing
2442 } else {
2443 # parse the prefix - one ' ', '-' or '+' for each parent
2444 set np $nparents($id)
2445 set spaces {}
2446 set minuses {}
2447 set pluses {}
2448 set isbad 0
2449 for {set j 0} {$j < $np} {incr j} {
2450 set c [string range $line $j $j]
2451 if {$c == " "} {
2452 lappend spaces $j
2453 } elseif {$c == "-"} {
2454 lappend minuses $j
2455 } elseif {$c == "+"} {
2456 lappend pluses $j
2457 } else {
2458 set isbad 1
2459 break
2462 set tags {}
2463 set num {}
2464 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2465 # line doesn't appear in result, parents in $minuses have the line
2466 set num [lindex $minuses 0]
2467 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2468 # line appears in result, parents in $pluses don't have the line
2469 lappend tags mresult
2470 set num [lindex $spaces 0]
2472 if {$num ne {}} {
2473 if {$num >= $mergemax} {
2474 set num "max"
2476 lappend tags m$num
2478 $ctext insert end "$line\n" $tags
2480 $ctext conf -state disabled
2481 if {[clock clicks -milliseconds] >= $nextupdate} {
2482 incr nextupdate 100
2483 fileevent $mdf readable {}
2484 update
2485 fileevent $mdf readable [list getmergediffline $mdf $id]
2489 proc startdiff {ids} {
2490 global treediffs diffids treepending diffmergeid
2492 set diffids $ids
2493 catch {unset diffmergeid}
2494 if {![info exists treediffs($ids)]} {
2495 if {![info exists treepending]} {
2496 gettreediffs $ids
2498 } else {
2499 addtocflist $ids
2503 proc addtocflist {ids} {
2504 global treediffs cflist
2505 foreach f $treediffs($ids) {
2506 $cflist insert end $f
2508 getblobdiffs $ids
2511 proc gettreediffs {ids} {
2512 global treediff parents treepending
2513 set treepending $ids
2514 set treediff {}
2515 if {[catch \
2516 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2517 ]} return
2518 fconfigure $gdtf -blocking 0
2519 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2522 proc gettreediffline {gdtf ids} {
2523 global treediff treediffs treepending diffids diffmergeid
2525 set n [gets $gdtf line]
2526 if {$n < 0} {
2527 if {![eof $gdtf]} return
2528 close $gdtf
2529 set treediffs($ids) $treediff
2530 unset treepending
2531 if {$ids != $diffids} {
2532 gettreediffs $diffids
2533 } else {
2534 if {[info exists diffmergeid]} {
2535 contmergediff $ids
2536 } else {
2537 addtocflist $ids
2540 return
2542 set file [lindex $line 5]
2543 lappend treediff $file
2546 proc getblobdiffs {ids} {
2547 global diffopts blobdifffd diffids env curdifftag curtagstart
2548 global difffilestart nextupdate diffinhdr treediffs
2550 set env(GIT_DIFF_OPTS) $diffopts
2551 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2552 if {[catch {set bdf [open $cmd r]} err]} {
2553 puts "error getting diffs: $err"
2554 return
2556 set diffinhdr 0
2557 fconfigure $bdf -blocking 0
2558 set blobdifffd($ids) $bdf
2559 set curdifftag Comments
2560 set curtagstart 0.0
2561 catch {unset difffilestart}
2562 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2563 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2566 proc getblobdiffline {bdf ids} {
2567 global diffids blobdifffd ctext curdifftag curtagstart
2568 global diffnexthead diffnextnote difffilestart
2569 global nextupdate diffinhdr treediffs
2571 set n [gets $bdf line]
2572 if {$n < 0} {
2573 if {[eof $bdf]} {
2574 close $bdf
2575 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2576 $ctext tag add $curdifftag $curtagstart end
2579 return
2581 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2582 return
2584 $ctext conf -state normal
2585 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2586 # start of a new file
2587 $ctext insert end "\n"
2588 $ctext tag add $curdifftag $curtagstart end
2589 set curtagstart [$ctext index "end - 1c"]
2590 set header $newname
2591 set here [$ctext index "end - 1c"]
2592 set i [lsearch -exact $treediffs($diffids) $fname]
2593 if {$i >= 0} {
2594 set difffilestart($i) $here
2595 incr i
2596 $ctext mark set fmark.$i $here
2597 $ctext mark gravity fmark.$i left
2599 if {$newname != $fname} {
2600 set i [lsearch -exact $treediffs($diffids) $newname]
2601 if {$i >= 0} {
2602 set difffilestart($i) $here
2603 incr i
2604 $ctext mark set fmark.$i $here
2605 $ctext mark gravity fmark.$i left
2608 set curdifftag "f:$fname"
2609 $ctext tag delete $curdifftag
2610 set l [expr {(78 - [string length $header]) / 2}]
2611 set pad [string range "----------------------------------------" 1 $l]
2612 $ctext insert end "$pad $header $pad\n" filesep
2613 set diffinhdr 1
2614 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2615 # do nothing
2616 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2617 set diffinhdr 0
2618 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2619 $line match f1l f1c f2l f2c rest]} {
2620 $ctext insert end "$line\n" hunksep
2621 set diffinhdr 0
2622 } else {
2623 set x [string range $line 0 0]
2624 if {$x == "-" || $x == "+"} {
2625 set tag [expr {$x == "+"}]
2626 $ctext insert end "$line\n" d$tag
2627 } elseif {$x == " "} {
2628 $ctext insert end "$line\n"
2629 } elseif {$diffinhdr || $x == "\\"} {
2630 # e.g. "\ No newline at end of file"
2631 $ctext insert end "$line\n" filesep
2632 } else {
2633 # Something else we don't recognize
2634 if {$curdifftag != "Comments"} {
2635 $ctext insert end "\n"
2636 $ctext tag add $curdifftag $curtagstart end
2637 set curtagstart [$ctext index "end - 1c"]
2638 set curdifftag Comments
2640 $ctext insert end "$line\n" filesep
2643 $ctext conf -state disabled
2644 if {[clock clicks -milliseconds] >= $nextupdate} {
2645 incr nextupdate 100
2646 fileevent $bdf readable {}
2647 update
2648 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2652 proc nextfile {} {
2653 global difffilestart ctext
2654 set here [$ctext index @0,0]
2655 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2656 if {[$ctext compare $difffilestart($i) > $here]} {
2657 if {![info exists pos]
2658 || [$ctext compare $difffilestart($i) < $pos]} {
2659 set pos $difffilestart($i)
2663 if {[info exists pos]} {
2664 $ctext yview $pos
2668 proc listboxsel {} {
2669 global ctext cflist currentid
2670 if {![info exists currentid]} return
2671 set sel [lsort [$cflist curselection]]
2672 if {$sel eq {}} return
2673 set first [lindex $sel 0]
2674 catch {$ctext yview fmark.$first}
2677 proc setcoords {} {
2678 global linespc charspc canvx0 canvy0 mainfont
2679 global xspc1 xspc2 lthickness
2681 set linespc [font metrics $mainfont -linespace]
2682 set charspc [font measure $mainfont "m"]
2683 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2684 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2685 set lthickness [expr {int($linespc / 9) + 1}]
2686 set xspc1(0) $linespc
2687 set xspc2 $linespc
2690 proc redisplay {} {
2691 global canv canvy0 linespc numcommits
2692 global selectedline
2694 set ymax [lindex [$canv cget -scrollregion] 3]
2695 if {$ymax eq {} || $ymax == 0} return
2696 set span [$canv yview]
2697 clear_display
2698 allcanvs conf -scrollregion \
2699 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2700 allcanvs yview moveto [lindex $span 0]
2701 drawvisible
2702 if {[info exists selectedline]} {
2703 selectline $selectedline 0
2707 proc incrfont {inc} {
2708 global mainfont namefont textfont ctext canv phase
2709 global stopped entries
2710 unmarkmatches
2711 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2712 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2713 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2714 setcoords
2715 $ctext conf -font $textfont
2716 $ctext tag conf filesep -font [concat $textfont bold]
2717 foreach e $entries {
2718 $e conf -font $mainfont
2720 if {$phase == "getcommits"} {
2721 $canv itemconf textitems -font $mainfont
2723 redisplay
2726 proc clearsha1 {} {
2727 global sha1entry sha1string
2728 if {[string length $sha1string] == 40} {
2729 $sha1entry delete 0 end
2733 proc sha1change {n1 n2 op} {
2734 global sha1string currentid sha1but
2735 if {$sha1string == {}
2736 || ([info exists currentid] && $sha1string == $currentid)} {
2737 set state disabled
2738 } else {
2739 set state normal
2741 if {[$sha1but cget -state] == $state} return
2742 if {$state == "normal"} {
2743 $sha1but conf -state normal -relief raised -text "Goto: "
2744 } else {
2745 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2749 proc gotocommit {} {
2750 global sha1string currentid commitrow tagids
2751 global displayorder numcommits
2753 if {$sha1string == {}
2754 || ([info exists currentid] && $sha1string == $currentid)} return
2755 if {[info exists tagids($sha1string)]} {
2756 set id $tagids($sha1string)
2757 } else {
2758 set id [string tolower $sha1string]
2759 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2760 set matches {}
2761 foreach i $displayorder {
2762 if {[string match $id* $i]} {
2763 lappend matches $i
2766 if {$matches ne {}} {
2767 if {[llength $matches] > 1} {
2768 error_popup "Short SHA1 id $id is ambiguous"
2769 return
2771 set id [lindex $matches 0]
2775 if {[info exists commitrow($id)]} {
2776 selectline $commitrow($id) 1
2777 return
2779 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2780 set type "SHA1 id"
2781 } else {
2782 set type "Tag"
2784 error_popup "$type $sha1string is not known"
2787 proc lineenter {x y id} {
2788 global hoverx hovery hoverid hovertimer
2789 global commitinfo canv
2791 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2792 set hoverx $x
2793 set hovery $y
2794 set hoverid $id
2795 if {[info exists hovertimer]} {
2796 after cancel $hovertimer
2798 set hovertimer [after 500 linehover]
2799 $canv delete hover
2802 proc linemotion {x y id} {
2803 global hoverx hovery hoverid hovertimer
2805 if {[info exists hoverid] && $id == $hoverid} {
2806 set hoverx $x
2807 set hovery $y
2808 if {[info exists hovertimer]} {
2809 after cancel $hovertimer
2811 set hovertimer [after 500 linehover]
2815 proc lineleave {id} {
2816 global hoverid hovertimer canv
2818 if {[info exists hoverid] && $id == $hoverid} {
2819 $canv delete hover
2820 if {[info exists hovertimer]} {
2821 after cancel $hovertimer
2822 unset hovertimer
2824 unset hoverid
2828 proc linehover {} {
2829 global hoverx hovery hoverid hovertimer
2830 global canv linespc lthickness
2831 global commitinfo mainfont
2833 set text [lindex $commitinfo($hoverid) 0]
2834 set ymax [lindex [$canv cget -scrollregion] 3]
2835 if {$ymax == {}} return
2836 set yfrac [lindex [$canv yview] 0]
2837 set x [expr {$hoverx + 2 * $linespc}]
2838 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2839 set x0 [expr {$x - 2 * $lthickness}]
2840 set y0 [expr {$y - 2 * $lthickness}]
2841 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2842 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2843 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2844 -fill \#ffff80 -outline black -width 1 -tags hover]
2845 $canv raise $t
2846 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2847 $canv raise $t
2850 proc clickisonarrow {id y} {
2851 global lthickness idrowranges
2853 set thresh [expr {2 * $lthickness + 6}]
2854 set n [expr {[llength $idrowranges($id)] - 1}]
2855 for {set i 1} {$i < $n} {incr i} {
2856 set row [lindex $idrowranges($id) $i]
2857 if {abs([yc $row] - $y) < $thresh} {
2858 return $i
2861 return {}
2864 proc arrowjump {id n y} {
2865 global idrowranges canv
2867 # 1 <-> 2, 3 <-> 4, etc...
2868 set n [expr {(($n - 1) ^ 1) + 1}]
2869 set row [lindex $idrowranges($id) $n]
2870 set yt [yc $row]
2871 set ymax [lindex [$canv cget -scrollregion] 3]
2872 if {$ymax eq {} || $ymax <= 0} return
2873 set view [$canv yview]
2874 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2875 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2876 if {$yfrac < 0} {
2877 set yfrac 0
2879 allcanvs yview moveto $yfrac
2882 proc lineclick {x y id isnew} {
2883 global ctext commitinfo children cflist canv thickerline
2885 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2886 unmarkmatches
2887 unselectline
2888 normalline
2889 $canv delete hover
2890 # draw this line thicker than normal
2891 set thickerline $id
2892 drawlines $id
2893 if {$isnew} {
2894 set ymax [lindex [$canv cget -scrollregion] 3]
2895 if {$ymax eq {}} return
2896 set yfrac [lindex [$canv yview] 0]
2897 set y [expr {$y + $yfrac * $ymax}]
2899 set dirn [clickisonarrow $id $y]
2900 if {$dirn ne {}} {
2901 arrowjump $id $dirn $y
2902 return
2905 if {$isnew} {
2906 addtohistory [list lineclick $x $y $id 0]
2908 # fill the details pane with info about this line
2909 $ctext conf -state normal
2910 $ctext delete 0.0 end
2911 $ctext tag conf link -foreground blue -underline 1
2912 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2913 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2914 $ctext insert end "Parent:\t"
2915 $ctext insert end $id [list link link0]
2916 $ctext tag bind link0 <1> [list selbyid $id]
2917 set info $commitinfo($id)
2918 $ctext insert end "\n\t[lindex $info 0]\n"
2919 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2920 set date [formatdate [lindex $info 2]]
2921 $ctext insert end "\tDate:\t$date\n"
2922 if {[info exists children($id)]} {
2923 $ctext insert end "\nChildren:"
2924 set i 0
2925 foreach child $children($id) {
2926 incr i
2927 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
2928 set info $commitinfo($child)
2929 $ctext insert end "\n\t"
2930 $ctext insert end $child [list link link$i]
2931 $ctext tag bind link$i <1> [list selbyid $child]
2932 $ctext insert end "\n\t[lindex $info 0]"
2933 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2934 set date [formatdate [lindex $info 2]]
2935 $ctext insert end "\n\tDate:\t$date\n"
2938 $ctext conf -state disabled
2940 $cflist delete 0 end
2943 proc normalline {} {
2944 global thickerline
2945 if {[info exists thickerline]} {
2946 set id $thickerline
2947 unset thickerline
2948 drawlines $id
2952 proc selbyid {id} {
2953 global commitrow
2954 if {[info exists commitrow($id)]} {
2955 selectline $commitrow($id) 1
2959 proc mstime {} {
2960 global startmstime
2961 if {![info exists startmstime]} {
2962 set startmstime [clock clicks -milliseconds]
2964 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2967 proc rowmenu {x y id} {
2968 global rowctxmenu commitrow selectedline rowmenuid
2970 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2971 set state disabled
2972 } else {
2973 set state normal
2975 $rowctxmenu entryconfigure 0 -state $state
2976 $rowctxmenu entryconfigure 1 -state $state
2977 $rowctxmenu entryconfigure 2 -state $state
2978 set rowmenuid $id
2979 tk_popup $rowctxmenu $x $y
2982 proc diffvssel {dirn} {
2983 global rowmenuid selectedline displayorder
2985 if {![info exists selectedline]} return
2986 if {$dirn} {
2987 set oldid [lindex $displayorder $selectedline]
2988 set newid $rowmenuid
2989 } else {
2990 set oldid $rowmenuid
2991 set newid [lindex $displayorder $selectedline]
2993 addtohistory [list doseldiff $oldid $newid]
2994 doseldiff $oldid $newid
2997 proc doseldiff {oldid newid} {
2998 global ctext cflist
2999 global commitinfo
3001 $ctext conf -state normal
3002 $ctext delete 0.0 end
3003 $ctext mark set fmark.0 0.0
3004 $ctext mark gravity fmark.0 left
3005 $cflist delete 0 end
3006 $cflist insert end "Top"
3007 $ctext insert end "From "
3008 $ctext tag conf link -foreground blue -underline 1
3009 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3010 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3011 $ctext tag bind link0 <1> [list selbyid $oldid]
3012 $ctext insert end $oldid [list link link0]
3013 $ctext insert end "\n "
3014 $ctext insert end [lindex $commitinfo($oldid) 0]
3015 $ctext insert end "\n\nTo "
3016 $ctext tag bind link1 <1> [list selbyid $newid]
3017 $ctext insert end $newid [list link link1]
3018 $ctext insert end "\n "
3019 $ctext insert end [lindex $commitinfo($newid) 0]
3020 $ctext insert end "\n"
3021 $ctext conf -state disabled
3022 $ctext tag delete Comments
3023 $ctext tag remove found 1.0 end
3024 startdiff [list $oldid $newid]
3027 proc mkpatch {} {
3028 global rowmenuid currentid commitinfo patchtop patchnum
3030 if {![info exists currentid]} return
3031 set oldid $currentid
3032 set oldhead [lindex $commitinfo($oldid) 0]
3033 set newid $rowmenuid
3034 set newhead [lindex $commitinfo($newid) 0]
3035 set top .patch
3036 set patchtop $top
3037 catch {destroy $top}
3038 toplevel $top
3039 label $top.title -text "Generate patch"
3040 grid $top.title - -pady 10
3041 label $top.from -text "From:"
3042 entry $top.fromsha1 -width 40 -relief flat
3043 $top.fromsha1 insert 0 $oldid
3044 $top.fromsha1 conf -state readonly
3045 grid $top.from $top.fromsha1 -sticky w
3046 entry $top.fromhead -width 60 -relief flat
3047 $top.fromhead insert 0 $oldhead
3048 $top.fromhead conf -state readonly
3049 grid x $top.fromhead -sticky w
3050 label $top.to -text "To:"
3051 entry $top.tosha1 -width 40 -relief flat
3052 $top.tosha1 insert 0 $newid
3053 $top.tosha1 conf -state readonly
3054 grid $top.to $top.tosha1 -sticky w
3055 entry $top.tohead -width 60 -relief flat
3056 $top.tohead insert 0 $newhead
3057 $top.tohead conf -state readonly
3058 grid x $top.tohead -sticky w
3059 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3060 grid $top.rev x -pady 10
3061 label $top.flab -text "Output file:"
3062 entry $top.fname -width 60
3063 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3064 incr patchnum
3065 grid $top.flab $top.fname -sticky w
3066 frame $top.buts
3067 button $top.buts.gen -text "Generate" -command mkpatchgo
3068 button $top.buts.can -text "Cancel" -command mkpatchcan
3069 grid $top.buts.gen $top.buts.can
3070 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3071 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3072 grid $top.buts - -pady 10 -sticky ew
3073 focus $top.fname
3076 proc mkpatchrev {} {
3077 global patchtop
3079 set oldid [$patchtop.fromsha1 get]
3080 set oldhead [$patchtop.fromhead get]
3081 set newid [$patchtop.tosha1 get]
3082 set newhead [$patchtop.tohead get]
3083 foreach e [list fromsha1 fromhead tosha1 tohead] \
3084 v [list $newid $newhead $oldid $oldhead] {
3085 $patchtop.$e conf -state normal
3086 $patchtop.$e delete 0 end
3087 $patchtop.$e insert 0 $v
3088 $patchtop.$e conf -state readonly
3092 proc mkpatchgo {} {
3093 global patchtop
3095 set oldid [$patchtop.fromsha1 get]
3096 set newid [$patchtop.tosha1 get]
3097 set fname [$patchtop.fname get]
3098 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3099 error_popup "Error creating patch: $err"
3101 catch {destroy $patchtop}
3102 unset patchtop
3105 proc mkpatchcan {} {
3106 global patchtop
3108 catch {destroy $patchtop}
3109 unset patchtop
3112 proc mktag {} {
3113 global rowmenuid mktagtop commitinfo
3115 set top .maketag
3116 set mktagtop $top
3117 catch {destroy $top}
3118 toplevel $top
3119 label $top.title -text "Create tag"
3120 grid $top.title - -pady 10
3121 label $top.id -text "ID:"
3122 entry $top.sha1 -width 40 -relief flat
3123 $top.sha1 insert 0 $rowmenuid
3124 $top.sha1 conf -state readonly
3125 grid $top.id $top.sha1 -sticky w
3126 entry $top.head -width 60 -relief flat
3127 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3128 $top.head conf -state readonly
3129 grid x $top.head -sticky w
3130 label $top.tlab -text "Tag name:"
3131 entry $top.tag -width 60
3132 grid $top.tlab $top.tag -sticky w
3133 frame $top.buts
3134 button $top.buts.gen -text "Create" -command mktaggo
3135 button $top.buts.can -text "Cancel" -command mktagcan
3136 grid $top.buts.gen $top.buts.can
3137 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3138 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3139 grid $top.buts - -pady 10 -sticky ew
3140 focus $top.tag
3143 proc domktag {} {
3144 global mktagtop env tagids idtags
3146 set id [$mktagtop.sha1 get]
3147 set tag [$mktagtop.tag get]
3148 if {$tag == {}} {
3149 error_popup "No tag name specified"
3150 return
3152 if {[info exists tagids($tag)]} {
3153 error_popup "Tag \"$tag\" already exists"
3154 return
3156 if {[catch {
3157 set dir [gitdir]
3158 set fname [file join $dir "refs/tags" $tag]
3159 set f [open $fname w]
3160 puts $f $id
3161 close $f
3162 } err]} {
3163 error_popup "Error creating tag: $err"
3164 return
3167 set tagids($tag) $id
3168 lappend idtags($id) $tag
3169 redrawtags $id
3172 proc redrawtags {id} {
3173 global canv linehtag commitrow idpos selectedline
3175 if {![info exists commitrow($id)]} return
3176 drawcmitrow $commitrow($id)
3177 $canv delete tag.$id
3178 set xt [eval drawtags $id $idpos($id)]
3179 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3180 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3181 selectline $selectedline 0
3185 proc mktagcan {} {
3186 global mktagtop
3188 catch {destroy $mktagtop}
3189 unset mktagtop
3192 proc mktaggo {} {
3193 domktag
3194 mktagcan
3197 proc writecommit {} {
3198 global rowmenuid wrcomtop commitinfo wrcomcmd
3200 set top .writecommit
3201 set wrcomtop $top
3202 catch {destroy $top}
3203 toplevel $top
3204 label $top.title -text "Write commit to file"
3205 grid $top.title - -pady 10
3206 label $top.id -text "ID:"
3207 entry $top.sha1 -width 40 -relief flat
3208 $top.sha1 insert 0 $rowmenuid
3209 $top.sha1 conf -state readonly
3210 grid $top.id $top.sha1 -sticky w
3211 entry $top.head -width 60 -relief flat
3212 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3213 $top.head conf -state readonly
3214 grid x $top.head -sticky w
3215 label $top.clab -text "Command:"
3216 entry $top.cmd -width 60 -textvariable wrcomcmd
3217 grid $top.clab $top.cmd -sticky w -pady 10
3218 label $top.flab -text "Output file:"
3219 entry $top.fname -width 60
3220 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3221 grid $top.flab $top.fname -sticky w
3222 frame $top.buts
3223 button $top.buts.gen -text "Write" -command wrcomgo
3224 button $top.buts.can -text "Cancel" -command wrcomcan
3225 grid $top.buts.gen $top.buts.can
3226 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3227 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3228 grid $top.buts - -pady 10 -sticky ew
3229 focus $top.fname
3232 proc wrcomgo {} {
3233 global wrcomtop
3235 set id [$wrcomtop.sha1 get]
3236 set cmd "echo $id | [$wrcomtop.cmd get]"
3237 set fname [$wrcomtop.fname get]
3238 if {[catch {exec sh -c $cmd >$fname &} err]} {
3239 error_popup "Error writing commit: $err"
3241 catch {destroy $wrcomtop}
3242 unset wrcomtop
3245 proc wrcomcan {} {
3246 global wrcomtop
3248 catch {destroy $wrcomtop}
3249 unset wrcomtop
3252 proc listrefs {id} {
3253 global idtags idheads idotherrefs
3255 set x {}
3256 if {[info exists idtags($id)]} {
3257 set x $idtags($id)
3259 set y {}
3260 if {[info exists idheads($id)]} {
3261 set y $idheads($id)
3263 set z {}
3264 if {[info exists idotherrefs($id)]} {
3265 set z $idotherrefs($id)
3267 return [list $x $y $z]
3270 proc rereadrefs {} {
3271 global idtags idheads idotherrefs
3272 global tagids headids otherrefids
3274 set refids [concat [array names idtags] \
3275 [array names idheads] [array names idotherrefs]]
3276 foreach id $refids {
3277 if {![info exists ref($id)]} {
3278 set ref($id) [listrefs $id]
3281 readrefs
3282 set refids [lsort -unique [concat $refids [array names idtags] \
3283 [array names idheads] [array names idotherrefs]]]
3284 foreach id $refids {
3285 set v [listrefs $id]
3286 if {![info exists ref($id)] || $ref($id) != $v} {
3287 redrawtags $id
3292 proc showtag {tag isnew} {
3293 global ctext cflist tagcontents tagids linknum
3295 if {$isnew} {
3296 addtohistory [list showtag $tag 0]
3298 $ctext conf -state normal
3299 $ctext delete 0.0 end
3300 set linknum 0
3301 if {[info exists tagcontents($tag)]} {
3302 set text $tagcontents($tag)
3303 } else {
3304 set text "Tag: $tag\nId: $tagids($tag)"
3306 appendwithlinks $text
3307 $ctext conf -state disabled
3308 $cflist delete 0 end
3311 proc doquit {} {
3312 global stopped
3313 set stopped 100
3314 destroy .
3317 proc doprefs {} {
3318 global maxwidth maxgraphpct diffopts findmergefiles
3319 global oldprefs prefstop
3321 set top .gitkprefs
3322 set prefstop $top
3323 if {[winfo exists $top]} {
3324 raise $top
3325 return
3327 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3328 set oldprefs($v) [set $v]
3330 toplevel $top
3331 wm title $top "Gitk preferences"
3332 label $top.ldisp -text "Commit list display options"
3333 grid $top.ldisp - -sticky w -pady 10
3334 label $top.spacer -text " "
3335 label $top.maxwidthl -text "Maximum graph width (lines)" \
3336 -font optionfont
3337 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3338 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3339 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3340 -font optionfont
3341 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3342 grid x $top.maxpctl $top.maxpct -sticky w
3343 checkbutton $top.findm -variable findmergefiles
3344 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3345 -font optionfont
3346 grid $top.findm $top.findml - -sticky w
3347 label $top.ddisp -text "Diff display options"
3348 grid $top.ddisp - -sticky w -pady 10
3349 label $top.diffoptl -text "Options for diff program" \
3350 -font optionfont
3351 entry $top.diffopt -width 20 -textvariable diffopts
3352 grid x $top.diffoptl $top.diffopt -sticky w
3353 frame $top.buts
3354 button $top.buts.ok -text "OK" -command prefsok
3355 button $top.buts.can -text "Cancel" -command prefscan
3356 grid $top.buts.ok $top.buts.can
3357 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3358 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3359 grid $top.buts - - -pady 10 -sticky ew
3362 proc prefscan {} {
3363 global maxwidth maxgraphpct diffopts findmergefiles
3364 global oldprefs prefstop
3366 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3367 set $v $oldprefs($v)
3369 catch {destroy $prefstop}
3370 unset prefstop
3373 proc prefsok {} {
3374 global maxwidth maxgraphpct
3375 global oldprefs prefstop
3377 catch {destroy $prefstop}
3378 unset prefstop
3379 if {$maxwidth != $oldprefs(maxwidth)
3380 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3381 redisplay
3385 proc formatdate {d} {
3386 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3389 # This list of encoding names and aliases is distilled from
3390 # http://www.iana.org/assignments/character-sets.
3391 # Not all of them are supported by Tcl.
3392 set encoding_aliases {
3393 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3394 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3395 { ISO-10646-UTF-1 csISO10646UTF1 }
3396 { ISO_646.basic:1983 ref csISO646basic1983 }
3397 { INVARIANT csINVARIANT }
3398 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3399 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3400 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3401 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3402 { NATS-DANO iso-ir-9-1 csNATSDANO }
3403 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3404 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3405 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3406 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3407 { ISO-2022-KR csISO2022KR }
3408 { EUC-KR csEUCKR }
3409 { ISO-2022-JP csISO2022JP }
3410 { ISO-2022-JP-2 csISO2022JP2 }
3411 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3412 csISO13JISC6220jp }
3413 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3414 { IT iso-ir-15 ISO646-IT csISO15Italian }
3415 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3416 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3417 { greek7-old iso-ir-18 csISO18Greek7Old }
3418 { latin-greek iso-ir-19 csISO19LatinGreek }
3419 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3420 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3421 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3422 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3423 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3424 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3425 { INIS iso-ir-49 csISO49INIS }
3426 { INIS-8 iso-ir-50 csISO50INIS8 }
3427 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3428 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3429 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3430 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3431 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3432 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3433 csISO60Norwegian1 }
3434 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3435 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3436 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3437 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3438 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3439 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3440 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3441 { greek7 iso-ir-88 csISO88Greek7 }
3442 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3443 { iso-ir-90 csISO90 }
3444 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3445 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3446 csISO92JISC62991984b }
3447 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3448 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3449 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3450 csISO95JIS62291984handadd }
3451 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3452 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3453 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3454 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3455 CP819 csISOLatin1 }
3456 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3457 { T.61-7bit iso-ir-102 csISO102T617bit }
3458 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3459 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3460 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3461 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3462 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3463 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3464 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3465 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3466 arabic csISOLatinArabic }
3467 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3468 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3469 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3470 greek greek8 csISOLatinGreek }
3471 { T.101-G2 iso-ir-128 csISO128T101G2 }
3472 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3473 csISOLatinHebrew }
3474 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3475 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3476 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3477 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3478 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3479 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3480 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3481 csISOLatinCyrillic }
3482 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3483 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3484 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3485 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3486 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3487 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3488 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3489 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3490 { ISO_10367-box iso-ir-155 csISO10367Box }
3491 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3492 { latin-lap lap iso-ir-158 csISO158Lap }
3493 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3494 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3495 { us-dk csUSDK }
3496 { dk-us csDKUS }
3497 { JIS_X0201 X0201 csHalfWidthKatakana }
3498 { KSC5636 ISO646-KR csKSC5636 }
3499 { ISO-10646-UCS-2 csUnicode }
3500 { ISO-10646-UCS-4 csUCS4 }
3501 { DEC-MCS dec csDECMCS }
3502 { hp-roman8 roman8 r8 csHPRoman8 }
3503 { macintosh mac csMacintosh }
3504 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3505 csIBM037 }
3506 { IBM038 EBCDIC-INT cp038 csIBM038 }
3507 { IBM273 CP273 csIBM273 }
3508 { IBM274 EBCDIC-BE CP274 csIBM274 }
3509 { IBM275 EBCDIC-BR cp275 csIBM275 }
3510 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3511 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3512 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3513 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3514 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3515 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3516 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3517 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3518 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3519 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3520 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3521 { IBM437 cp437 437 csPC8CodePage437 }
3522 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3523 { IBM775 cp775 csPC775Baltic }
3524 { IBM850 cp850 850 csPC850Multilingual }
3525 { IBM851 cp851 851 csIBM851 }
3526 { IBM852 cp852 852 csPCp852 }
3527 { IBM855 cp855 855 csIBM855 }
3528 { IBM857 cp857 857 csIBM857 }
3529 { IBM860 cp860 860 csIBM860 }
3530 { IBM861 cp861 861 cp-is csIBM861 }
3531 { IBM862 cp862 862 csPC862LatinHebrew }
3532 { IBM863 cp863 863 csIBM863 }
3533 { IBM864 cp864 csIBM864 }
3534 { IBM865 cp865 865 csIBM865 }
3535 { IBM866 cp866 866 csIBM866 }
3536 { IBM868 CP868 cp-ar csIBM868 }
3537 { IBM869 cp869 869 cp-gr csIBM869 }
3538 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3539 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3540 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3541 { IBM891 cp891 csIBM891 }
3542 { IBM903 cp903 csIBM903 }
3543 { IBM904 cp904 904 csIBBM904 }
3544 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3545 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3546 { IBM1026 CP1026 csIBM1026 }
3547 { EBCDIC-AT-DE csIBMEBCDICATDE }
3548 { EBCDIC-AT-DE-A csEBCDICATDEA }
3549 { EBCDIC-CA-FR csEBCDICCAFR }
3550 { EBCDIC-DK-NO csEBCDICDKNO }
3551 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3552 { EBCDIC-FI-SE csEBCDICFISE }
3553 { EBCDIC-FI-SE-A csEBCDICFISEA }
3554 { EBCDIC-FR csEBCDICFR }
3555 { EBCDIC-IT csEBCDICIT }
3556 { EBCDIC-PT csEBCDICPT }
3557 { EBCDIC-ES csEBCDICES }
3558 { EBCDIC-ES-A csEBCDICESA }
3559 { EBCDIC-ES-S csEBCDICESS }
3560 { EBCDIC-UK csEBCDICUK }
3561 { EBCDIC-US csEBCDICUS }
3562 { UNKNOWN-8BIT csUnknown8BiT }
3563 { MNEMONIC csMnemonic }
3564 { MNEM csMnem }
3565 { VISCII csVISCII }
3566 { VIQR csVIQR }
3567 { KOI8-R csKOI8R }
3568 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3569 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3570 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3571 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3572 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3573 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3574 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3575 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3576 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3577 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3578 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3579 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3580 { IBM1047 IBM-1047 }
3581 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3582 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3583 { UNICODE-1-1 csUnicode11 }
3584 { CESU-8 csCESU-8 }
3585 { BOCU-1 csBOCU-1 }
3586 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3587 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3588 l8 }
3589 { ISO-8859-15 ISO_8859-15 Latin-9 }
3590 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3591 { GBK CP936 MS936 windows-936 }
3592 { JIS_Encoding csJISEncoding }
3593 { Shift_JIS MS_Kanji csShiftJIS }
3594 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3595 EUC-JP }
3596 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3597 { ISO-10646-UCS-Basic csUnicodeASCII }
3598 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3599 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3600 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3601 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3602 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3603 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3604 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3605 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3606 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3607 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3608 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3609 { Ventura-US csVenturaUS }
3610 { Ventura-International csVenturaInternational }
3611 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3612 { PC8-Turkish csPC8Turkish }
3613 { IBM-Symbols csIBMSymbols }
3614 { IBM-Thai csIBMThai }
3615 { HP-Legal csHPLegal }
3616 { HP-Pi-font csHPPiFont }
3617 { HP-Math8 csHPMath8 }
3618 { Adobe-Symbol-Encoding csHPPSMath }
3619 { HP-DeskTop csHPDesktop }
3620 { Ventura-Math csVenturaMath }
3621 { Microsoft-Publishing csMicrosoftPublishing }
3622 { Windows-31J csWindows31J }
3623 { GB2312 csGB2312 }
3624 { Big5 csBig5 }
3627 proc tcl_encoding {enc} {
3628 global encoding_aliases
3629 set names [encoding names]
3630 set lcnames [string tolower $names]
3631 set enc [string tolower $enc]
3632 set i [lsearch -exact $lcnames $enc]
3633 if {$i < 0} {
3634 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3635 if {[regsub {^iso[-_]} $enc iso encx]} {
3636 set i [lsearch -exact $lcnames $encx]
3639 if {$i < 0} {
3640 foreach l $encoding_aliases {
3641 set ll [string tolower $l]
3642 if {[lsearch -exact $ll $enc] < 0} continue
3643 # look through the aliases for one that tcl knows about
3644 foreach e $ll {
3645 set i [lsearch -exact $lcnames $e]
3646 if {$i < 0} {
3647 if {[regsub {^iso[-_]} $e iso ex]} {
3648 set i [lsearch -exact $lcnames $ex]
3651 if {$i >= 0} break
3653 break
3656 if {$i >= 0} {
3657 return [lindex $names $i]
3659 return {}
3662 # defaults...
3663 set datemode 0
3664 set diffopts "-U 5 -p"
3665 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3667 set gitencoding {}
3668 catch {
3669 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3671 if {$gitencoding == ""} {
3672 set gitencoding "utf-8"
3674 set tclencoding [tcl_encoding $gitencoding]
3675 if {$tclencoding == {}} {
3676 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3679 set mainfont {Helvetica 9}
3680 set textfont {Courier 9}
3681 set findmergefiles 0
3682 set maxgraphpct 50
3683 set maxwidth 16
3684 set revlistorder 0
3685 set fastdate 0
3686 set uparrowlen 7
3687 set downarrowlen 7
3688 set mingaplen 30
3690 set colors {green red blue magenta darkgrey brown orange}
3692 catch {source ~/.gitk}
3694 set namefont $mainfont
3696 font create optionfont -family sans-serif -size -12
3698 set revtreeargs {}
3699 foreach arg $argv {
3700 switch -regexp -- $arg {
3701 "^$" { }
3702 "^-d" { set datemode 1 }
3703 default {
3704 lappend revtreeargs $arg
3709 # check that we can find a .git directory somewhere...
3710 set gitdir [gitdir]
3711 if {![file isdirectory $gitdir]} {
3712 error_popup "Cannot find the git directory \"$gitdir\"."
3713 exit 1
3716 set history {}
3717 set historyindex 0
3719 set optim_delay 16
3721 set stopped 0
3722 set stuffsaved 0
3723 set patchnum 0
3724 setcoords
3725 makewindow $revtreeargs
3726 readrefs
3727 getcommits $revtreeargs