add clean and ignore rules for xdiff/
[git/jnareb-git/bp-gitweb.git] / gitk
blobf4c662423c916dfaabfe14f45a90104944c0dd5c
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
39 set startmsecs [clock clicks -milliseconds]
40 set nextupdate [expr {$startmsecs + 100}]
41 set ncmupdate 1
42 if {[catch {
43 set commfd [open [concat | git-rev-list --header --topo-order \
44 --parents $rlargs] r]
45 } err]} {
46 puts stderr "Error executing git-rev-list: $err"
47 exit 1
49 set leftover {}
50 fconfigure $commfd -blocking 0 -translation lf
51 if {$tclencoding != {}} {
52 fconfigure $commfd -encoding $tclencoding
54 fileevent $commfd readable [list getcommitlines $commfd]
55 . config -cursor watch
56 settextcursor watch
59 proc getcommits {rargs} {
60 global oldcommits commits phase canv mainfont env
62 # check that we can find a .git directory somewhere...
63 set gitdir [gitdir]
64 if {![file isdirectory $gitdir]} {
65 error_popup "Cannot find the git directory \"$gitdir\"."
66 exit 1
68 set oldcommits {}
69 set commits {}
70 set phase getcommits
71 start_rev_list [parse_args $rargs]
72 $canv delete all
73 $canv create text 3 3 -anchor nw -text "Reading commits..." \
74 -font $mainfont -tags textitems
77 proc getcommitlines {commfd} {
78 global oldcommits commits parents cdate children nchildren
79 global commitlisted phase nextupdate
80 global stopped redisplaying leftover
81 global canv
83 set stuff [read $commfd]
84 if {$stuff == {}} {
85 if {![eof $commfd]} return
86 # set it blocking so we wait for the process to terminate
87 fconfigure $commfd -blocking 1
88 if {![catch {close $commfd} err]} {
89 after idle finishcommits
90 return
92 if {[string range $err 0 4] == "usage"} {
93 set err \
94 "Gitk: error reading commits: bad arguments to git-rev-list.\
95 (Note: arguments to gitk are passed to git-rev-list\
96 to allow selection of commits to be displayed.)"
97 } else {
98 set err "Error reading commits: $err"
100 error_popup $err
101 exit 1
103 set start 0
104 while 1 {
105 set i [string first "\0" $stuff $start]
106 if {$i < 0} {
107 append leftover [string range $stuff $start end]
108 return
110 set cmit [string range $stuff $start [expr {$i - 1}]]
111 if {$start == 0} {
112 set cmit "$leftover$cmit"
113 set leftover {}
115 set start [expr {$i + 1}]
116 set j [string first "\n" $cmit]
117 set ok 0
118 if {$j >= 0} {
119 set ids [string range $cmit 0 [expr {$j - 1}]]
120 set ok 1
121 foreach id $ids {
122 if {![regexp {^[0-9a-f]{40}$} $id]} {
123 set ok 0
124 break
128 if {!$ok} {
129 set shortcmit $cmit
130 if {[string length $shortcmit] > 80} {
131 set shortcmit "[string range $shortcmit 0 80]..."
133 error_popup "Can't parse git-rev-list output: {$shortcmit}"
134 exit 1
136 set id [lindex $ids 0]
137 set olds [lrange $ids 1 end]
138 set cmit [string range $cmit [expr {$j + 1}] end]
139 lappend commits $id
140 set commitlisted($id) 1
141 parsecommit $id $cmit 1 [lrange $ids 1 end]
142 drawcommit $id 1
143 if {[clock clicks -milliseconds] >= $nextupdate} {
144 doupdate 1
146 while {$redisplaying} {
147 set redisplaying 0
148 if {$stopped == 1} {
149 set stopped 0
150 set phase "getcommits"
151 foreach id $commits {
152 drawcommit $id 1
153 if {$stopped} break
154 if {[clock clicks -milliseconds] >= $nextupdate} {
155 doupdate 1
163 proc doupdate {reading} {
164 global commfd nextupdate numcommits ncmupdate
166 if {$reading} {
167 fileevent $commfd readable {}
169 update
170 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
171 if {$numcommits < 100} {
172 set ncmupdate [expr {$numcommits + 1}]
173 } elseif {$numcommits < 10000} {
174 set ncmupdate [expr {$numcommits + 10}]
175 } else {
176 set ncmupdate [expr {$numcommits + 100}]
178 if {$reading} {
179 fileevent $commfd readable [list getcommitlines $commfd]
183 proc readcommit {id} {
184 if {[catch {set contents [exec git-cat-file commit $id]}]} return
185 parsecommit $id $contents 0 {}
188 proc updatecommits {rargs} {
189 global commitlisted commfd phase
190 global startmsecs nextupdate ncmupdate
191 global idtags idheads idotherrefs
192 global leftover
193 global parsed_args
194 global canv mainfont
195 global oldcommits commits
196 global parents nchildren children ncleft
198 set old_args $parsed_args
199 parse_args $rargs
201 if {$phase == "getcommits" || $phase == "incrdraw"} {
202 # havent read all the old commits, just start again from scratch
203 stopfindproc
204 set oldcommits {}
205 set commits {}
206 foreach v {children nchildren parents commitlisted commitinfo
207 selectedline matchinglines treediffs
208 mergefilelist currentid rowtextx} {
209 global $v
210 catch {unset $v}
212 readrefs
213 if {$phase == "incrdraw"} {
214 allcanvs delete all
215 $canv create text 3 3 -anchor nw -text "Reading commits..." \
216 -font $mainfont -tags textitems
217 set phase getcommits
219 start_rev_list $parsed_args
220 return
223 foreach id $old_args {
224 if {![regexp {^[0-9a-f]{40}$} $id]} continue
225 if {[info exists oldref($id)]} continue
226 set oldref($id) $id
227 lappend ignoreold "^$id"
229 foreach id $parsed_args {
230 if {![regexp {^[0-9a-f]{40}$} $id]} continue
231 if {[info exists ref($id)]} continue
232 set ref($id) $id
233 lappend ignorenew "^$id"
236 foreach a $old_args {
237 if {![info exists ref($a)]} {
238 lappend ignorenew $a
242 set phase updatecommits
243 set oldcommits $commits
244 set commits {}
245 set removed_commits [split [eval exec git-rev-list $ignorenew] "\n" ]
246 if {[llength $removed_commits] > 0} {
247 allcanvs delete all
248 foreach c $removed_commits {
249 set i [lsearch -exact $oldcommits $c]
250 if {$i >= 0} {
251 set oldcommits [lreplace $oldcommits $i $i]
252 unset commitlisted($c)
253 foreach p $parents($c) {
254 if {[info exists nchildren($p)]} {
255 set j [lsearch -exact $children($p) $c]
256 if {$j >= 0} {
257 set children($p) [lreplace $children($p) $j $j]
258 incr nchildren($p) -1
264 set phase removecommits
267 set args {}
268 foreach a $parsed_args {
269 if {![info exists oldref($a)]} {
270 lappend args $a
274 readrefs
275 start_rev_list [concat $ignoreold $args]
278 proc updatechildren {id olds} {
279 global children nchildren parents nparents ncleft
281 if {![info exists nchildren($id)]} {
282 set children($id) {}
283 set nchildren($id) 0
284 set ncleft($id) 0
286 set parents($id) $olds
287 set nparents($id) [llength $olds]
288 foreach p $olds {
289 if {![info exists nchildren($p)]} {
290 set children($p) [list $id]
291 set nchildren($p) 1
292 set ncleft($p) 1
293 } elseif {[lsearch -exact $children($p) $id] < 0} {
294 lappend children($p) $id
295 incr nchildren($p)
296 incr ncleft($p)
301 proc parsecommit {id contents listed olds} {
302 global commitinfo cdate
304 set inhdr 1
305 set comment {}
306 set headline {}
307 set auname {}
308 set audate {}
309 set comname {}
310 set comdate {}
311 updatechildren $id $olds
312 set hdrend [string first "\n\n" $contents]
313 if {$hdrend < 0} {
314 # should never happen...
315 set hdrend [string length $contents]
317 set header [string range $contents 0 [expr {$hdrend - 1}]]
318 set comment [string range $contents [expr {$hdrend + 2}] end]
319 foreach line [split $header "\n"] {
320 set tag [lindex $line 0]
321 if {$tag == "author"} {
322 set audate [lindex $line end-1]
323 set auname [lrange $line 1 end-2]
324 } elseif {$tag == "committer"} {
325 set comdate [lindex $line end-1]
326 set comname [lrange $line 1 end-2]
329 set headline {}
330 # take the first line of the comment as the headline
331 set i [string first "\n" $comment]
332 if {$i >= 0} {
333 set headline [string trim [string range $comment 0 $i]]
334 } else {
335 set headline $comment
337 if {!$listed} {
338 # git-rev-list indents the comment by 4 spaces;
339 # if we got this via git-cat-file, add the indentation
340 set newcomment {}
341 foreach line [split $comment "\n"] {
342 append newcomment " "
343 append newcomment $line
344 append newcomment "\n"
346 set comment $newcomment
348 if {$comdate != {}} {
349 set cdate($id) $comdate
351 set commitinfo($id) [list $headline $auname $audate \
352 $comname $comdate $comment]
355 proc readrefs {} {
356 global tagids idtags headids idheads tagcontents
357 global otherrefids idotherrefs
359 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
360 catch {unset $v}
362 set refd [open [list | git-ls-remote [gitdir]] r]
363 while {0 <= [set n [gets $refd line]]} {
364 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
365 match id path]} {
366 continue
368 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
369 set type others
370 set name $path
372 if {$type == "tags"} {
373 set tagids($name) $id
374 lappend idtags($id) $name
375 set obj {}
376 set type {}
377 set tag {}
378 catch {
379 set commit [exec git-rev-parse "$id^0"]
380 if {"$commit" != "$id"} {
381 set tagids($name) $commit
382 lappend idtags($commit) $name
385 catch {
386 set tagcontents($name) [exec git-cat-file tag "$id"]
388 } elseif { $type == "heads" } {
389 set headids($name) $id
390 lappend idheads($id) $name
391 } else {
392 set otherrefids($name) $id
393 lappend idotherrefs($id) $name
396 close $refd
399 proc error_popup msg {
400 set w .error
401 toplevel $w
402 wm transient $w .
403 message $w.m -text $msg -justify center -aspect 400
404 pack $w.m -side top -fill x -padx 20 -pady 20
405 button $w.ok -text OK -command "destroy $w"
406 pack $w.ok -side bottom -fill x
407 bind $w <Visibility> "grab $w; focus $w"
408 tkwait window $w
411 proc makewindow {rargs} {
412 global canv canv2 canv3 linespc charspc ctext cflist textfont
413 global findtype findtypemenu findloc findstring fstring geometry
414 global entries sha1entry sha1string sha1but
415 global maincursor textcursor curtextcursor
416 global rowctxmenu mergemax
418 menu .bar
419 .bar add cascade -label "File" -menu .bar.file
420 menu .bar.file
421 .bar.file add command -label "Update" -command [list updatecommits $rargs]
422 .bar.file add command -label "Reread references" -command rereadrefs
423 .bar.file add command -label "Quit" -command doquit
424 menu .bar.edit
425 .bar add cascade -label "Edit" -menu .bar.edit
426 .bar.edit add command -label "Preferences" -command doprefs
427 menu .bar.help
428 .bar add cascade -label "Help" -menu .bar.help
429 .bar.help add command -label "About gitk" -command about
430 . configure -menu .bar
432 if {![info exists geometry(canv1)]} {
433 set geometry(canv1) [expr {45 * $charspc}]
434 set geometry(canv2) [expr {30 * $charspc}]
435 set geometry(canv3) [expr {15 * $charspc}]
436 set geometry(canvh) [expr {25 * $linespc + 4}]
437 set geometry(ctextw) 80
438 set geometry(ctexth) 30
439 set geometry(cflistw) 30
441 panedwindow .ctop -orient vertical
442 if {[info exists geometry(width)]} {
443 .ctop conf -width $geometry(width) -height $geometry(height)
444 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
445 set geometry(ctexth) [expr {($texth - 8) /
446 [font metrics $textfont -linespace]}]
448 frame .ctop.top
449 frame .ctop.top.bar
450 pack .ctop.top.bar -side bottom -fill x
451 set cscroll .ctop.top.csb
452 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
453 pack $cscroll -side right -fill y
454 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
455 pack .ctop.top.clist -side top -fill both -expand 1
456 .ctop add .ctop.top
457 set canv .ctop.top.clist.canv
458 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
459 -bg white -bd 0 \
460 -yscrollincr $linespc -yscrollcommand "$cscroll set"
461 .ctop.top.clist add $canv
462 set canv2 .ctop.top.clist.canv2
463 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
464 -bg white -bd 0 -yscrollincr $linespc
465 .ctop.top.clist add $canv2
466 set canv3 .ctop.top.clist.canv3
467 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
468 -bg white -bd 0 -yscrollincr $linespc
469 .ctop.top.clist add $canv3
470 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
472 set sha1entry .ctop.top.bar.sha1
473 set entries $sha1entry
474 set sha1but .ctop.top.bar.sha1label
475 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
476 -command gotocommit -width 8
477 $sha1but conf -disabledforeground [$sha1but cget -foreground]
478 pack .ctop.top.bar.sha1label -side left
479 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
480 trace add variable sha1string write sha1change
481 pack $sha1entry -side left -pady 2
483 image create bitmap bm-left -data {
484 #define left_width 16
485 #define left_height 16
486 static unsigned char left_bits[] = {
487 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
488 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
489 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
491 image create bitmap bm-right -data {
492 #define right_width 16
493 #define right_height 16
494 static unsigned char right_bits[] = {
495 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
496 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
497 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
499 button .ctop.top.bar.leftbut -image bm-left -command goback \
500 -state disabled -width 26
501 pack .ctop.top.bar.leftbut -side left -fill y
502 button .ctop.top.bar.rightbut -image bm-right -command goforw \
503 -state disabled -width 26
504 pack .ctop.top.bar.rightbut -side left -fill y
506 button .ctop.top.bar.findbut -text "Find" -command dofind
507 pack .ctop.top.bar.findbut -side left
508 set findstring {}
509 set fstring .ctop.top.bar.findstring
510 lappend entries $fstring
511 entry $fstring -width 30 -font $textfont -textvariable findstring
512 pack $fstring -side left -expand 1 -fill x
513 set findtype Exact
514 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
515 findtype Exact IgnCase Regexp]
516 set findloc "All fields"
517 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
518 Comments Author Committer Files Pickaxe
519 pack .ctop.top.bar.findloc -side right
520 pack .ctop.top.bar.findtype -side right
521 # for making sure type==Exact whenever loc==Pickaxe
522 trace add variable findloc write findlocchange
524 panedwindow .ctop.cdet -orient horizontal
525 .ctop add .ctop.cdet
526 frame .ctop.cdet.left
527 set ctext .ctop.cdet.left.ctext
528 text $ctext -bg white -state disabled -font $textfont \
529 -width $geometry(ctextw) -height $geometry(ctexth) \
530 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
531 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
532 pack .ctop.cdet.left.sb -side right -fill y
533 pack $ctext -side left -fill both -expand 1
534 .ctop.cdet add .ctop.cdet.left
536 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
537 $ctext tag conf hunksep -fore blue
538 $ctext tag conf d0 -fore red
539 $ctext tag conf d1 -fore "#00a000"
540 $ctext tag conf m0 -fore red
541 $ctext tag conf m1 -fore blue
542 $ctext tag conf m2 -fore green
543 $ctext tag conf m3 -fore purple
544 $ctext tag conf m4 -fore brown
545 $ctext tag conf m5 -fore "#009090"
546 $ctext tag conf m6 -fore magenta
547 $ctext tag conf m7 -fore "#808000"
548 $ctext tag conf m8 -fore "#009000"
549 $ctext tag conf m9 -fore "#ff0080"
550 $ctext tag conf m10 -fore cyan
551 $ctext tag conf m11 -fore "#b07070"
552 $ctext tag conf m12 -fore "#70b0f0"
553 $ctext tag conf m13 -fore "#70f0b0"
554 $ctext tag conf m14 -fore "#f0b070"
555 $ctext tag conf m15 -fore "#ff70b0"
556 $ctext tag conf mmax -fore darkgrey
557 set mergemax 16
558 $ctext tag conf mresult -font [concat $textfont bold]
559 $ctext tag conf msep -font [concat $textfont bold]
560 $ctext tag conf found -back yellow
562 frame .ctop.cdet.right
563 set cflist .ctop.cdet.right.cfiles
564 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
565 -yscrollcommand ".ctop.cdet.right.sb set"
566 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
567 pack .ctop.cdet.right.sb -side right -fill y
568 pack $cflist -side left -fill both -expand 1
569 .ctop.cdet add .ctop.cdet.right
570 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
572 pack .ctop -side top -fill both -expand 1
574 bindall <1> {selcanvline %W %x %y}
575 #bindall <B1-Motion> {selcanvline %W %x %y}
576 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
577 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
578 bindall <2> "allcanvs scan mark 0 %y"
579 bindall <B2-Motion> "allcanvs scan dragto 0 %y"
580 bind . <Key-Up> "selnextline -1"
581 bind . <Key-Down> "selnextline 1"
582 bind . <Key-Right> "goforw"
583 bind . <Key-Left> "goback"
584 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
585 bind . <Key-Next> "allcanvs yview scroll 1 pages"
586 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
587 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
588 bindkey <Key-space> "$ctext yview scroll 1 pages"
589 bindkey p "selnextline -1"
590 bindkey n "selnextline 1"
591 bindkey z "goback"
592 bindkey x "goforw"
593 bindkey i "selnextline -1"
594 bindkey k "selnextline 1"
595 bindkey j "goback"
596 bindkey l "goforw"
597 bindkey b "$ctext yview scroll -1 pages"
598 bindkey d "$ctext yview scroll 18 units"
599 bindkey u "$ctext yview scroll -18 units"
600 bindkey / {findnext 1}
601 bindkey <Key-Return> {findnext 0}
602 bindkey ? findprev
603 bindkey f nextfile
604 bind . <Control-q> doquit
605 bind . <Control-f> dofind
606 bind . <Control-g> {findnext 0}
607 bind . <Control-r> findprev
608 bind . <Control-equal> {incrfont 1}
609 bind . <Control-KP_Add> {incrfont 1}
610 bind . <Control-minus> {incrfont -1}
611 bind . <Control-KP_Subtract> {incrfont -1}
612 bind $cflist <<ListboxSelect>> listboxsel
613 bind . <Destroy> {savestuff %W}
614 bind . <Button-1> "click %W"
615 bind $fstring <Key-Return> dofind
616 bind $sha1entry <Key-Return> gotocommit
617 bind $sha1entry <<PasteSelection>> clearsha1
619 set maincursor [. cget -cursor]
620 set textcursor [$ctext cget -cursor]
621 set curtextcursor $textcursor
623 set rowctxmenu .rowctxmenu
624 menu $rowctxmenu -tearoff 0
625 $rowctxmenu add command -label "Diff this -> selected" \
626 -command {diffvssel 0}
627 $rowctxmenu add command -label "Diff selected -> this" \
628 -command {diffvssel 1}
629 $rowctxmenu add command -label "Make patch" -command mkpatch
630 $rowctxmenu add command -label "Create tag" -command mktag
631 $rowctxmenu add command -label "Write commit to file" -command writecommit
634 # when we make a key binding for the toplevel, make sure
635 # it doesn't get triggered when that key is pressed in the
636 # find string entry widget.
637 proc bindkey {ev script} {
638 global entries
639 bind . $ev $script
640 set escript [bind Entry $ev]
641 if {$escript == {}} {
642 set escript [bind Entry <Key>]
644 foreach e $entries {
645 bind $e $ev "$escript; break"
649 # set the focus back to the toplevel for any click outside
650 # the entry widgets
651 proc click {w} {
652 global entries
653 foreach e $entries {
654 if {$w == $e} return
656 focus .
659 proc savestuff {w} {
660 global canv canv2 canv3 ctext cflist mainfont textfont
661 global stuffsaved findmergefiles maxgraphpct
662 global maxwidth
664 if {$stuffsaved} return
665 if {![winfo viewable .]} return
666 catch {
667 set f [open "~/.gitk-new" w]
668 puts $f [list set mainfont $mainfont]
669 puts $f [list set textfont $textfont]
670 puts $f [list set findmergefiles $findmergefiles]
671 puts $f [list set maxgraphpct $maxgraphpct]
672 puts $f [list set maxwidth $maxwidth]
673 puts $f "set geometry(width) [winfo width .ctop]"
674 puts $f "set geometry(height) [winfo height .ctop]"
675 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
676 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
677 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
678 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
679 set wid [expr {([winfo width $ctext] - 8) \
680 / [font measure $textfont "0"]}]
681 puts $f "set geometry(ctextw) $wid"
682 set wid [expr {([winfo width $cflist] - 11) \
683 / [font measure [$cflist cget -font] "0"]}]
684 puts $f "set geometry(cflistw) $wid"
685 close $f
686 file rename -force "~/.gitk-new" "~/.gitk"
688 set stuffsaved 1
691 proc resizeclistpanes {win w} {
692 global oldwidth
693 if {[info exists oldwidth($win)]} {
694 set s0 [$win sash coord 0]
695 set s1 [$win sash coord 1]
696 if {$w < 60} {
697 set sash0 [expr {int($w/2 - 2)}]
698 set sash1 [expr {int($w*5/6 - 2)}]
699 } else {
700 set factor [expr {1.0 * $w / $oldwidth($win)}]
701 set sash0 [expr {int($factor * [lindex $s0 0])}]
702 set sash1 [expr {int($factor * [lindex $s1 0])}]
703 if {$sash0 < 30} {
704 set sash0 30
706 if {$sash1 < $sash0 + 20} {
707 set sash1 [expr {$sash0 + 20}]
709 if {$sash1 > $w - 10} {
710 set sash1 [expr {$w - 10}]
711 if {$sash0 > $sash1 - 20} {
712 set sash0 [expr {$sash1 - 20}]
716 $win sash place 0 $sash0 [lindex $s0 1]
717 $win sash place 1 $sash1 [lindex $s1 1]
719 set oldwidth($win) $w
722 proc resizecdetpanes {win w} {
723 global oldwidth
724 if {[info exists oldwidth($win)]} {
725 set s0 [$win sash coord 0]
726 if {$w < 60} {
727 set sash0 [expr {int($w*3/4 - 2)}]
728 } else {
729 set factor [expr {1.0 * $w / $oldwidth($win)}]
730 set sash0 [expr {int($factor * [lindex $s0 0])}]
731 if {$sash0 < 45} {
732 set sash0 45
734 if {$sash0 > $w - 15} {
735 set sash0 [expr {$w - 15}]
738 $win sash place 0 $sash0 [lindex $s0 1]
740 set oldwidth($win) $w
743 proc allcanvs args {
744 global canv canv2 canv3
745 eval $canv $args
746 eval $canv2 $args
747 eval $canv3 $args
750 proc bindall {event action} {
751 global canv canv2 canv3
752 bind $canv $event $action
753 bind $canv2 $event $action
754 bind $canv3 $event $action
757 proc about {} {
758 set w .about
759 if {[winfo exists $w]} {
760 raise $w
761 return
763 toplevel $w
764 wm title $w "About gitk"
765 message $w.m -text {
766 Gitk version 1.2
768 Copyright © 2005 Paul Mackerras
770 Use and redistribute under the terms of the GNU General Public License} \
771 -justify center -aspect 400
772 pack $w.m -side top -fill x -padx 20 -pady 20
773 button $w.ok -text Close -command "destroy $w"
774 pack $w.ok -side bottom
777 proc assigncolor {id} {
778 global colormap commcolors colors nextcolor
779 global parents nparents children nchildren
780 global cornercrossings crossings
782 if {[info exists colormap($id)]} return
783 set ncolors [llength $colors]
784 if {$nparents($id) <= 1 && $nchildren($id) == 1} {
785 set child [lindex $children($id) 0]
786 if {[info exists colormap($child)]
787 && $nparents($child) == 1} {
788 set colormap($id) $colormap($child)
789 return
792 set badcolors {}
793 if {[info exists cornercrossings($id)]} {
794 foreach x $cornercrossings($id) {
795 if {[info exists colormap($x)]
796 && [lsearch -exact $badcolors $colormap($x)] < 0} {
797 lappend badcolors $colormap($x)
800 if {[llength $badcolors] >= $ncolors} {
801 set badcolors {}
804 set origbad $badcolors
805 if {[llength $badcolors] < $ncolors - 1} {
806 if {[info exists crossings($id)]} {
807 foreach x $crossings($id) {
808 if {[info exists colormap($x)]
809 && [lsearch -exact $badcolors $colormap($x)] < 0} {
810 lappend badcolors $colormap($x)
813 if {[llength $badcolors] >= $ncolors} {
814 set badcolors $origbad
817 set origbad $badcolors
819 if {[llength $badcolors] < $ncolors - 1} {
820 foreach child $children($id) {
821 if {[info exists colormap($child)]
822 && [lsearch -exact $badcolors $colormap($child)] < 0} {
823 lappend badcolors $colormap($child)
825 if {[info exists parents($child)]} {
826 foreach p $parents($child) {
827 if {[info exists colormap($p)]
828 && [lsearch -exact $badcolors $colormap($p)] < 0} {
829 lappend badcolors $colormap($p)
834 if {[llength $badcolors] >= $ncolors} {
835 set badcolors $origbad
838 for {set i 0} {$i <= $ncolors} {incr i} {
839 set c [lindex $colors $nextcolor]
840 if {[incr nextcolor] >= $ncolors} {
841 set nextcolor 0
843 if {[lsearch -exact $badcolors $c]} break
845 set colormap($id) $c
848 proc initgraph {} {
849 global canvy canvy0 lineno numcommits nextcolor linespc
850 global nchildren ncleft
851 global displist nhyperspace
853 allcanvs delete all
854 set nextcolor 0
855 set canvy $canvy0
856 set lineno -1
857 set numcommits 0
858 foreach v {mainline mainlinearrow sidelines colormap cornercrossings
859 crossings idline lineid} {
860 global $v
861 catch {unset $v}
863 foreach id [array names nchildren] {
864 set ncleft($id) $nchildren($id)
866 set displist {}
867 set nhyperspace 0
870 proc bindline {t id} {
871 global canv
873 $canv bind $t <Enter> "lineenter %x %y $id"
874 $canv bind $t <Motion> "linemotion %x %y $id"
875 $canv bind $t <Leave> "lineleave $id"
876 $canv bind $t <Button-1> "lineclick %x %y $id 1"
879 proc drawlines {id xtra delold} {
880 global mainline mainlinearrow sidelines lthickness colormap canv
882 if {$delold} {
883 $canv delete lines.$id
885 if {[info exists mainline($id)]} {
886 set t [$canv create line $mainline($id) \
887 -width [expr {($xtra + 1) * $lthickness}] \
888 -fill $colormap($id) -tags lines.$id \
889 -arrow $mainlinearrow($id)]
890 $canv lower $t
891 bindline $t $id
893 if {[info exists sidelines($id)]} {
894 foreach ls $sidelines($id) {
895 set coords [lindex $ls 0]
896 set thick [lindex $ls 1]
897 set arrow [lindex $ls 2]
898 set t [$canv create line $coords -fill $colormap($id) \
899 -width [expr {($thick + $xtra) * $lthickness}] \
900 -arrow $arrow -tags lines.$id]
901 $canv lower $t
902 bindline $t $id
907 # level here is an index in displist
908 proc drawcommitline {level} {
909 global parents children nparents displist
910 global canv canv2 canv3 mainfont namefont canvy linespc
911 global lineid linehtag linentag linedtag commitinfo
912 global colormap numcommits currentparents dupparents
913 global idtags idline idheads idotherrefs
914 global lineno lthickness mainline mainlinearrow sidelines
915 global commitlisted rowtextx idpos lastuse displist
916 global oldnlines olddlevel olddisplist
918 incr numcommits
919 incr lineno
920 set id [lindex $displist $level]
921 set lastuse($id) $lineno
922 set lineid($lineno) $id
923 set idline($id) $lineno
924 set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
925 if {![info exists commitinfo($id)]} {
926 readcommit $id
927 if {![info exists commitinfo($id)]} {
928 set commitinfo($id) {"No commit information available"}
929 set nparents($id) 0
932 assigncolor $id
933 set currentparents {}
934 set dupparents {}
935 if {[info exists commitlisted($id)] && [info exists parents($id)]} {
936 foreach p $parents($id) {
937 if {[lsearch -exact $currentparents $p] < 0} {
938 lappend currentparents $p
939 } else {
940 # remember that this parent was listed twice
941 lappend dupparents $p
945 set x [xcoord $level $level $lineno]
946 set y1 $canvy
947 set canvy [expr {$canvy + $linespc}]
948 allcanvs conf -scrollregion \
949 [list 0 0 0 [expr {$y1 + 0.5 * $linespc + 2}]]
950 if {[info exists mainline($id)]} {
951 lappend mainline($id) $x $y1
952 if {$mainlinearrow($id) ne "none"} {
953 set mainline($id) [trimdiagstart $mainline($id)]
956 drawlines $id 0 0
957 set orad [expr {$linespc / 3}]
958 set t [$canv create oval [expr {$x - $orad}] [expr {$y1 - $orad}] \
959 [expr {$x + $orad - 1}] [expr {$y1 + $orad - 1}] \
960 -fill $ofill -outline black -width 1]
961 $canv raise $t
962 $canv bind $t <1> {selcanvline {} %x %y}
963 set xt [xcoord [llength $displist] $level $lineno]
964 if {[llength $currentparents] > 2} {
965 set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
967 set rowtextx($lineno) $xt
968 set idpos($id) [list $x $xt $y1]
969 if {[info exists idtags($id)] || [info exists idheads($id)]
970 || [info exists idotherrefs($id)]} {
971 set xt [drawtags $id $x $xt $y1]
973 set headline [lindex $commitinfo($id) 0]
974 set name [lindex $commitinfo($id) 1]
975 set date [lindex $commitinfo($id) 2]
976 set date [formatdate $date]
977 set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
978 -text $headline -font $mainfont ]
979 $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
980 set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
981 -text $name -font $namefont]
982 set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
983 -text $date -font $mainfont]
985 set olddlevel $level
986 set olddisplist $displist
987 set oldnlines [llength $displist]
990 proc drawtags {id x xt y1} {
991 global idtags idheads idotherrefs
992 global linespc lthickness
993 global canv mainfont idline rowtextx
995 set marks {}
996 set ntags 0
997 set nheads 0
998 if {[info exists idtags($id)]} {
999 set marks $idtags($id)
1000 set ntags [llength $marks]
1002 if {[info exists idheads($id)]} {
1003 set marks [concat $marks $idheads($id)]
1004 set nheads [llength $idheads($id)]
1006 if {[info exists idotherrefs($id)]} {
1007 set marks [concat $marks $idotherrefs($id)]
1009 if {$marks eq {}} {
1010 return $xt
1013 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1014 set yt [expr {$y1 - 0.5 * $linespc}]
1015 set yb [expr {$yt + $linespc - 1}]
1016 set xvals {}
1017 set wvals {}
1018 foreach tag $marks {
1019 set wid [font measure $mainfont $tag]
1020 lappend xvals $xt
1021 lappend wvals $wid
1022 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1024 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1025 -width $lthickness -fill black -tags tag.$id]
1026 $canv lower $t
1027 foreach tag $marks x $xvals wid $wvals {
1028 set xl [expr {$x + $delta}]
1029 set xr [expr {$x + $delta + $wid + $lthickness}]
1030 if {[incr ntags -1] >= 0} {
1031 # draw a tag
1032 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1033 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1034 -width 1 -outline black -fill yellow -tags tag.$id]
1035 $canv bind $t <1> [list showtag $tag 1]
1036 set rowtextx($idline($id)) [expr {$xr + $linespc}]
1037 } else {
1038 # draw a head or other ref
1039 if {[incr nheads -1] >= 0} {
1040 set col green
1041 } else {
1042 set col "#ddddff"
1044 set xl [expr {$xl - $delta/2}]
1045 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1046 -width 1 -outline black -fill $col -tags tag.$id
1048 set t [$canv create text $xl $y1 -anchor w -text $tag \
1049 -font $mainfont -tags tag.$id]
1050 if {$ntags >= 0} {
1051 $canv bind $t <1> [list showtag $tag 1]
1054 return $xt
1057 proc notecrossings {id lo hi corner} {
1058 global olddisplist crossings cornercrossings
1060 for {set i $lo} {[incr i] < $hi} {} {
1061 set p [lindex $olddisplist $i]
1062 if {$p == {}} continue
1063 if {$i == $corner} {
1064 if {![info exists cornercrossings($id)]
1065 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1066 lappend cornercrossings($id) $p
1068 if {![info exists cornercrossings($p)]
1069 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1070 lappend cornercrossings($p) $id
1072 } else {
1073 if {![info exists crossings($id)]
1074 || [lsearch -exact $crossings($id) $p] < 0} {
1075 lappend crossings($id) $p
1077 if {![info exists crossings($p)]
1078 || [lsearch -exact $crossings($p) $id] < 0} {
1079 lappend crossings($p) $id
1085 proc xcoord {i level ln} {
1086 global canvx0 xspc1 xspc2
1088 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1089 if {$i > 0 && $i == $level} {
1090 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1091 } elseif {$i > $level} {
1092 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1094 return $x
1097 # it seems Tk can't draw arrows on the end of diagonal line segments...
1098 proc trimdiagend {line} {
1099 while {[llength $line] > 4} {
1100 set x1 [lindex $line end-3]
1101 set y1 [lindex $line end-2]
1102 set x2 [lindex $line end-1]
1103 set y2 [lindex $line end]
1104 if {($x1 == $x2) != ($y1 == $y2)} break
1105 set line [lreplace $line end-1 end]
1107 return $line
1110 proc trimdiagstart {line} {
1111 while {[llength $line] > 4} {
1112 set x1 [lindex $line 0]
1113 set y1 [lindex $line 1]
1114 set x2 [lindex $line 2]
1115 set y2 [lindex $line 3]
1116 if {($x1 == $x2) != ($y1 == $y2)} break
1117 set line [lreplace $line 0 1]
1119 return $line
1122 proc drawslants {id needonscreen nohs} {
1123 global canv mainline mainlinearrow sidelines
1124 global canvx0 canvy xspc1 xspc2 lthickness
1125 global currentparents dupparents
1126 global lthickness linespc canvy colormap lineno geometry
1127 global maxgraphpct maxwidth
1128 global displist onscreen lastuse
1129 global parents commitlisted
1130 global oldnlines olddlevel olddisplist
1131 global nhyperspace numcommits nnewparents
1133 if {$lineno < 0} {
1134 lappend displist $id
1135 set onscreen($id) 1
1136 return 0
1139 set y1 [expr {$canvy - $linespc}]
1140 set y2 $canvy
1142 # work out what we need to get back on screen
1143 set reins {}
1144 if {$onscreen($id) < 0} {
1145 # next to do isn't displayed, better get it on screen...
1146 lappend reins [list $id 0]
1148 # make sure all the previous commits's parents are on the screen
1149 foreach p $currentparents {
1150 if {$onscreen($p) < 0} {
1151 lappend reins [list $p 0]
1154 # bring back anything requested by caller
1155 if {$needonscreen ne {}} {
1156 lappend reins $needonscreen
1159 # try the shortcut
1160 if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1161 set dlevel $olddlevel
1162 set x [xcoord $dlevel $dlevel $lineno]
1163 set mainline($id) [list $x $y1]
1164 set mainlinearrow($id) none
1165 set lastuse($id) $lineno
1166 set displist [lreplace $displist $dlevel $dlevel $id]
1167 set onscreen($id) 1
1168 set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1169 return $dlevel
1172 # update displist
1173 set displist [lreplace $displist $olddlevel $olddlevel]
1174 set j $olddlevel
1175 foreach p $currentparents {
1176 set lastuse($p) $lineno
1177 if {$onscreen($p) == 0} {
1178 set displist [linsert $displist $j $p]
1179 set onscreen($p) 1
1180 incr j
1183 if {$onscreen($id) == 0} {
1184 lappend displist $id
1185 set onscreen($id) 1
1188 # remove the null entry if present
1189 set nullentry [lsearch -exact $displist {}]
1190 if {$nullentry >= 0} {
1191 set displist [lreplace $displist $nullentry $nullentry]
1194 # bring back the ones we need now (if we did it earlier
1195 # it would change displist and invalidate olddlevel)
1196 foreach pi $reins {
1197 # test again in case of duplicates in reins
1198 set p [lindex $pi 0]
1199 if {$onscreen($p) < 0} {
1200 set onscreen($p) 1
1201 set lastuse($p) $lineno
1202 set displist [linsert $displist [lindex $pi 1] $p]
1203 incr nhyperspace -1
1207 set lastuse($id) $lineno
1209 # see if we need to make any lines jump off into hyperspace
1210 set displ [llength $displist]
1211 if {$displ > $maxwidth} {
1212 set ages {}
1213 foreach x $displist {
1214 lappend ages [list $lastuse($x) $x]
1216 set ages [lsort -integer -index 0 $ages]
1217 set k 0
1218 while {$displ > $maxwidth} {
1219 set use [lindex $ages $k 0]
1220 set victim [lindex $ages $k 1]
1221 if {$use >= $lineno - 5} break
1222 incr k
1223 if {[lsearch -exact $nohs $victim] >= 0} continue
1224 set i [lsearch -exact $displist $victim]
1225 set displist [lreplace $displist $i $i]
1226 set onscreen($victim) -1
1227 incr nhyperspace
1228 incr displ -1
1229 if {$i < $nullentry} {
1230 incr nullentry -1
1232 set x [lindex $mainline($victim) end-1]
1233 lappend mainline($victim) $x $y1
1234 set line [trimdiagend $mainline($victim)]
1235 set arrow "last"
1236 if {$mainlinearrow($victim) ne "none"} {
1237 set line [trimdiagstart $line]
1238 set arrow "both"
1240 lappend sidelines($victim) [list $line 1 $arrow]
1241 unset mainline($victim)
1245 set dlevel [lsearch -exact $displist $id]
1247 # If we are reducing, put in a null entry
1248 if {$displ < $oldnlines} {
1249 # does the next line look like a merge?
1250 # i.e. does it have > 1 new parent?
1251 if {$nnewparents($id) > 1} {
1252 set i [expr {$dlevel + 1}]
1253 } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1254 set i $olddlevel
1255 if {$nullentry >= 0 && $nullentry < $i} {
1256 incr i -1
1258 } elseif {$nullentry >= 0} {
1259 set i $nullentry
1260 while {$i < $displ
1261 && [lindex $olddisplist $i] == [lindex $displist $i]} {
1262 incr i
1264 } else {
1265 set i $olddlevel
1266 if {$dlevel >= $i} {
1267 incr i
1270 if {$i < $displ} {
1271 set displist [linsert $displist $i {}]
1272 incr displ
1273 if {$dlevel >= $i} {
1274 incr dlevel
1279 # decide on the line spacing for the next line
1280 set lj [expr {$lineno + 1}]
1281 set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1282 if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1283 set xspc1($lj) $xspc2
1284 } else {
1285 set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1286 if {$xspc1($lj) < $lthickness} {
1287 set xspc1($lj) $lthickness
1291 foreach idi $reins {
1292 set id [lindex $idi 0]
1293 set j [lsearch -exact $displist $id]
1294 set xj [xcoord $j $dlevel $lj]
1295 set mainline($id) [list $xj $y2]
1296 set mainlinearrow($id) first
1299 set i -1
1300 foreach id $olddisplist {
1301 incr i
1302 if {$id == {}} continue
1303 if {$onscreen($id) <= 0} continue
1304 set xi [xcoord $i $olddlevel $lineno]
1305 if {$i == $olddlevel} {
1306 foreach p $currentparents {
1307 set j [lsearch -exact $displist $p]
1308 set coords [list $xi $y1]
1309 set xj [xcoord $j $dlevel $lj]
1310 if {$xj < $xi - $linespc} {
1311 lappend coords [expr {$xj + $linespc}] $y1
1312 notecrossings $p $j $i [expr {$j + 1}]
1313 } elseif {$xj > $xi + $linespc} {
1314 lappend coords [expr {$xj - $linespc}] $y1
1315 notecrossings $p $i $j [expr {$j - 1}]
1317 if {[lsearch -exact $dupparents $p] >= 0} {
1318 # draw a double-width line to indicate the doubled parent
1319 lappend coords $xj $y2
1320 lappend sidelines($p) [list $coords 2 none]
1321 if {![info exists mainline($p)]} {
1322 set mainline($p) [list $xj $y2]
1323 set mainlinearrow($p) none
1325 } else {
1326 # normal case, no parent duplicated
1327 set yb $y2
1328 set dx [expr {abs($xi - $xj)}]
1329 if {0 && $dx < $linespc} {
1330 set yb [expr {$y1 + $dx}]
1332 if {![info exists mainline($p)]} {
1333 if {$xi != $xj} {
1334 lappend coords $xj $yb
1336 set mainline($p) $coords
1337 set mainlinearrow($p) none
1338 } else {
1339 lappend coords $xj $yb
1340 if {$yb < $y2} {
1341 lappend coords $xj $y2
1343 lappend sidelines($p) [list $coords 1 none]
1347 } else {
1348 set j $i
1349 if {[lindex $displist $i] != $id} {
1350 set j [lsearch -exact $displist $id]
1352 if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1353 || ($olddlevel < $i && $i < $dlevel)
1354 || ($dlevel < $i && $i < $olddlevel)} {
1355 set xj [xcoord $j $dlevel $lj]
1356 lappend mainline($id) $xi $y1 $xj $y2
1360 return $dlevel
1363 # search for x in a list of lists
1364 proc llsearch {llist x} {
1365 set i 0
1366 foreach l $llist {
1367 if {$l == $x || [lsearch -exact $l $x] >= 0} {
1368 return $i
1370 incr i
1372 return -1
1375 proc drawmore {reading} {
1376 global displayorder numcommits ncmupdate nextupdate
1377 global stopped nhyperspace parents commitlisted
1378 global maxwidth onscreen displist currentparents olddlevel
1380 set n [llength $displayorder]
1381 while {$numcommits < $n} {
1382 set id [lindex $displayorder $numcommits]
1383 set ctxend [expr {$numcommits + 10}]
1384 if {!$reading && $ctxend > $n} {
1385 set ctxend $n
1387 set dlist {}
1388 if {$numcommits > 0} {
1389 set dlist [lreplace $displist $olddlevel $olddlevel]
1390 set i $olddlevel
1391 foreach p $currentparents {
1392 if {$onscreen($p) == 0} {
1393 set dlist [linsert $dlist $i $p]
1394 incr i
1398 set nohs {}
1399 set reins {}
1400 set isfat [expr {[llength $dlist] > $maxwidth}]
1401 if {$nhyperspace > 0 || $isfat} {
1402 if {$ctxend > $n} break
1403 # work out what to bring back and
1404 # what we want to don't want to send into hyperspace
1405 set room 1
1406 for {set k $numcommits} {$k < $ctxend} {incr k} {
1407 set x [lindex $displayorder $k]
1408 set i [llsearch $dlist $x]
1409 if {$i < 0} {
1410 set i [llength $dlist]
1411 lappend dlist $x
1413 if {[lsearch -exact $nohs $x] < 0} {
1414 lappend nohs $x
1416 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1417 set reins [list $x $i]
1419 set newp {}
1420 if {[info exists commitlisted($x)]} {
1421 set right 0
1422 foreach p $parents($x) {
1423 if {[llsearch $dlist $p] < 0} {
1424 lappend newp $p
1425 if {[lsearch -exact $nohs $p] < 0} {
1426 lappend nohs $p
1428 if {$reins eq {} && $onscreen($p) < 0 && $room} {
1429 set reins [list $p [expr {$i + $right}]]
1432 set right 1
1435 set l [lindex $dlist $i]
1436 if {[llength $l] == 1} {
1437 set l $newp
1438 } else {
1439 set j [lsearch -exact $l $x]
1440 set l [concat [lreplace $l $j $j] $newp]
1442 set dlist [lreplace $dlist $i $i $l]
1443 if {$room && $isfat && [llength $newp] <= 1} {
1444 set room 0
1449 set dlevel [drawslants $id $reins $nohs]
1450 drawcommitline $dlevel
1451 if {[clock clicks -milliseconds] >= $nextupdate
1452 && $numcommits >= $ncmupdate} {
1453 doupdate $reading
1454 if {$stopped} break
1459 # level here is an index in todo
1460 proc updatetodo {level noshortcut} {
1461 global ncleft todo nnewparents
1462 global commitlisted parents onscreen
1464 set id [lindex $todo $level]
1465 set olds {}
1466 if {[info exists commitlisted($id)]} {
1467 foreach p $parents($id) {
1468 if {[lsearch -exact $olds $p] < 0} {
1469 lappend olds $p
1473 if {!$noshortcut && [llength $olds] == 1} {
1474 set p [lindex $olds 0]
1475 if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1476 set ncleft($p) 0
1477 set todo [lreplace $todo $level $level $p]
1478 set onscreen($p) 0
1479 set nnewparents($id) 1
1480 return 0
1484 set todo [lreplace $todo $level $level]
1485 set i $level
1486 set n 0
1487 foreach p $olds {
1488 incr ncleft($p) -1
1489 set k [lsearch -exact $todo $p]
1490 if {$k < 0} {
1491 set todo [linsert $todo $i $p]
1492 set onscreen($p) 0
1493 incr i
1494 incr n
1497 set nnewparents($id) $n
1499 return 1
1502 proc decidenext {{noread 0}} {
1503 global ncleft todo
1504 global datemode cdate
1505 global commitinfo
1507 # choose which one to do next time around
1508 set todol [llength $todo]
1509 set level -1
1510 set latest {}
1511 for {set k $todol} {[incr k -1] >= 0} {} {
1512 set p [lindex $todo $k]
1513 if {$ncleft($p) == 0} {
1514 if {$datemode} {
1515 if {![info exists commitinfo($p)]} {
1516 if {$noread} {
1517 return {}
1519 readcommit $p
1521 if {$latest == {} || $cdate($p) > $latest} {
1522 set level $k
1523 set latest $cdate($p)
1525 } else {
1526 set level $k
1527 break
1532 return $level
1535 proc drawcommit {id reading} {
1536 global phase todo nchildren datemode nextupdate revlistorder ncleft
1537 global numcommits ncmupdate displayorder todo onscreen parents
1538 global commitlisted commitordered
1540 if {$phase != "incrdraw"} {
1541 set phase incrdraw
1542 set displayorder {}
1543 set todo {}
1544 initgraph
1545 catch {unset commitordered}
1547 set commitordered($id) 1
1548 if {$nchildren($id) == 0} {
1549 lappend todo $id
1550 set onscreen($id) 0
1552 if {$revlistorder} {
1553 set level [lsearch -exact $todo $id]
1554 if {$level < 0} {
1555 error_popup "oops, $id isn't in todo"
1556 return
1558 lappend displayorder $id
1559 updatetodo $level 0
1560 } else {
1561 set level [decidenext 1]
1562 if {$level == {} || $level < 0} return
1563 while 1 {
1564 set id [lindex $todo $level]
1565 if {![info exists commitordered($id)]} {
1566 break
1568 lappend displayorder [lindex $todo $level]
1569 if {[updatetodo $level $datemode]} {
1570 set level [decidenext 1]
1571 if {$level == {} || $level < 0} break
1575 drawmore $reading
1578 proc finishcommits {} {
1579 global phase oldcommits commits
1580 global canv mainfont ctext maincursor textcursor
1581 global parents displayorder todo
1583 if {$phase == "incrdraw" || $phase == "removecommits"} {
1584 foreach id $oldcommits {
1585 lappend commits $id
1586 drawcommit $id 0
1588 set oldcommits {}
1589 drawrest
1590 } elseif {$phase == "updatecommits"} {
1591 # there were no new commits, in fact
1592 set commits $oldcommits
1593 set oldcommits {}
1594 set phase {}
1595 } else {
1596 $canv delete all
1597 $canv create text 3 3 -anchor nw -text "No commits selected" \
1598 -font $mainfont -tags textitems
1599 set phase {}
1601 . config -cursor $maincursor
1602 settextcursor $textcursor
1605 # Don't change the text pane cursor if it is currently the hand cursor,
1606 # showing that we are over a sha1 ID link.
1607 proc settextcursor {c} {
1608 global ctext curtextcursor
1610 if {[$ctext cget -cursor] == $curtextcursor} {
1611 $ctext config -cursor $c
1613 set curtextcursor $c
1616 proc drawgraph {} {
1617 global nextupdate startmsecs ncmupdate
1618 global displayorder onscreen
1620 if {$displayorder == {}} return
1621 set startmsecs [clock clicks -milliseconds]
1622 set nextupdate [expr {$startmsecs + 100}]
1623 set ncmupdate 1
1624 initgraph
1625 foreach id $displayorder {
1626 set onscreen($id) 0
1628 drawmore 0
1631 proc drawrest {} {
1632 global phase stopped redisplaying selectedline
1633 global datemode todo displayorder ncleft
1634 global numcommits ncmupdate
1635 global nextupdate startmsecs revlistorder
1637 set level [decidenext]
1638 if {$level >= 0} {
1639 set phase drawgraph
1640 while 1 {
1641 lappend displayorder [lindex $todo $level]
1642 set hard [updatetodo $level $datemode]
1643 if {$hard} {
1644 set level [decidenext]
1645 if {$level < 0} break
1649 if {$todo != {}} {
1650 puts "ERROR: none of the pending commits can be done yet:"
1651 foreach p $todo {
1652 puts " $p ($ncleft($p))"
1656 drawmore 0
1657 set phase {}
1658 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1659 #puts "overall $drawmsecs ms for $numcommits commits"
1660 if {$redisplaying} {
1661 if {$stopped == 0 && [info exists selectedline]} {
1662 selectline $selectedline 0
1664 if {$stopped == 1} {
1665 set stopped 0
1666 after idle drawgraph
1667 } else {
1668 set redisplaying 0
1673 proc findmatches {f} {
1674 global findtype foundstring foundstrlen
1675 if {$findtype == "Regexp"} {
1676 set matches [regexp -indices -all -inline $foundstring $f]
1677 } else {
1678 if {$findtype == "IgnCase"} {
1679 set str [string tolower $f]
1680 } else {
1681 set str $f
1683 set matches {}
1684 set i 0
1685 while {[set j [string first $foundstring $str $i]] >= 0} {
1686 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1687 set i [expr {$j + $foundstrlen}]
1690 return $matches
1693 proc dofind {} {
1694 global findtype findloc findstring markedmatches commitinfo
1695 global numcommits lineid linehtag linentag linedtag
1696 global mainfont namefont canv canv2 canv3 selectedline
1697 global matchinglines foundstring foundstrlen
1699 stopfindproc
1700 unmarkmatches
1701 focus .
1702 set matchinglines {}
1703 if {$findloc == "Pickaxe"} {
1704 findpatches
1705 return
1707 if {$findtype == "IgnCase"} {
1708 set foundstring [string tolower $findstring]
1709 } else {
1710 set foundstring $findstring
1712 set foundstrlen [string length $findstring]
1713 if {$foundstrlen == 0} return
1714 if {$findloc == "Files"} {
1715 findfiles
1716 return
1718 if {![info exists selectedline]} {
1719 set oldsel -1
1720 } else {
1721 set oldsel $selectedline
1723 set didsel 0
1724 set fldtypes {Headline Author Date Committer CDate Comment}
1725 for {set l 0} {$l < $numcommits} {incr l} {
1726 set id $lineid($l)
1727 set info $commitinfo($id)
1728 set doesmatch 0
1729 foreach f $info ty $fldtypes {
1730 if {$findloc != "All fields" && $findloc != $ty} {
1731 continue
1733 set matches [findmatches $f]
1734 if {$matches == {}} continue
1735 set doesmatch 1
1736 if {$ty == "Headline"} {
1737 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1738 } elseif {$ty == "Author"} {
1739 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1740 } elseif {$ty == "Date"} {
1741 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1744 if {$doesmatch} {
1745 lappend matchinglines $l
1746 if {!$didsel && $l > $oldsel} {
1747 findselectline $l
1748 set didsel 1
1752 if {$matchinglines == {}} {
1753 bell
1754 } elseif {!$didsel} {
1755 findselectline [lindex $matchinglines 0]
1759 proc findselectline {l} {
1760 global findloc commentend ctext
1761 selectline $l 1
1762 if {$findloc == "All fields" || $findloc == "Comments"} {
1763 # highlight the matches in the comments
1764 set f [$ctext get 1.0 $commentend]
1765 set matches [findmatches $f]
1766 foreach match $matches {
1767 set start [lindex $match 0]
1768 set end [expr {[lindex $match 1] + 1}]
1769 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1774 proc findnext {restart} {
1775 global matchinglines selectedline
1776 if {![info exists matchinglines]} {
1777 if {$restart} {
1778 dofind
1780 return
1782 if {![info exists selectedline]} return
1783 foreach l $matchinglines {
1784 if {$l > $selectedline} {
1785 findselectline $l
1786 return
1789 bell
1792 proc findprev {} {
1793 global matchinglines selectedline
1794 if {![info exists matchinglines]} {
1795 dofind
1796 return
1798 if {![info exists selectedline]} return
1799 set prev {}
1800 foreach l $matchinglines {
1801 if {$l >= $selectedline} break
1802 set prev $l
1804 if {$prev != {}} {
1805 findselectline $prev
1806 } else {
1807 bell
1811 proc findlocchange {name ix op} {
1812 global findloc findtype findtypemenu
1813 if {$findloc == "Pickaxe"} {
1814 set findtype Exact
1815 set state disabled
1816 } else {
1817 set state normal
1819 $findtypemenu entryconf 1 -state $state
1820 $findtypemenu entryconf 2 -state $state
1823 proc stopfindproc {{done 0}} {
1824 global findprocpid findprocfile findids
1825 global ctext findoldcursor phase maincursor textcursor
1826 global findinprogress
1828 catch {unset findids}
1829 if {[info exists findprocpid]} {
1830 if {!$done} {
1831 catch {exec kill $findprocpid}
1833 catch {close $findprocfile}
1834 unset findprocpid
1836 if {[info exists findinprogress]} {
1837 unset findinprogress
1838 if {$phase != "incrdraw"} {
1839 . config -cursor $maincursor
1840 settextcursor $textcursor
1845 proc findpatches {} {
1846 global findstring selectedline numcommits
1847 global findprocpid findprocfile
1848 global finddidsel ctext lineid findinprogress
1849 global findinsertpos
1851 if {$numcommits == 0} return
1853 # make a list of all the ids to search, starting at the one
1854 # after the selected line (if any)
1855 if {[info exists selectedline]} {
1856 set l $selectedline
1857 } else {
1858 set l -1
1860 set inputids {}
1861 for {set i 0} {$i < $numcommits} {incr i} {
1862 if {[incr l] >= $numcommits} {
1863 set l 0
1865 append inputids $lineid($l) "\n"
1868 if {[catch {
1869 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1870 << $inputids] r]
1871 } err]} {
1872 error_popup "Error starting search process: $err"
1873 return
1876 set findinsertpos end
1877 set findprocfile $f
1878 set findprocpid [pid $f]
1879 fconfigure $f -blocking 0
1880 fileevent $f readable readfindproc
1881 set finddidsel 0
1882 . config -cursor watch
1883 settextcursor watch
1884 set findinprogress 1
1887 proc readfindproc {} {
1888 global findprocfile finddidsel
1889 global idline matchinglines findinsertpos
1891 set n [gets $findprocfile line]
1892 if {$n < 0} {
1893 if {[eof $findprocfile]} {
1894 stopfindproc 1
1895 if {!$finddidsel} {
1896 bell
1899 return
1901 if {![regexp {^[0-9a-f]{40}} $line id]} {
1902 error_popup "Can't parse git-diff-tree output: $line"
1903 stopfindproc
1904 return
1906 if {![info exists idline($id)]} {
1907 puts stderr "spurious id: $id"
1908 return
1910 set l $idline($id)
1911 insertmatch $l $id
1914 proc insertmatch {l id} {
1915 global matchinglines findinsertpos finddidsel
1917 if {$findinsertpos == "end"} {
1918 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1919 set matchinglines [linsert $matchinglines 0 $l]
1920 set findinsertpos 1
1921 } else {
1922 lappend matchinglines $l
1924 } else {
1925 set matchinglines [linsert $matchinglines $findinsertpos $l]
1926 incr findinsertpos
1928 markheadline $l $id
1929 if {!$finddidsel} {
1930 findselectline $l
1931 set finddidsel 1
1935 proc findfiles {} {
1936 global selectedline numcommits lineid ctext
1937 global ffileline finddidsel parents nparents
1938 global findinprogress findstartline findinsertpos
1939 global treediffs fdiffid fdiffsneeded fdiffpos
1940 global findmergefiles
1942 if {$numcommits == 0} return
1944 if {[info exists selectedline]} {
1945 set l [expr {$selectedline + 1}]
1946 } else {
1947 set l 0
1949 set ffileline $l
1950 set findstartline $l
1951 set diffsneeded {}
1952 set fdiffsneeded {}
1953 while 1 {
1954 set id $lineid($l)
1955 if {$findmergefiles || $nparents($id) == 1} {
1956 if {![info exists treediffs($id)]} {
1957 append diffsneeded "$id\n"
1958 lappend fdiffsneeded $id
1961 if {[incr l] >= $numcommits} {
1962 set l 0
1964 if {$l == $findstartline} break
1967 # start off a git-diff-tree process if needed
1968 if {$diffsneeded ne {}} {
1969 if {[catch {
1970 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1971 } err ]} {
1972 error_popup "Error starting search process: $err"
1973 return
1975 catch {unset fdiffid}
1976 set fdiffpos 0
1977 fconfigure $df -blocking 0
1978 fileevent $df readable [list readfilediffs $df]
1981 set finddidsel 0
1982 set findinsertpos end
1983 set id $lineid($l)
1984 . config -cursor watch
1985 settextcursor watch
1986 set findinprogress 1
1987 findcont $id
1988 update
1991 proc readfilediffs {df} {
1992 global findid fdiffid fdiffs
1994 set n [gets $df line]
1995 if {$n < 0} {
1996 if {[eof $df]} {
1997 donefilediff
1998 if {[catch {close $df} err]} {
1999 stopfindproc
2000 bell
2001 error_popup "Error in git-diff-tree: $err"
2002 } elseif {[info exists findid]} {
2003 set id $findid
2004 stopfindproc
2005 bell
2006 error_popup "Couldn't find diffs for $id"
2009 return
2011 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2012 # start of a new string of diffs
2013 donefilediff
2014 set fdiffid $id
2015 set fdiffs {}
2016 } elseif {[string match ":*" $line]} {
2017 lappend fdiffs [lindex $line 5]
2021 proc donefilediff {} {
2022 global fdiffid fdiffs treediffs findid
2023 global fdiffsneeded fdiffpos
2025 if {[info exists fdiffid]} {
2026 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2027 && $fdiffpos < [llength $fdiffsneeded]} {
2028 # git-diff-tree doesn't output anything for a commit
2029 # which doesn't change anything
2030 set nullid [lindex $fdiffsneeded $fdiffpos]
2031 set treediffs($nullid) {}
2032 if {[info exists findid] && $nullid eq $findid} {
2033 unset findid
2034 findcont $nullid
2036 incr fdiffpos
2038 incr fdiffpos
2040 if {![info exists treediffs($fdiffid)]} {
2041 set treediffs($fdiffid) $fdiffs
2043 if {[info exists findid] && $fdiffid eq $findid} {
2044 unset findid
2045 findcont $fdiffid
2050 proc findcont {id} {
2051 global findid treediffs parents nparents
2052 global ffileline findstartline finddidsel
2053 global lineid numcommits matchinglines findinprogress
2054 global findmergefiles
2056 set l $ffileline
2057 while 1 {
2058 if {$findmergefiles || $nparents($id) == 1} {
2059 if {![info exists treediffs($id)]} {
2060 set findid $id
2061 set ffileline $l
2062 return
2064 set doesmatch 0
2065 foreach f $treediffs($id) {
2066 set x [findmatches $f]
2067 if {$x != {}} {
2068 set doesmatch 1
2069 break
2072 if {$doesmatch} {
2073 insertmatch $l $id
2076 if {[incr l] >= $numcommits} {
2077 set l 0
2079 if {$l == $findstartline} break
2080 set id $lineid($l)
2082 stopfindproc
2083 if {!$finddidsel} {
2084 bell
2088 # mark a commit as matching by putting a yellow background
2089 # behind the headline
2090 proc markheadline {l id} {
2091 global canv mainfont linehtag commitinfo
2093 set bbox [$canv bbox $linehtag($l)]
2094 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2095 $canv lower $t
2098 # mark the bits of a headline, author or date that match a find string
2099 proc markmatches {canv l str tag matches font} {
2100 set bbox [$canv bbox $tag]
2101 set x0 [lindex $bbox 0]
2102 set y0 [lindex $bbox 1]
2103 set y1 [lindex $bbox 3]
2104 foreach match $matches {
2105 set start [lindex $match 0]
2106 set end [lindex $match 1]
2107 if {$start > $end} continue
2108 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2109 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2110 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2111 [expr {$x0+$xlen+2}] $y1 \
2112 -outline {} -tags matches -fill yellow]
2113 $canv lower $t
2117 proc unmarkmatches {} {
2118 global matchinglines findids
2119 allcanvs delete matches
2120 catch {unset matchinglines}
2121 catch {unset findids}
2124 proc selcanvline {w x y} {
2125 global canv canvy0 ctext linespc
2126 global lineid linehtag linentag linedtag rowtextx
2127 set ymax [lindex [$canv cget -scrollregion] 3]
2128 if {$ymax == {}} return
2129 set yfrac [lindex [$canv yview] 0]
2130 set y [expr {$y + $yfrac * $ymax}]
2131 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2132 if {$l < 0} {
2133 set l 0
2135 if {$w eq $canv} {
2136 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2138 unmarkmatches
2139 selectline $l 1
2142 proc commit_descriptor {p} {
2143 global commitinfo
2144 set l "..."
2145 if {[info exists commitinfo($p)]} {
2146 set l [lindex $commitinfo($p) 0]
2148 return "$p ($l)"
2151 # append some text to the ctext widget, and make any SHA1 ID
2152 # that we know about be a clickable link.
2153 proc appendwithlinks {text} {
2154 global ctext idline linknum
2156 set start [$ctext index "end - 1c"]
2157 $ctext insert end $text
2158 $ctext insert end "\n"
2159 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2160 foreach l $links {
2161 set s [lindex $l 0]
2162 set e [lindex $l 1]
2163 set linkid [string range $text $s $e]
2164 if {![info exists idline($linkid)]} continue
2165 incr e
2166 $ctext tag add link "$start + $s c" "$start + $e c"
2167 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2168 $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2169 incr linknum
2171 $ctext tag conf link -foreground blue -underline 1
2172 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2173 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2176 proc selectline {l isnew} {
2177 global canv canv2 canv3 ctext commitinfo selectedline
2178 global lineid linehtag linentag linedtag
2179 global canvy0 linespc parents nparents children
2180 global cflist currentid sha1entry
2181 global commentend idtags idline linknum
2182 global mergemax
2184 $canv delete hover
2185 normalline
2186 if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2187 $canv delete secsel
2188 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2189 -tags secsel -fill [$canv cget -selectbackground]]
2190 $canv lower $t
2191 $canv2 delete secsel
2192 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2193 -tags secsel -fill [$canv2 cget -selectbackground]]
2194 $canv2 lower $t
2195 $canv3 delete secsel
2196 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2197 -tags secsel -fill [$canv3 cget -selectbackground]]
2198 $canv3 lower $t
2199 set y [expr {$canvy0 + $l * $linespc}]
2200 set ymax [lindex [$canv cget -scrollregion] 3]
2201 set ytop [expr {$y - $linespc - 1}]
2202 set ybot [expr {$y + $linespc + 1}]
2203 set wnow [$canv yview]
2204 set wtop [expr {[lindex $wnow 0] * $ymax}]
2205 set wbot [expr {[lindex $wnow 1] * $ymax}]
2206 set wh [expr {$wbot - $wtop}]
2207 set newtop $wtop
2208 if {$ytop < $wtop} {
2209 if {$ybot < $wtop} {
2210 set newtop [expr {$y - $wh / 2.0}]
2211 } else {
2212 set newtop $ytop
2213 if {$newtop > $wtop - $linespc} {
2214 set newtop [expr {$wtop - $linespc}]
2217 } elseif {$ybot > $wbot} {
2218 if {$ytop > $wbot} {
2219 set newtop [expr {$y - $wh / 2.0}]
2220 } else {
2221 set newtop [expr {$ybot - $wh}]
2222 if {$newtop < $wtop + $linespc} {
2223 set newtop [expr {$wtop + $linespc}]
2227 if {$newtop != $wtop} {
2228 if {$newtop < 0} {
2229 set newtop 0
2231 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2234 if {$isnew} {
2235 addtohistory [list selectline $l 0]
2238 set selectedline $l
2240 set id $lineid($l)
2241 set currentid $id
2242 $sha1entry delete 0 end
2243 $sha1entry insert 0 $id
2244 $sha1entry selection from 0
2245 $sha1entry selection to end
2247 $ctext conf -state normal
2248 $ctext delete 0.0 end
2249 set linknum 0
2250 $ctext mark set fmark.0 0.0
2251 $ctext mark gravity fmark.0 left
2252 set info $commitinfo($id)
2253 set date [formatdate [lindex $info 2]]
2254 $ctext insert end "Author: [lindex $info 1] $date\n"
2255 set date [formatdate [lindex $info 4]]
2256 $ctext insert end "Committer: [lindex $info 3] $date\n"
2257 if {[info exists idtags($id)]} {
2258 $ctext insert end "Tags:"
2259 foreach tag $idtags($id) {
2260 $ctext insert end " $tag"
2262 $ctext insert end "\n"
2265 set comment {}
2266 if {$nparents($id) > 1} {
2267 set np 0
2268 foreach p $parents($id) {
2269 if {$np >= $mergemax} {
2270 set tag mmax
2271 } else {
2272 set tag m$np
2274 $ctext insert end "Parent: " $tag
2275 appendwithlinks [commit_descriptor $p]
2276 incr np
2278 } else {
2279 if {[info exists parents($id)]} {
2280 foreach p $parents($id) {
2281 append comment "Parent: [commit_descriptor $p]\n"
2286 if {[info exists children($id)]} {
2287 foreach c $children($id) {
2288 append comment "Child: [commit_descriptor $c]\n"
2291 append comment "\n"
2292 append comment [lindex $info 5]
2294 # make anything that looks like a SHA1 ID be a clickable link
2295 appendwithlinks $comment
2297 $ctext tag delete Comments
2298 $ctext tag remove found 1.0 end
2299 $ctext conf -state disabled
2300 set commentend [$ctext index "end - 1c"]
2302 $cflist delete 0 end
2303 $cflist insert end "Comments"
2304 if {$nparents($id) == 1} {
2305 startdiff $id
2306 } elseif {$nparents($id) > 1} {
2307 mergediff $id
2311 proc selnextline {dir} {
2312 global selectedline
2313 if {![info exists selectedline]} return
2314 set l [expr {$selectedline + $dir}]
2315 unmarkmatches
2316 selectline $l 1
2319 proc unselectline {} {
2320 global selectedline
2322 catch {unset selectedline}
2323 allcanvs delete secsel
2326 proc addtohistory {cmd} {
2327 global history historyindex
2329 if {$historyindex > 0
2330 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2331 return
2334 if {$historyindex < [llength $history]} {
2335 set history [lreplace $history $historyindex end $cmd]
2336 } else {
2337 lappend history $cmd
2339 incr historyindex
2340 if {$historyindex > 1} {
2341 .ctop.top.bar.leftbut conf -state normal
2342 } else {
2343 .ctop.top.bar.leftbut conf -state disabled
2345 .ctop.top.bar.rightbut conf -state disabled
2348 proc goback {} {
2349 global history historyindex
2351 if {$historyindex > 1} {
2352 incr historyindex -1
2353 set cmd [lindex $history [expr {$historyindex - 1}]]
2354 eval $cmd
2355 .ctop.top.bar.rightbut conf -state normal
2357 if {$historyindex <= 1} {
2358 .ctop.top.bar.leftbut conf -state disabled
2362 proc goforw {} {
2363 global history historyindex
2365 if {$historyindex < [llength $history]} {
2366 set cmd [lindex $history $historyindex]
2367 incr historyindex
2368 eval $cmd
2369 .ctop.top.bar.leftbut conf -state normal
2371 if {$historyindex >= [llength $history]} {
2372 .ctop.top.bar.rightbut conf -state disabled
2376 proc mergediff {id} {
2377 global parents diffmergeid diffopts mdifffd
2378 global difffilestart
2380 set diffmergeid $id
2381 catch {unset difffilestart}
2382 # this doesn't seem to actually affect anything...
2383 set env(GIT_DIFF_OPTS) $diffopts
2384 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2385 if {[catch {set mdf [open $cmd r]} err]} {
2386 error_popup "Error getting merge diffs: $err"
2387 return
2389 fconfigure $mdf -blocking 0
2390 set mdifffd($id) $mdf
2391 fileevent $mdf readable [list getmergediffline $mdf $id]
2392 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2395 proc getmergediffline {mdf id} {
2396 global diffmergeid ctext cflist nextupdate nparents mergemax
2397 global difffilestart
2399 set n [gets $mdf line]
2400 if {$n < 0} {
2401 if {[eof $mdf]} {
2402 close $mdf
2404 return
2406 if {![info exists diffmergeid] || $id != $diffmergeid} {
2407 return
2409 $ctext conf -state normal
2410 if {[regexp {^diff --cc (.*)} $line match fname]} {
2411 # start of a new file
2412 $ctext insert end "\n"
2413 set here [$ctext index "end - 1c"]
2414 set i [$cflist index end]
2415 $ctext mark set fmark.$i $here
2416 $ctext mark gravity fmark.$i left
2417 set difffilestart([expr {$i-1}]) $here
2418 $cflist insert end $fname
2419 set l [expr {(78 - [string length $fname]) / 2}]
2420 set pad [string range "----------------------------------------" 1 $l]
2421 $ctext insert end "$pad $fname $pad\n" filesep
2422 } elseif {[regexp {^@@} $line]} {
2423 $ctext insert end "$line\n" hunksep
2424 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2425 # do nothing
2426 } else {
2427 # parse the prefix - one ' ', '-' or '+' for each parent
2428 set np $nparents($id)
2429 set spaces {}
2430 set minuses {}
2431 set pluses {}
2432 set isbad 0
2433 for {set j 0} {$j < $np} {incr j} {
2434 set c [string range $line $j $j]
2435 if {$c == " "} {
2436 lappend spaces $j
2437 } elseif {$c == "-"} {
2438 lappend minuses $j
2439 } elseif {$c == "+"} {
2440 lappend pluses $j
2441 } else {
2442 set isbad 1
2443 break
2446 set tags {}
2447 set num {}
2448 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2449 # line doesn't appear in result, parents in $minuses have the line
2450 set num [lindex $minuses 0]
2451 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2452 # line appears in result, parents in $pluses don't have the line
2453 lappend tags mresult
2454 set num [lindex $spaces 0]
2456 if {$num ne {}} {
2457 if {$num >= $mergemax} {
2458 set num "max"
2460 lappend tags m$num
2462 $ctext insert end "$line\n" $tags
2464 $ctext conf -state disabled
2465 if {[clock clicks -milliseconds] >= $nextupdate} {
2466 incr nextupdate 100
2467 fileevent $mdf readable {}
2468 update
2469 fileevent $mdf readable [list getmergediffline $mdf $id]
2473 proc startdiff {ids} {
2474 global treediffs diffids treepending diffmergeid
2476 set diffids $ids
2477 catch {unset diffmergeid}
2478 if {![info exists treediffs($ids)]} {
2479 if {![info exists treepending]} {
2480 gettreediffs $ids
2482 } else {
2483 addtocflist $ids
2487 proc addtocflist {ids} {
2488 global treediffs cflist
2489 foreach f $treediffs($ids) {
2490 $cflist insert end $f
2492 getblobdiffs $ids
2495 proc gettreediffs {ids} {
2496 global treediff parents treepending
2497 set treepending $ids
2498 set treediff {}
2499 if {[catch \
2500 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2501 ]} return
2502 fconfigure $gdtf -blocking 0
2503 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2506 proc gettreediffline {gdtf ids} {
2507 global treediff treediffs treepending diffids diffmergeid
2509 set n [gets $gdtf line]
2510 if {$n < 0} {
2511 if {![eof $gdtf]} return
2512 close $gdtf
2513 set treediffs($ids) $treediff
2514 unset treepending
2515 if {$ids != $diffids} {
2516 gettreediffs $diffids
2517 } else {
2518 if {[info exists diffmergeid]} {
2519 contmergediff $ids
2520 } else {
2521 addtocflist $ids
2524 return
2526 set file [lindex $line 5]
2527 lappend treediff $file
2530 proc getblobdiffs {ids} {
2531 global diffopts blobdifffd diffids env curdifftag curtagstart
2532 global difffilestart nextupdate diffinhdr treediffs
2534 set env(GIT_DIFF_OPTS) $diffopts
2535 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2536 if {[catch {set bdf [open $cmd r]} err]} {
2537 puts "error getting diffs: $err"
2538 return
2540 set diffinhdr 0
2541 fconfigure $bdf -blocking 0
2542 set blobdifffd($ids) $bdf
2543 set curdifftag Comments
2544 set curtagstart 0.0
2545 catch {unset difffilestart}
2546 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2547 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2550 proc getblobdiffline {bdf ids} {
2551 global diffids blobdifffd ctext curdifftag curtagstart
2552 global diffnexthead diffnextnote difffilestart
2553 global nextupdate diffinhdr treediffs
2555 set n [gets $bdf line]
2556 if {$n < 0} {
2557 if {[eof $bdf]} {
2558 close $bdf
2559 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2560 $ctext tag add $curdifftag $curtagstart end
2563 return
2565 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2566 return
2568 $ctext conf -state normal
2569 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2570 # start of a new file
2571 $ctext insert end "\n"
2572 $ctext tag add $curdifftag $curtagstart end
2573 set curtagstart [$ctext index "end - 1c"]
2574 set header $newname
2575 set here [$ctext index "end - 1c"]
2576 set i [lsearch -exact $treediffs($diffids) $fname]
2577 if {$i >= 0} {
2578 set difffilestart($i) $here
2579 incr i
2580 $ctext mark set fmark.$i $here
2581 $ctext mark gravity fmark.$i left
2583 if {$newname != $fname} {
2584 set i [lsearch -exact $treediffs($diffids) $newname]
2585 if {$i >= 0} {
2586 set difffilestart($i) $here
2587 incr i
2588 $ctext mark set fmark.$i $here
2589 $ctext mark gravity fmark.$i left
2592 set curdifftag "f:$fname"
2593 $ctext tag delete $curdifftag
2594 set l [expr {(78 - [string length $header]) / 2}]
2595 set pad [string range "----------------------------------------" 1 $l]
2596 $ctext insert end "$pad $header $pad\n" filesep
2597 set diffinhdr 1
2598 } elseif {[regexp {^(---|\+\+\+)} $line]} {
2599 set diffinhdr 0
2600 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2601 $line match f1l f1c f2l f2c rest]} {
2602 $ctext insert end "$line\n" hunksep
2603 set diffinhdr 0
2604 } else {
2605 set x [string range $line 0 0]
2606 if {$x == "-" || $x == "+"} {
2607 set tag [expr {$x == "+"}]
2608 $ctext insert end "$line\n" d$tag
2609 } elseif {$x == " "} {
2610 $ctext insert end "$line\n"
2611 } elseif {$diffinhdr || $x == "\\"} {
2612 # e.g. "\ No newline at end of file"
2613 $ctext insert end "$line\n" filesep
2614 } else {
2615 # Something else we don't recognize
2616 if {$curdifftag != "Comments"} {
2617 $ctext insert end "\n"
2618 $ctext tag add $curdifftag $curtagstart end
2619 set curtagstart [$ctext index "end - 1c"]
2620 set curdifftag Comments
2622 $ctext insert end "$line\n" filesep
2625 $ctext conf -state disabled
2626 if {[clock clicks -milliseconds] >= $nextupdate} {
2627 incr nextupdate 100
2628 fileevent $bdf readable {}
2629 update
2630 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2634 proc nextfile {} {
2635 global difffilestart ctext
2636 set here [$ctext index @0,0]
2637 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2638 if {[$ctext compare $difffilestart($i) > $here]} {
2639 if {![info exists pos]
2640 || [$ctext compare $difffilestart($i) < $pos]} {
2641 set pos $difffilestart($i)
2645 if {[info exists pos]} {
2646 $ctext yview $pos
2650 proc listboxsel {} {
2651 global ctext cflist currentid
2652 if {![info exists currentid]} return
2653 set sel [lsort [$cflist curselection]]
2654 if {$sel eq {}} return
2655 set first [lindex $sel 0]
2656 catch {$ctext yview fmark.$first}
2659 proc setcoords {} {
2660 global linespc charspc canvx0 canvy0 mainfont
2661 global xspc1 xspc2 lthickness
2663 set linespc [font metrics $mainfont -linespace]
2664 set charspc [font measure $mainfont "m"]
2665 set canvy0 [expr {3 + 0.5 * $linespc}]
2666 set canvx0 [expr {3 + 0.5 * $linespc}]
2667 set lthickness [expr {int($linespc / 9) + 1}]
2668 set xspc1(0) $linespc
2669 set xspc2 $linespc
2672 proc redisplay {} {
2673 global stopped redisplaying phase
2674 if {$stopped > 1} return
2675 if {$phase == "getcommits"} return
2676 set redisplaying 1
2677 if {$phase == "drawgraph" || $phase == "incrdraw"} {
2678 set stopped 1
2679 } else {
2680 drawgraph
2684 proc incrfont {inc} {
2685 global mainfont namefont textfont ctext canv phase
2686 global stopped entries
2687 unmarkmatches
2688 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2689 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2690 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2691 setcoords
2692 $ctext conf -font $textfont
2693 $ctext tag conf filesep -font [concat $textfont bold]
2694 foreach e $entries {
2695 $e conf -font $mainfont
2697 if {$phase == "getcommits"} {
2698 $canv itemconf textitems -font $mainfont
2700 redisplay
2703 proc clearsha1 {} {
2704 global sha1entry sha1string
2705 if {[string length $sha1string] == 40} {
2706 $sha1entry delete 0 end
2710 proc sha1change {n1 n2 op} {
2711 global sha1string currentid sha1but
2712 if {$sha1string == {}
2713 || ([info exists currentid] && $sha1string == $currentid)} {
2714 set state disabled
2715 } else {
2716 set state normal
2718 if {[$sha1but cget -state] == $state} return
2719 if {$state == "normal"} {
2720 $sha1but conf -state normal -relief raised -text "Goto: "
2721 } else {
2722 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2726 proc gotocommit {} {
2727 global sha1string currentid idline tagids
2728 global lineid numcommits
2730 if {$sha1string == {}
2731 || ([info exists currentid] && $sha1string == $currentid)} return
2732 if {[info exists tagids($sha1string)]} {
2733 set id $tagids($sha1string)
2734 } else {
2735 set id [string tolower $sha1string]
2736 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2737 set matches {}
2738 for {set l 0} {$l < $numcommits} {incr l} {
2739 if {[string match $id* $lineid($l)]} {
2740 lappend matches $lineid($l)
2743 if {$matches ne {}} {
2744 if {[llength $matches] > 1} {
2745 error_popup "Short SHA1 id $id is ambiguous"
2746 return
2748 set id [lindex $matches 0]
2752 if {[info exists idline($id)]} {
2753 selectline $idline($id) 1
2754 return
2756 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2757 set type "SHA1 id"
2758 } else {
2759 set type "Tag"
2761 error_popup "$type $sha1string is not known"
2764 proc lineenter {x y id} {
2765 global hoverx hovery hoverid hovertimer
2766 global commitinfo canv
2768 if {![info exists commitinfo($id)]} return
2769 set hoverx $x
2770 set hovery $y
2771 set hoverid $id
2772 if {[info exists hovertimer]} {
2773 after cancel $hovertimer
2775 set hovertimer [after 500 linehover]
2776 $canv delete hover
2779 proc linemotion {x y id} {
2780 global hoverx hovery hoverid hovertimer
2782 if {[info exists hoverid] && $id == $hoverid} {
2783 set hoverx $x
2784 set hovery $y
2785 if {[info exists hovertimer]} {
2786 after cancel $hovertimer
2788 set hovertimer [after 500 linehover]
2792 proc lineleave {id} {
2793 global hoverid hovertimer canv
2795 if {[info exists hoverid] && $id == $hoverid} {
2796 $canv delete hover
2797 if {[info exists hovertimer]} {
2798 after cancel $hovertimer
2799 unset hovertimer
2801 unset hoverid
2805 proc linehover {} {
2806 global hoverx hovery hoverid hovertimer
2807 global canv linespc lthickness
2808 global commitinfo mainfont
2810 set text [lindex $commitinfo($hoverid) 0]
2811 set ymax [lindex [$canv cget -scrollregion] 3]
2812 if {$ymax == {}} return
2813 set yfrac [lindex [$canv yview] 0]
2814 set x [expr {$hoverx + 2 * $linespc}]
2815 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2816 set x0 [expr {$x - 2 * $lthickness}]
2817 set y0 [expr {$y - 2 * $lthickness}]
2818 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2819 set y1 [expr {$y + $linespc + 2 * $lthickness}]
2820 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2821 -fill \#ffff80 -outline black -width 1 -tags hover]
2822 $canv raise $t
2823 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2824 $canv raise $t
2827 proc clickisonarrow {id y} {
2828 global mainline mainlinearrow sidelines lthickness
2830 set thresh [expr {2 * $lthickness + 6}]
2831 if {[info exists mainline($id)]} {
2832 if {$mainlinearrow($id) ne "none"} {
2833 if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
2834 return "up"
2838 if {[info exists sidelines($id)]} {
2839 foreach ls $sidelines($id) {
2840 set coords [lindex $ls 0]
2841 set arrow [lindex $ls 2]
2842 if {$arrow eq "first" || $arrow eq "both"} {
2843 if {abs([lindex $coords 1] - $y) < $thresh} {
2844 return "up"
2847 if {$arrow eq "last" || $arrow eq "both"} {
2848 if {abs([lindex $coords end] - $y) < $thresh} {
2849 return "down"
2854 return {}
2857 proc arrowjump {id dirn y} {
2858 global mainline sidelines canv canv2 canv3
2860 set yt {}
2861 if {$dirn eq "down"} {
2862 if {[info exists mainline($id)]} {
2863 set y1 [lindex $mainline($id) 1]
2864 if {$y1 > $y} {
2865 set yt $y1
2868 if {[info exists sidelines($id)]} {
2869 foreach ls $sidelines($id) {
2870 set y1 [lindex $ls 0 1]
2871 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
2872 set yt $y1
2876 } else {
2877 if {[info exists sidelines($id)]} {
2878 foreach ls $sidelines($id) {
2879 set y1 [lindex $ls 0 end]
2880 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
2881 set yt $y1
2886 if {$yt eq {}} return
2887 set ymax [lindex [$canv cget -scrollregion] 3]
2888 if {$ymax eq {} || $ymax <= 0} return
2889 set view [$canv yview]
2890 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2891 set yfrac [expr {$yt / $ymax - $yspan / 2}]
2892 if {$yfrac < 0} {
2893 set yfrac 0
2895 $canv yview moveto $yfrac
2896 $canv2 yview moveto $yfrac
2897 $canv3 yview moveto $yfrac
2900 proc lineclick {x y id isnew} {
2901 global ctext commitinfo children cflist canv thickerline
2903 unmarkmatches
2904 unselectline
2905 normalline
2906 $canv delete hover
2907 # draw this line thicker than normal
2908 drawlines $id 1 1
2909 set thickerline $id
2910 if {$isnew} {
2911 set ymax [lindex [$canv cget -scrollregion] 3]
2912 if {$ymax eq {}} return
2913 set yfrac [lindex [$canv yview] 0]
2914 set y [expr {$y + $yfrac * $ymax}]
2916 set dirn [clickisonarrow $id $y]
2917 if {$dirn ne {}} {
2918 arrowjump $id $dirn $y
2919 return
2922 if {$isnew} {
2923 addtohistory [list lineclick $x $y $id 0]
2925 # fill the details pane with info about this line
2926 $ctext conf -state normal
2927 $ctext delete 0.0 end
2928 $ctext tag conf link -foreground blue -underline 1
2929 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2930 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2931 $ctext insert end "Parent:\t"
2932 $ctext insert end $id [list link link0]
2933 $ctext tag bind link0 <1> [list selbyid $id]
2934 set info $commitinfo($id)
2935 $ctext insert end "\n\t[lindex $info 0]\n"
2936 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2937 set date [formatdate [lindex $info 2]]
2938 $ctext insert end "\tDate:\t$date\n"
2939 if {[info exists children($id)]} {
2940 $ctext insert end "\nChildren:"
2941 set i 0
2942 foreach child $children($id) {
2943 incr i
2944 set info $commitinfo($child)
2945 $ctext insert end "\n\t"
2946 $ctext insert end $child [list link link$i]
2947 $ctext tag bind link$i <1> [list selbyid $child]
2948 $ctext insert end "\n\t[lindex $info 0]"
2949 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2950 set date [formatdate [lindex $info 2]]
2951 $ctext insert end "\n\tDate:\t$date\n"
2954 $ctext conf -state disabled
2956 $cflist delete 0 end
2959 proc normalline {} {
2960 global thickerline
2961 if {[info exists thickerline]} {
2962 drawlines $thickerline 0 1
2963 unset thickerline
2967 proc selbyid {id} {
2968 global idline
2969 if {[info exists idline($id)]} {
2970 selectline $idline($id) 1
2974 proc mstime {} {
2975 global startmstime
2976 if {![info exists startmstime]} {
2977 set startmstime [clock clicks -milliseconds]
2979 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2982 proc rowmenu {x y id} {
2983 global rowctxmenu idline selectedline rowmenuid
2985 if {![info exists selectedline] || $idline($id) eq $selectedline} {
2986 set state disabled
2987 } else {
2988 set state normal
2990 $rowctxmenu entryconfigure 0 -state $state
2991 $rowctxmenu entryconfigure 1 -state $state
2992 $rowctxmenu entryconfigure 2 -state $state
2993 set rowmenuid $id
2994 tk_popup $rowctxmenu $x $y
2997 proc diffvssel {dirn} {
2998 global rowmenuid selectedline lineid
3000 if {![info exists selectedline]} return
3001 if {$dirn} {
3002 set oldid $lineid($selectedline)
3003 set newid $rowmenuid
3004 } else {
3005 set oldid $rowmenuid
3006 set newid $lineid($selectedline)
3008 addtohistory [list doseldiff $oldid $newid]
3009 doseldiff $oldid $newid
3012 proc doseldiff {oldid newid} {
3013 global ctext cflist
3014 global commitinfo
3016 $ctext conf -state normal
3017 $ctext delete 0.0 end
3018 $ctext mark set fmark.0 0.0
3019 $ctext mark gravity fmark.0 left
3020 $cflist delete 0 end
3021 $cflist insert end "Top"
3022 $ctext insert end "From "
3023 $ctext tag conf link -foreground blue -underline 1
3024 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3025 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3026 $ctext tag bind link0 <1> [list selbyid $oldid]
3027 $ctext insert end $oldid [list link link0]
3028 $ctext insert end "\n "
3029 $ctext insert end [lindex $commitinfo($oldid) 0]
3030 $ctext insert end "\n\nTo "
3031 $ctext tag bind link1 <1> [list selbyid $newid]
3032 $ctext insert end $newid [list link link1]
3033 $ctext insert end "\n "
3034 $ctext insert end [lindex $commitinfo($newid) 0]
3035 $ctext insert end "\n"
3036 $ctext conf -state disabled
3037 $ctext tag delete Comments
3038 $ctext tag remove found 1.0 end
3039 startdiff [list $oldid $newid]
3042 proc mkpatch {} {
3043 global rowmenuid currentid commitinfo patchtop patchnum
3045 if {![info exists currentid]} return
3046 set oldid $currentid
3047 set oldhead [lindex $commitinfo($oldid) 0]
3048 set newid $rowmenuid
3049 set newhead [lindex $commitinfo($newid) 0]
3050 set top .patch
3051 set patchtop $top
3052 catch {destroy $top}
3053 toplevel $top
3054 label $top.title -text "Generate patch"
3055 grid $top.title - -pady 10
3056 label $top.from -text "From:"
3057 entry $top.fromsha1 -width 40 -relief flat
3058 $top.fromsha1 insert 0 $oldid
3059 $top.fromsha1 conf -state readonly
3060 grid $top.from $top.fromsha1 -sticky w
3061 entry $top.fromhead -width 60 -relief flat
3062 $top.fromhead insert 0 $oldhead
3063 $top.fromhead conf -state readonly
3064 grid x $top.fromhead -sticky w
3065 label $top.to -text "To:"
3066 entry $top.tosha1 -width 40 -relief flat
3067 $top.tosha1 insert 0 $newid
3068 $top.tosha1 conf -state readonly
3069 grid $top.to $top.tosha1 -sticky w
3070 entry $top.tohead -width 60 -relief flat
3071 $top.tohead insert 0 $newhead
3072 $top.tohead conf -state readonly
3073 grid x $top.tohead -sticky w
3074 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3075 grid $top.rev x -pady 10
3076 label $top.flab -text "Output file:"
3077 entry $top.fname -width 60
3078 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3079 incr patchnum
3080 grid $top.flab $top.fname -sticky w
3081 frame $top.buts
3082 button $top.buts.gen -text "Generate" -command mkpatchgo
3083 button $top.buts.can -text "Cancel" -command mkpatchcan
3084 grid $top.buts.gen $top.buts.can
3085 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3086 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3087 grid $top.buts - -pady 10 -sticky ew
3088 focus $top.fname
3091 proc mkpatchrev {} {
3092 global patchtop
3094 set oldid [$patchtop.fromsha1 get]
3095 set oldhead [$patchtop.fromhead get]
3096 set newid [$patchtop.tosha1 get]
3097 set newhead [$patchtop.tohead get]
3098 foreach e [list fromsha1 fromhead tosha1 tohead] \
3099 v [list $newid $newhead $oldid $oldhead] {
3100 $patchtop.$e conf -state normal
3101 $patchtop.$e delete 0 end
3102 $patchtop.$e insert 0 $v
3103 $patchtop.$e conf -state readonly
3107 proc mkpatchgo {} {
3108 global patchtop
3110 set oldid [$patchtop.fromsha1 get]
3111 set newid [$patchtop.tosha1 get]
3112 set fname [$patchtop.fname get]
3113 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3114 error_popup "Error creating patch: $err"
3116 catch {destroy $patchtop}
3117 unset patchtop
3120 proc mkpatchcan {} {
3121 global patchtop
3123 catch {destroy $patchtop}
3124 unset patchtop
3127 proc mktag {} {
3128 global rowmenuid mktagtop commitinfo
3130 set top .maketag
3131 set mktagtop $top
3132 catch {destroy $top}
3133 toplevel $top
3134 label $top.title -text "Create tag"
3135 grid $top.title - -pady 10
3136 label $top.id -text "ID:"
3137 entry $top.sha1 -width 40 -relief flat
3138 $top.sha1 insert 0 $rowmenuid
3139 $top.sha1 conf -state readonly
3140 grid $top.id $top.sha1 -sticky w
3141 entry $top.head -width 60 -relief flat
3142 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3143 $top.head conf -state readonly
3144 grid x $top.head -sticky w
3145 label $top.tlab -text "Tag name:"
3146 entry $top.tag -width 60
3147 grid $top.tlab $top.tag -sticky w
3148 frame $top.buts
3149 button $top.buts.gen -text "Create" -command mktaggo
3150 button $top.buts.can -text "Cancel" -command mktagcan
3151 grid $top.buts.gen $top.buts.can
3152 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3153 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3154 grid $top.buts - -pady 10 -sticky ew
3155 focus $top.tag
3158 proc domktag {} {
3159 global mktagtop env tagids idtags
3161 set id [$mktagtop.sha1 get]
3162 set tag [$mktagtop.tag get]
3163 if {$tag == {}} {
3164 error_popup "No tag name specified"
3165 return
3167 if {[info exists tagids($tag)]} {
3168 error_popup "Tag \"$tag\" already exists"
3169 return
3171 if {[catch {
3172 set dir [gitdir]
3173 set fname [file join $dir "refs/tags" $tag]
3174 set f [open $fname w]
3175 puts $f $id
3176 close $f
3177 } err]} {
3178 error_popup "Error creating tag: $err"
3179 return
3182 set tagids($tag) $id
3183 lappend idtags($id) $tag
3184 redrawtags $id
3187 proc redrawtags {id} {
3188 global canv linehtag idline idpos selectedline
3190 if {![info exists idline($id)]} return
3191 $canv delete tag.$id
3192 set xt [eval drawtags $id $idpos($id)]
3193 $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3194 if {[info exists selectedline] && $selectedline == $idline($id)} {
3195 selectline $selectedline 0
3199 proc mktagcan {} {
3200 global mktagtop
3202 catch {destroy $mktagtop}
3203 unset mktagtop
3206 proc mktaggo {} {
3207 domktag
3208 mktagcan
3211 proc writecommit {} {
3212 global rowmenuid wrcomtop commitinfo wrcomcmd
3214 set top .writecommit
3215 set wrcomtop $top
3216 catch {destroy $top}
3217 toplevel $top
3218 label $top.title -text "Write commit to file"
3219 grid $top.title - -pady 10
3220 label $top.id -text "ID:"
3221 entry $top.sha1 -width 40 -relief flat
3222 $top.sha1 insert 0 $rowmenuid
3223 $top.sha1 conf -state readonly
3224 grid $top.id $top.sha1 -sticky w
3225 entry $top.head -width 60 -relief flat
3226 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3227 $top.head conf -state readonly
3228 grid x $top.head -sticky w
3229 label $top.clab -text "Command:"
3230 entry $top.cmd -width 60 -textvariable wrcomcmd
3231 grid $top.clab $top.cmd -sticky w -pady 10
3232 label $top.flab -text "Output file:"
3233 entry $top.fname -width 60
3234 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3235 grid $top.flab $top.fname -sticky w
3236 frame $top.buts
3237 button $top.buts.gen -text "Write" -command wrcomgo
3238 button $top.buts.can -text "Cancel" -command wrcomcan
3239 grid $top.buts.gen $top.buts.can
3240 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3241 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3242 grid $top.buts - -pady 10 -sticky ew
3243 focus $top.fname
3246 proc wrcomgo {} {
3247 global wrcomtop
3249 set id [$wrcomtop.sha1 get]
3250 set cmd "echo $id | [$wrcomtop.cmd get]"
3251 set fname [$wrcomtop.fname get]
3252 if {[catch {exec sh -c $cmd >$fname &} err]} {
3253 error_popup "Error writing commit: $err"
3255 catch {destroy $wrcomtop}
3256 unset wrcomtop
3259 proc wrcomcan {} {
3260 global wrcomtop
3262 catch {destroy $wrcomtop}
3263 unset wrcomtop
3266 proc listrefs {id} {
3267 global idtags idheads idotherrefs
3269 set x {}
3270 if {[info exists idtags($id)]} {
3271 set x $idtags($id)
3273 set y {}
3274 if {[info exists idheads($id)]} {
3275 set y $idheads($id)
3277 set z {}
3278 if {[info exists idotherrefs($id)]} {
3279 set z $idotherrefs($id)
3281 return [list $x $y $z]
3284 proc rereadrefs {} {
3285 global idtags idheads idotherrefs
3286 global tagids headids otherrefids
3288 set refids [concat [array names idtags] \
3289 [array names idheads] [array names idotherrefs]]
3290 foreach id $refids {
3291 if {![info exists ref($id)]} {
3292 set ref($id) [listrefs $id]
3295 readrefs
3296 set refids [lsort -unique [concat $refids [array names idtags] \
3297 [array names idheads] [array names idotherrefs]]]
3298 foreach id $refids {
3299 set v [listrefs $id]
3300 if {![info exists ref($id)] || $ref($id) != $v} {
3301 redrawtags $id
3306 proc showtag {tag isnew} {
3307 global ctext cflist tagcontents tagids linknum
3309 if {$isnew} {
3310 addtohistory [list showtag $tag 0]
3312 $ctext conf -state normal
3313 $ctext delete 0.0 end
3314 set linknum 0
3315 if {[info exists tagcontents($tag)]} {
3316 set text $tagcontents($tag)
3317 } else {
3318 set text "Tag: $tag\nId: $tagids($tag)"
3320 appendwithlinks $text
3321 $ctext conf -state disabled
3322 $cflist delete 0 end
3325 proc doquit {} {
3326 global stopped
3327 set stopped 100
3328 destroy .
3331 proc doprefs {} {
3332 global maxwidth maxgraphpct diffopts findmergefiles
3333 global oldprefs prefstop
3335 set top .gitkprefs
3336 set prefstop $top
3337 if {[winfo exists $top]} {
3338 raise $top
3339 return
3341 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3342 set oldprefs($v) [set $v]
3344 toplevel $top
3345 wm title $top "Gitk preferences"
3346 label $top.ldisp -text "Commit list display options"
3347 grid $top.ldisp - -sticky w -pady 10
3348 label $top.spacer -text " "
3349 label $top.maxwidthl -text "Maximum graph width (lines)" \
3350 -font optionfont
3351 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3352 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3353 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3354 -font optionfont
3355 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3356 grid x $top.maxpctl $top.maxpct -sticky w
3357 checkbutton $top.findm -variable findmergefiles
3358 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3359 -font optionfont
3360 grid $top.findm $top.findml - -sticky w
3361 label $top.ddisp -text "Diff display options"
3362 grid $top.ddisp - -sticky w -pady 10
3363 label $top.diffoptl -text "Options for diff program" \
3364 -font optionfont
3365 entry $top.diffopt -width 20 -textvariable diffopts
3366 grid x $top.diffoptl $top.diffopt -sticky w
3367 frame $top.buts
3368 button $top.buts.ok -text "OK" -command prefsok
3369 button $top.buts.can -text "Cancel" -command prefscan
3370 grid $top.buts.ok $top.buts.can
3371 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3372 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3373 grid $top.buts - - -pady 10 -sticky ew
3376 proc prefscan {} {
3377 global maxwidth maxgraphpct diffopts findmergefiles
3378 global oldprefs prefstop
3380 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3381 set $v $oldprefs($v)
3383 catch {destroy $prefstop}
3384 unset prefstop
3387 proc prefsok {} {
3388 global maxwidth maxgraphpct
3389 global oldprefs prefstop
3391 catch {destroy $prefstop}
3392 unset prefstop
3393 if {$maxwidth != $oldprefs(maxwidth)
3394 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3395 redisplay
3399 proc formatdate {d} {
3400 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3403 # This list of encoding names and aliases is distilled from
3404 # http://www.iana.org/assignments/character-sets.
3405 # Not all of them are supported by Tcl.
3406 set encoding_aliases {
3407 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3408 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3409 { ISO-10646-UTF-1 csISO10646UTF1 }
3410 { ISO_646.basic:1983 ref csISO646basic1983 }
3411 { INVARIANT csINVARIANT }
3412 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3413 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3414 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3415 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3416 { NATS-DANO iso-ir-9-1 csNATSDANO }
3417 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3418 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3419 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3420 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3421 { ISO-2022-KR csISO2022KR }
3422 { EUC-KR csEUCKR }
3423 { ISO-2022-JP csISO2022JP }
3424 { ISO-2022-JP-2 csISO2022JP2 }
3425 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3426 csISO13JISC6220jp }
3427 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3428 { IT iso-ir-15 ISO646-IT csISO15Italian }
3429 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3430 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3431 { greek7-old iso-ir-18 csISO18Greek7Old }
3432 { latin-greek iso-ir-19 csISO19LatinGreek }
3433 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3434 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3435 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3436 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3437 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3438 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3439 { INIS iso-ir-49 csISO49INIS }
3440 { INIS-8 iso-ir-50 csISO50INIS8 }
3441 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3442 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3443 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3444 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3445 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3446 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3447 csISO60Norwegian1 }
3448 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3449 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3450 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3451 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3452 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3453 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3454 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3455 { greek7 iso-ir-88 csISO88Greek7 }
3456 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3457 { iso-ir-90 csISO90 }
3458 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3459 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3460 csISO92JISC62991984b }
3461 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3462 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3463 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3464 csISO95JIS62291984handadd }
3465 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3466 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3467 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3468 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3469 CP819 csISOLatin1 }
3470 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3471 { T.61-7bit iso-ir-102 csISO102T617bit }
3472 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3473 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3474 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3475 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3476 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3477 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3478 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3479 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3480 arabic csISOLatinArabic }
3481 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3482 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3483 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3484 greek greek8 csISOLatinGreek }
3485 { T.101-G2 iso-ir-128 csISO128T101G2 }
3486 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3487 csISOLatinHebrew }
3488 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3489 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3490 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3491 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3492 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3493 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3494 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3495 csISOLatinCyrillic }
3496 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3497 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3498 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3499 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3500 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3501 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3502 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3503 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3504 { ISO_10367-box iso-ir-155 csISO10367Box }
3505 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3506 { latin-lap lap iso-ir-158 csISO158Lap }
3507 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3508 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3509 { us-dk csUSDK }
3510 { dk-us csDKUS }
3511 { JIS_X0201 X0201 csHalfWidthKatakana }
3512 { KSC5636 ISO646-KR csKSC5636 }
3513 { ISO-10646-UCS-2 csUnicode }
3514 { ISO-10646-UCS-4 csUCS4 }
3515 { DEC-MCS dec csDECMCS }
3516 { hp-roman8 roman8 r8 csHPRoman8 }
3517 { macintosh mac csMacintosh }
3518 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3519 csIBM037 }
3520 { IBM038 EBCDIC-INT cp038 csIBM038 }
3521 { IBM273 CP273 csIBM273 }
3522 { IBM274 EBCDIC-BE CP274 csIBM274 }
3523 { IBM275 EBCDIC-BR cp275 csIBM275 }
3524 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3525 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3526 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3527 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3528 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3529 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3530 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3531 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3532 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3533 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3534 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3535 { IBM437 cp437 437 csPC8CodePage437 }
3536 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3537 { IBM775 cp775 csPC775Baltic }
3538 { IBM850 cp850 850 csPC850Multilingual }
3539 { IBM851 cp851 851 csIBM851 }
3540 { IBM852 cp852 852 csPCp852 }
3541 { IBM855 cp855 855 csIBM855 }
3542 { IBM857 cp857 857 csIBM857 }
3543 { IBM860 cp860 860 csIBM860 }
3544 { IBM861 cp861 861 cp-is csIBM861 }
3545 { IBM862 cp862 862 csPC862LatinHebrew }
3546 { IBM863 cp863 863 csIBM863 }
3547 { IBM864 cp864 csIBM864 }
3548 { IBM865 cp865 865 csIBM865 }
3549 { IBM866 cp866 866 csIBM866 }
3550 { IBM868 CP868 cp-ar csIBM868 }
3551 { IBM869 cp869 869 cp-gr csIBM869 }
3552 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3553 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3554 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3555 { IBM891 cp891 csIBM891 }
3556 { IBM903 cp903 csIBM903 }
3557 { IBM904 cp904 904 csIBBM904 }
3558 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3559 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3560 { IBM1026 CP1026 csIBM1026 }
3561 { EBCDIC-AT-DE csIBMEBCDICATDE }
3562 { EBCDIC-AT-DE-A csEBCDICATDEA }
3563 { EBCDIC-CA-FR csEBCDICCAFR }
3564 { EBCDIC-DK-NO csEBCDICDKNO }
3565 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3566 { EBCDIC-FI-SE csEBCDICFISE }
3567 { EBCDIC-FI-SE-A csEBCDICFISEA }
3568 { EBCDIC-FR csEBCDICFR }
3569 { EBCDIC-IT csEBCDICIT }
3570 { EBCDIC-PT csEBCDICPT }
3571 { EBCDIC-ES csEBCDICES }
3572 { EBCDIC-ES-A csEBCDICESA }
3573 { EBCDIC-ES-S csEBCDICESS }
3574 { EBCDIC-UK csEBCDICUK }
3575 { EBCDIC-US csEBCDICUS }
3576 { UNKNOWN-8BIT csUnknown8BiT }
3577 { MNEMONIC csMnemonic }
3578 { MNEM csMnem }
3579 { VISCII csVISCII }
3580 { VIQR csVIQR }
3581 { KOI8-R csKOI8R }
3582 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3583 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3584 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3585 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3586 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3587 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3588 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3589 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3590 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3591 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3592 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3593 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3594 { IBM1047 IBM-1047 }
3595 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3596 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3597 { UNICODE-1-1 csUnicode11 }
3598 { CESU-8 csCESU-8 }
3599 { BOCU-1 csBOCU-1 }
3600 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3601 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3602 l8 }
3603 { ISO-8859-15 ISO_8859-15 Latin-9 }
3604 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3605 { GBK CP936 MS936 windows-936 }
3606 { JIS_Encoding csJISEncoding }
3607 { Shift_JIS MS_Kanji csShiftJIS }
3608 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3609 EUC-JP }
3610 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3611 { ISO-10646-UCS-Basic csUnicodeASCII }
3612 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3613 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3614 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3615 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3616 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3617 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3618 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3619 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3620 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3621 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3622 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3623 { Ventura-US csVenturaUS }
3624 { Ventura-International csVenturaInternational }
3625 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3626 { PC8-Turkish csPC8Turkish }
3627 { IBM-Symbols csIBMSymbols }
3628 { IBM-Thai csIBMThai }
3629 { HP-Legal csHPLegal }
3630 { HP-Pi-font csHPPiFont }
3631 { HP-Math8 csHPMath8 }
3632 { Adobe-Symbol-Encoding csHPPSMath }
3633 { HP-DeskTop csHPDesktop }
3634 { Ventura-Math csVenturaMath }
3635 { Microsoft-Publishing csMicrosoftPublishing }
3636 { Windows-31J csWindows31J }
3637 { GB2312 csGB2312 }
3638 { Big5 csBig5 }
3641 proc tcl_encoding {enc} {
3642 global encoding_aliases
3643 set names [encoding names]
3644 set lcnames [string tolower $names]
3645 set enc [string tolower $enc]
3646 set i [lsearch -exact $lcnames $enc]
3647 if {$i < 0} {
3648 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3649 if {[regsub {^iso[-_]} $enc iso encx]} {
3650 set i [lsearch -exact $lcnames $encx]
3653 if {$i < 0} {
3654 foreach l $encoding_aliases {
3655 set ll [string tolower $l]
3656 if {[lsearch -exact $ll $enc] < 0} continue
3657 # look through the aliases for one that tcl knows about
3658 foreach e $ll {
3659 set i [lsearch -exact $lcnames $e]
3660 if {$i < 0} {
3661 if {[regsub {^iso[-_]} $e iso ex]} {
3662 set i [lsearch -exact $lcnames $ex]
3665 if {$i >= 0} break
3667 break
3670 if {$i >= 0} {
3671 return [lindex $names $i]
3673 return {}
3676 # defaults...
3677 set datemode 0
3678 set diffopts "-U 5 -p"
3679 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3681 set gitencoding {}
3682 catch {
3683 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3685 if {$gitencoding == ""} {
3686 set gitencoding "utf-8"
3688 set tclencoding [tcl_encoding $gitencoding]
3689 if {$tclencoding == {}} {
3690 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3693 set mainfont {Helvetica 9}
3694 set textfont {Courier 9}
3695 set findmergefiles 0
3696 set maxgraphpct 50
3697 set maxwidth 16
3698 set revlistorder 0
3699 set fastdate 0
3701 set colors {green red blue magenta darkgrey brown orange}
3703 catch {source ~/.gitk}
3705 set namefont $mainfont
3707 font create optionfont -family sans-serif -size -12
3709 set revtreeargs {}
3710 foreach arg $argv {
3711 switch -regexp -- $arg {
3712 "^$" { }
3713 "^-d" { set datemode 1 }
3714 "^-r" { set revlistorder 1 }
3715 default {
3716 lappend revtreeargs $arg
3721 set history {}
3722 set historyindex 0
3724 set stopped 0
3725 set redisplaying 0
3726 set stuffsaved 0
3727 set patchnum 0
3728 setcoords
3729 makewindow $revtreeargs
3730 readrefs
3731 getcommits $revtreeargs