gitk: Make downward-pointing arrows end in vertical line segment
[git/gitweb-caching.git] / gitk
blob69d67ee64a508f6468f1afe9889af3af94fda0a6
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 set rm1 [expr {$row - 1}]
956 lappend linesegends($rm1) $i
957 lappend idrowranges($i) $rm1
958 if {[incr nev -1] <= 0} break
959 continue
961 set rowchk($id) [expr {$row + $r}]
964 lset rowidlist $row $idlist
965 lset rowoffsets $row $offs
967 set col [lsearch -exact $idlist $id]
968 if {$col < 0} {
969 set col [llength $idlist]
970 lappend idlist $id
971 lset rowidlist $row $idlist
972 set z {}
973 if {$nchildren($id) > 0} {
974 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
975 unset idinlist($id)
977 lappend offs $z
978 lset rowoffsets $row $offs
979 if {$z ne {}} {
980 makeuparrow $id $col $row $z
982 } else {
983 unset idinlist($id)
985 if {[info exists idrowranges($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
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 idrowranges($id) $row
1051 incr row
1052 set offs [ntimes $col 0]
1053 set idlist [lreplace $idlist $col $col]
1054 lappend rowidlist $idlist
1055 lappend rowoffsets $offs
1058 foreach id [array names idinlist] {
1059 addextraid $id $row
1060 lset rowidlist $row [list $id]
1061 lset rowoffsets $row 0
1062 makeuparrow $id 0 $row 0
1063 lappend idrowranges($id) $row
1064 incr row
1065 lappend rowidlist {}
1066 lappend rowoffsets {}
1070 proc insert_pad {row col npad} {
1071 global rowidlist rowoffsets
1073 set pad [ntimes $npad {}]
1074 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1075 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1076 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1079 proc optimize_rows {row col endrow} {
1080 global rowidlist rowoffsets idrowranges linesegends displayorder
1082 for {} {$row < $endrow} {incr row} {
1083 set idlist [lindex $rowidlist $row]
1084 set offs [lindex $rowoffsets $row]
1085 set haspad 0
1086 set downarrowcols {}
1087 if {[info exists linesegends($row)]} {
1088 set downarrowcols $linesegends($row)
1089 if {$col > 0} {
1090 while {$downarrowcols ne {}} {
1091 set i [lsearch -exact $idlist [lindex $downarrowcols 0]]
1092 if {$i < 0 || $i >= $col} break
1093 set downarrowcols [lrange $downarrowcols 1 end]
1097 for {} {$col < [llength $offs]} {incr col} {
1098 if {[lindex $idlist $col] eq {}} {
1099 set haspad 1
1100 continue
1102 set z [lindex $offs $col]
1103 if {$z eq {}} continue
1104 set isarrow 0
1105 set x0 [expr {$col + $z}]
1106 set y0 [expr {$row - 1}]
1107 set z0 [lindex $rowoffsets $y0 $x0]
1108 if {$z0 eq {}} {
1109 set id [lindex $idlist $col]
1110 if {[info exists idrowranges($id)] &&
1111 $y0 > [lindex $idrowranges($id) 0]} {
1112 set isarrow 1
1114 } elseif {$downarrowcols ne {} &&
1115 [lindex $idlist $col] eq [lindex $downarrowcols 0]} {
1116 set downarrowcols [lrange $downarrowcols 1 end]
1117 set isarrow 1
1119 if {$z < -1 || ($z < 0 && $isarrow)} {
1120 set npad [expr {-1 - $z + $isarrow}]
1121 set offs [incrange $offs $col $npad]
1122 insert_pad $y0 $x0 $npad
1123 if {$y0 > 0} {
1124 optimize_rows $y0 $x0 $row
1126 set z [lindex $offs $col]
1127 set x0 [expr {$col + $z}]
1128 set z0 [lindex $rowoffsets $y0 $x0]
1129 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1130 set npad [expr {$z - 1 + $isarrow}]
1131 set y1 [expr {$row + 1}]
1132 set offs2 [lindex $rowoffsets $y1]
1133 set x1 -1
1134 foreach z $offs2 {
1135 incr x1
1136 if {$z eq {} || $x1 + $z < $col} continue
1137 if {$x1 + $z > $col} {
1138 incr npad
1140 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1141 break
1143 set pad [ntimes $npad {}]
1144 set idlist [eval linsert \$idlist $col $pad]
1145 set tmp [eval linsert \$offs $col $pad]
1146 incr col $npad
1147 set offs [incrange $tmp $col [expr {-$npad}]]
1148 set z [lindex $offs $col]
1149 set haspad 1
1151 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1152 insert_pad $y0 $x0 1
1153 set offs [incrange $offs $col 1]
1154 optimize_rows $y0 [expr {$x0 + 1}] $row
1157 if {!$haspad} {
1158 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1159 set o [lindex $offs $col]
1160 if {$o eq {} || $o <= 0} break
1162 if {[incr col] < [llength $idlist]} {
1163 set y1 [expr {$row + 1}]
1164 set offs2 [lindex $rowoffsets $y1]
1165 set x1 -1
1166 foreach z $offs2 {
1167 incr x1
1168 if {$z eq {} || $x1 + $z < $col} continue
1169 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1170 break
1172 set idlist [linsert $idlist $col {}]
1173 set tmp [linsert $offs $col {}]
1174 incr col
1175 set offs [incrange $tmp $col -1]
1178 lset rowidlist $row $idlist
1179 lset rowoffsets $row $offs
1180 set col 0
1184 proc xc {row col} {
1185 global canvx0 linespc
1186 return [expr {$canvx0 + $col * $linespc}]
1189 proc yc {row} {
1190 global canvy0 linespc
1191 return [expr {$canvy0 + $row * $linespc}]
1194 proc linewidth {id} {
1195 global thickerline lthickness
1197 set wid $lthickness
1198 if {[info exists thickerline] && $id eq $thickerline} {
1199 set wid [expr {2 * $lthickness}]
1201 return $wid
1204 proc drawlineseg {id i} {
1205 global rowoffsets rowidlist idrowranges
1206 global canv colormap
1208 set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1209 set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1210 if {$startrow == $row} return
1211 assigncolor $id
1212 set coords {}
1213 set col [lsearch -exact [lindex $rowidlist $row] $id]
1214 if {$col < 0} {
1215 puts "oops: drawline: id $id not on row $row"
1216 return
1218 set lasto {}
1219 set ns 0
1220 while {1} {
1221 set o [lindex $rowoffsets $row $col]
1222 if {$o eq {}} break
1223 if {$o ne $lasto} {
1224 # changing direction
1225 set x [xc $row $col]
1226 set y [yc $row]
1227 lappend coords $x $y
1228 set lasto $o
1230 incr col $o
1231 incr row -1
1233 if {$coords eq {}} return
1234 set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1235 set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1236 set arrow [lindex {none first last both} $arrow]
1237 set x [xc $row $col]
1238 set y [yc $row]
1239 lappend coords $x $y
1240 set t [$canv create line $coords -width [linewidth $id] \
1241 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1242 $canv lower $t
1243 bindline $t $id
1246 proc drawparentlinks {id row col olds} {
1247 global rowidlist canv colormap
1249 set row2 [expr {$row + 1}]
1250 set x [xc $row $col]
1251 set y [yc $row]
1252 set y2 [yc $row2]
1253 set ids [lindex $rowidlist $row2]
1254 # rmx = right-most X coord used
1255 set rmx 0
1256 foreach p $olds {
1257 set i [lsearch -exact $ids $p]
1258 if {$i < 0} {
1259 puts "oops, parent $p of $id not in list"
1260 continue
1262 assigncolor $p
1263 # should handle duplicated parents here...
1264 set coords [list $x $y]
1265 if {$i < $col - 1} {
1266 lappend coords [xc $row [expr {$i + 1}]] $y
1267 } elseif {$i > $col + 1} {
1268 lappend coords [xc $row [expr {$i - 1}]] $y
1270 set x2 [xc $row2 $i]
1271 if {$x2 > $rmx} {
1272 set rmx $x2
1274 lappend coords $x2 $y2
1275 set t [$canv create line $coords -width [linewidth $p] \
1276 -fill $colormap($p) -tags lines.$p]
1277 $canv lower $t
1278 bindline $t $p
1280 return $rmx
1283 proc drawlines {id} {
1284 global colormap canv
1285 global idrowranges idrangedrawn
1286 global children iddrawn commitrow rowidlist
1288 $canv delete lines.$id
1289 set nr [expr {[llength $idrowranges($id)] / 2}]
1290 for {set i 0} {$i < $nr} {incr i} {
1291 if {[info exists idrangedrawn($id,$i)]} {
1292 drawlineseg $id $i
1295 if {[info exists children($id)]} {
1296 foreach child $children($id) {
1297 if {[info exists iddrawn($child)]} {
1298 set row $commitrow($child)
1299 set col [lsearch -exact [lindex $rowidlist $row] $child]
1300 if {$col >= 0} {
1301 drawparentlinks $child $row $col [list $id]
1308 proc drawcmittext {id row col rmx} {
1309 global linespc canv canv2 canv3 canvy0
1310 global commitlisted commitinfo rowidlist
1311 global rowtextx idpos idtags idheads idotherrefs
1312 global linehtag linentag linedtag
1313 global mainfont namefont
1315 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1316 set x [xc $row $col]
1317 set y [yc $row]
1318 set orad [expr {$linespc / 3}]
1319 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1320 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1321 -fill $ofill -outline black -width 1]
1322 $canv raise $t
1323 $canv bind $t <1> {selcanvline {} %x %y}
1324 set xt [xc $row [llength [lindex $rowidlist $row]]]
1325 if {$xt < $rmx} {
1326 set xt $rmx
1328 set rowtextx($row) $xt
1329 set idpos($id) [list $x $xt $y]
1330 if {[info exists idtags($id)] || [info exists idheads($id)]
1331 || [info exists idotherrefs($id)]} {
1332 set xt [drawtags $id $x $xt $y]
1334 set headline [lindex $commitinfo($id) 0]
1335 set name [lindex $commitinfo($id) 1]
1336 set date [lindex $commitinfo($id) 2]
1337 set date [formatdate $date]
1338 set linehtag($row) [$canv create text $xt $y -anchor w \
1339 -text $headline -font $mainfont ]
1340 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1341 set linentag($row) [$canv2 create text 3 $y -anchor w \
1342 -text $name -font $namefont]
1343 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1344 -text $date -font $mainfont]
1347 proc drawcmitrow {row} {
1348 global displayorder rowidlist
1349 global idrowranges idrangedrawn iddrawn
1350 global commitinfo commitlisted parents numcommits
1352 if {$row >= $numcommits} return
1353 foreach id [lindex $rowidlist $row] {
1354 if {![info exists idrowranges($id)]} continue
1355 set i -1
1356 foreach {s e} $idrowranges($id) {
1357 incr i
1358 if {$row < $s} continue
1359 if {$e eq {}} break
1360 if {$row <= $e} {
1361 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1362 drawlineseg $id $i
1363 set idrangedrawn($id,$i) 1
1365 break
1370 set id [lindex $displayorder $row]
1371 if {[info exists iddrawn($id)]} return
1372 set col [lsearch -exact [lindex $rowidlist $row] $id]
1373 if {$col < 0} {
1374 puts "oops, row $row id $id not in list"
1375 return
1377 if {![info exists commitinfo($id)]} {
1378 getcommit $id
1380 assigncolor $id
1381 if {[info exists commitlisted($id)] && [info exists parents($id)]
1382 && $parents($id) ne {}} {
1383 set rmx [drawparentlinks $id $row $col $parents($id)]
1384 } else {
1385 set rmx 0
1387 drawcmittext $id $row $col $rmx
1388 set iddrawn($id) 1
1391 proc drawfrac {f0 f1} {
1392 global numcommits canv
1393 global linespc
1395 set ymax [lindex [$canv cget -scrollregion] 3]
1396 if {$ymax eq {} || $ymax == 0} return
1397 set y0 [expr {int($f0 * $ymax)}]
1398 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1399 if {$row < 0} {
1400 set row 0
1402 set y1 [expr {int($f1 * $ymax)}]
1403 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1404 if {$endrow >= $numcommits} {
1405 set endrow [expr {$numcommits - 1}]
1407 for {} {$row <= $endrow} {incr row} {
1408 drawcmitrow $row
1412 proc drawvisible {} {
1413 global canv
1414 eval drawfrac [$canv yview]
1417 proc clear_display {} {
1418 global iddrawn idrangedrawn
1420 allcanvs delete all
1421 catch {unset iddrawn}
1422 catch {unset idrangedrawn}
1425 proc assigncolor {id} {
1426 global colormap colors nextcolor
1427 global parents nparents children nchildren
1428 global cornercrossings crossings
1430 if {[info exists colormap($id)]} return
1431 set ncolors [llength $colors]
1432 if {$nchildren($id) == 1} {
1433 set child [lindex $children($id) 0]
1434 if {[info exists colormap($child)]
1435 && $nparents($child) == 1} {
1436 set colormap($id) $colormap($child)
1437 return
1440 set badcolors {}
1441 if {[info exists cornercrossings($id)]} {
1442 foreach x $cornercrossings($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 {}
1452 set origbad $badcolors
1453 if {[llength $badcolors] < $ncolors - 1} {
1454 if {[info exists crossings($id)]} {
1455 foreach x $crossings($id) {
1456 if {[info exists colormap($x)]
1457 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1458 lappend badcolors $colormap($x)
1461 if {[llength $badcolors] >= $ncolors} {
1462 set badcolors $origbad
1465 set origbad $badcolors
1467 if {[llength $badcolors] < $ncolors - 1} {
1468 foreach child $children($id) {
1469 if {[info exists colormap($child)]
1470 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1471 lappend badcolors $colormap($child)
1473 if {[info exists parents($child)]} {
1474 foreach p $parents($child) {
1475 if {[info exists colormap($p)]
1476 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1477 lappend badcolors $colormap($p)
1482 if {[llength $badcolors] >= $ncolors} {
1483 set badcolors $origbad
1486 for {set i 0} {$i <= $ncolors} {incr i} {
1487 set c [lindex $colors $nextcolor]
1488 if {[incr nextcolor] >= $ncolors} {
1489 set nextcolor 0
1491 if {[lsearch -exact $badcolors $c]} break
1493 set colormap($id) $c
1496 proc bindline {t id} {
1497 global canv
1499 $canv bind $t <Enter> "lineenter %x %y $id"
1500 $canv bind $t <Motion> "linemotion %x %y $id"
1501 $canv bind $t <Leave> "lineleave $id"
1502 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1505 proc drawtags {id x xt y1} {
1506 global idtags idheads idotherrefs
1507 global linespc lthickness
1508 global canv mainfont commitrow rowtextx
1510 set marks {}
1511 set ntags 0
1512 set nheads 0
1513 if {[info exists idtags($id)]} {
1514 set marks $idtags($id)
1515 set ntags [llength $marks]
1517 if {[info exists idheads($id)]} {
1518 set marks [concat $marks $idheads($id)]
1519 set nheads [llength $idheads($id)]
1521 if {[info exists idotherrefs($id)]} {
1522 set marks [concat $marks $idotherrefs($id)]
1524 if {$marks eq {}} {
1525 return $xt
1528 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1529 set yt [expr {$y1 - 0.5 * $linespc}]
1530 set yb [expr {$yt + $linespc - 1}]
1531 set xvals {}
1532 set wvals {}
1533 foreach tag $marks {
1534 set wid [font measure $mainfont $tag]
1535 lappend xvals $xt
1536 lappend wvals $wid
1537 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1539 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1540 -width $lthickness -fill black -tags tag.$id]
1541 $canv lower $t
1542 foreach tag $marks x $xvals wid $wvals {
1543 set xl [expr {$x + $delta}]
1544 set xr [expr {$x + $delta + $wid + $lthickness}]
1545 if {[incr ntags -1] >= 0} {
1546 # draw a tag
1547 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1548 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1549 -width 1 -outline black -fill yellow -tags tag.$id]
1550 $canv bind $t <1> [list showtag $tag 1]
1551 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1552 } else {
1553 # draw a head or other ref
1554 if {[incr nheads -1] >= 0} {
1555 set col green
1556 } else {
1557 set col "#ddddff"
1559 set xl [expr {$xl - $delta/2}]
1560 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1561 -width 1 -outline black -fill $col -tags tag.$id
1563 set t [$canv create text $xl $y1 -anchor w -text $tag \
1564 -font $mainfont -tags tag.$id]
1565 if {$ntags >= 0} {
1566 $canv bind $t <1> [list showtag $tag 1]
1569 return $xt
1572 proc checkcrossings {row endrow} {
1573 global displayorder parents rowidlist
1575 for {} {$row < $endrow} {incr row} {
1576 set id [lindex $displayorder $row]
1577 set i [lsearch -exact [lindex $rowidlist $row] $id]
1578 if {$i < 0} continue
1579 set idlist [lindex $rowidlist [expr {$row+1}]]
1580 foreach p $parents($id) {
1581 set j [lsearch -exact $idlist $p]
1582 if {$j > 0} {
1583 if {$j < $i - 1} {
1584 notecrossings $row $p $j $i [expr {$j+1}]
1585 } elseif {$j > $i + 1} {
1586 notecrossings $row $p $i $j [expr {$j-1}]
1593 proc notecrossings {row id lo hi corner} {
1594 global rowidlist crossings cornercrossings
1596 for {set i $lo} {[incr i] < $hi} {} {
1597 set p [lindex [lindex $rowidlist $row] $i]
1598 if {$p == {}} continue
1599 if {$i == $corner} {
1600 if {![info exists cornercrossings($id)]
1601 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1602 lappend cornercrossings($id) $p
1604 if {![info exists cornercrossings($p)]
1605 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1606 lappend cornercrossings($p) $id
1608 } else {
1609 if {![info exists crossings($id)]
1610 || [lsearch -exact $crossings($id) $p] < 0} {
1611 lappend crossings($id) $p
1613 if {![info exists crossings($p)]
1614 || [lsearch -exact $crossings($p) $id] < 0} {
1615 lappend crossings($p) $id
1621 proc xcoord {i level ln} {
1622 global canvx0 xspc1 xspc2
1624 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1625 if {$i > 0 && $i == $level} {
1626 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1627 } elseif {$i > $level} {
1628 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1630 return $x
1633 proc finishcommits {} {
1634 global commitidx phase
1635 global canv mainfont ctext maincursor textcursor
1636 global findinprogress
1638 if {$commitidx > 0} {
1639 drawrest
1640 } else {
1641 $canv delete all
1642 $canv create text 3 3 -anchor nw -text "No commits selected" \
1643 -font $mainfont -tags textitems
1645 if {![info exists findinprogress]} {
1646 . config -cursor $maincursor
1647 settextcursor $textcursor
1649 set phase {}
1652 # Don't change the text pane cursor if it is currently the hand cursor,
1653 # showing that we are over a sha1 ID link.
1654 proc settextcursor {c} {
1655 global ctext curtextcursor
1657 if {[$ctext cget -cursor] == $curtextcursor} {
1658 $ctext config -cursor $c
1660 set curtextcursor $c
1663 proc drawrest {} {
1664 global numcommits
1665 global startmsecs
1666 global canvy0 numcommits linespc
1667 global rowlaidout commitidx
1669 set row $rowlaidout
1670 layoutrows $rowlaidout $commitidx 1
1671 layouttail
1672 optimize_rows $row 0 $commitidx
1673 showstuff $commitidx
1675 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1676 #puts "overall $drawmsecs ms for $numcommits commits"
1679 proc findmatches {f} {
1680 global findtype foundstring foundstrlen
1681 if {$findtype == "Regexp"} {
1682 set matches [regexp -indices -all -inline $foundstring $f]
1683 } else {
1684 if {$findtype == "IgnCase"} {
1685 set str [string tolower $f]
1686 } else {
1687 set str $f
1689 set matches {}
1690 set i 0
1691 while {[set j [string first $foundstring $str $i]] >= 0} {
1692 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1693 set i [expr {$j + $foundstrlen}]
1696 return $matches
1699 proc dofind {} {
1700 global findtype findloc findstring markedmatches commitinfo
1701 global numcommits displayorder linehtag linentag linedtag
1702 global mainfont namefont canv canv2 canv3 selectedline
1703 global matchinglines foundstring foundstrlen matchstring
1704 global commitdata
1706 stopfindproc
1707 unmarkmatches
1708 focus .
1709 set matchinglines {}
1710 if {$findloc == "Pickaxe"} {
1711 findpatches
1712 return
1714 if {$findtype == "IgnCase"} {
1715 set foundstring [string tolower $findstring]
1716 } else {
1717 set foundstring $findstring
1719 set foundstrlen [string length $findstring]
1720 if {$foundstrlen == 0} return
1721 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1722 set matchstring "*$matchstring*"
1723 if {$findloc == "Files"} {
1724 findfiles
1725 return
1727 if {![info exists selectedline]} {
1728 set oldsel -1
1729 } else {
1730 set oldsel $selectedline
1732 set didsel 0
1733 set fldtypes {Headline Author Date Committer CDate Comment}
1734 set l -1
1735 foreach id $displayorder {
1736 set d $commitdata($id)
1737 incr l
1738 if {$findtype == "Regexp"} {
1739 set doesmatch [regexp $foundstring $d]
1740 } elseif {$findtype == "IgnCase"} {
1741 set doesmatch [string match -nocase $matchstring $d]
1742 } else {
1743 set doesmatch [string match $matchstring $d]
1745 if {!$doesmatch} continue
1746 if {![info exists commitinfo($id)]} {
1747 getcommit $id
1749 set info $commitinfo($id)
1750 set doesmatch 0
1751 foreach f $info ty $fldtypes {
1752 if {$findloc != "All fields" && $findloc != $ty} {
1753 continue
1755 set matches [findmatches $f]
1756 if {$matches == {}} continue
1757 set doesmatch 1
1758 if {$ty == "Headline"} {
1759 drawcmitrow $l
1760 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1761 } elseif {$ty == "Author"} {
1762 drawcmitrow $l
1763 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1764 } elseif {$ty == "Date"} {
1765 drawcmitrow $l
1766 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1769 if {$doesmatch} {
1770 lappend matchinglines $l
1771 if {!$didsel && $l > $oldsel} {
1772 findselectline $l
1773 set didsel 1
1777 if {$matchinglines == {}} {
1778 bell
1779 } elseif {!$didsel} {
1780 findselectline [lindex $matchinglines 0]
1784 proc findselectline {l} {
1785 global findloc commentend ctext
1786 selectline $l 1
1787 if {$findloc == "All fields" || $findloc == "Comments"} {
1788 # highlight the matches in the comments
1789 set f [$ctext get 1.0 $commentend]
1790 set matches [findmatches $f]
1791 foreach match $matches {
1792 set start [lindex $match 0]
1793 set end [expr {[lindex $match 1] + 1}]
1794 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1799 proc findnext {restart} {
1800 global matchinglines selectedline
1801 if {![info exists matchinglines]} {
1802 if {$restart} {
1803 dofind
1805 return
1807 if {![info exists selectedline]} return
1808 foreach l $matchinglines {
1809 if {$l > $selectedline} {
1810 findselectline $l
1811 return
1814 bell
1817 proc findprev {} {
1818 global matchinglines selectedline
1819 if {![info exists matchinglines]} {
1820 dofind
1821 return
1823 if {![info exists selectedline]} return
1824 set prev {}
1825 foreach l $matchinglines {
1826 if {$l >= $selectedline} break
1827 set prev $l
1829 if {$prev != {}} {
1830 findselectline $prev
1831 } else {
1832 bell
1836 proc findlocchange {name ix op} {
1837 global findloc findtype findtypemenu
1838 if {$findloc == "Pickaxe"} {
1839 set findtype Exact
1840 set state disabled
1841 } else {
1842 set state normal
1844 $findtypemenu entryconf 1 -state $state
1845 $findtypemenu entryconf 2 -state $state
1848 proc stopfindproc {{done 0}} {
1849 global findprocpid findprocfile findids
1850 global ctext findoldcursor phase maincursor textcursor
1851 global findinprogress
1853 catch {unset findids}
1854 if {[info exists findprocpid]} {
1855 if {!$done} {
1856 catch {exec kill $findprocpid}
1858 catch {close $findprocfile}
1859 unset findprocpid
1861 if {[info exists findinprogress]} {
1862 unset findinprogress
1863 if {$phase != "incrdraw"} {
1864 . config -cursor $maincursor
1865 settextcursor $textcursor
1870 proc findpatches {} {
1871 global findstring selectedline numcommits
1872 global findprocpid findprocfile
1873 global finddidsel ctext displayorder findinprogress
1874 global findinsertpos
1876 if {$numcommits == 0} return
1878 # make a list of all the ids to search, starting at the one
1879 # after the selected line (if any)
1880 if {[info exists selectedline]} {
1881 set l $selectedline
1882 } else {
1883 set l -1
1885 set inputids {}
1886 for {set i 0} {$i < $numcommits} {incr i} {
1887 if {[incr l] >= $numcommits} {
1888 set l 0
1890 append inputids [lindex $displayorder $l] "\n"
1893 if {[catch {
1894 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1895 << $inputids] r]
1896 } err]} {
1897 error_popup "Error starting search process: $err"
1898 return
1901 set findinsertpos end
1902 set findprocfile $f
1903 set findprocpid [pid $f]
1904 fconfigure $f -blocking 0
1905 fileevent $f readable readfindproc
1906 set finddidsel 0
1907 . config -cursor watch
1908 settextcursor watch
1909 set findinprogress 1
1912 proc readfindproc {} {
1913 global findprocfile finddidsel
1914 global commitrow matchinglines findinsertpos
1916 set n [gets $findprocfile line]
1917 if {$n < 0} {
1918 if {[eof $findprocfile]} {
1919 stopfindproc 1
1920 if {!$finddidsel} {
1921 bell
1924 return
1926 if {![regexp {^[0-9a-f]{40}} $line id]} {
1927 error_popup "Can't parse git-diff-tree output: $line"
1928 stopfindproc
1929 return
1931 if {![info exists commitrow($id)]} {
1932 puts stderr "spurious id: $id"
1933 return
1935 set l $commitrow($id)
1936 insertmatch $l $id
1939 proc insertmatch {l id} {
1940 global matchinglines findinsertpos finddidsel
1942 if {$findinsertpos == "end"} {
1943 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1944 set matchinglines [linsert $matchinglines 0 $l]
1945 set findinsertpos 1
1946 } else {
1947 lappend matchinglines $l
1949 } else {
1950 set matchinglines [linsert $matchinglines $findinsertpos $l]
1951 incr findinsertpos
1953 markheadline $l $id
1954 if {!$finddidsel} {
1955 findselectline $l
1956 set finddidsel 1
1960 proc findfiles {} {
1961 global selectedline numcommits displayorder ctext
1962 global ffileline finddidsel parents nparents
1963 global findinprogress findstartline findinsertpos
1964 global treediffs fdiffid fdiffsneeded fdiffpos
1965 global findmergefiles
1967 if {$numcommits == 0} return
1969 if {[info exists selectedline]} {
1970 set l [expr {$selectedline + 1}]
1971 } else {
1972 set l 0
1974 set ffileline $l
1975 set findstartline $l
1976 set diffsneeded {}
1977 set fdiffsneeded {}
1978 while 1 {
1979 set id [lindex $displayorder $l]
1980 if {$findmergefiles || $nparents($id) == 1} {
1981 if {![info exists treediffs($id)]} {
1982 append diffsneeded "$id\n"
1983 lappend fdiffsneeded $id
1986 if {[incr l] >= $numcommits} {
1987 set l 0
1989 if {$l == $findstartline} break
1992 # start off a git-diff-tree process if needed
1993 if {$diffsneeded ne {}} {
1994 if {[catch {
1995 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1996 } err ]} {
1997 error_popup "Error starting search process: $err"
1998 return
2000 catch {unset fdiffid}
2001 set fdiffpos 0
2002 fconfigure $df -blocking 0
2003 fileevent $df readable [list readfilediffs $df]
2006 set finddidsel 0
2007 set findinsertpos end
2008 set id [lindex $displayorder $l]
2009 . config -cursor watch
2010 settextcursor watch
2011 set findinprogress 1
2012 findcont $id
2013 update
2016 proc readfilediffs {df} {
2017 global findid fdiffid fdiffs
2019 set n [gets $df line]
2020 if {$n < 0} {
2021 if {[eof $df]} {
2022 donefilediff
2023 if {[catch {close $df} err]} {
2024 stopfindproc
2025 bell
2026 error_popup "Error in git-diff-tree: $err"
2027 } elseif {[info exists findid]} {
2028 set id $findid
2029 stopfindproc
2030 bell
2031 error_popup "Couldn't find diffs for $id"
2034 return
2036 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2037 # start of a new string of diffs
2038 donefilediff
2039 set fdiffid $id
2040 set fdiffs {}
2041 } elseif {[string match ":*" $line]} {
2042 lappend fdiffs [lindex $line 5]
2046 proc donefilediff {} {
2047 global fdiffid fdiffs treediffs findid
2048 global fdiffsneeded fdiffpos
2050 if {[info exists fdiffid]} {
2051 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2052 && $fdiffpos < [llength $fdiffsneeded]} {
2053 # git-diff-tree doesn't output anything for a commit
2054 # which doesn't change anything
2055 set nullid [lindex $fdiffsneeded $fdiffpos]
2056 set treediffs($nullid) {}
2057 if {[info exists findid] && $nullid eq $findid} {
2058 unset findid
2059 findcont $nullid
2061 incr fdiffpos
2063 incr fdiffpos
2065 if {![info exists treediffs($fdiffid)]} {
2066 set treediffs($fdiffid) $fdiffs
2068 if {[info exists findid] && $fdiffid eq $findid} {
2069 unset findid
2070 findcont $fdiffid
2075 proc findcont {id} {
2076 global findid treediffs parents nparents
2077 global ffileline findstartline finddidsel
2078 global displayorder numcommits matchinglines findinprogress
2079 global findmergefiles
2081 set l $ffileline
2082 while 1 {
2083 if {$findmergefiles || $nparents($id) == 1} {
2084 if {![info exists treediffs($id)]} {
2085 set findid $id
2086 set ffileline $l
2087 return
2089 set doesmatch 0
2090 foreach f $treediffs($id) {
2091 set x [findmatches $f]
2092 if {$x != {}} {
2093 set doesmatch 1
2094 break
2097 if {$doesmatch} {
2098 insertmatch $l $id
2101 if {[incr l] >= $numcommits} {
2102 set l 0
2104 if {$l == $findstartline} break
2105 set id [lindex $displayorder $l]
2107 stopfindproc
2108 if {!$finddidsel} {
2109 bell
2113 # mark a commit as matching by putting a yellow background
2114 # behind the headline
2115 proc markheadline {l id} {
2116 global canv mainfont linehtag
2118 drawcmitrow $l
2119 set bbox [$canv bbox $linehtag($l)]
2120 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2121 $canv lower $t
2124 # mark the bits of a headline, author or date that match a find string
2125 proc markmatches {canv l str tag matches font} {
2126 set bbox [$canv bbox $tag]
2127 set x0 [lindex $bbox 0]
2128 set y0 [lindex $bbox 1]
2129 set y1 [lindex $bbox 3]
2130 foreach match $matches {
2131 set start [lindex $match 0]
2132 set end [lindex $match 1]
2133 if {$start > $end} continue
2134 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2135 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2136 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2137 [expr {$x0+$xlen+2}] $y1 \
2138 -outline {} -tags matches -fill yellow]
2139 $canv lower $t
2143 proc unmarkmatches {} {
2144 global matchinglines findids
2145 allcanvs delete matches
2146 catch {unset matchinglines}
2147 catch {unset findids}
2150 proc selcanvline {w x y} {
2151 global canv canvy0 ctext linespc
2152 global rowtextx
2153 set ymax [lindex [$canv cget -scrollregion] 3]
2154 if {$ymax == {}} return
2155 set yfrac [lindex [$canv yview] 0]
2156 set y [expr {$y + $yfrac * $ymax}]
2157 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2158 if {$l < 0} {
2159 set l 0
2161 if {$w eq $canv} {
2162 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2164 unmarkmatches
2165 selectline $l 1
2168 proc commit_descriptor {p} {
2169 global commitinfo
2170 set l "..."
2171 if {[info exists commitinfo($p)]} {
2172 set l [lindex $commitinfo($p) 0]
2174 return "$p ($l)"
2177 # append some text to the ctext widget, and make any SHA1 ID
2178 # that we know about be a clickable link.
2179 proc appendwithlinks {text} {
2180 global ctext commitrow linknum
2182 set start [$ctext index "end - 1c"]
2183 $ctext insert end $text
2184 $ctext insert end "\n"
2185 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2186 foreach l $links {
2187 set s [lindex $l 0]
2188 set e [lindex $l 1]
2189 set linkid [string range $text $s $e]
2190 if {![info exists commitrow($linkid)]} continue
2191 incr e
2192 $ctext tag add link "$start + $s c" "$start + $e c"
2193 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2194 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2195 incr linknum
2197 $ctext tag conf link -foreground blue -underline 1
2198 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2199 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2202 proc selectline {l isnew} {
2203 global canv canv2 canv3 ctext commitinfo selectedline
2204 global displayorder linehtag linentag linedtag
2205 global canvy0 linespc parents nparents children
2206 global cflist currentid sha1entry
2207 global commentend idtags linknum
2208 global mergemax numcommits
2210 $canv delete hover
2211 normalline
2212 if {$l < 0 || $l >= $numcommits} return
2213 set y [expr {$canvy0 + $l * $linespc}]
2214 set ymax [lindex [$canv cget -scrollregion] 3]
2215 set ytop [expr {$y - $linespc - 1}]
2216 set ybot [expr {$y + $linespc + 1}]
2217 set wnow [$canv yview]
2218 set wtop [expr {[lindex $wnow 0] * $ymax}]
2219 set wbot [expr {[lindex $wnow 1] * $ymax}]
2220 set wh [expr {$wbot - $wtop}]
2221 set newtop $wtop
2222 if {$ytop < $wtop} {
2223 if {$ybot < $wtop} {
2224 set newtop [expr {$y - $wh / 2.0}]
2225 } else {
2226 set newtop $ytop
2227 if {$newtop > $wtop - $linespc} {
2228 set newtop [expr {$wtop - $linespc}]
2231 } elseif {$ybot > $wbot} {
2232 if {$ytop > $wbot} {
2233 set newtop [expr {$y - $wh / 2.0}]
2234 } else {
2235 set newtop [expr {$ybot - $wh}]
2236 if {$newtop < $wtop + $linespc} {
2237 set newtop [expr {$wtop + $linespc}]
2241 if {$newtop != $wtop} {
2242 if {$newtop < 0} {
2243 set newtop 0
2245 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2246 drawvisible
2249 if {![info exists linehtag($l)]} return
2250 $canv delete secsel
2251 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2252 -tags secsel -fill [$canv cget -selectbackground]]
2253 $canv lower $t
2254 $canv2 delete secsel
2255 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2256 -tags secsel -fill [$canv2 cget -selectbackground]]
2257 $canv2 lower $t
2258 $canv3 delete secsel
2259 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2260 -tags secsel -fill [$canv3 cget -selectbackground]]
2261 $canv3 lower $t
2263 if {$isnew} {
2264 addtohistory [list selectline $l 0]
2267 set selectedline $l
2269 set id [lindex $displayorder $l]
2270 set currentid $id
2271 $sha1entry delete 0 end
2272 $sha1entry insert 0 $id
2273 $sha1entry selection from 0
2274 $sha1entry selection to end
2276 $ctext conf -state normal
2277 $ctext delete 0.0 end
2278 set linknum 0
2279 $ctext mark set fmark.0 0.0
2280 $ctext mark gravity fmark.0 left
2281 set info $commitinfo($id)
2282 set date [formatdate [lindex $info 2]]
2283 $ctext insert end "Author: [lindex $info 1] $date\n"
2284 set date [formatdate [lindex $info 4]]
2285 $ctext insert end "Committer: [lindex $info 3] $date\n"
2286 if {[info exists idtags($id)]} {
2287 $ctext insert end "Tags:"
2288 foreach tag $idtags($id) {
2289 $ctext insert end " $tag"
2291 $ctext insert end "\n"
2294 set comment {}
2295 if {$nparents($id) > 1} {
2296 set np 0
2297 foreach p $parents($id) {
2298 if {$np >= $mergemax} {
2299 set tag mmax
2300 } else {
2301 set tag m$np
2303 $ctext insert end "Parent: " $tag
2304 appendwithlinks [commit_descriptor $p]
2305 incr np
2307 } else {
2308 if {[info exists parents($id)]} {
2309 foreach p $parents($id) {
2310 append comment "Parent: [commit_descriptor $p]\n"
2315 if {[info exists children($id)]} {
2316 foreach c $children($id) {
2317 append comment "Child: [commit_descriptor $c]\n"
2320 append comment "\n"
2321 append comment [lindex $info 5]
2323 # make anything that looks like a SHA1 ID be a clickable link
2324 appendwithlinks $comment
2326 $ctext tag delete Comments
2327 $ctext tag remove found 1.0 end
2328 $ctext conf -state disabled
2329 set commentend [$ctext index "end - 1c"]
2331 $cflist delete 0 end
2332 $cflist insert end "Comments"
2333 if {$nparents($id) == 1} {
2334 startdiff $id
2335 } elseif {$nparents($id) > 1} {
2336 mergediff $id
2340 proc selnextline {dir} {
2341 global selectedline
2342 if {![info exists selectedline]} return
2343 set l [expr {$selectedline + $dir}]
2344 unmarkmatches
2345 selectline $l 1
2348 proc unselectline {} {
2349 global selectedline
2351 catch {unset selectedline}
2352 allcanvs delete secsel
2355 proc addtohistory {cmd} {
2356 global history historyindex
2358 if {$historyindex > 0
2359 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2360 return
2363 if {$historyindex < [llength $history]} {
2364 set history [lreplace $history $historyindex end $cmd]
2365 } else {
2366 lappend history $cmd
2368 incr historyindex
2369 if {$historyindex > 1} {
2370 .ctop.top.bar.leftbut conf -state normal
2371 } else {
2372 .ctop.top.bar.leftbut conf -state disabled
2374 .ctop.top.bar.rightbut conf -state disabled
2377 proc goback {} {
2378 global history historyindex
2380 if {$historyindex > 1} {
2381 incr historyindex -1
2382 set cmd [lindex $history [expr {$historyindex - 1}]]
2383 eval $cmd
2384 .ctop.top.bar.rightbut conf -state normal
2386 if {$historyindex <= 1} {
2387 .ctop.top.bar.leftbut conf -state disabled
2391 proc goforw {} {
2392 global history historyindex
2394 if {$historyindex < [llength $history]} {
2395 set cmd [lindex $history $historyindex]
2396 incr historyindex
2397 eval $cmd
2398 .ctop.top.bar.leftbut conf -state normal
2400 if {$historyindex >= [llength $history]} {
2401 .ctop.top.bar.rightbut conf -state disabled
2405 proc mergediff {id} {
2406 global parents diffmergeid diffopts mdifffd
2407 global difffilestart
2409 set diffmergeid $id
2410 catch {unset difffilestart}
2411 # this doesn't seem to actually affect anything...
2412 set env(GIT_DIFF_OPTS) $diffopts
2413 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2414 if {[catch {set mdf [open $cmd r]} err]} {
2415 error_popup "Error getting merge diffs: $err"
2416 return
2418 fconfigure $mdf -blocking 0
2419 set mdifffd($id) $mdf
2420 fileevent $mdf readable [list getmergediffline $mdf $id]
2421 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2424 proc getmergediffline {mdf id} {
2425 global diffmergeid ctext cflist nextupdate nparents mergemax
2426 global difffilestart
2428 set n [gets $mdf line]
2429 if {$n < 0} {
2430 if {[eof $mdf]} {
2431 close $mdf
2433 return
2435 if {![info exists diffmergeid] || $id != $diffmergeid} {
2436 return
2438 $ctext conf -state normal
2439 if {[regexp {^diff --cc (.*)} $line match fname]} {
2440 # start of a new file
2441 $ctext insert end "\n"
2442 set here [$ctext index "end - 1c"]
2443 set i [$cflist index end]
2444 $ctext mark set fmark.$i $here
2445 $ctext mark gravity fmark.$i left
2446 set difffilestart([expr {$i-1}]) $here
2447 $cflist insert end $fname
2448 set l [expr {(78 - [string length $fname]) / 2}]
2449 set pad [string range "----------------------------------------" 1 $l]
2450 $ctext insert end "$pad $fname $pad\n" filesep
2451 } elseif {[regexp {^@@} $line]} {
2452 $ctext insert end "$line\n" hunksep
2453 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2454 # do nothing
2455 } else {
2456 # parse the prefix - one ' ', '-' or '+' for each parent
2457 set np $nparents($id)
2458 set spaces {}
2459 set minuses {}
2460 set pluses {}
2461 set isbad 0
2462 for {set j 0} {$j < $np} {incr j} {
2463 set c [string range $line $j $j]
2464 if {$c == " "} {
2465 lappend spaces $j
2466 } elseif {$c == "-"} {
2467 lappend minuses $j
2468 } elseif {$c == "+"} {
2469 lappend pluses $j
2470 } else {
2471 set isbad 1
2472 break
2475 set tags {}
2476 set num {}
2477 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2478 # line doesn't appear in result, parents in $minuses have the line
2479 set num [lindex $minuses 0]
2480 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2481 # line appears in result, parents in $pluses don't have the line
2482 lappend tags mresult
2483 set num [lindex $spaces 0]
2485 if {$num ne {}} {
2486 if {$num >= $mergemax} {
2487 set num "max"
2489 lappend tags m$num
2491 $ctext insert end "$line\n" $tags
2493 $ctext conf -state disabled
2494 if {[clock clicks -milliseconds] >= $nextupdate} {
2495 incr nextupdate 100
2496 fileevent $mdf readable {}
2497 update
2498 fileevent $mdf readable [list getmergediffline $mdf $id]
2502 proc startdiff {ids} {
2503 global treediffs diffids treepending diffmergeid
2505 set diffids $ids
2506 catch {unset diffmergeid}
2507 if {![info exists treediffs($ids)]} {
2508 if {![info exists treepending]} {
2509 gettreediffs $ids
2511 } else {
2512 addtocflist $ids
2516 proc addtocflist {ids} {
2517 global treediffs cflist
2518 foreach f $treediffs($ids) {
2519 $cflist insert end $f
2521 getblobdiffs $ids
2524 proc gettreediffs {ids} {
2525 global treediff parents treepending
2526 set treepending $ids
2527 set treediff {}
2528 if {[catch \
2529 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2530 ]} return
2531 fconfigure $gdtf -blocking 0
2532 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2535 proc gettreediffline {gdtf ids} {
2536 global treediff treediffs treepending diffids diffmergeid
2538 set n [gets $gdtf line]
2539 if {$n < 0} {
2540 if {![eof $gdtf]} return
2541 close $gdtf
2542 set treediffs($ids) $treediff
2543 unset treepending
2544 if {$ids != $diffids} {
2545 gettreediffs $diffids
2546 } else {
2547 if {[info exists diffmergeid]} {
2548 contmergediff $ids
2549 } else {
2550 addtocflist $ids
2553 return
2555 set file [lindex $line 5]
2556 lappend treediff $file
2559 proc getblobdiffs {ids} {
2560 global diffopts blobdifffd diffids env curdifftag curtagstart
2561 global difffilestart nextupdate diffinhdr treediffs
2563 set env(GIT_DIFF_OPTS) $diffopts
2564 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2565 if {[catch {set bdf [open $cmd r]} err]} {
2566 puts "error getting diffs: $err"
2567 return
2569 set diffinhdr 0
2570 fconfigure $bdf -blocking 0
2571 set blobdifffd($ids) $bdf
2572 set curdifftag Comments
2573 set curtagstart 0.0
2574 catch {unset difffilestart}
2575 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2576 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2579 proc getblobdiffline {bdf ids} {
2580 global diffids blobdifffd ctext curdifftag curtagstart
2581 global diffnexthead diffnextnote difffilestart
2582 global nextupdate diffinhdr treediffs
2584 set n [gets $bdf line]
2585 if {$n < 0} {
2586 if {[eof $bdf]} {
2587 close $bdf
2588 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2589 $ctext tag add $curdifftag $curtagstart end
2592 return
2594 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2595 return
2597 $ctext conf -state normal
2598 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2599 # start of a new file
2600 $ctext insert end "\n"
2601 $ctext tag add $curdifftag $curtagstart end
2602 set curtagstart [$ctext index "end - 1c"]
2603 set header $newname
2604 set here [$ctext index "end - 1c"]
2605 set i [lsearch -exact $treediffs($diffids) $fname]
2606 if {$i >= 0} {
2607 set difffilestart($i) $here
2608 incr i
2609 $ctext mark set fmark.$i $here
2610 $ctext mark gravity fmark.$i left
2612 if {$newname != $fname} {
2613 set i [lsearch -exact $treediffs($diffids) $newname]
2614 if {$i >= 0} {
2615 set difffilestart($i) $here
2616 incr i
2617 $ctext mark set fmark.$i $here
2618 $ctext mark gravity fmark.$i left
2621 set curdifftag "f:$fname"
2622 $ctext tag delete $curdifftag
2623 set l [expr {(78 - [string length $header]) / 2}]
2624 set pad [string range "----------------------------------------" 1 $l]
2625 $ctext insert end "$pad $header $pad\n" filesep
2626 set diffinhdr 1
2627 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2628 # do nothing
2629 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2630 set diffinhdr 0
2631 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2632 $line match f1l f1c f2l f2c rest]} {
2633 $ctext insert end "$line\n" hunksep
2634 set diffinhdr 0
2635 } else {
2636 set x [string range $line 0 0]
2637 if {$x == "-" || $x == "+"} {
2638 set tag [expr {$x == "+"}]
2639 $ctext insert end "$line\n" d$tag
2640 } elseif {$x == " "} {
2641 $ctext insert end "$line\n"
2642 } elseif {$diffinhdr || $x == "\\"} {
2643 # e.g. "\ No newline at end of file"
2644 $ctext insert end "$line\n" filesep
2645 } else {
2646 # Something else we don't recognize
2647 if {$curdifftag != "Comments"} {
2648 $ctext insert end "\n"
2649 $ctext tag add $curdifftag $curtagstart end
2650 set curtagstart [$ctext index "end - 1c"]
2651 set curdifftag Comments
2653 $ctext insert end "$line\n" filesep
2656 $ctext conf -state disabled
2657 if {[clock clicks -milliseconds] >= $nextupdate} {
2658 incr nextupdate 100
2659 fileevent $bdf readable {}
2660 update
2661 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2665 proc nextfile {} {
2666 global difffilestart ctext
2667 set here [$ctext index @0,0]
2668 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2669 if {[$ctext compare $difffilestart($i) > $here]} {
2670 if {![info exists pos]
2671 || [$ctext compare $difffilestart($i) < $pos]} {
2672 set pos $difffilestart($i)
2676 if {[info exists pos]} {
2677 $ctext yview $pos
2681 proc listboxsel {} {
2682 global ctext cflist currentid
2683 if {![info exists currentid]} return
2684 set sel [lsort [$cflist curselection]]
2685 if {$sel eq {}} return
2686 set first [lindex $sel 0]
2687 catch {$ctext yview fmark.$first}
2690 proc setcoords {} {
2691 global linespc charspc canvx0 canvy0 mainfont
2692 global xspc1 xspc2 lthickness
2694 set linespc [font metrics $mainfont -linespace]
2695 set charspc [font measure $mainfont "m"]
2696 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2697 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2698 set lthickness [expr {int($linespc / 9) + 1}]
2699 set xspc1(0) $linespc
2700 set xspc2 $linespc
2703 proc redisplay {} {
2704 global canv canvy0 linespc numcommits
2705 global selectedline
2707 set ymax [lindex [$canv cget -scrollregion] 3]
2708 if {$ymax eq {} || $ymax == 0} return
2709 set span [$canv yview]
2710 clear_display
2711 allcanvs conf -scrollregion \
2712 [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2713 allcanvs yview moveto [lindex $span 0]
2714 drawvisible
2715 if {[info exists selectedline]} {
2716 selectline $selectedline 0
2720 proc incrfont {inc} {
2721 global mainfont namefont textfont ctext canv phase
2722 global stopped entries
2723 unmarkmatches
2724 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2725 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2726 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2727 setcoords
2728 $ctext conf -font $textfont
2729 $ctext tag conf filesep -font [concat $textfont bold]
2730 foreach e $entries {
2731 $e conf -font $mainfont
2733 if {$phase == "getcommits"} {
2734 $canv itemconf textitems -font $mainfont
2736 redisplay
2739 proc clearsha1 {} {
2740 global sha1entry sha1string
2741 if {[string length $sha1string] == 40} {
2742 $sha1entry delete 0 end
2746 proc sha1change {n1 n2 op} {
2747 global sha1string currentid sha1but
2748 if {$sha1string == {}
2749 || ([info exists currentid] && $sha1string == $currentid)} {
2750 set state disabled
2751 } else {
2752 set state normal
2754 if {[$sha1but cget -state] == $state} return
2755 if {$state == "normal"} {
2756 $sha1but conf -state normal -relief raised -text "Goto: "
2757 } else {
2758 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2762 proc gotocommit {} {
2763 global sha1string currentid commitrow tagids
2764 global displayorder numcommits
2766 if {$sha1string == {}
2767 || ([info exists currentid] && $sha1string == $currentid)} return
2768 if {[info exists tagids($sha1string)]} {
2769 set id $tagids($sha1string)
2770 } else {
2771 set id [string tolower $sha1string]
2772 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2773 set matches {}
2774 foreach i $displayorder {
2775 if {[string match $id* $i]} {
2776 lappend matches $i
2779 if {$matches ne {}} {
2780 if {[llength $matches] > 1} {
2781 error_popup "Short SHA1 id $id is ambiguous"
2782 return
2784 set id [lindex $matches 0]
2788 if {[info exists commitrow($id)]} {
2789 selectline $commitrow($id) 1
2790 return
2792 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2793 set type "SHA1 id"
2794 } else {
2795 set type "Tag"
2797 error_popup "$type $sha1string is not known"
2800 proc lineenter {x y id} {
2801 global hoverx hovery hoverid hovertimer
2802 global commitinfo canv
2804 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2805 set hoverx $x
2806 set hovery $y
2807 set hoverid $id
2808 if {[info exists hovertimer]} {
2809 after cancel $hovertimer
2811 set hovertimer [after 500 linehover]
2812 $canv delete hover
2815 proc linemotion {x y id} {
2816 global hoverx hovery hoverid hovertimer
2818 if {[info exists hoverid] && $id == $hoverid} {
2819 set hoverx $x
2820 set hovery $y
2821 if {[info exists hovertimer]} {
2822 after cancel $hovertimer
2824 set hovertimer [after 500 linehover]
2828 proc lineleave {id} {
2829 global hoverid hovertimer canv
2831 if {[info exists hoverid] && $id == $hoverid} {
2832 $canv delete hover
2833 if {[info exists hovertimer]} {
2834 after cancel $hovertimer
2835 unset hovertimer
2837 unset hoverid
2841 proc linehover {} {
2842 global hoverx hovery hoverid hovertimer
2843 global canv linespc lthickness
2844 global commitinfo mainfont
2846 set text [lindex $commitinfo($hoverid) 0]
2847 set ymax [lindex [$canv cget -scrollregion] 3]
2848 if {$ymax == {}} return
2849 set yfrac [lindex [$canv yview] 0]
2850 set x [expr {$hoverx + 2 * $linespc}]
2851 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2852 set x0 [expr {$x - 2 * $lthickness}]
2853 set y0 [expr {$y - 2 * $lthickness}]
2854 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2855 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2856 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2857 -fill \#ffff80 -outline black -width 1 -tags hover]
2858 $canv raise $t
2859 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2860 $canv raise $t
2863 proc clickisonarrow {id y} {
2864 global lthickness idrowranges
2866 set thresh [expr {2 * $lthickness + 6}]
2867 set n [expr {[llength $idrowranges($id)] - 1}]
2868 for {set i 1} {$i < $n} {incr i} {
2869 set row [lindex $idrowranges($id) $i]
2870 if {abs([yc $row] - $y) < $thresh} {
2871 return $i
2874 return {}
2877 proc arrowjump {id n y} {
2878 global idrowranges canv
2880 # 1 <-> 2, 3 <-> 4, etc...
2881 set n [expr {(($n - 1) ^ 1) + 1}]
2882 set row [lindex $idrowranges($id) $n]
2883 set yt [yc $row]
2884 set ymax [lindex [$canv cget -scrollregion] 3]
2885 if {$ymax eq {} || $ymax <= 0} return
2886 set view [$canv yview]
2887 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2888 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2889 if {$yfrac < 0} {
2890 set yfrac 0
2892 allcanvs yview moveto $yfrac
2895 proc lineclick {x y id isnew} {
2896 global ctext commitinfo children cflist canv thickerline
2898 if {![info exists commitinfo($id)] && ![getcommit $id]} return
2899 unmarkmatches
2900 unselectline
2901 normalline
2902 $canv delete hover
2903 # draw this line thicker than normal
2904 set thickerline $id
2905 drawlines $id
2906 if {$isnew} {
2907 set ymax [lindex [$canv cget -scrollregion] 3]
2908 if {$ymax eq {}} return
2909 set yfrac [lindex [$canv yview] 0]
2910 set y [expr {$y + $yfrac * $ymax}]
2912 set dirn [clickisonarrow $id $y]
2913 if {$dirn ne {}} {
2914 arrowjump $id $dirn $y
2915 return
2918 if {$isnew} {
2919 addtohistory [list lineclick $x $y $id 0]
2921 # fill the details pane with info about this line
2922 $ctext conf -state normal
2923 $ctext delete 0.0 end
2924 $ctext tag conf link -foreground blue -underline 1
2925 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2926 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2927 $ctext insert end "Parent:\t"
2928 $ctext insert end $id [list link link0]
2929 $ctext tag bind link0 <1> [list selbyid $id]
2930 set info $commitinfo($id)
2931 $ctext insert end "\n\t[lindex $info 0]\n"
2932 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2933 set date [formatdate [lindex $info 2]]
2934 $ctext insert end "\tDate:\t$date\n"
2935 if {[info exists children($id)]} {
2936 $ctext insert end "\nChildren:"
2937 set i 0
2938 foreach child $children($id) {
2939 incr i
2940 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
2941 set info $commitinfo($child)
2942 $ctext insert end "\n\t"
2943 $ctext insert end $child [list link link$i]
2944 $ctext tag bind link$i <1> [list selbyid $child]
2945 $ctext insert end "\n\t[lindex $info 0]"
2946 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2947 set date [formatdate [lindex $info 2]]
2948 $ctext insert end "\n\tDate:\t$date\n"
2951 $ctext conf -state disabled
2953 $cflist delete 0 end
2956 proc normalline {} {
2957 global thickerline
2958 if {[info exists thickerline]} {
2959 set id $thickerline
2960 unset thickerline
2961 drawlines $id
2965 proc selbyid {id} {
2966 global commitrow
2967 if {[info exists commitrow($id)]} {
2968 selectline $commitrow($id) 1
2972 proc mstime {} {
2973 global startmstime
2974 if {![info exists startmstime]} {
2975 set startmstime [clock clicks -milliseconds]
2977 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2980 proc rowmenu {x y id} {
2981 global rowctxmenu commitrow selectedline rowmenuid
2983 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2984 set state disabled
2985 } else {
2986 set state normal
2988 $rowctxmenu entryconfigure 0 -state $state
2989 $rowctxmenu entryconfigure 1 -state $state
2990 $rowctxmenu entryconfigure 2 -state $state
2991 set rowmenuid $id
2992 tk_popup $rowctxmenu $x $y
2995 proc diffvssel {dirn} {
2996 global rowmenuid selectedline displayorder
2998 if {![info exists selectedline]} return
2999 if {$dirn} {
3000 set oldid [lindex $displayorder $selectedline]
3001 set newid $rowmenuid
3002 } else {
3003 set oldid $rowmenuid
3004 set newid [lindex $displayorder $selectedline]
3006 addtohistory [list doseldiff $oldid $newid]
3007 doseldiff $oldid $newid
3010 proc doseldiff {oldid newid} {
3011 global ctext cflist
3012 global commitinfo
3014 $ctext conf -state normal
3015 $ctext delete 0.0 end
3016 $ctext mark set fmark.0 0.0
3017 $ctext mark gravity fmark.0 left
3018 $cflist delete 0 end
3019 $cflist insert end "Top"
3020 $ctext insert end "From "
3021 $ctext tag conf link -foreground blue -underline 1
3022 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3023 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3024 $ctext tag bind link0 <1> [list selbyid $oldid]
3025 $ctext insert end $oldid [list link link0]
3026 $ctext insert end "\n "
3027 $ctext insert end [lindex $commitinfo($oldid) 0]
3028 $ctext insert end "\n\nTo "
3029 $ctext tag bind link1 <1> [list selbyid $newid]
3030 $ctext insert end $newid [list link link1]
3031 $ctext insert end "\n "
3032 $ctext insert end [lindex $commitinfo($newid) 0]
3033 $ctext insert end "\n"
3034 $ctext conf -state disabled
3035 $ctext tag delete Comments
3036 $ctext tag remove found 1.0 end
3037 startdiff [list $oldid $newid]
3040 proc mkpatch {} {
3041 global rowmenuid currentid commitinfo patchtop patchnum
3043 if {![info exists currentid]} return
3044 set oldid $currentid
3045 set oldhead [lindex $commitinfo($oldid) 0]
3046 set newid $rowmenuid
3047 set newhead [lindex $commitinfo($newid) 0]
3048 set top .patch
3049 set patchtop $top
3050 catch {destroy $top}
3051 toplevel $top
3052 label $top.title -text "Generate patch"
3053 grid $top.title - -pady 10
3054 label $top.from -text "From:"
3055 entry $top.fromsha1 -width 40 -relief flat
3056 $top.fromsha1 insert 0 $oldid
3057 $top.fromsha1 conf -state readonly
3058 grid $top.from $top.fromsha1 -sticky w
3059 entry $top.fromhead -width 60 -relief flat
3060 $top.fromhead insert 0 $oldhead
3061 $top.fromhead conf -state readonly
3062 grid x $top.fromhead -sticky w
3063 label $top.to -text "To:"
3064 entry $top.tosha1 -width 40 -relief flat
3065 $top.tosha1 insert 0 $newid
3066 $top.tosha1 conf -state readonly
3067 grid $top.to $top.tosha1 -sticky w
3068 entry $top.tohead -width 60 -relief flat
3069 $top.tohead insert 0 $newhead
3070 $top.tohead conf -state readonly
3071 grid x $top.tohead -sticky w
3072 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3073 grid $top.rev x -pady 10
3074 label $top.flab -text "Output file:"
3075 entry $top.fname -width 60
3076 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3077 incr patchnum
3078 grid $top.flab $top.fname -sticky w
3079 frame $top.buts
3080 button $top.buts.gen -text "Generate" -command mkpatchgo
3081 button $top.buts.can -text "Cancel" -command mkpatchcan
3082 grid $top.buts.gen $top.buts.can
3083 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3084 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3085 grid $top.buts - -pady 10 -sticky ew
3086 focus $top.fname
3089 proc mkpatchrev {} {
3090 global patchtop
3092 set oldid [$patchtop.fromsha1 get]
3093 set oldhead [$patchtop.fromhead get]
3094 set newid [$patchtop.tosha1 get]
3095 set newhead [$patchtop.tohead get]
3096 foreach e [list fromsha1 fromhead tosha1 tohead] \
3097 v [list $newid $newhead $oldid $oldhead] {
3098 $patchtop.$e conf -state normal
3099 $patchtop.$e delete 0 end
3100 $patchtop.$e insert 0 $v
3101 $patchtop.$e conf -state readonly
3105 proc mkpatchgo {} {
3106 global patchtop
3108 set oldid [$patchtop.fromsha1 get]
3109 set newid [$patchtop.tosha1 get]
3110 set fname [$patchtop.fname get]
3111 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3112 error_popup "Error creating patch: $err"
3114 catch {destroy $patchtop}
3115 unset patchtop
3118 proc mkpatchcan {} {
3119 global patchtop
3121 catch {destroy $patchtop}
3122 unset patchtop
3125 proc mktag {} {
3126 global rowmenuid mktagtop commitinfo
3128 set top .maketag
3129 set mktagtop $top
3130 catch {destroy $top}
3131 toplevel $top
3132 label $top.title -text "Create tag"
3133 grid $top.title - -pady 10
3134 label $top.id -text "ID:"
3135 entry $top.sha1 -width 40 -relief flat
3136 $top.sha1 insert 0 $rowmenuid
3137 $top.sha1 conf -state readonly
3138 grid $top.id $top.sha1 -sticky w
3139 entry $top.head -width 60 -relief flat
3140 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3141 $top.head conf -state readonly
3142 grid x $top.head -sticky w
3143 label $top.tlab -text "Tag name:"
3144 entry $top.tag -width 60
3145 grid $top.tlab $top.tag -sticky w
3146 frame $top.buts
3147 button $top.buts.gen -text "Create" -command mktaggo
3148 button $top.buts.can -text "Cancel" -command mktagcan
3149 grid $top.buts.gen $top.buts.can
3150 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3151 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3152 grid $top.buts - -pady 10 -sticky ew
3153 focus $top.tag
3156 proc domktag {} {
3157 global mktagtop env tagids idtags
3159 set id [$mktagtop.sha1 get]
3160 set tag [$mktagtop.tag get]
3161 if {$tag == {}} {
3162 error_popup "No tag name specified"
3163 return
3165 if {[info exists tagids($tag)]} {
3166 error_popup "Tag \"$tag\" already exists"
3167 return
3169 if {[catch {
3170 set dir [gitdir]
3171 set fname [file join $dir "refs/tags" $tag]
3172 set f [open $fname w]
3173 puts $f $id
3174 close $f
3175 } err]} {
3176 error_popup "Error creating tag: $err"
3177 return
3180 set tagids($tag) $id
3181 lappend idtags($id) $tag
3182 redrawtags $id
3185 proc redrawtags {id} {
3186 global canv linehtag commitrow idpos selectedline
3188 if {![info exists commitrow($id)]} return
3189 drawcmitrow $commitrow($id)
3190 $canv delete tag.$id
3191 set xt [eval drawtags $id $idpos($id)]
3192 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3193 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3194 selectline $selectedline 0
3198 proc mktagcan {} {
3199 global mktagtop
3201 catch {destroy $mktagtop}
3202 unset mktagtop
3205 proc mktaggo {} {
3206 domktag
3207 mktagcan
3210 proc writecommit {} {
3211 global rowmenuid wrcomtop commitinfo wrcomcmd
3213 set top .writecommit
3214 set wrcomtop $top
3215 catch {destroy $top}
3216 toplevel $top
3217 label $top.title -text "Write commit to file"
3218 grid $top.title - -pady 10
3219 label $top.id -text "ID:"
3220 entry $top.sha1 -width 40 -relief flat
3221 $top.sha1 insert 0 $rowmenuid
3222 $top.sha1 conf -state readonly
3223 grid $top.id $top.sha1 -sticky w
3224 entry $top.head -width 60 -relief flat
3225 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3226 $top.head conf -state readonly
3227 grid x $top.head -sticky w
3228 label $top.clab -text "Command:"
3229 entry $top.cmd -width 60 -textvariable wrcomcmd
3230 grid $top.clab $top.cmd -sticky w -pady 10
3231 label $top.flab -text "Output file:"
3232 entry $top.fname -width 60
3233 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3234 grid $top.flab $top.fname -sticky w
3235 frame $top.buts
3236 button $top.buts.gen -text "Write" -command wrcomgo
3237 button $top.buts.can -text "Cancel" -command wrcomcan
3238 grid $top.buts.gen $top.buts.can
3239 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3240 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3241 grid $top.buts - -pady 10 -sticky ew
3242 focus $top.fname
3245 proc wrcomgo {} {
3246 global wrcomtop
3248 set id [$wrcomtop.sha1 get]
3249 set cmd "echo $id | [$wrcomtop.cmd get]"
3250 set fname [$wrcomtop.fname get]
3251 if {[catch {exec sh -c $cmd >$fname &} err]} {
3252 error_popup "Error writing commit: $err"
3254 catch {destroy $wrcomtop}
3255 unset wrcomtop
3258 proc wrcomcan {} {
3259 global wrcomtop
3261 catch {destroy $wrcomtop}
3262 unset wrcomtop
3265 proc listrefs {id} {
3266 global idtags idheads idotherrefs
3268 set x {}
3269 if {[info exists idtags($id)]} {
3270 set x $idtags($id)
3272 set y {}
3273 if {[info exists idheads($id)]} {
3274 set y $idheads($id)
3276 set z {}
3277 if {[info exists idotherrefs($id)]} {
3278 set z $idotherrefs($id)
3280 return [list $x $y $z]
3283 proc rereadrefs {} {
3284 global idtags idheads idotherrefs
3285 global tagids headids otherrefids
3287 set refids [concat [array names idtags] \
3288 [array names idheads] [array names idotherrefs]]
3289 foreach id $refids {
3290 if {![info exists ref($id)]} {
3291 set ref($id) [listrefs $id]
3294 readrefs
3295 set refids [lsort -unique [concat $refids [array names idtags] \
3296 [array names idheads] [array names idotherrefs]]]
3297 foreach id $refids {
3298 set v [listrefs $id]
3299 if {![info exists ref($id)] || $ref($id) != $v} {
3300 redrawtags $id
3305 proc showtag {tag isnew} {
3306 global ctext cflist tagcontents tagids linknum
3308 if {$isnew} {
3309 addtohistory [list showtag $tag 0]
3311 $ctext conf -state normal
3312 $ctext delete 0.0 end
3313 set linknum 0
3314 if {[info exists tagcontents($tag)]} {
3315 set text $tagcontents($tag)
3316 } else {
3317 set text "Tag: $tag\nId: $tagids($tag)"
3319 appendwithlinks $text
3320 $ctext conf -state disabled
3321 $cflist delete 0 end
3324 proc doquit {} {
3325 global stopped
3326 set stopped 100
3327 destroy .
3330 proc doprefs {} {
3331 global maxwidth maxgraphpct diffopts findmergefiles
3332 global oldprefs prefstop
3334 set top .gitkprefs
3335 set prefstop $top
3336 if {[winfo exists $top]} {
3337 raise $top
3338 return
3340 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3341 set oldprefs($v) [set $v]
3343 toplevel $top
3344 wm title $top "Gitk preferences"
3345 label $top.ldisp -text "Commit list display options"
3346 grid $top.ldisp - -sticky w -pady 10
3347 label $top.spacer -text " "
3348 label $top.maxwidthl -text "Maximum graph width (lines)" \
3349 -font optionfont
3350 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3351 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3352 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3353 -font optionfont
3354 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3355 grid x $top.maxpctl $top.maxpct -sticky w
3356 checkbutton $top.findm -variable findmergefiles
3357 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3358 -font optionfont
3359 grid $top.findm $top.findml - -sticky w
3360 label $top.ddisp -text "Diff display options"
3361 grid $top.ddisp - -sticky w -pady 10
3362 label $top.diffoptl -text "Options for diff program" \
3363 -font optionfont
3364 entry $top.diffopt -width 20 -textvariable diffopts
3365 grid x $top.diffoptl $top.diffopt -sticky w
3366 frame $top.buts
3367 button $top.buts.ok -text "OK" -command prefsok
3368 button $top.buts.can -text "Cancel" -command prefscan
3369 grid $top.buts.ok $top.buts.can
3370 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3371 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3372 grid $top.buts - - -pady 10 -sticky ew
3375 proc prefscan {} {
3376 global maxwidth maxgraphpct diffopts findmergefiles
3377 global oldprefs prefstop
3379 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3380 set $v $oldprefs($v)
3382 catch {destroy $prefstop}
3383 unset prefstop
3386 proc prefsok {} {
3387 global maxwidth maxgraphpct
3388 global oldprefs prefstop
3390 catch {destroy $prefstop}
3391 unset prefstop
3392 if {$maxwidth != $oldprefs(maxwidth)
3393 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3394 redisplay
3398 proc formatdate {d} {
3399 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3402 # This list of encoding names and aliases is distilled from
3403 # http://www.iana.org/assignments/character-sets.
3404 # Not all of them are supported by Tcl.
3405 set encoding_aliases {
3406 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3407 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3408 { ISO-10646-UTF-1 csISO10646UTF1 }
3409 { ISO_646.basic:1983 ref csISO646basic1983 }
3410 { INVARIANT csINVARIANT }
3411 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3412 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3413 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3414 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3415 { NATS-DANO iso-ir-9-1 csNATSDANO }
3416 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3417 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3418 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3419 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3420 { ISO-2022-KR csISO2022KR }
3421 { EUC-KR csEUCKR }
3422 { ISO-2022-JP csISO2022JP }
3423 { ISO-2022-JP-2 csISO2022JP2 }
3424 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3425 csISO13JISC6220jp }
3426 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3427 { IT iso-ir-15 ISO646-IT csISO15Italian }
3428 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3429 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3430 { greek7-old iso-ir-18 csISO18Greek7Old }
3431 { latin-greek iso-ir-19 csISO19LatinGreek }
3432 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3433 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3434 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3435 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3436 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3437 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3438 { INIS iso-ir-49 csISO49INIS }
3439 { INIS-8 iso-ir-50 csISO50INIS8 }
3440 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3441 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3442 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3443 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3444 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3445 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3446 csISO60Norwegian1 }
3447 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3448 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3449 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3450 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3451 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3452 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3453 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3454 { greek7 iso-ir-88 csISO88Greek7 }
3455 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3456 { iso-ir-90 csISO90 }
3457 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3458 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3459 csISO92JISC62991984b }
3460 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3461 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3462 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3463 csISO95JIS62291984handadd }
3464 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3465 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3466 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3467 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3468 CP819 csISOLatin1 }
3469 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3470 { T.61-7bit iso-ir-102 csISO102T617bit }
3471 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3472 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3473 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3474 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3475 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3476 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3477 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3478 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3479 arabic csISOLatinArabic }
3480 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3481 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3482 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3483 greek greek8 csISOLatinGreek }
3484 { T.101-G2 iso-ir-128 csISO128T101G2 }
3485 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3486 csISOLatinHebrew }
3487 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3488 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3489 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3490 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3491 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3492 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3493 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3494 csISOLatinCyrillic }
3495 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3496 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3497 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3498 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3499 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3500 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3501 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3502 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3503 { ISO_10367-box iso-ir-155 csISO10367Box }
3504 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3505 { latin-lap lap iso-ir-158 csISO158Lap }
3506 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3507 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3508 { us-dk csUSDK }
3509 { dk-us csDKUS }
3510 { JIS_X0201 X0201 csHalfWidthKatakana }
3511 { KSC5636 ISO646-KR csKSC5636 }
3512 { ISO-10646-UCS-2 csUnicode }
3513 { ISO-10646-UCS-4 csUCS4 }
3514 { DEC-MCS dec csDECMCS }
3515 { hp-roman8 roman8 r8 csHPRoman8 }
3516 { macintosh mac csMacintosh }
3517 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3518 csIBM037 }
3519 { IBM038 EBCDIC-INT cp038 csIBM038 }
3520 { IBM273 CP273 csIBM273 }
3521 { IBM274 EBCDIC-BE CP274 csIBM274 }
3522 { IBM275 EBCDIC-BR cp275 csIBM275 }
3523 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3524 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3525 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3526 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3527 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3528 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3529 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3530 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3531 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3532 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3533 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3534 { IBM437 cp437 437 csPC8CodePage437 }
3535 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3536 { IBM775 cp775 csPC775Baltic }
3537 { IBM850 cp850 850 csPC850Multilingual }
3538 { IBM851 cp851 851 csIBM851 }
3539 { IBM852 cp852 852 csPCp852 }
3540 { IBM855 cp855 855 csIBM855 }
3541 { IBM857 cp857 857 csIBM857 }
3542 { IBM860 cp860 860 csIBM860 }
3543 { IBM861 cp861 861 cp-is csIBM861 }
3544 { IBM862 cp862 862 csPC862LatinHebrew }
3545 { IBM863 cp863 863 csIBM863 }
3546 { IBM864 cp864 csIBM864 }
3547 { IBM865 cp865 865 csIBM865 }
3548 { IBM866 cp866 866 csIBM866 }
3549 { IBM868 CP868 cp-ar csIBM868 }
3550 { IBM869 cp869 869 cp-gr csIBM869 }
3551 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3552 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3553 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3554 { IBM891 cp891 csIBM891 }
3555 { IBM903 cp903 csIBM903 }
3556 { IBM904 cp904 904 csIBBM904 }
3557 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3558 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3559 { IBM1026 CP1026 csIBM1026 }
3560 { EBCDIC-AT-DE csIBMEBCDICATDE }
3561 { EBCDIC-AT-DE-A csEBCDICATDEA }
3562 { EBCDIC-CA-FR csEBCDICCAFR }
3563 { EBCDIC-DK-NO csEBCDICDKNO }
3564 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3565 { EBCDIC-FI-SE csEBCDICFISE }
3566 { EBCDIC-FI-SE-A csEBCDICFISEA }
3567 { EBCDIC-FR csEBCDICFR }
3568 { EBCDIC-IT csEBCDICIT }
3569 { EBCDIC-PT csEBCDICPT }
3570 { EBCDIC-ES csEBCDICES }
3571 { EBCDIC-ES-A csEBCDICESA }
3572 { EBCDIC-ES-S csEBCDICESS }
3573 { EBCDIC-UK csEBCDICUK }
3574 { EBCDIC-US csEBCDICUS }
3575 { UNKNOWN-8BIT csUnknown8BiT }
3576 { MNEMONIC csMnemonic }
3577 { MNEM csMnem }
3578 { VISCII csVISCII }
3579 { VIQR csVIQR }
3580 { KOI8-R csKOI8R }
3581 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3582 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3583 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3584 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3585 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3586 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3587 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3588 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3589 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3590 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3591 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3592 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3593 { IBM1047 IBM-1047 }
3594 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3595 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3596 { UNICODE-1-1 csUnicode11 }
3597 { CESU-8 csCESU-8 }
3598 { BOCU-1 csBOCU-1 }
3599 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3600 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3601 l8 }
3602 { ISO-8859-15 ISO_8859-15 Latin-9 }
3603 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3604 { GBK CP936 MS936 windows-936 }
3605 { JIS_Encoding csJISEncoding }
3606 { Shift_JIS MS_Kanji csShiftJIS }
3607 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3608 EUC-JP }
3609 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3610 { ISO-10646-UCS-Basic csUnicodeASCII }
3611 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3612 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3613 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3614 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3615 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3616 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3617 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3618 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3619 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3620 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3621 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3622 { Ventura-US csVenturaUS }
3623 { Ventura-International csVenturaInternational }
3624 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3625 { PC8-Turkish csPC8Turkish }
3626 { IBM-Symbols csIBMSymbols }
3627 { IBM-Thai csIBMThai }
3628 { HP-Legal csHPLegal }
3629 { HP-Pi-font csHPPiFont }
3630 { HP-Math8 csHPMath8 }
3631 { Adobe-Symbol-Encoding csHPPSMath }
3632 { HP-DeskTop csHPDesktop }
3633 { Ventura-Math csVenturaMath }
3634 { Microsoft-Publishing csMicrosoftPublishing }
3635 { Windows-31J csWindows31J }
3636 { GB2312 csGB2312 }
3637 { Big5 csBig5 }
3640 proc tcl_encoding {enc} {
3641 global encoding_aliases
3642 set names [encoding names]
3643 set lcnames [string tolower $names]
3644 set enc [string tolower $enc]
3645 set i [lsearch -exact $lcnames $enc]
3646 if {$i < 0} {
3647 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3648 if {[regsub {^iso[-_]} $enc iso encx]} {
3649 set i [lsearch -exact $lcnames $encx]
3652 if {$i < 0} {
3653 foreach l $encoding_aliases {
3654 set ll [string tolower $l]
3655 if {[lsearch -exact $ll $enc] < 0} continue
3656 # look through the aliases for one that tcl knows about
3657 foreach e $ll {
3658 set i [lsearch -exact $lcnames $e]
3659 if {$i < 0} {
3660 if {[regsub {^iso[-_]} $e iso ex]} {
3661 set i [lsearch -exact $lcnames $ex]
3664 if {$i >= 0} break
3666 break
3669 if {$i >= 0} {
3670 return [lindex $names $i]
3672 return {}
3675 # defaults...
3676 set datemode 0
3677 set diffopts "-U 5 -p"
3678 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3680 set gitencoding {}
3681 catch {
3682 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3684 if {$gitencoding == ""} {
3685 set gitencoding "utf-8"
3687 set tclencoding [tcl_encoding $gitencoding]
3688 if {$tclencoding == {}} {
3689 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3692 set mainfont {Helvetica 9}
3693 set textfont {Courier 9}
3694 set findmergefiles 0
3695 set maxgraphpct 50
3696 set maxwidth 16
3697 set revlistorder 0
3698 set fastdate 0
3699 set uparrowlen 7
3700 set downarrowlen 7
3701 set mingaplen 30
3703 set colors {green red blue magenta darkgrey brown orange}
3705 catch {source ~/.gitk}
3707 set namefont $mainfont
3709 font create optionfont -family sans-serif -size -12
3711 set revtreeargs {}
3712 foreach arg $argv {
3713 switch -regexp -- $arg {
3714 "^$" { }
3715 "^-d" { set datemode 1 }
3716 default {
3717 lappend revtreeargs $arg
3722 # check that we can find a .git directory somewhere...
3723 set gitdir [gitdir]
3724 if {![file isdirectory $gitdir]} {
3725 error_popup "Cannot find the git directory \"$gitdir\"."
3726 exit 1
3729 set history {}
3730 set historyindex 0
3732 set optim_delay 16
3734 set stopped 0
3735 set stuffsaved 0
3736 set patchnum 0
3737 setcoords
3738 makewindow $revtreeargs
3739 readrefs
3740 getcommits $revtreeargs