gitk: Use a text widget for the file list
[git/mingw/4msysgit.git] / gitk
blobbd205f876a59d6f8f201582d929d4967ab3736cf
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 start_rev_list {} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global revtreeargs curview viewfiles
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
26 set ncmupdate 1
27 initlayout
28 set args $revtreeargs
29 if {$viewfiles($curview) ne {}} {
30 set args [concat $args "--" $viewfiles($curview)]
32 set order "--topo-order"
33 if {$datemode} {
34 set order "--date-order"
36 if {[catch {
37 set commfd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
39 } err]} {
40 puts stderr "Error executing git-rev-list: $err"
41 exit 1
43 set leftover {}
44 fconfigure $commfd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $commfd -encoding $tclencoding
48 fileevent $commfd readable [list getcommitlines $commfd]
49 . config -cursor watch
50 settextcursor watch
53 proc stop_rev_list {} {
54 global commfd
56 if {![info exists commfd]} return
57 catch {
58 set pid [pid $commfd]
59 exec kill $pid
61 catch {close $commfd}
62 unset commfd
65 proc getcommits {} {
66 global phase canv mainfont
68 set phase getcommits
69 start_rev_list
70 $canv delete all
71 $canv create text 3 3 -anchor nw -text "Reading commits..." \
72 -font $mainfont -tags textitems
75 proc getcommitlines {commfd} {
76 global commitlisted nextupdate
77 global leftover
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children
81 set stuff [read $commfd]
82 if {$stuff == {}} {
83 if {![eof $commfd]} return
84 # set it blocking so we wait for the process to terminate
85 fconfigure $commfd -blocking 1
86 if {![catch {close $commfd} err]} {
87 after idle finishcommits
88 return
90 if {[string range $err 0 4] == "usage"} {
91 set err \
92 "Gitk: error reading commits: bad arguments to git-rev-list.\
93 (Note: arguments to gitk are passed to git-rev-list\
94 to allow selection of commits to be displayed.)"
95 } else {
96 set err "Error reading commits: $err"
98 error_popup $err
99 exit 1
101 set start 0
102 set gotsome 0
103 while 1 {
104 set i [string first "\0" $stuff $start]
105 if {$i < 0} {
106 append leftover [string range $stuff $start end]
107 break
109 if {$start == 0} {
110 set cmit $leftover
111 append cmit [string range $stuff 0 [expr {$i - 1}]]
112 set leftover {}
113 } else {
114 set cmit [string range $stuff $start [expr {$i - 1}]]
116 set start [expr {$i + 1}]
117 set j [string first "\n" $cmit]
118 set ok 0
119 set listed 1
120 if {$j >= 0} {
121 set ids [string range $cmit 0 [expr {$j - 1}]]
122 if {[string range $ids 0 0] == "-"} {
123 set listed 0
124 set ids [string range $ids 1 end]
126 set ok 1
127 foreach id $ids {
128 if {[string length $id] != 40} {
129 set ok 0
130 break
134 if {!$ok} {
135 set shortcmit $cmit
136 if {[string length $shortcmit] > 80} {
137 set shortcmit "[string range $shortcmit 0 80]..."
139 error_popup "Can't parse git-rev-list output: {$shortcmit}"
140 exit 1
142 set id [lindex $ids 0]
143 if {$listed} {
144 set olds [lrange $ids 1 end]
145 set i 0
146 foreach p $olds {
147 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
148 lappend children($p) $id
150 incr i
152 } else {
153 set olds {}
155 lappend parentlist $olds
156 if {[info exists children($id)]} {
157 lappend childlist $children($id)
158 unset children($id)
159 } else {
160 lappend childlist {}
162 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
163 set commitrow($id) $commitidx
164 incr commitidx
165 lappend displayorder $id
166 lappend commitlisted $listed
167 set gotsome 1
169 if {$gotsome} {
170 layoutmore
172 if {[clock clicks -milliseconds] >= $nextupdate} {
173 doupdate 1
177 proc doupdate {reading} {
178 global commfd nextupdate numcommits ncmupdate
180 if {$reading} {
181 fileevent $commfd readable {}
183 update
184 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
185 if {$numcommits < 100} {
186 set ncmupdate [expr {$numcommits + 1}]
187 } elseif {$numcommits < 10000} {
188 set ncmupdate [expr {$numcommits + 10}]
189 } else {
190 set ncmupdate [expr {$numcommits + 100}]
192 if {$reading} {
193 fileevent $commfd readable [list getcommitlines $commfd]
197 proc readcommit {id} {
198 if {[catch {set contents [exec git-cat-file commit $id]}]} return
199 parsecommit $id $contents 0
202 proc updatecommits {} {
203 global viewdata curview revtreeargs phase
205 if {$phase ne {}} {
206 stop_rev_list
207 set phase {}
209 set n $curview
210 set curview -1
211 catch {unset viewdata($n)}
212 readrefs
213 showview $n
216 proc parsecommit {id contents listed} {
217 global commitinfo cdate
219 set inhdr 1
220 set comment {}
221 set headline {}
222 set auname {}
223 set audate {}
224 set comname {}
225 set comdate {}
226 set hdrend [string first "\n\n" $contents]
227 if {$hdrend < 0} {
228 # should never happen...
229 set hdrend [string length $contents]
231 set header [string range $contents 0 [expr {$hdrend - 1}]]
232 set comment [string range $contents [expr {$hdrend + 2}] end]
233 foreach line [split $header "\n"] {
234 set tag [lindex $line 0]
235 if {$tag == "author"} {
236 set audate [lindex $line end-1]
237 set auname [lrange $line 1 end-2]
238 } elseif {$tag == "committer"} {
239 set comdate [lindex $line end-1]
240 set comname [lrange $line 1 end-2]
243 set headline {}
244 # take the first line of the comment as the headline
245 set i [string first "\n" $comment]
246 if {$i >= 0} {
247 set headline [string trim [string range $comment 0 $i]]
248 } else {
249 set headline $comment
251 if {!$listed} {
252 # git-rev-list indents the comment by 4 spaces;
253 # if we got this via git-cat-file, add the indentation
254 set newcomment {}
255 foreach line [split $comment "\n"] {
256 append newcomment " "
257 append newcomment $line
258 append newcomment "\n"
260 set comment $newcomment
262 if {$comdate != {}} {
263 set cdate($id) $comdate
265 set commitinfo($id) [list $headline $auname $audate \
266 $comname $comdate $comment]
269 proc getcommit {id} {
270 global commitdata commitinfo
272 if {[info exists commitdata($id)]} {
273 parsecommit $id $commitdata($id) 1
274 } else {
275 readcommit $id
276 if {![info exists commitinfo($id)]} {
277 set commitinfo($id) {"No commit information available"}
280 return 1
283 proc readrefs {} {
284 global tagids idtags headids idheads tagcontents
285 global otherrefids idotherrefs
287 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
288 catch {unset $v}
290 set refd [open [list | git ls-remote [gitdir]] r]
291 while {0 <= [set n [gets $refd line]]} {
292 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
293 match id path]} {
294 continue
296 if {[regexp {^remotes/.*/HEAD$} $path match]} {
297 continue
299 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
300 set type others
301 set name $path
303 if {[regexp {^remotes/} $path match]} {
304 set type heads
306 if {$type == "tags"} {
307 set tagids($name) $id
308 lappend idtags($id) $name
309 set obj {}
310 set type {}
311 set tag {}
312 catch {
313 set commit [exec git-rev-parse "$id^0"]
314 if {"$commit" != "$id"} {
315 set tagids($name) $commit
316 lappend idtags($commit) $name
319 catch {
320 set tagcontents($name) [exec git-cat-file tag "$id"]
322 } elseif { $type == "heads" } {
323 set headids($name) $id
324 lappend idheads($id) $name
325 } else {
326 set otherrefids($name) $id
327 lappend idotherrefs($id) $name
330 close $refd
333 proc error_popup msg {
334 set w .error
335 toplevel $w
336 wm transient $w .
337 message $w.m -text $msg -justify center -aspect 400
338 pack $w.m -side top -fill x -padx 20 -pady 20
339 button $w.ok -text OK -command "destroy $w"
340 pack $w.ok -side bottom -fill x
341 bind $w <Visibility> "grab $w; focus $w"
342 bind $w <Key-Return> "destroy $w"
343 tkwait window $w
346 proc makewindow {} {
347 global canv canv2 canv3 linespc charspc ctext cflist
348 global textfont mainfont uifont
349 global findtype findtypemenu findloc findstring fstring geometry
350 global entries sha1entry sha1string sha1but
351 global maincursor textcursor curtextcursor
352 global rowctxmenu mergemax
354 menu .bar
355 .bar add cascade -label "File" -menu .bar.file
356 .bar configure -font $uifont
357 menu .bar.file
358 .bar.file add command -label "Update" -command updatecommits
359 .bar.file add command -label "Reread references" -command rereadrefs
360 .bar.file add command -label "Quit" -command doquit
361 .bar.file configure -font $uifont
362 menu .bar.edit
363 .bar add cascade -label "Edit" -menu .bar.edit
364 .bar.edit add command -label "Preferences" -command doprefs
365 .bar.edit configure -font $uifont
366 menu .bar.view -font $uifont
367 .bar add cascade -label "View" -menu .bar.view
368 .bar.view add command -label "New view..." -command newview
369 .bar.view add command -label "Edit view..." -command editview
370 .bar.view add command -label "Delete view" -command delview -state disabled
371 .bar.view add separator
372 .bar.view add radiobutton -label "All files" -command {showview 0} \
373 -variable selectedview -value 0
374 menu .bar.help
375 .bar add cascade -label "Help" -menu .bar.help
376 .bar.help add command -label "About gitk" -command about
377 .bar.help add command -label "Key bindings" -command keys
378 .bar.help configure -font $uifont
379 . configure -menu .bar
381 if {![info exists geometry(canv1)]} {
382 set geometry(canv1) [expr {45 * $charspc}]
383 set geometry(canv2) [expr {30 * $charspc}]
384 set geometry(canv3) [expr {15 * $charspc}]
385 set geometry(canvh) [expr {25 * $linespc + 4}]
386 set geometry(ctextw) 80
387 set geometry(ctexth) 30
388 set geometry(cflistw) 30
390 panedwindow .ctop -orient vertical
391 if {[info exists geometry(width)]} {
392 .ctop conf -width $geometry(width) -height $geometry(height)
393 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
394 set geometry(ctexth) [expr {($texth - 8) /
395 [font metrics $textfont -linespace]}]
397 frame .ctop.top
398 frame .ctop.top.bar
399 pack .ctop.top.bar -side bottom -fill x
400 set cscroll .ctop.top.csb
401 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
402 pack $cscroll -side right -fill y
403 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
404 pack .ctop.top.clist -side top -fill both -expand 1
405 .ctop add .ctop.top
406 set canv .ctop.top.clist.canv
407 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
408 -bg white -bd 0 \
409 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
410 .ctop.top.clist add $canv
411 set canv2 .ctop.top.clist.canv2
412 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
413 -bg white -bd 0 -yscrollincr $linespc
414 .ctop.top.clist add $canv2
415 set canv3 .ctop.top.clist.canv3
416 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
417 -bg white -bd 0 -yscrollincr $linespc
418 .ctop.top.clist add $canv3
419 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
421 set sha1entry .ctop.top.bar.sha1
422 set entries $sha1entry
423 set sha1but .ctop.top.bar.sha1label
424 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
425 -command gotocommit -width 8 -font $uifont
426 $sha1but conf -disabledforeground [$sha1but cget -foreground]
427 pack .ctop.top.bar.sha1label -side left
428 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
429 trace add variable sha1string write sha1change
430 pack $sha1entry -side left -pady 2
432 image create bitmap bm-left -data {
433 #define left_width 16
434 #define left_height 16
435 static unsigned char left_bits[] = {
436 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
437 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
438 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
440 image create bitmap bm-right -data {
441 #define right_width 16
442 #define right_height 16
443 static unsigned char right_bits[] = {
444 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
445 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
446 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
448 button .ctop.top.bar.leftbut -image bm-left -command goback \
449 -state disabled -width 26
450 pack .ctop.top.bar.leftbut -side left -fill y
451 button .ctop.top.bar.rightbut -image bm-right -command goforw \
452 -state disabled -width 26
453 pack .ctop.top.bar.rightbut -side left -fill y
455 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
456 pack .ctop.top.bar.findbut -side left
457 set findstring {}
458 set fstring .ctop.top.bar.findstring
459 lappend entries $fstring
460 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
461 pack $fstring -side left -expand 1 -fill x
462 set findtype Exact
463 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
464 findtype Exact IgnCase Regexp]
465 .ctop.top.bar.findtype configure -font $uifont
466 .ctop.top.bar.findtype.menu configure -font $uifont
467 set findloc "All fields"
468 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
469 Comments Author Committer Files Pickaxe
470 .ctop.top.bar.findloc configure -font $uifont
471 .ctop.top.bar.findloc.menu configure -font $uifont
473 pack .ctop.top.bar.findloc -side right
474 pack .ctop.top.bar.findtype -side right
475 # for making sure type==Exact whenever loc==Pickaxe
476 trace add variable findloc write findlocchange
478 panedwindow .ctop.cdet -orient horizontal
479 .ctop add .ctop.cdet
480 frame .ctop.cdet.left
481 set ctext .ctop.cdet.left.ctext
482 text $ctext -bg white -state disabled -font $textfont \
483 -width $geometry(ctextw) -height $geometry(ctexth) \
484 -yscrollcommand scrolltext -wrap none
485 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
486 pack .ctop.cdet.left.sb -side right -fill y
487 pack $ctext -side left -fill both -expand 1
488 .ctop.cdet add .ctop.cdet.left
490 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
491 $ctext tag conf hunksep -fore blue
492 $ctext tag conf d0 -fore red
493 $ctext tag conf d1 -fore "#00a000"
494 $ctext tag conf m0 -fore red
495 $ctext tag conf m1 -fore blue
496 $ctext tag conf m2 -fore green
497 $ctext tag conf m3 -fore purple
498 $ctext tag conf m4 -fore brown
499 $ctext tag conf m5 -fore "#009090"
500 $ctext tag conf m6 -fore magenta
501 $ctext tag conf m7 -fore "#808000"
502 $ctext tag conf m8 -fore "#009000"
503 $ctext tag conf m9 -fore "#ff0080"
504 $ctext tag conf m10 -fore cyan
505 $ctext tag conf m11 -fore "#b07070"
506 $ctext tag conf m12 -fore "#70b0f0"
507 $ctext tag conf m13 -fore "#70f0b0"
508 $ctext tag conf m14 -fore "#f0b070"
509 $ctext tag conf m15 -fore "#ff70b0"
510 $ctext tag conf mmax -fore darkgrey
511 set mergemax 16
512 $ctext tag conf mresult -font [concat $textfont bold]
513 $ctext tag conf msep -font [concat $textfont bold]
514 $ctext tag conf found -back yellow
516 frame .ctop.cdet.right
517 set cflist .ctop.cdet.right.cfiles
518 set indent [font measure $mainfont "nn"]
519 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
520 -tabs [list $indent [expr {2 * $indent}]] \
521 -yscrollcommand ".ctop.cdet.right.sb set" \
522 -cursor [. cget -cursor] \
523 -spacing1 1 -spacing3 1
524 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
525 pack .ctop.cdet.right.sb -side right -fill y
526 pack $cflist -side left -fill both -expand 1
527 $cflist tag configure highlight -background yellow
528 .ctop.cdet add .ctop.cdet.right
529 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
531 pack .ctop -side top -fill both -expand 1
533 bindall <1> {selcanvline %W %x %y}
534 #bindall <B1-Motion> {selcanvline %W %x %y}
535 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
536 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
537 bindall <2> "canvscan mark %W %x %y"
538 bindall <B2-Motion> "canvscan dragto %W %x %y"
539 bindkey <Home> selfirstline
540 bindkey <End> sellastline
541 bind . <Key-Up> "selnextline -1"
542 bind . <Key-Down> "selnextline 1"
543 bindkey <Key-Right> "goforw"
544 bindkey <Key-Left> "goback"
545 bind . <Key-Prior> "selnextpage -1"
546 bind . <Key-Next> "selnextpage 1"
547 bind . <Control-Home> "allcanvs yview moveto 0.0"
548 bind . <Control-End> "allcanvs yview moveto 1.0"
549 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
550 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
551 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
552 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
553 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
554 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
555 bindkey <Key-space> "$ctext yview scroll 1 pages"
556 bindkey p "selnextline -1"
557 bindkey n "selnextline 1"
558 bindkey z "goback"
559 bindkey x "goforw"
560 bindkey i "selnextline -1"
561 bindkey k "selnextline 1"
562 bindkey j "goback"
563 bindkey l "goforw"
564 bindkey b "$ctext yview scroll -1 pages"
565 bindkey d "$ctext yview scroll 18 units"
566 bindkey u "$ctext yview scroll -18 units"
567 bindkey / {findnext 1}
568 bindkey <Key-Return> {findnext 0}
569 bindkey ? findprev
570 bindkey f nextfile
571 bind . <Control-q> doquit
572 bind . <Control-f> dofind
573 bind . <Control-g> {findnext 0}
574 bind . <Control-r> findprev
575 bind . <Control-equal> {incrfont 1}
576 bind . <Control-KP_Add> {incrfont 1}
577 bind . <Control-minus> {incrfont -1}
578 bind . <Control-KP_Subtract> {incrfont -1}
579 bind . <Destroy> {savestuff %W}
580 bind . <Button-1> "click %W"
581 bind $fstring <Key-Return> dofind
582 bind $sha1entry <Key-Return> gotocommit
583 bind $sha1entry <<PasteSelection>> clearsha1
584 bind $cflist <1> {sel_flist %W %x %y; break}
585 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
587 set maincursor [. cget -cursor]
588 set textcursor [$ctext cget -cursor]
589 set curtextcursor $textcursor
591 set rowctxmenu .rowctxmenu
592 menu $rowctxmenu -tearoff 0
593 $rowctxmenu add command -label "Diff this -> selected" \
594 -command {diffvssel 0}
595 $rowctxmenu add command -label "Diff selected -> this" \
596 -command {diffvssel 1}
597 $rowctxmenu add command -label "Make patch" -command mkpatch
598 $rowctxmenu add command -label "Create tag" -command mktag
599 $rowctxmenu add command -label "Write commit to file" -command writecommit
602 # mouse-2 makes all windows scan vertically, but only the one
603 # the cursor is in scans horizontally
604 proc canvscan {op w x y} {
605 global canv canv2 canv3
606 foreach c [list $canv $canv2 $canv3] {
607 if {$c == $w} {
608 $c scan $op $x $y
609 } else {
610 $c scan $op 0 $y
615 proc scrollcanv {cscroll f0 f1} {
616 $cscroll set $f0 $f1
617 drawfrac $f0 $f1
620 # when we make a key binding for the toplevel, make sure
621 # it doesn't get triggered when that key is pressed in the
622 # find string entry widget.
623 proc bindkey {ev script} {
624 global entries
625 bind . $ev $script
626 set escript [bind Entry $ev]
627 if {$escript == {}} {
628 set escript [bind Entry <Key>]
630 foreach e $entries {
631 bind $e $ev "$escript; break"
635 # set the focus back to the toplevel for any click outside
636 # the entry widgets
637 proc click {w} {
638 global entries
639 foreach e $entries {
640 if {$w == $e} return
642 focus .
645 proc savestuff {w} {
646 global canv canv2 canv3 ctext cflist mainfont textfont uifont
647 global stuffsaved findmergefiles maxgraphpct
648 global maxwidth
649 global viewname viewfiles viewperm nextviewnum
651 if {$stuffsaved} return
652 if {![winfo viewable .]} return
653 catch {
654 set f [open "~/.gitk-new" w]
655 puts $f [list set mainfont $mainfont]
656 puts $f [list set textfont $textfont]
657 puts $f [list set uifont $uifont]
658 puts $f [list set findmergefiles $findmergefiles]
659 puts $f [list set maxgraphpct $maxgraphpct]
660 puts $f [list set maxwidth $maxwidth]
661 puts $f "set geometry(width) [winfo width .ctop]"
662 puts $f "set geometry(height) [winfo height .ctop]"
663 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
664 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
665 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
666 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
667 set wid [expr {([winfo width $ctext] - 8) \
668 / [font measure $textfont "0"]}]
669 puts $f "set geometry(ctextw) $wid"
670 set wid [expr {([winfo width $cflist] - 11) \
671 / [font measure [$cflist cget -font] "0"]}]
672 puts $f "set geometry(cflistw) $wid"
673 puts -nonewline $f "set permviews {"
674 for {set v 0} {$v < $nextviewnum} {incr v} {
675 if {$viewperm($v)} {
676 puts $f "{[list $viewname($v) $viewfiles($v)]}"
679 puts $f "}"
680 close $f
681 file rename -force "~/.gitk-new" "~/.gitk"
683 set stuffsaved 1
686 proc resizeclistpanes {win w} {
687 global oldwidth
688 if {[info exists oldwidth($win)]} {
689 set s0 [$win sash coord 0]
690 set s1 [$win sash coord 1]
691 if {$w < 60} {
692 set sash0 [expr {int($w/2 - 2)}]
693 set sash1 [expr {int($w*5/6 - 2)}]
694 } else {
695 set factor [expr {1.0 * $w / $oldwidth($win)}]
696 set sash0 [expr {int($factor * [lindex $s0 0])}]
697 set sash1 [expr {int($factor * [lindex $s1 0])}]
698 if {$sash0 < 30} {
699 set sash0 30
701 if {$sash1 < $sash0 + 20} {
702 set sash1 [expr {$sash0 + 20}]
704 if {$sash1 > $w - 10} {
705 set sash1 [expr {$w - 10}]
706 if {$sash0 > $sash1 - 20} {
707 set sash0 [expr {$sash1 - 20}]
711 $win sash place 0 $sash0 [lindex $s0 1]
712 $win sash place 1 $sash1 [lindex $s1 1]
714 set oldwidth($win) $w
717 proc resizecdetpanes {win w} {
718 global oldwidth
719 if {[info exists oldwidth($win)]} {
720 set s0 [$win sash coord 0]
721 if {$w < 60} {
722 set sash0 [expr {int($w*3/4 - 2)}]
723 } else {
724 set factor [expr {1.0 * $w / $oldwidth($win)}]
725 set sash0 [expr {int($factor * [lindex $s0 0])}]
726 if {$sash0 < 45} {
727 set sash0 45
729 if {$sash0 > $w - 15} {
730 set sash0 [expr {$w - 15}]
733 $win sash place 0 $sash0 [lindex $s0 1]
735 set oldwidth($win) $w
738 proc allcanvs args {
739 global canv canv2 canv3
740 eval $canv $args
741 eval $canv2 $args
742 eval $canv3 $args
745 proc bindall {event action} {
746 global canv canv2 canv3
747 bind $canv $event $action
748 bind $canv2 $event $action
749 bind $canv3 $event $action
752 proc about {} {
753 set w .about
754 if {[winfo exists $w]} {
755 raise $w
756 return
758 toplevel $w
759 wm title $w "About gitk"
760 message $w.m -text {
761 Gitk - a commit viewer for git
763 Copyright © 2005-2006 Paul Mackerras
765 Use and redistribute under the terms of the GNU General Public License} \
766 -justify center -aspect 400
767 pack $w.m -side top -fill x -padx 20 -pady 20
768 button $w.ok -text Close -command "destroy $w"
769 pack $w.ok -side bottom
772 proc keys {} {
773 set w .keys
774 if {[winfo exists $w]} {
775 raise $w
776 return
778 toplevel $w
779 wm title $w "Gitk key bindings"
780 message $w.m -text {
781 Gitk key bindings:
783 <Ctrl-Q> Quit
784 <Home> Move to first commit
785 <End> Move to last commit
786 <Up>, p, i Move up one commit
787 <Down>, n, k Move down one commit
788 <Left>, z, j Go back in history list
789 <Right>, x, l Go forward in history list
790 <PageUp> Move up one page in commit list
791 <PageDown> Move down one page in commit list
792 <Ctrl-Home> Scroll to top of commit list
793 <Ctrl-End> Scroll to bottom of commit list
794 <Ctrl-Up> Scroll commit list up one line
795 <Ctrl-Down> Scroll commit list down one line
796 <Ctrl-PageUp> Scroll commit list up one page
797 <Ctrl-PageDown> Scroll commit list down one page
798 <Delete>, b Scroll diff view up one page
799 <Backspace> Scroll diff view up one page
800 <Space> Scroll diff view down one page
801 u Scroll diff view up 18 lines
802 d Scroll diff view down 18 lines
803 <Ctrl-F> Find
804 <Ctrl-G> Move to next find hit
805 <Ctrl-R> Move to previous find hit
806 <Return> Move to next find hit
807 / Move to next find hit, or redo find
808 ? Move to previous find hit
809 f Scroll diff view to next file
810 <Ctrl-KP+> Increase font size
811 <Ctrl-plus> Increase font size
812 <Ctrl-KP-> Decrease font size
813 <Ctrl-minus> Decrease font size
815 -justify left -bg white -border 2 -relief sunken
816 pack $w.m -side top -fill both
817 button $w.ok -text Close -command "destroy $w"
818 pack $w.ok -side bottom
821 # Procedures for manipulating the file list window at the
822 # bottom right of the overall window.
823 proc init_flist {first} {
824 global cflist cflist_top cflist_bot selectedline difffilestart
826 $cflist conf -state normal
827 $cflist delete 0.0 end
828 if {$first ne {}} {
829 $cflist insert end $first
830 set cflist_top 1
831 set cflist_bot 1
832 $cflist tag add highlight 1.0 "1.0 lineend"
833 } else {
834 catch {unset cflist_top}
836 $cflist conf -state disabled
837 set difffilestart {}
840 proc add_flist {f} {
841 global flistmode cflist
843 $cflist conf -state normal
844 if {$flistmode eq "flat"} {
845 $cflist insert end "\n$f"
847 $cflist conf -state disabled
850 proc sel_flist {w x y} {
851 global flistmode ctext difffilestart cflist cflist_top
853 if {![info exists cflist_top]} return
854 set l [lindex [split [$w index "@$x,$y"] "."] 0]
855 if {$flistmode eq "flat"} {
856 if {$l == 1} {
857 $ctext yview 1.0
858 } else {
859 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
861 highlight_flist $l
865 proc scrolltext {f0 f1} {
866 global cflist_top
868 .ctop.cdet.left.sb set $f0 $f1
869 if {[info exists cflist_top]} {
870 highlight_flist $cflist_top
874 # Given an index $tl in the $ctext window, this works out which line
875 # of the $cflist window displays the filename whose patch is shown
876 # at the given point in the $ctext window. $ll is a hint about which
877 # line it might be, and is used as the starting point of the search.
878 proc ctext_index {tl ll} {
879 global ctext difffilestart
881 while {$ll >= 2 && [$ctext compare $tl < \
882 [lindex $difffilestart [expr {$ll - 2}]]]} {
883 incr ll -1
885 set nfiles [llength $difffilestart]
886 while {$ll - 1 < $nfiles && [$ctext compare $tl >= \
887 [lindex $difffilestart [expr {$ll - 1}]]]} {
888 incr ll
890 return $ll
893 proc highlight_flist {ll} {
894 global ctext cflist cflist_top cflist_bot difffilestart
896 if {![info exists difffilestart] || [llength $difffilestart] == 0} return
897 set ll [ctext_index [$ctext index @0,1] $ll]
898 set lb $cflist_bot
899 if {$lb < $ll} {
900 set lb $ll
902 set y [expr {[winfo height $ctext] - 2}]
903 set lb [ctext_index [$ctext index @0,$y] $lb]
904 if {$ll != $cflist_top || $lb != $cflist_bot} {
905 $cflist tag remove highlight $cflist_top.0 "$cflist_bot.0 lineend"
906 for {set l $ll} {$l <= $lb} {incr l} {
907 $cflist tag add highlight $l.0 "$l.0 lineend"
909 set cflist_top $ll
910 set cflist_bot $lb
914 # Code to implement multiple views
916 proc newview {} {
917 global nextviewnum newviewname newviewperm uifont
919 set top .gitkview
920 if {[winfo exists $top]} {
921 raise $top
922 return
924 set newviewname($nextviewnum) "View $nextviewnum"
925 set newviewperm($nextviewnum) 0
926 vieweditor $top $nextviewnum "Gitk view definition"
929 proc editview {} {
930 global curview
931 global viewname viewperm newviewname newviewperm
933 set top .gitkvedit-$curview
934 if {[winfo exists $top]} {
935 raise $top
936 return
938 set newviewname($curview) $viewname($curview)
939 set newviewperm($curview) $viewperm($curview)
940 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
943 proc vieweditor {top n title} {
944 global newviewname newviewperm viewfiles
945 global uifont
947 toplevel $top
948 wm title $top $title
949 label $top.nl -text "Name" -font $uifont
950 entry $top.name -width 20 -textvariable newviewname($n)
951 grid $top.nl $top.name -sticky w -pady 5
952 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
953 grid $top.perm - -pady 5 -sticky w
954 message $top.l -aspect 500 -font $uifont \
955 -text "Enter files and directories to include, one per line:"
956 grid $top.l - -sticky w
957 text $top.t -width 40 -height 10 -background white
958 if {[info exists viewfiles($n)]} {
959 foreach f $viewfiles($n) {
960 $top.t insert end $f
961 $top.t insert end "\n"
963 $top.t delete {end - 1c} end
964 $top.t mark set insert 0.0
966 grid $top.t - -sticky w -padx 5
967 frame $top.buts
968 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
969 button $top.buts.can -text "Cancel" -command [list destroy $top]
970 grid $top.buts.ok $top.buts.can
971 grid columnconfigure $top.buts 0 -weight 1 -uniform a
972 grid columnconfigure $top.buts 1 -weight 1 -uniform a
973 grid $top.buts - -pady 10 -sticky ew
974 focus $top.t
977 proc viewmenuitem {n} {
978 set nmenu [.bar.view index end]
979 set targetcmd [list showview $n]
980 for {set i 6} {$i <= $nmenu} {incr i} {
981 if {[.bar.view entrycget $i -command] eq $targetcmd} {
982 return $i
985 return {}
988 proc newviewok {top n} {
989 global nextviewnum newviewperm newviewname
990 global viewname viewfiles viewperm selectedview curview
992 set files {}
993 foreach f [split [$top.t get 0.0 end] "\n"] {
994 set ft [string trim $f]
995 if {$ft ne {}} {
996 lappend files $ft
999 if {![info exists viewfiles($n)]} {
1000 # creating a new view
1001 incr nextviewnum
1002 set viewname($n) $newviewname($n)
1003 set viewperm($n) $newviewperm($n)
1004 set viewfiles($n) $files
1005 .bar.view add radiobutton -label $viewname($n) \
1006 -command [list showview $n] -variable selectedview -value $n
1007 after idle showview $n
1008 } else {
1009 # editing an existing view
1010 set viewperm($n) $newviewperm($n)
1011 if {$newviewname($n) ne $viewname($n)} {
1012 set viewname($n) $newviewname($n)
1013 set i [viewmenuitem $n]
1014 if {$i ne {}} {
1015 .bar.view entryconf $i -label $viewname($n)
1018 if {$files ne $viewfiles($n)} {
1019 set viewfiles($n) $files
1020 if {$curview == $n} {
1021 after idle updatecommits
1025 catch {destroy $top}
1028 proc delview {} {
1029 global curview viewdata viewperm
1031 if {$curview == 0} return
1032 set i [viewmenuitem $curview]
1033 if {$i ne {}} {
1034 .bar.view delete $i
1036 set viewdata($curview) {}
1037 set viewperm($curview) 0
1038 showview 0
1041 proc flatten {var} {
1042 global $var
1044 set ret {}
1045 foreach i [array names $var] {
1046 lappend ret $i [set $var\($i\)]
1048 return $ret
1051 proc unflatten {var l} {
1052 global $var
1054 catch {unset $var}
1055 foreach {i v} $l {
1056 set $var\($i\) $v
1060 proc showview {n} {
1061 global curview viewdata viewfiles
1062 global displayorder parentlist childlist rowidlist rowoffsets
1063 global colormap rowtextx commitrow
1064 global numcommits rowrangelist commitlisted idrowranges
1065 global selectedline currentid canv canvy0
1066 global matchinglines treediffs
1067 global pending_select phase
1068 global commitidx rowlaidout rowoptim linesegends leftover
1069 global commfd nextupdate
1070 global selectedview
1072 if {$n == $curview} return
1073 set selid {}
1074 if {[info exists selectedline]} {
1075 set selid $currentid
1076 set y [yc $selectedline]
1077 set ymax [lindex [$canv cget -scrollregion] 3]
1078 set span [$canv yview]
1079 set ytop [expr {[lindex $span 0] * $ymax}]
1080 set ybot [expr {[lindex $span 1] * $ymax}]
1081 if {$ytop < $y && $y < $ybot} {
1082 set yscreen [expr {$y - $ytop}]
1083 } else {
1084 set yscreen [expr {($ybot - $ytop) / 2}]
1087 unselectline
1088 normalline
1089 stopfindproc
1090 if {$curview >= 0} {
1091 if {$phase ne {}} {
1092 set viewdata($curview) \
1093 [list $phase $displayorder $parentlist $childlist $rowidlist \
1094 $rowoffsets $rowrangelist $commitlisted \
1095 [flatten children] [flatten idrowranges] \
1096 [flatten idinlist] \
1097 $commitidx $rowlaidout $rowoptim $numcommits \
1098 $linesegends $leftover $commfd]
1099 fileevent $commfd readable {}
1100 } elseif {![info exists viewdata($curview)]
1101 || [lindex $viewdata($curview) 0] ne {}} {
1102 set viewdata($curview) \
1103 [list {} $displayorder $parentlist $childlist $rowidlist \
1104 $rowoffsets $rowrangelist $commitlisted]
1107 catch {unset matchinglines}
1108 catch {unset treediffs}
1109 clear_display
1111 set curview $n
1112 set selectedview $n
1113 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1114 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1116 if {![info exists viewdata($n)]} {
1117 set pending_select $selid
1118 getcommits
1119 return
1122 set v $viewdata($n)
1123 set phase [lindex $v 0]
1124 set displayorder [lindex $v 1]
1125 set parentlist [lindex $v 2]
1126 set childlist [lindex $v 3]
1127 set rowidlist [lindex $v 4]
1128 set rowoffsets [lindex $v 5]
1129 set rowrangelist [lindex $v 6]
1130 set commitlisted [lindex $v 7]
1131 if {$phase eq {}} {
1132 set numcommits [llength $displayorder]
1133 catch {unset idrowranges}
1134 catch {unset children}
1135 } else {
1136 unflatten children [lindex $v 8]
1137 unflatten idrowranges [lindex $v 9]
1138 unflatten idinlist [lindex $v 10]
1139 set commitidx [lindex $v 11]
1140 set rowlaidout [lindex $v 12]
1141 set rowoptim [lindex $v 13]
1142 set numcommits [lindex $v 14]
1143 set linesegends [lindex $v 15]
1144 set leftover [lindex $v 16]
1145 set commfd [lindex $v 17]
1146 fileevent $commfd readable [list getcommitlines $commfd]
1147 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1150 catch {unset colormap}
1151 catch {unset rowtextx}
1152 catch {unset commitrow}
1153 set curview $n
1154 set row 0
1155 foreach id $displayorder {
1156 set commitrow($id) $row
1157 incr row
1159 setcanvscroll
1160 set yf 0
1161 set row 0
1162 if {$selid ne {} && [info exists commitrow($selid)]} {
1163 set row $commitrow($selid)
1164 # try to get the selected row in the same position on the screen
1165 set ymax [lindex [$canv cget -scrollregion] 3]
1166 set ytop [expr {[yc $row] - $yscreen}]
1167 if {$ytop < 0} {
1168 set ytop 0
1170 set yf [expr {$ytop * 1.0 / $ymax}]
1172 allcanvs yview moveto $yf
1173 drawvisible
1174 selectline $row 0
1175 if {$phase eq {}} {
1176 global maincursor textcursor
1177 . config -cursor $maincursor
1178 settextcursor $textcursor
1179 } else {
1180 . config -cursor watch
1181 settextcursor watch
1182 if {$phase eq "getcommits"} {
1183 global mainfont
1184 $canv create text 3 3 -anchor nw -text "Reading commits..." \
1185 -font $mainfont -tags textitems
1190 proc shortids {ids} {
1191 set res {}
1192 foreach id $ids {
1193 if {[llength $id] > 1} {
1194 lappend res [shortids $id]
1195 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1196 lappend res [string range $id 0 7]
1197 } else {
1198 lappend res $id
1201 return $res
1204 proc incrange {l x o} {
1205 set n [llength $l]
1206 while {$x < $n} {
1207 set e [lindex $l $x]
1208 if {$e ne {}} {
1209 lset l $x [expr {$e + $o}]
1211 incr x
1213 return $l
1216 proc ntimes {n o} {
1217 set ret {}
1218 for {} {$n > 0} {incr n -1} {
1219 lappend ret $o
1221 return $ret
1224 proc usedinrange {id l1 l2} {
1225 global children commitrow childlist
1227 if {[info exists commitrow($id)]} {
1228 set r $commitrow($id)
1229 if {$l1 <= $r && $r <= $l2} {
1230 return [expr {$r - $l1 + 1}]
1232 set kids [lindex $childlist $r]
1233 } else {
1234 set kids $children($id)
1236 foreach c $kids {
1237 set r $commitrow($c)
1238 if {$l1 <= $r && $r <= $l2} {
1239 return [expr {$r - $l1 + 1}]
1242 return 0
1245 proc sanity {row {full 0}} {
1246 global rowidlist rowoffsets
1248 set col -1
1249 set ids [lindex $rowidlist $row]
1250 foreach id $ids {
1251 incr col
1252 if {$id eq {}} continue
1253 if {$col < [llength $ids] - 1 &&
1254 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1255 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1257 set o [lindex $rowoffsets $row $col]
1258 set y $row
1259 set x $col
1260 while {$o ne {}} {
1261 incr y -1
1262 incr x $o
1263 if {[lindex $rowidlist $y $x] != $id} {
1264 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1265 puts " id=[shortids $id] check started at row $row"
1266 for {set i $row} {$i >= $y} {incr i -1} {
1267 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1269 break
1271 if {!$full} break
1272 set o [lindex $rowoffsets $y $x]
1277 proc makeuparrow {oid x y z} {
1278 global rowidlist rowoffsets uparrowlen idrowranges
1280 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1281 incr y -1
1282 incr x $z
1283 set off0 [lindex $rowoffsets $y]
1284 for {set x0 $x} {1} {incr x0} {
1285 if {$x0 >= [llength $off0]} {
1286 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1287 break
1289 set z [lindex $off0 $x0]
1290 if {$z ne {}} {
1291 incr x0 $z
1292 break
1295 set z [expr {$x0 - $x}]
1296 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1297 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1299 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1300 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1301 lappend idrowranges($oid) $y
1304 proc initlayout {} {
1305 global rowidlist rowoffsets displayorder commitlisted
1306 global rowlaidout rowoptim
1307 global idinlist rowchk rowrangelist idrowranges
1308 global commitidx numcommits canvxmax canv
1309 global nextcolor
1310 global parentlist childlist children
1311 global colormap rowtextx commitrow
1312 global linesegends
1314 set commitidx 0
1315 set numcommits 0
1316 set displayorder {}
1317 set commitlisted {}
1318 set parentlist {}
1319 set childlist {}
1320 set rowrangelist {}
1321 catch {unset children}
1322 set nextcolor 0
1323 set rowidlist {{}}
1324 set rowoffsets {{}}
1325 catch {unset idinlist}
1326 catch {unset rowchk}
1327 set rowlaidout 0
1328 set rowoptim 0
1329 set canvxmax [$canv cget -width]
1330 catch {unset colormap}
1331 catch {unset rowtextx}
1332 catch {unset commitrow}
1333 catch {unset idrowranges}
1334 set linesegends {}
1337 proc setcanvscroll {} {
1338 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1340 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1341 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1342 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1343 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1346 proc visiblerows {} {
1347 global canv numcommits linespc
1349 set ymax [lindex [$canv cget -scrollregion] 3]
1350 if {$ymax eq {} || $ymax == 0} return
1351 set f [$canv yview]
1352 set y0 [expr {int([lindex $f 0] * $ymax)}]
1353 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1354 if {$r0 < 0} {
1355 set r0 0
1357 set y1 [expr {int([lindex $f 1] * $ymax)}]
1358 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1359 if {$r1 >= $numcommits} {
1360 set r1 [expr {$numcommits - 1}]
1362 return [list $r0 $r1]
1365 proc layoutmore {} {
1366 global rowlaidout rowoptim commitidx numcommits optim_delay
1367 global uparrowlen
1369 set row $rowlaidout
1370 set rowlaidout [layoutrows $row $commitidx 0]
1371 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1372 if {$orow > $rowoptim} {
1373 optimize_rows $rowoptim 0 $orow
1374 set rowoptim $orow
1376 set canshow [expr {$rowoptim - $optim_delay}]
1377 if {$canshow > $numcommits} {
1378 showstuff $canshow
1382 proc showstuff {canshow} {
1383 global numcommits commitrow pending_select selectedline
1384 global linesegends idrowranges idrangedrawn
1386 if {$numcommits == 0} {
1387 global phase
1388 set phase "incrdraw"
1389 allcanvs delete all
1391 set row $numcommits
1392 set numcommits $canshow
1393 setcanvscroll
1394 set rows [visiblerows]
1395 set r0 [lindex $rows 0]
1396 set r1 [lindex $rows 1]
1397 set selrow -1
1398 for {set r $row} {$r < $canshow} {incr r} {
1399 foreach id [lindex $linesegends [expr {$r+1}]] {
1400 set i -1
1401 foreach {s e} [rowranges $id] {
1402 incr i
1403 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1404 && ![info exists idrangedrawn($id,$i)]} {
1405 drawlineseg $id $i
1406 set idrangedrawn($id,$i) 1
1411 if {$canshow > $r1} {
1412 set canshow $r1
1414 while {$row < $canshow} {
1415 drawcmitrow $row
1416 incr row
1418 if {[info exists pending_select] &&
1419 [info exists commitrow($pending_select)] &&
1420 $commitrow($pending_select) < $numcommits} {
1421 selectline $commitrow($pending_select) 1
1423 if {![info exists selectedline] && ![info exists pending_select]} {
1424 selectline 0 1
1428 proc layoutrows {row endrow last} {
1429 global rowidlist rowoffsets displayorder
1430 global uparrowlen downarrowlen maxwidth mingaplen
1431 global childlist parentlist
1432 global idrowranges linesegends
1433 global commitidx
1434 global idinlist rowchk rowrangelist
1436 set idlist [lindex $rowidlist $row]
1437 set offs [lindex $rowoffsets $row]
1438 while {$row < $endrow} {
1439 set id [lindex $displayorder $row]
1440 set oldolds {}
1441 set newolds {}
1442 foreach p [lindex $parentlist $row] {
1443 if {![info exists idinlist($p)]} {
1444 lappend newolds $p
1445 } elseif {!$idinlist($p)} {
1446 lappend oldolds $p
1449 set lse {}
1450 set nev [expr {[llength $idlist] + [llength $newolds]
1451 + [llength $oldolds] - $maxwidth + 1}]
1452 if {$nev > 0} {
1453 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1454 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1455 set i [lindex $idlist $x]
1456 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1457 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1458 [expr {$row + $uparrowlen + $mingaplen}]]
1459 if {$r == 0} {
1460 set idlist [lreplace $idlist $x $x]
1461 set offs [lreplace $offs $x $x]
1462 set offs [incrange $offs $x 1]
1463 set idinlist($i) 0
1464 set rm1 [expr {$row - 1}]
1465 lappend lse $i
1466 lappend idrowranges($i) $rm1
1467 if {[incr nev -1] <= 0} break
1468 continue
1470 set rowchk($id) [expr {$row + $r}]
1473 lset rowidlist $row $idlist
1474 lset rowoffsets $row $offs
1476 lappend linesegends $lse
1477 set col [lsearch -exact $idlist $id]
1478 if {$col < 0} {
1479 set col [llength $idlist]
1480 lappend idlist $id
1481 lset rowidlist $row $idlist
1482 set z {}
1483 if {[lindex $childlist $row] ne {}} {
1484 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1485 unset idinlist($id)
1487 lappend offs $z
1488 lset rowoffsets $row $offs
1489 if {$z ne {}} {
1490 makeuparrow $id $col $row $z
1492 } else {
1493 unset idinlist($id)
1495 set ranges {}
1496 if {[info exists idrowranges($id)]} {
1497 set ranges $idrowranges($id)
1498 lappend ranges $row
1499 unset idrowranges($id)
1501 lappend rowrangelist $ranges
1502 incr row
1503 set offs [ntimes [llength $idlist] 0]
1504 set l [llength $newolds]
1505 set idlist [eval lreplace \$idlist $col $col $newolds]
1506 set o 0
1507 if {$l != 1} {
1508 set offs [lrange $offs 0 [expr {$col - 1}]]
1509 foreach x $newolds {
1510 lappend offs {}
1511 incr o -1
1513 incr o
1514 set tmp [expr {[llength $idlist] - [llength $offs]}]
1515 if {$tmp > 0} {
1516 set offs [concat $offs [ntimes $tmp $o]]
1518 } else {
1519 lset offs $col {}
1521 foreach i $newolds {
1522 set idinlist($i) 1
1523 set idrowranges($i) $row
1525 incr col $l
1526 foreach oid $oldolds {
1527 set idinlist($oid) 1
1528 set idlist [linsert $idlist $col $oid]
1529 set offs [linsert $offs $col $o]
1530 makeuparrow $oid $col $row $o
1531 incr col
1533 lappend rowidlist $idlist
1534 lappend rowoffsets $offs
1536 return $row
1539 proc addextraid {id row} {
1540 global displayorder commitrow commitinfo
1541 global commitidx commitlisted
1542 global parentlist childlist children
1544 incr commitidx
1545 lappend displayorder $id
1546 lappend commitlisted 0
1547 lappend parentlist {}
1548 set commitrow($id) $row
1549 readcommit $id
1550 if {![info exists commitinfo($id)]} {
1551 set commitinfo($id) {"No commit information available"}
1553 if {[info exists children($id)]} {
1554 lappend childlist $children($id)
1555 unset children($id)
1556 } else {
1557 lappend childlist {}
1561 proc layouttail {} {
1562 global rowidlist rowoffsets idinlist commitidx
1563 global idrowranges rowrangelist
1565 set row $commitidx
1566 set idlist [lindex $rowidlist $row]
1567 while {$idlist ne {}} {
1568 set col [expr {[llength $idlist] - 1}]
1569 set id [lindex $idlist $col]
1570 addextraid $id $row
1571 unset idinlist($id)
1572 lappend idrowranges($id) $row
1573 lappend rowrangelist $idrowranges($id)
1574 unset idrowranges($id)
1575 incr row
1576 set offs [ntimes $col 0]
1577 set idlist [lreplace $idlist $col $col]
1578 lappend rowidlist $idlist
1579 lappend rowoffsets $offs
1582 foreach id [array names idinlist] {
1583 addextraid $id $row
1584 lset rowidlist $row [list $id]
1585 lset rowoffsets $row 0
1586 makeuparrow $id 0 $row 0
1587 lappend idrowranges($id) $row
1588 lappend rowrangelist $idrowranges($id)
1589 unset idrowranges($id)
1590 incr row
1591 lappend rowidlist {}
1592 lappend rowoffsets {}
1596 proc insert_pad {row col npad} {
1597 global rowidlist rowoffsets
1599 set pad [ntimes $npad {}]
1600 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1601 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1602 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1605 proc optimize_rows {row col endrow} {
1606 global rowidlist rowoffsets idrowranges displayorder
1608 for {} {$row < $endrow} {incr row} {
1609 set idlist [lindex $rowidlist $row]
1610 set offs [lindex $rowoffsets $row]
1611 set haspad 0
1612 for {} {$col < [llength $offs]} {incr col} {
1613 if {[lindex $idlist $col] eq {}} {
1614 set haspad 1
1615 continue
1617 set z [lindex $offs $col]
1618 if {$z eq {}} continue
1619 set isarrow 0
1620 set x0 [expr {$col + $z}]
1621 set y0 [expr {$row - 1}]
1622 set z0 [lindex $rowoffsets $y0 $x0]
1623 if {$z0 eq {}} {
1624 set id [lindex $idlist $col]
1625 set ranges [rowranges $id]
1626 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1627 set isarrow 1
1630 if {$z < -1 || ($z < 0 && $isarrow)} {
1631 set npad [expr {-1 - $z + $isarrow}]
1632 set offs [incrange $offs $col $npad]
1633 insert_pad $y0 $x0 $npad
1634 if {$y0 > 0} {
1635 optimize_rows $y0 $x0 $row
1637 set z [lindex $offs $col]
1638 set x0 [expr {$col + $z}]
1639 set z0 [lindex $rowoffsets $y0 $x0]
1640 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1641 set npad [expr {$z - 1 + $isarrow}]
1642 set y1 [expr {$row + 1}]
1643 set offs2 [lindex $rowoffsets $y1]
1644 set x1 -1
1645 foreach z $offs2 {
1646 incr x1
1647 if {$z eq {} || $x1 + $z < $col} continue
1648 if {$x1 + $z > $col} {
1649 incr npad
1651 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1652 break
1654 set pad [ntimes $npad {}]
1655 set idlist [eval linsert \$idlist $col $pad]
1656 set tmp [eval linsert \$offs $col $pad]
1657 incr col $npad
1658 set offs [incrange $tmp $col [expr {-$npad}]]
1659 set z [lindex $offs $col]
1660 set haspad 1
1662 if {$z0 eq {} && !$isarrow} {
1663 # this line links to its first child on row $row-2
1664 set rm2 [expr {$row - 2}]
1665 set id [lindex $displayorder $rm2]
1666 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1667 if {$xc >= 0} {
1668 set z0 [expr {$xc - $x0}]
1671 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1672 insert_pad $y0 $x0 1
1673 set offs [incrange $offs $col 1]
1674 optimize_rows $y0 [expr {$x0 + 1}] $row
1677 if {!$haspad} {
1678 set o {}
1679 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1680 set o [lindex $offs $col]
1681 if {$o eq {}} {
1682 # check if this is the link to the first child
1683 set id [lindex $idlist $col]
1684 set ranges [rowranges $id]
1685 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1686 # it is, work out offset to child
1687 set y0 [expr {$row - 1}]
1688 set id [lindex $displayorder $y0]
1689 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1690 if {$x0 >= 0} {
1691 set o [expr {$x0 - $col}]
1695 if {$o eq {} || $o <= 0} break
1697 if {$o ne {} && [incr col] < [llength $idlist]} {
1698 set y1 [expr {$row + 1}]
1699 set offs2 [lindex $rowoffsets $y1]
1700 set x1 -1
1701 foreach z $offs2 {
1702 incr x1
1703 if {$z eq {} || $x1 + $z < $col} continue
1704 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1705 break
1707 set idlist [linsert $idlist $col {}]
1708 set tmp [linsert $offs $col {}]
1709 incr col
1710 set offs [incrange $tmp $col -1]
1713 lset rowidlist $row $idlist
1714 lset rowoffsets $row $offs
1715 set col 0
1719 proc xc {row col} {
1720 global canvx0 linespc
1721 return [expr {$canvx0 + $col * $linespc}]
1724 proc yc {row} {
1725 global canvy0 linespc
1726 return [expr {$canvy0 + $row * $linespc}]
1729 proc linewidth {id} {
1730 global thickerline lthickness
1732 set wid $lthickness
1733 if {[info exists thickerline] && $id eq $thickerline} {
1734 set wid [expr {2 * $lthickness}]
1736 return $wid
1739 proc rowranges {id} {
1740 global phase idrowranges commitrow rowlaidout rowrangelist
1742 set ranges {}
1743 if {$phase eq {} ||
1744 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1745 set ranges [lindex $rowrangelist $commitrow($id)]
1746 } elseif {[info exists idrowranges($id)]} {
1747 set ranges $idrowranges($id)
1749 return $ranges
1752 proc drawlineseg {id i} {
1753 global rowoffsets rowidlist
1754 global displayorder
1755 global canv colormap linespc
1756 global numcommits commitrow
1758 set ranges [rowranges $id]
1759 set downarrow 1
1760 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1761 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1762 } else {
1763 set downarrow 1
1765 set startrow [lindex $ranges [expr {2 * $i}]]
1766 set row [lindex $ranges [expr {2 * $i + 1}]]
1767 if {$startrow == $row} return
1768 assigncolor $id
1769 set coords {}
1770 set col [lsearch -exact [lindex $rowidlist $row] $id]
1771 if {$col < 0} {
1772 puts "oops: drawline: id $id not on row $row"
1773 return
1775 set lasto {}
1776 set ns 0
1777 while {1} {
1778 set o [lindex $rowoffsets $row $col]
1779 if {$o eq {}} break
1780 if {$o ne $lasto} {
1781 # changing direction
1782 set x [xc $row $col]
1783 set y [yc $row]
1784 lappend coords $x $y
1785 set lasto $o
1787 incr col $o
1788 incr row -1
1790 set x [xc $row $col]
1791 set y [yc $row]
1792 lappend coords $x $y
1793 if {$i == 0} {
1794 # draw the link to the first child as part of this line
1795 incr row -1
1796 set child [lindex $displayorder $row]
1797 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1798 if {$ccol >= 0} {
1799 set x [xc $row $ccol]
1800 set y [yc $row]
1801 if {$ccol < $col - 1} {
1802 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1803 } elseif {$ccol > $col + 1} {
1804 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1806 lappend coords $x $y
1809 if {[llength $coords] < 4} return
1810 if {$downarrow} {
1811 # This line has an arrow at the lower end: check if the arrow is
1812 # on a diagonal segment, and if so, work around the Tk 8.4
1813 # refusal to draw arrows on diagonal lines.
1814 set x0 [lindex $coords 0]
1815 set x1 [lindex $coords 2]
1816 if {$x0 != $x1} {
1817 set y0 [lindex $coords 1]
1818 set y1 [lindex $coords 3]
1819 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1820 # we have a nearby vertical segment, just trim off the diag bit
1821 set coords [lrange $coords 2 end]
1822 } else {
1823 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1824 set xi [expr {$x0 - $slope * $linespc / 2}]
1825 set yi [expr {$y0 - $linespc / 2}]
1826 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1830 set arrow [expr {2 * ($i > 0) + $downarrow}]
1831 set arrow [lindex {none first last both} $arrow]
1832 set t [$canv create line $coords -width [linewidth $id] \
1833 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1834 $canv lower $t
1835 bindline $t $id
1838 proc drawparentlinks {id row col olds} {
1839 global rowidlist canv colormap
1841 set row2 [expr {$row + 1}]
1842 set x [xc $row $col]
1843 set y [yc $row]
1844 set y2 [yc $row2]
1845 set ids [lindex $rowidlist $row2]
1846 # rmx = right-most X coord used
1847 set rmx 0
1848 foreach p $olds {
1849 set i [lsearch -exact $ids $p]
1850 if {$i < 0} {
1851 puts "oops, parent $p of $id not in list"
1852 continue
1854 set x2 [xc $row2 $i]
1855 if {$x2 > $rmx} {
1856 set rmx $x2
1858 set ranges [rowranges $p]
1859 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1860 && $row2 < [lindex $ranges 1]} {
1861 # drawlineseg will do this one for us
1862 continue
1864 assigncolor $p
1865 # should handle duplicated parents here...
1866 set coords [list $x $y]
1867 if {$i < $col - 1} {
1868 lappend coords [xc $row [expr {$i + 1}]] $y
1869 } elseif {$i > $col + 1} {
1870 lappend coords [xc $row [expr {$i - 1}]] $y
1872 lappend coords $x2 $y2
1873 set t [$canv create line $coords -width [linewidth $p] \
1874 -fill $colormap($p) -tags lines.$p]
1875 $canv lower $t
1876 bindline $t $p
1878 return $rmx
1881 proc drawlines {id} {
1882 global colormap canv
1883 global idrangedrawn
1884 global childlist iddrawn commitrow rowidlist
1886 $canv delete lines.$id
1887 set nr [expr {[llength [rowranges $id]] / 2}]
1888 for {set i 0} {$i < $nr} {incr i} {
1889 if {[info exists idrangedrawn($id,$i)]} {
1890 drawlineseg $id $i
1893 foreach child [lindex $childlist $commitrow($id)] {
1894 if {[info exists iddrawn($child)]} {
1895 set row $commitrow($child)
1896 set col [lsearch -exact [lindex $rowidlist $row] $child]
1897 if {$col >= 0} {
1898 drawparentlinks $child $row $col [list $id]
1904 proc drawcmittext {id row col rmx} {
1905 global linespc canv canv2 canv3 canvy0
1906 global commitlisted commitinfo rowidlist
1907 global rowtextx idpos idtags idheads idotherrefs
1908 global linehtag linentag linedtag
1909 global mainfont namefont canvxmax
1911 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1912 set x [xc $row $col]
1913 set y [yc $row]
1914 set orad [expr {$linespc / 3}]
1915 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1916 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1917 -fill $ofill -outline black -width 1]
1918 $canv raise $t
1919 $canv bind $t <1> {selcanvline {} %x %y}
1920 set xt [xc $row [llength [lindex $rowidlist $row]]]
1921 if {$xt < $rmx} {
1922 set xt $rmx
1924 set rowtextx($row) $xt
1925 set idpos($id) [list $x $xt $y]
1926 if {[info exists idtags($id)] || [info exists idheads($id)]
1927 || [info exists idotherrefs($id)]} {
1928 set xt [drawtags $id $x $xt $y]
1930 set headline [lindex $commitinfo($id) 0]
1931 set name [lindex $commitinfo($id) 1]
1932 set date [lindex $commitinfo($id) 2]
1933 set date [formatdate $date]
1934 set linehtag($row) [$canv create text $xt $y -anchor w \
1935 -text $headline -font $mainfont ]
1936 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1937 set linentag($row) [$canv2 create text 3 $y -anchor w \
1938 -text $name -font $namefont]
1939 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1940 -text $date -font $mainfont]
1941 set xr [expr {$xt + [font measure $mainfont $headline]}]
1942 if {$xr > $canvxmax} {
1943 set canvxmax $xr
1944 setcanvscroll
1948 proc drawcmitrow {row} {
1949 global displayorder rowidlist
1950 global idrangedrawn iddrawn
1951 global commitinfo parentlist numcommits
1953 if {$row >= $numcommits} return
1954 foreach id [lindex $rowidlist $row] {
1955 if {$id eq {}} continue
1956 set i -1
1957 foreach {s e} [rowranges $id] {
1958 incr i
1959 if {$row < $s} continue
1960 if {$e eq {}} break
1961 if {$row <= $e} {
1962 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1963 drawlineseg $id $i
1964 set idrangedrawn($id,$i) 1
1966 break
1971 set id [lindex $displayorder $row]
1972 if {[info exists iddrawn($id)]} return
1973 set col [lsearch -exact [lindex $rowidlist $row] $id]
1974 if {$col < 0} {
1975 puts "oops, row $row id $id not in list"
1976 return
1978 if {![info exists commitinfo($id)]} {
1979 getcommit $id
1981 assigncolor $id
1982 set olds [lindex $parentlist $row]
1983 if {$olds ne {}} {
1984 set rmx [drawparentlinks $id $row $col $olds]
1985 } else {
1986 set rmx 0
1988 drawcmittext $id $row $col $rmx
1989 set iddrawn($id) 1
1992 proc drawfrac {f0 f1} {
1993 global numcommits canv
1994 global linespc
1996 set ymax [lindex [$canv cget -scrollregion] 3]
1997 if {$ymax eq {} || $ymax == 0} return
1998 set y0 [expr {int($f0 * $ymax)}]
1999 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2000 if {$row < 0} {
2001 set row 0
2003 set y1 [expr {int($f1 * $ymax)}]
2004 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2005 if {$endrow >= $numcommits} {
2006 set endrow [expr {$numcommits - 1}]
2008 for {} {$row <= $endrow} {incr row} {
2009 drawcmitrow $row
2013 proc drawvisible {} {
2014 global canv
2015 eval drawfrac [$canv yview]
2018 proc clear_display {} {
2019 global iddrawn idrangedrawn
2021 allcanvs delete all
2022 catch {unset iddrawn}
2023 catch {unset idrangedrawn}
2026 proc findcrossings {id} {
2027 global rowidlist parentlist numcommits rowoffsets displayorder
2029 set cross {}
2030 set ccross {}
2031 foreach {s e} [rowranges $id] {
2032 if {$e >= $numcommits} {
2033 set e [expr {$numcommits - 1}]
2035 if {$e <= $s} continue
2036 set x [lsearch -exact [lindex $rowidlist $e] $id]
2037 if {$x < 0} {
2038 puts "findcrossings: oops, no [shortids $id] in row $e"
2039 continue
2041 for {set row $e} {[incr row -1] >= $s} {} {
2042 set olds [lindex $parentlist $row]
2043 set kid [lindex $displayorder $row]
2044 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2045 if {$kidx < 0} continue
2046 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2047 foreach p $olds {
2048 set px [lsearch -exact $nextrow $p]
2049 if {$px < 0} continue
2050 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2051 if {[lsearch -exact $ccross $p] >= 0} continue
2052 if {$x == $px + ($kidx < $px? -1: 1)} {
2053 lappend ccross $p
2054 } elseif {[lsearch -exact $cross $p] < 0} {
2055 lappend cross $p
2059 set inc [lindex $rowoffsets $row $x]
2060 if {$inc eq {}} break
2061 incr x $inc
2064 return [concat $ccross {{}} $cross]
2067 proc assigncolor {id} {
2068 global colormap colors nextcolor
2069 global commitrow parentlist children childlist
2071 if {[info exists colormap($id)]} return
2072 set ncolors [llength $colors]
2073 if {[info exists commitrow($id)]} {
2074 set kids [lindex $childlist $commitrow($id)]
2075 } elseif {[info exists children($id)]} {
2076 set kids $children($id)
2077 } else {
2078 set kids {}
2080 if {[llength $kids] == 1} {
2081 set child [lindex $kids 0]
2082 if {[info exists colormap($child)]
2083 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
2084 set colormap($id) $colormap($child)
2085 return
2088 set badcolors {}
2089 set origbad {}
2090 foreach x [findcrossings $id] {
2091 if {$x eq {}} {
2092 # delimiter between corner crossings and other crossings
2093 if {[llength $badcolors] >= $ncolors - 1} break
2094 set origbad $badcolors
2096 if {[info exists colormap($x)]
2097 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2098 lappend badcolors $colormap($x)
2101 if {[llength $badcolors] >= $ncolors} {
2102 set badcolors $origbad
2104 set origbad $badcolors
2105 if {[llength $badcolors] < $ncolors - 1} {
2106 foreach child $kids {
2107 if {[info exists colormap($child)]
2108 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2109 lappend badcolors $colormap($child)
2111 foreach p [lindex $parentlist $commitrow($child)] {
2112 if {[info exists colormap($p)]
2113 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2114 lappend badcolors $colormap($p)
2118 if {[llength $badcolors] >= $ncolors} {
2119 set badcolors $origbad
2122 for {set i 0} {$i <= $ncolors} {incr i} {
2123 set c [lindex $colors $nextcolor]
2124 if {[incr nextcolor] >= $ncolors} {
2125 set nextcolor 0
2127 if {[lsearch -exact $badcolors $c]} break
2129 set colormap($id) $c
2132 proc bindline {t id} {
2133 global canv
2135 $canv bind $t <Enter> "lineenter %x %y $id"
2136 $canv bind $t <Motion> "linemotion %x %y $id"
2137 $canv bind $t <Leave> "lineleave $id"
2138 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2141 proc drawtags {id x xt y1} {
2142 global idtags idheads idotherrefs
2143 global linespc lthickness
2144 global canv mainfont commitrow rowtextx
2146 set marks {}
2147 set ntags 0
2148 set nheads 0
2149 if {[info exists idtags($id)]} {
2150 set marks $idtags($id)
2151 set ntags [llength $marks]
2153 if {[info exists idheads($id)]} {
2154 set marks [concat $marks $idheads($id)]
2155 set nheads [llength $idheads($id)]
2157 if {[info exists idotherrefs($id)]} {
2158 set marks [concat $marks $idotherrefs($id)]
2160 if {$marks eq {}} {
2161 return $xt
2164 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2165 set yt [expr {$y1 - 0.5 * $linespc}]
2166 set yb [expr {$yt + $linespc - 1}]
2167 set xvals {}
2168 set wvals {}
2169 foreach tag $marks {
2170 set wid [font measure $mainfont $tag]
2171 lappend xvals $xt
2172 lappend wvals $wid
2173 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2175 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2176 -width $lthickness -fill black -tags tag.$id]
2177 $canv lower $t
2178 foreach tag $marks x $xvals wid $wvals {
2179 set xl [expr {$x + $delta}]
2180 set xr [expr {$x + $delta + $wid + $lthickness}]
2181 if {[incr ntags -1] >= 0} {
2182 # draw a tag
2183 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2184 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2185 -width 1 -outline black -fill yellow -tags tag.$id]
2186 $canv bind $t <1> [list showtag $tag 1]
2187 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2188 } else {
2189 # draw a head or other ref
2190 if {[incr nheads -1] >= 0} {
2191 set col green
2192 } else {
2193 set col "#ddddff"
2195 set xl [expr {$xl - $delta/2}]
2196 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2197 -width 1 -outline black -fill $col -tags tag.$id
2198 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2199 set rwid [font measure $mainfont $remoteprefix]
2200 set xi [expr {$x + 1}]
2201 set yti [expr {$yt + 1}]
2202 set xri [expr {$x + $rwid}]
2203 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2204 -width 0 -fill "#ffddaa" -tags tag.$id
2207 set t [$canv create text $xl $y1 -anchor w -text $tag \
2208 -font $mainfont -tags tag.$id]
2209 if {$ntags >= 0} {
2210 $canv bind $t <1> [list showtag $tag 1]
2213 return $xt
2216 proc xcoord {i level ln} {
2217 global canvx0 xspc1 xspc2
2219 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2220 if {$i > 0 && $i == $level} {
2221 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2222 } elseif {$i > $level} {
2223 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2225 return $x
2228 proc finishcommits {} {
2229 global commitidx phase
2230 global canv mainfont ctext maincursor textcursor
2231 global findinprogress pending_select
2233 if {$commitidx > 0} {
2234 drawrest
2235 } else {
2236 $canv delete all
2237 $canv create text 3 3 -anchor nw -text "No commits selected" \
2238 -font $mainfont -tags textitems
2240 if {![info exists findinprogress]} {
2241 . config -cursor $maincursor
2242 settextcursor $textcursor
2244 set phase {}
2245 catch {unset pending_select}
2248 # Don't change the text pane cursor if it is currently the hand cursor,
2249 # showing that we are over a sha1 ID link.
2250 proc settextcursor {c} {
2251 global ctext curtextcursor
2253 if {[$ctext cget -cursor] == $curtextcursor} {
2254 $ctext config -cursor $c
2256 set curtextcursor $c
2259 proc drawrest {} {
2260 global numcommits
2261 global startmsecs
2262 global canvy0 numcommits linespc
2263 global rowlaidout commitidx
2264 global pending_select
2266 set row $rowlaidout
2267 layoutrows $rowlaidout $commitidx 1
2268 layouttail
2269 optimize_rows $row 0 $commitidx
2270 showstuff $commitidx
2271 if {[info exists pending_select]} {
2272 selectline 0 1
2275 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2276 #puts "overall $drawmsecs ms for $numcommits commits"
2279 proc findmatches {f} {
2280 global findtype foundstring foundstrlen
2281 if {$findtype == "Regexp"} {
2282 set matches [regexp -indices -all -inline $foundstring $f]
2283 } else {
2284 if {$findtype == "IgnCase"} {
2285 set str [string tolower $f]
2286 } else {
2287 set str $f
2289 set matches {}
2290 set i 0
2291 while {[set j [string first $foundstring $str $i]] >= 0} {
2292 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2293 set i [expr {$j + $foundstrlen}]
2296 return $matches
2299 proc dofind {} {
2300 global findtype findloc findstring markedmatches commitinfo
2301 global numcommits displayorder linehtag linentag linedtag
2302 global mainfont namefont canv canv2 canv3 selectedline
2303 global matchinglines foundstring foundstrlen matchstring
2304 global commitdata
2306 stopfindproc
2307 unmarkmatches
2308 focus .
2309 set matchinglines {}
2310 if {$findloc == "Pickaxe"} {
2311 findpatches
2312 return
2314 if {$findtype == "IgnCase"} {
2315 set foundstring [string tolower $findstring]
2316 } else {
2317 set foundstring $findstring
2319 set foundstrlen [string length $findstring]
2320 if {$foundstrlen == 0} return
2321 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2322 set matchstring "*$matchstring*"
2323 if {$findloc == "Files"} {
2324 findfiles
2325 return
2327 if {![info exists selectedline]} {
2328 set oldsel -1
2329 } else {
2330 set oldsel $selectedline
2332 set didsel 0
2333 set fldtypes {Headline Author Date Committer CDate Comment}
2334 set l -1
2335 foreach id $displayorder {
2336 set d $commitdata($id)
2337 incr l
2338 if {$findtype == "Regexp"} {
2339 set doesmatch [regexp $foundstring $d]
2340 } elseif {$findtype == "IgnCase"} {
2341 set doesmatch [string match -nocase $matchstring $d]
2342 } else {
2343 set doesmatch [string match $matchstring $d]
2345 if {!$doesmatch} continue
2346 if {![info exists commitinfo($id)]} {
2347 getcommit $id
2349 set info $commitinfo($id)
2350 set doesmatch 0
2351 foreach f $info ty $fldtypes {
2352 if {$findloc != "All fields" && $findloc != $ty} {
2353 continue
2355 set matches [findmatches $f]
2356 if {$matches == {}} continue
2357 set doesmatch 1
2358 if {$ty == "Headline"} {
2359 drawcmitrow $l
2360 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2361 } elseif {$ty == "Author"} {
2362 drawcmitrow $l
2363 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2364 } elseif {$ty == "Date"} {
2365 drawcmitrow $l
2366 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2369 if {$doesmatch} {
2370 lappend matchinglines $l
2371 if {!$didsel && $l > $oldsel} {
2372 findselectline $l
2373 set didsel 1
2377 if {$matchinglines == {}} {
2378 bell
2379 } elseif {!$didsel} {
2380 findselectline [lindex $matchinglines 0]
2384 proc findselectline {l} {
2385 global findloc commentend ctext
2386 selectline $l 1
2387 if {$findloc == "All fields" || $findloc == "Comments"} {
2388 # highlight the matches in the comments
2389 set f [$ctext get 1.0 $commentend]
2390 set matches [findmatches $f]
2391 foreach match $matches {
2392 set start [lindex $match 0]
2393 set end [expr {[lindex $match 1] + 1}]
2394 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2399 proc findnext {restart} {
2400 global matchinglines selectedline
2401 if {![info exists matchinglines]} {
2402 if {$restart} {
2403 dofind
2405 return
2407 if {![info exists selectedline]} return
2408 foreach l $matchinglines {
2409 if {$l > $selectedline} {
2410 findselectline $l
2411 return
2414 bell
2417 proc findprev {} {
2418 global matchinglines selectedline
2419 if {![info exists matchinglines]} {
2420 dofind
2421 return
2423 if {![info exists selectedline]} return
2424 set prev {}
2425 foreach l $matchinglines {
2426 if {$l >= $selectedline} break
2427 set prev $l
2429 if {$prev != {}} {
2430 findselectline $prev
2431 } else {
2432 bell
2436 proc findlocchange {name ix op} {
2437 global findloc findtype findtypemenu
2438 if {$findloc == "Pickaxe"} {
2439 set findtype Exact
2440 set state disabled
2441 } else {
2442 set state normal
2444 $findtypemenu entryconf 1 -state $state
2445 $findtypemenu entryconf 2 -state $state
2448 proc stopfindproc {{done 0}} {
2449 global findprocpid findprocfile findids
2450 global ctext findoldcursor phase maincursor textcursor
2451 global findinprogress
2453 catch {unset findids}
2454 if {[info exists findprocpid]} {
2455 if {!$done} {
2456 catch {exec kill $findprocpid}
2458 catch {close $findprocfile}
2459 unset findprocpid
2461 if {[info exists findinprogress]} {
2462 unset findinprogress
2463 if {$phase eq {}} {
2464 . config -cursor $maincursor
2465 settextcursor $textcursor
2470 proc findpatches {} {
2471 global findstring selectedline numcommits
2472 global findprocpid findprocfile
2473 global finddidsel ctext displayorder findinprogress
2474 global findinsertpos
2476 if {$numcommits == 0} return
2478 # make a list of all the ids to search, starting at the one
2479 # after the selected line (if any)
2480 if {[info exists selectedline]} {
2481 set l $selectedline
2482 } else {
2483 set l -1
2485 set inputids {}
2486 for {set i 0} {$i < $numcommits} {incr i} {
2487 if {[incr l] >= $numcommits} {
2488 set l 0
2490 append inputids [lindex $displayorder $l] "\n"
2493 if {[catch {
2494 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2495 << $inputids] r]
2496 } err]} {
2497 error_popup "Error starting search process: $err"
2498 return
2501 set findinsertpos end
2502 set findprocfile $f
2503 set findprocpid [pid $f]
2504 fconfigure $f -blocking 0
2505 fileevent $f readable readfindproc
2506 set finddidsel 0
2507 . config -cursor watch
2508 settextcursor watch
2509 set findinprogress 1
2512 proc readfindproc {} {
2513 global findprocfile finddidsel
2514 global commitrow matchinglines findinsertpos
2516 set n [gets $findprocfile line]
2517 if {$n < 0} {
2518 if {[eof $findprocfile]} {
2519 stopfindproc 1
2520 if {!$finddidsel} {
2521 bell
2524 return
2526 if {![regexp {^[0-9a-f]{40}} $line id]} {
2527 error_popup "Can't parse git-diff-tree output: $line"
2528 stopfindproc
2529 return
2531 if {![info exists commitrow($id)]} {
2532 puts stderr "spurious id: $id"
2533 return
2535 set l $commitrow($id)
2536 insertmatch $l $id
2539 proc insertmatch {l id} {
2540 global matchinglines findinsertpos finddidsel
2542 if {$findinsertpos == "end"} {
2543 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2544 set matchinglines [linsert $matchinglines 0 $l]
2545 set findinsertpos 1
2546 } else {
2547 lappend matchinglines $l
2549 } else {
2550 set matchinglines [linsert $matchinglines $findinsertpos $l]
2551 incr findinsertpos
2553 markheadline $l $id
2554 if {!$finddidsel} {
2555 findselectline $l
2556 set finddidsel 1
2560 proc findfiles {} {
2561 global selectedline numcommits displayorder ctext
2562 global ffileline finddidsel parentlist
2563 global findinprogress findstartline findinsertpos
2564 global treediffs fdiffid fdiffsneeded fdiffpos
2565 global findmergefiles
2567 if {$numcommits == 0} return
2569 if {[info exists selectedline]} {
2570 set l [expr {$selectedline + 1}]
2571 } else {
2572 set l 0
2574 set ffileline $l
2575 set findstartline $l
2576 set diffsneeded {}
2577 set fdiffsneeded {}
2578 while 1 {
2579 set id [lindex $displayorder $l]
2580 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2581 if {![info exists treediffs($id)]} {
2582 append diffsneeded "$id\n"
2583 lappend fdiffsneeded $id
2586 if {[incr l] >= $numcommits} {
2587 set l 0
2589 if {$l == $findstartline} break
2592 # start off a git-diff-tree process if needed
2593 if {$diffsneeded ne {}} {
2594 if {[catch {
2595 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2596 } err ]} {
2597 error_popup "Error starting search process: $err"
2598 return
2600 catch {unset fdiffid}
2601 set fdiffpos 0
2602 fconfigure $df -blocking 0
2603 fileevent $df readable [list readfilediffs $df]
2606 set finddidsel 0
2607 set findinsertpos end
2608 set id [lindex $displayorder $l]
2609 . config -cursor watch
2610 settextcursor watch
2611 set findinprogress 1
2612 findcont
2613 update
2616 proc readfilediffs {df} {
2617 global findid fdiffid fdiffs
2619 set n [gets $df line]
2620 if {$n < 0} {
2621 if {[eof $df]} {
2622 donefilediff
2623 if {[catch {close $df} err]} {
2624 stopfindproc
2625 bell
2626 error_popup "Error in git-diff-tree: $err"
2627 } elseif {[info exists findid]} {
2628 set id $findid
2629 stopfindproc
2630 bell
2631 error_popup "Couldn't find diffs for $id"
2634 return
2636 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2637 # start of a new string of diffs
2638 donefilediff
2639 set fdiffid $id
2640 set fdiffs {}
2641 } elseif {[string match ":*" $line]} {
2642 lappend fdiffs [lindex $line 5]
2646 proc donefilediff {} {
2647 global fdiffid fdiffs treediffs findid
2648 global fdiffsneeded fdiffpos
2650 if {[info exists fdiffid]} {
2651 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2652 && $fdiffpos < [llength $fdiffsneeded]} {
2653 # git-diff-tree doesn't output anything for a commit
2654 # which doesn't change anything
2655 set nullid [lindex $fdiffsneeded $fdiffpos]
2656 set treediffs($nullid) {}
2657 if {[info exists findid] && $nullid eq $findid} {
2658 unset findid
2659 findcont
2661 incr fdiffpos
2663 incr fdiffpos
2665 if {![info exists treediffs($fdiffid)]} {
2666 set treediffs($fdiffid) $fdiffs
2668 if {[info exists findid] && $fdiffid eq $findid} {
2669 unset findid
2670 findcont
2675 proc findcont {} {
2676 global findid treediffs parentlist
2677 global ffileline findstartline finddidsel
2678 global displayorder numcommits matchinglines findinprogress
2679 global findmergefiles
2681 set l $ffileline
2682 while {1} {
2683 set id [lindex $displayorder $l]
2684 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2685 if {![info exists treediffs($id)]} {
2686 set findid $id
2687 set ffileline $l
2688 return
2690 set doesmatch 0
2691 foreach f $treediffs($id) {
2692 set x [findmatches $f]
2693 if {$x != {}} {
2694 set doesmatch 1
2695 break
2698 if {$doesmatch} {
2699 insertmatch $l $id
2702 if {[incr l] >= $numcommits} {
2703 set l 0
2705 if {$l == $findstartline} break
2707 stopfindproc
2708 if {!$finddidsel} {
2709 bell
2713 # mark a commit as matching by putting a yellow background
2714 # behind the headline
2715 proc markheadline {l id} {
2716 global canv mainfont linehtag
2718 drawcmitrow $l
2719 set bbox [$canv bbox $linehtag($l)]
2720 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2721 $canv lower $t
2724 # mark the bits of a headline, author or date that match a find string
2725 proc markmatches {canv l str tag matches font} {
2726 set bbox [$canv bbox $tag]
2727 set x0 [lindex $bbox 0]
2728 set y0 [lindex $bbox 1]
2729 set y1 [lindex $bbox 3]
2730 foreach match $matches {
2731 set start [lindex $match 0]
2732 set end [lindex $match 1]
2733 if {$start > $end} continue
2734 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2735 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2736 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2737 [expr {$x0+$xlen+2}] $y1 \
2738 -outline {} -tags matches -fill yellow]
2739 $canv lower $t
2743 proc unmarkmatches {} {
2744 global matchinglines findids
2745 allcanvs delete matches
2746 catch {unset matchinglines}
2747 catch {unset findids}
2750 proc selcanvline {w x y} {
2751 global canv canvy0 ctext linespc
2752 global rowtextx
2753 set ymax [lindex [$canv cget -scrollregion] 3]
2754 if {$ymax == {}} return
2755 set yfrac [lindex [$canv yview] 0]
2756 set y [expr {$y + $yfrac * $ymax}]
2757 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2758 if {$l < 0} {
2759 set l 0
2761 if {$w eq $canv} {
2762 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2764 unmarkmatches
2765 selectline $l 1
2768 proc commit_descriptor {p} {
2769 global commitinfo
2770 set l "..."
2771 if {[info exists commitinfo($p)]} {
2772 set l [lindex $commitinfo($p) 0]
2774 return "$p ($l)"
2777 # append some text to the ctext widget, and make any SHA1 ID
2778 # that we know about be a clickable link.
2779 proc appendwithlinks {text} {
2780 global ctext commitrow linknum
2782 set start [$ctext index "end - 1c"]
2783 $ctext insert end $text
2784 $ctext insert end "\n"
2785 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2786 foreach l $links {
2787 set s [lindex $l 0]
2788 set e [lindex $l 1]
2789 set linkid [string range $text $s $e]
2790 if {![info exists commitrow($linkid)]} continue
2791 incr e
2792 $ctext tag add link "$start + $s c" "$start + $e c"
2793 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2794 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2795 incr linknum
2797 $ctext tag conf link -foreground blue -underline 1
2798 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2799 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2802 proc viewnextline {dir} {
2803 global canv linespc
2805 $canv delete hover
2806 set ymax [lindex [$canv cget -scrollregion] 3]
2807 set wnow [$canv yview]
2808 set wtop [expr {[lindex $wnow 0] * $ymax}]
2809 set newtop [expr {$wtop + $dir * $linespc}]
2810 if {$newtop < 0} {
2811 set newtop 0
2812 } elseif {$newtop > $ymax} {
2813 set newtop $ymax
2815 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2818 proc selectline {l isnew} {
2819 global canv canv2 canv3 ctext commitinfo selectedline
2820 global displayorder linehtag linentag linedtag
2821 global canvy0 linespc parentlist childlist
2822 global currentid sha1entry
2823 global commentend idtags linknum
2824 global mergemax numcommits pending_select
2826 catch {unset pending_select}
2827 $canv delete hover
2828 normalline
2829 if {$l < 0 || $l >= $numcommits} return
2830 set y [expr {$canvy0 + $l * $linespc}]
2831 set ymax [lindex [$canv cget -scrollregion] 3]
2832 set ytop [expr {$y - $linespc - 1}]
2833 set ybot [expr {$y + $linespc + 1}]
2834 set wnow [$canv yview]
2835 set wtop [expr {[lindex $wnow 0] * $ymax}]
2836 set wbot [expr {[lindex $wnow 1] * $ymax}]
2837 set wh [expr {$wbot - $wtop}]
2838 set newtop $wtop
2839 if {$ytop < $wtop} {
2840 if {$ybot < $wtop} {
2841 set newtop [expr {$y - $wh / 2.0}]
2842 } else {
2843 set newtop $ytop
2844 if {$newtop > $wtop - $linespc} {
2845 set newtop [expr {$wtop - $linespc}]
2848 } elseif {$ybot > $wbot} {
2849 if {$ytop > $wbot} {
2850 set newtop [expr {$y - $wh / 2.0}]
2851 } else {
2852 set newtop [expr {$ybot - $wh}]
2853 if {$newtop < $wtop + $linespc} {
2854 set newtop [expr {$wtop + $linespc}]
2858 if {$newtop != $wtop} {
2859 if {$newtop < 0} {
2860 set newtop 0
2862 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2863 drawvisible
2866 if {![info exists linehtag($l)]} return
2867 $canv delete secsel
2868 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2869 -tags secsel -fill [$canv cget -selectbackground]]
2870 $canv lower $t
2871 $canv2 delete secsel
2872 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2873 -tags secsel -fill [$canv2 cget -selectbackground]]
2874 $canv2 lower $t
2875 $canv3 delete secsel
2876 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2877 -tags secsel -fill [$canv3 cget -selectbackground]]
2878 $canv3 lower $t
2880 if {$isnew} {
2881 addtohistory [list selectline $l 0]
2884 set selectedline $l
2886 set id [lindex $displayorder $l]
2887 set currentid $id
2888 $sha1entry delete 0 end
2889 $sha1entry insert 0 $id
2890 $sha1entry selection from 0
2891 $sha1entry selection to end
2893 $ctext conf -state normal
2894 $ctext delete 0.0 end
2895 set linknum 0
2896 $ctext mark set fmark.0 0.0
2897 $ctext mark gravity fmark.0 left
2898 set info $commitinfo($id)
2899 set date [formatdate [lindex $info 2]]
2900 $ctext insert end "Author: [lindex $info 1] $date\n"
2901 set date [formatdate [lindex $info 4]]
2902 $ctext insert end "Committer: [lindex $info 3] $date\n"
2903 if {[info exists idtags($id)]} {
2904 $ctext insert end "Tags:"
2905 foreach tag $idtags($id) {
2906 $ctext insert end " $tag"
2908 $ctext insert end "\n"
2911 set comment {}
2912 set olds [lindex $parentlist $l]
2913 if {[llength $olds] > 1} {
2914 set np 0
2915 foreach p $olds {
2916 if {$np >= $mergemax} {
2917 set tag mmax
2918 } else {
2919 set tag m$np
2921 $ctext insert end "Parent: " $tag
2922 appendwithlinks [commit_descriptor $p]
2923 incr np
2925 } else {
2926 foreach p $olds {
2927 append comment "Parent: [commit_descriptor $p]\n"
2931 foreach c [lindex $childlist $l] {
2932 append comment "Child: [commit_descriptor $c]\n"
2934 append comment "\n"
2935 append comment [lindex $info 5]
2937 # make anything that looks like a SHA1 ID be a clickable link
2938 appendwithlinks $comment
2940 $ctext tag delete Comments
2941 $ctext tag remove found 1.0 end
2942 $ctext conf -state disabled
2943 set commentend [$ctext index "end - 1c"]
2945 init_flist "Comments"
2946 if {[llength $olds] <= 1} {
2947 startdiff $id
2948 } else {
2949 mergediff $id $l
2953 proc selfirstline {} {
2954 unmarkmatches
2955 selectline 0 1
2958 proc sellastline {} {
2959 global numcommits
2960 unmarkmatches
2961 set l [expr {$numcommits - 1}]
2962 selectline $l 1
2965 proc selnextline {dir} {
2966 global selectedline
2967 if {![info exists selectedline]} return
2968 set l [expr {$selectedline + $dir}]
2969 unmarkmatches
2970 selectline $l 1
2973 proc selnextpage {dir} {
2974 global canv linespc selectedline numcommits
2976 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2977 if {$lpp < 1} {
2978 set lpp 1
2980 allcanvs yview scroll [expr {$dir * $lpp}] units
2981 if {![info exists selectedline]} return
2982 set l [expr {$selectedline + $dir * $lpp}]
2983 if {$l < 0} {
2984 set l 0
2985 } elseif {$l >= $numcommits} {
2986 set l [expr $numcommits - 1]
2988 unmarkmatches
2989 selectline $l 1
2992 proc unselectline {} {
2993 global selectedline currentid
2995 catch {unset selectedline}
2996 catch {unset currentid}
2997 allcanvs delete secsel
3000 proc addtohistory {cmd} {
3001 global history historyindex curview
3003 set elt [list $curview $cmd]
3004 if {$historyindex > 0
3005 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3006 return
3009 if {$historyindex < [llength $history]} {
3010 set history [lreplace $history $historyindex end $elt]
3011 } else {
3012 lappend history $elt
3014 incr historyindex
3015 if {$historyindex > 1} {
3016 .ctop.top.bar.leftbut conf -state normal
3017 } else {
3018 .ctop.top.bar.leftbut conf -state disabled
3020 .ctop.top.bar.rightbut conf -state disabled
3023 proc godo {elt} {
3024 global curview
3026 set view [lindex $elt 0]
3027 set cmd [lindex $elt 1]
3028 if {$curview != $view} {
3029 showview $view
3031 eval $cmd
3034 proc goback {} {
3035 global history historyindex
3037 if {$historyindex > 1} {
3038 incr historyindex -1
3039 godo [lindex $history [expr {$historyindex - 1}]]
3040 .ctop.top.bar.rightbut conf -state normal
3042 if {$historyindex <= 1} {
3043 .ctop.top.bar.leftbut conf -state disabled
3047 proc goforw {} {
3048 global history historyindex
3050 if {$historyindex < [llength $history]} {
3051 set cmd [lindex $history $historyindex]
3052 incr historyindex
3053 godo $cmd
3054 .ctop.top.bar.leftbut conf -state normal
3056 if {$historyindex >= [llength $history]} {
3057 .ctop.top.bar.rightbut conf -state disabled
3061 proc mergediff {id l} {
3062 global diffmergeid diffopts mdifffd
3063 global diffids
3064 global parentlist
3066 set diffmergeid $id
3067 set diffids $id
3068 # this doesn't seem to actually affect anything...
3069 set env(GIT_DIFF_OPTS) $diffopts
3070 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3071 if {[catch {set mdf [open $cmd r]} err]} {
3072 error_popup "Error getting merge diffs: $err"
3073 return
3075 fconfigure $mdf -blocking 0
3076 set mdifffd($id) $mdf
3077 set np [llength [lindex $parentlist $l]]
3078 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3079 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3082 proc getmergediffline {mdf id np} {
3083 global diffmergeid ctext cflist nextupdate mergemax
3084 global difffilestart mdifffd
3086 set n [gets $mdf line]
3087 if {$n < 0} {
3088 if {[eof $mdf]} {
3089 close $mdf
3091 return
3093 if {![info exists diffmergeid] || $id != $diffmergeid
3094 || $mdf != $mdifffd($id)} {
3095 return
3097 $ctext conf -state normal
3098 if {[regexp {^diff --cc (.*)} $line match fname]} {
3099 # start of a new file
3100 $ctext insert end "\n"
3101 set here [$ctext index "end - 1c"]
3102 $ctext mark set f:$fname $here
3103 $ctext mark gravity f:$fname left
3104 lappend difffilestart $here
3105 add_flist $fname
3106 set l [expr {(78 - [string length $fname]) / 2}]
3107 set pad [string range "----------------------------------------" 1 $l]
3108 $ctext insert end "$pad $fname $pad\n" filesep
3109 } elseif {[regexp {^@@} $line]} {
3110 $ctext insert end "$line\n" hunksep
3111 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3112 # do nothing
3113 } else {
3114 # parse the prefix - one ' ', '-' or '+' for each parent
3115 set spaces {}
3116 set minuses {}
3117 set pluses {}
3118 set isbad 0
3119 for {set j 0} {$j < $np} {incr j} {
3120 set c [string range $line $j $j]
3121 if {$c == " "} {
3122 lappend spaces $j
3123 } elseif {$c == "-"} {
3124 lappend minuses $j
3125 } elseif {$c == "+"} {
3126 lappend pluses $j
3127 } else {
3128 set isbad 1
3129 break
3132 set tags {}
3133 set num {}
3134 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3135 # line doesn't appear in result, parents in $minuses have the line
3136 set num [lindex $minuses 0]
3137 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3138 # line appears in result, parents in $pluses don't have the line
3139 lappend tags mresult
3140 set num [lindex $spaces 0]
3142 if {$num ne {}} {
3143 if {$num >= $mergemax} {
3144 set num "max"
3146 lappend tags m$num
3148 $ctext insert end "$line\n" $tags
3150 $ctext conf -state disabled
3151 if {[clock clicks -milliseconds] >= $nextupdate} {
3152 incr nextupdate 100
3153 fileevent $mdf readable {}
3154 update
3155 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3159 proc startdiff {ids} {
3160 global treediffs diffids treepending diffmergeid
3162 set diffids $ids
3163 catch {unset diffmergeid}
3164 if {![info exists treediffs($ids)]} {
3165 if {![info exists treepending]} {
3166 gettreediffs $ids
3168 } else {
3169 addtocflist $ids
3173 proc addtocflist {ids} {
3174 global treediffs cflist
3175 foreach f $treediffs($ids) {
3176 add_flist $f
3178 getblobdiffs $ids
3181 proc gettreediffs {ids} {
3182 global treediff treepending
3183 set treepending $ids
3184 set treediff {}
3185 if {[catch \
3186 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3187 ]} return
3188 fconfigure $gdtf -blocking 0
3189 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3192 proc gettreediffline {gdtf ids} {
3193 global treediff treediffs treepending diffids diffmergeid
3195 set n [gets $gdtf line]
3196 if {$n < 0} {
3197 if {![eof $gdtf]} return
3198 close $gdtf
3199 set treediffs($ids) $treediff
3200 unset treepending
3201 if {$ids != $diffids} {
3202 if {![info exists diffmergeid]} {
3203 gettreediffs $diffids
3205 } else {
3206 addtocflist $ids
3208 return
3210 set file [lindex $line 5]
3211 lappend treediff $file
3214 proc getblobdiffs {ids} {
3215 global diffopts blobdifffd diffids env curdifftag curtagstart
3216 global nextupdate diffinhdr treediffs
3218 set env(GIT_DIFF_OPTS) $diffopts
3219 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3220 if {[catch {set bdf [open $cmd r]} err]} {
3221 puts "error getting diffs: $err"
3222 return
3224 set diffinhdr 0
3225 fconfigure $bdf -blocking 0
3226 set blobdifffd($ids) $bdf
3227 set curdifftag Comments
3228 set curtagstart 0.0
3229 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3230 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3233 proc getblobdiffline {bdf ids} {
3234 global diffids blobdifffd ctext curdifftag curtagstart
3235 global diffnexthead diffnextnote difffilestart
3236 global nextupdate diffinhdr treediffs
3238 set n [gets $bdf line]
3239 if {$n < 0} {
3240 if {[eof $bdf]} {
3241 close $bdf
3242 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3243 $ctext tag add $curdifftag $curtagstart end
3246 return
3248 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3249 return
3251 $ctext conf -state normal
3252 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3253 # start of a new file
3254 $ctext insert end "\n"
3255 $ctext tag add $curdifftag $curtagstart end
3256 set here [$ctext index "end - 1c"]
3257 set curtagstart $here
3258 set header $newname
3259 lappend difffilestart $here
3260 $ctext mark set f:$fname $here
3261 $ctext mark gravity f:$fname left
3262 if {$newname != $fname} {
3263 $ctext mark set f:$newfname $here
3264 $ctext mark gravity f:$newfname left
3266 set curdifftag "f:$fname"
3267 $ctext tag delete $curdifftag
3268 set l [expr {(78 - [string length $header]) / 2}]
3269 set pad [string range "----------------------------------------" 1 $l]
3270 $ctext insert end "$pad $header $pad\n" filesep
3271 set diffinhdr 1
3272 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3273 # do nothing
3274 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3275 set diffinhdr 0
3276 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3277 $line match f1l f1c f2l f2c rest]} {
3278 $ctext insert end "$line\n" hunksep
3279 set diffinhdr 0
3280 } else {
3281 set x [string range $line 0 0]
3282 if {$x == "-" || $x == "+"} {
3283 set tag [expr {$x == "+"}]
3284 $ctext insert end "$line\n" d$tag
3285 } elseif {$x == " "} {
3286 $ctext insert end "$line\n"
3287 } elseif {$diffinhdr || $x == "\\"} {
3288 # e.g. "\ No newline at end of file"
3289 $ctext insert end "$line\n" filesep
3290 } else {
3291 # Something else we don't recognize
3292 if {$curdifftag != "Comments"} {
3293 $ctext insert end "\n"
3294 $ctext tag add $curdifftag $curtagstart end
3295 set curtagstart [$ctext index "end - 1c"]
3296 set curdifftag Comments
3298 $ctext insert end "$line\n" filesep
3301 $ctext conf -state disabled
3302 if {[clock clicks -milliseconds] >= $nextupdate} {
3303 incr nextupdate 100
3304 fileevent $bdf readable {}
3305 update
3306 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3310 proc nextfile {} {
3311 global difffilestart ctext
3312 set here [$ctext index @0,0]
3313 foreach loc $difffilestart {
3314 if {[$ctext compare $loc > $here]} {
3315 $ctext yview $loc
3320 proc setcoords {} {
3321 global linespc charspc canvx0 canvy0 mainfont
3322 global xspc1 xspc2 lthickness
3324 set linespc [font metrics $mainfont -linespace]
3325 set charspc [font measure $mainfont "m"]
3326 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3327 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3328 set lthickness [expr {int($linespc / 9) + 1}]
3329 set xspc1(0) $linespc
3330 set xspc2 $linespc
3333 proc redisplay {} {
3334 global canv
3335 global selectedline
3337 set ymax [lindex [$canv cget -scrollregion] 3]
3338 if {$ymax eq {} || $ymax == 0} return
3339 set span [$canv yview]
3340 clear_display
3341 setcanvscroll
3342 allcanvs yview moveto [lindex $span 0]
3343 drawvisible
3344 if {[info exists selectedline]} {
3345 selectline $selectedline 0
3349 proc incrfont {inc} {
3350 global mainfont namefont textfont ctext canv phase
3351 global stopped entries
3352 unmarkmatches
3353 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3354 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3355 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3356 setcoords
3357 $ctext conf -font $textfont
3358 $ctext tag conf filesep -font [concat $textfont bold]
3359 foreach e $entries {
3360 $e conf -font $mainfont
3362 if {$phase eq "getcommits"} {
3363 $canv itemconf textitems -font $mainfont
3365 redisplay
3368 proc clearsha1 {} {
3369 global sha1entry sha1string
3370 if {[string length $sha1string] == 40} {
3371 $sha1entry delete 0 end
3375 proc sha1change {n1 n2 op} {
3376 global sha1string currentid sha1but
3377 if {$sha1string == {}
3378 || ([info exists currentid] && $sha1string == $currentid)} {
3379 set state disabled
3380 } else {
3381 set state normal
3383 if {[$sha1but cget -state] == $state} return
3384 if {$state == "normal"} {
3385 $sha1but conf -state normal -relief raised -text "Goto: "
3386 } else {
3387 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3391 proc gotocommit {} {
3392 global sha1string currentid commitrow tagids headids
3393 global displayorder numcommits
3395 if {$sha1string == {}
3396 || ([info exists currentid] && $sha1string == $currentid)} return
3397 if {[info exists tagids($sha1string)]} {
3398 set id $tagids($sha1string)
3399 } elseif {[info exists headids($sha1string)]} {
3400 set id $headids($sha1string)
3401 } else {
3402 set id [string tolower $sha1string]
3403 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3404 set matches {}
3405 foreach i $displayorder {
3406 if {[string match $id* $i]} {
3407 lappend matches $i
3410 if {$matches ne {}} {
3411 if {[llength $matches] > 1} {
3412 error_popup "Short SHA1 id $id is ambiguous"
3413 return
3415 set id [lindex $matches 0]
3419 if {[info exists commitrow($id)]} {
3420 selectline $commitrow($id) 1
3421 return
3423 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3424 set type "SHA1 id"
3425 } else {
3426 set type "Tag/Head"
3428 error_popup "$type $sha1string is not known"
3431 proc lineenter {x y id} {
3432 global hoverx hovery hoverid hovertimer
3433 global commitinfo canv
3435 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3436 set hoverx $x
3437 set hovery $y
3438 set hoverid $id
3439 if {[info exists hovertimer]} {
3440 after cancel $hovertimer
3442 set hovertimer [after 500 linehover]
3443 $canv delete hover
3446 proc linemotion {x y id} {
3447 global hoverx hovery hoverid hovertimer
3449 if {[info exists hoverid] && $id == $hoverid} {
3450 set hoverx $x
3451 set hovery $y
3452 if {[info exists hovertimer]} {
3453 after cancel $hovertimer
3455 set hovertimer [after 500 linehover]
3459 proc lineleave {id} {
3460 global hoverid hovertimer canv
3462 if {[info exists hoverid] && $id == $hoverid} {
3463 $canv delete hover
3464 if {[info exists hovertimer]} {
3465 after cancel $hovertimer
3466 unset hovertimer
3468 unset hoverid
3472 proc linehover {} {
3473 global hoverx hovery hoverid hovertimer
3474 global canv linespc lthickness
3475 global commitinfo mainfont
3477 set text [lindex $commitinfo($hoverid) 0]
3478 set ymax [lindex [$canv cget -scrollregion] 3]
3479 if {$ymax == {}} return
3480 set yfrac [lindex [$canv yview] 0]
3481 set x [expr {$hoverx + 2 * $linespc}]
3482 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3483 set x0 [expr {$x - 2 * $lthickness}]
3484 set y0 [expr {$y - 2 * $lthickness}]
3485 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3486 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3487 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3488 -fill \#ffff80 -outline black -width 1 -tags hover]
3489 $canv raise $t
3490 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3491 $canv raise $t
3494 proc clickisonarrow {id y} {
3495 global lthickness
3497 set ranges [rowranges $id]
3498 set thresh [expr {2 * $lthickness + 6}]
3499 set n [expr {[llength $ranges] - 1}]
3500 for {set i 1} {$i < $n} {incr i} {
3501 set row [lindex $ranges $i]
3502 if {abs([yc $row] - $y) < $thresh} {
3503 return $i
3506 return {}
3509 proc arrowjump {id n y} {
3510 global canv
3512 # 1 <-> 2, 3 <-> 4, etc...
3513 set n [expr {(($n - 1) ^ 1) + 1}]
3514 set row [lindex [rowranges $id] $n]
3515 set yt [yc $row]
3516 set ymax [lindex [$canv cget -scrollregion] 3]
3517 if {$ymax eq {} || $ymax <= 0} return
3518 set view [$canv yview]
3519 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3520 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3521 if {$yfrac < 0} {
3522 set yfrac 0
3524 allcanvs yview moveto $yfrac
3527 proc lineclick {x y id isnew} {
3528 global ctext commitinfo childlist commitrow canv thickerline
3530 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3531 unmarkmatches
3532 unselectline
3533 normalline
3534 $canv delete hover
3535 # draw this line thicker than normal
3536 set thickerline $id
3537 drawlines $id
3538 if {$isnew} {
3539 set ymax [lindex [$canv cget -scrollregion] 3]
3540 if {$ymax eq {}} return
3541 set yfrac [lindex [$canv yview] 0]
3542 set y [expr {$y + $yfrac * $ymax}]
3544 set dirn [clickisonarrow $id $y]
3545 if {$dirn ne {}} {
3546 arrowjump $id $dirn $y
3547 return
3550 if {$isnew} {
3551 addtohistory [list lineclick $x $y $id 0]
3553 # fill the details pane with info about this line
3554 $ctext conf -state normal
3555 $ctext delete 0.0 end
3556 $ctext tag conf link -foreground blue -underline 1
3557 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3558 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3559 $ctext insert end "Parent:\t"
3560 $ctext insert end $id [list link link0]
3561 $ctext tag bind link0 <1> [list selbyid $id]
3562 set info $commitinfo($id)
3563 $ctext insert end "\n\t[lindex $info 0]\n"
3564 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3565 set date [formatdate [lindex $info 2]]
3566 $ctext insert end "\tDate:\t$date\n"
3567 set kids [lindex $childlist $commitrow($id)]
3568 if {$kids ne {}} {
3569 $ctext insert end "\nChildren:"
3570 set i 0
3571 foreach child $kids {
3572 incr i
3573 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3574 set info $commitinfo($child)
3575 $ctext insert end "\n\t"
3576 $ctext insert end $child [list link link$i]
3577 $ctext tag bind link$i <1> [list selbyid $child]
3578 $ctext insert end "\n\t[lindex $info 0]"
3579 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3580 set date [formatdate [lindex $info 2]]
3581 $ctext insert end "\n\tDate:\t$date\n"
3584 $ctext conf -state disabled
3585 init_flist {}
3588 proc normalline {} {
3589 global thickerline
3590 if {[info exists thickerline]} {
3591 set id $thickerline
3592 unset thickerline
3593 drawlines $id
3597 proc selbyid {id} {
3598 global commitrow
3599 if {[info exists commitrow($id)]} {
3600 selectline $commitrow($id) 1
3604 proc mstime {} {
3605 global startmstime
3606 if {![info exists startmstime]} {
3607 set startmstime [clock clicks -milliseconds]
3609 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3612 proc rowmenu {x y id} {
3613 global rowctxmenu commitrow selectedline rowmenuid
3615 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3616 set state disabled
3617 } else {
3618 set state normal
3620 $rowctxmenu entryconfigure 0 -state $state
3621 $rowctxmenu entryconfigure 1 -state $state
3622 $rowctxmenu entryconfigure 2 -state $state
3623 set rowmenuid $id
3624 tk_popup $rowctxmenu $x $y
3627 proc diffvssel {dirn} {
3628 global rowmenuid selectedline displayorder
3630 if {![info exists selectedline]} return
3631 if {$dirn} {
3632 set oldid [lindex $displayorder $selectedline]
3633 set newid $rowmenuid
3634 } else {
3635 set oldid $rowmenuid
3636 set newid [lindex $displayorder $selectedline]
3638 addtohistory [list doseldiff $oldid $newid]
3639 doseldiff $oldid $newid
3642 proc doseldiff {oldid newid} {
3643 global ctext
3644 global commitinfo
3646 $ctext conf -state normal
3647 $ctext delete 0.0 end
3648 $ctext mark set fmark.0 0.0
3649 $ctext mark gravity fmark.0 left
3650 init_flist "Top"
3651 $ctext insert end "From "
3652 $ctext tag conf link -foreground blue -underline 1
3653 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3654 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3655 $ctext tag bind link0 <1> [list selbyid $oldid]
3656 $ctext insert end $oldid [list link link0]
3657 $ctext insert end "\n "
3658 $ctext insert end [lindex $commitinfo($oldid) 0]
3659 $ctext insert end "\n\nTo "
3660 $ctext tag bind link1 <1> [list selbyid $newid]
3661 $ctext insert end $newid [list link link1]
3662 $ctext insert end "\n "
3663 $ctext insert end [lindex $commitinfo($newid) 0]
3664 $ctext insert end "\n"
3665 $ctext conf -state disabled
3666 $ctext tag delete Comments
3667 $ctext tag remove found 1.0 end
3668 startdiff [list $oldid $newid]
3671 proc mkpatch {} {
3672 global rowmenuid currentid commitinfo patchtop patchnum
3674 if {![info exists currentid]} return
3675 set oldid $currentid
3676 set oldhead [lindex $commitinfo($oldid) 0]
3677 set newid $rowmenuid
3678 set newhead [lindex $commitinfo($newid) 0]
3679 set top .patch
3680 set patchtop $top
3681 catch {destroy $top}
3682 toplevel $top
3683 label $top.title -text "Generate patch"
3684 grid $top.title - -pady 10
3685 label $top.from -text "From:"
3686 entry $top.fromsha1 -width 40 -relief flat
3687 $top.fromsha1 insert 0 $oldid
3688 $top.fromsha1 conf -state readonly
3689 grid $top.from $top.fromsha1 -sticky w
3690 entry $top.fromhead -width 60 -relief flat
3691 $top.fromhead insert 0 $oldhead
3692 $top.fromhead conf -state readonly
3693 grid x $top.fromhead -sticky w
3694 label $top.to -text "To:"
3695 entry $top.tosha1 -width 40 -relief flat
3696 $top.tosha1 insert 0 $newid
3697 $top.tosha1 conf -state readonly
3698 grid $top.to $top.tosha1 -sticky w
3699 entry $top.tohead -width 60 -relief flat
3700 $top.tohead insert 0 $newhead
3701 $top.tohead conf -state readonly
3702 grid x $top.tohead -sticky w
3703 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3704 grid $top.rev x -pady 10
3705 label $top.flab -text "Output file:"
3706 entry $top.fname -width 60
3707 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3708 incr patchnum
3709 grid $top.flab $top.fname -sticky w
3710 frame $top.buts
3711 button $top.buts.gen -text "Generate" -command mkpatchgo
3712 button $top.buts.can -text "Cancel" -command mkpatchcan
3713 grid $top.buts.gen $top.buts.can
3714 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3715 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3716 grid $top.buts - -pady 10 -sticky ew
3717 focus $top.fname
3720 proc mkpatchrev {} {
3721 global patchtop
3723 set oldid [$patchtop.fromsha1 get]
3724 set oldhead [$patchtop.fromhead get]
3725 set newid [$patchtop.tosha1 get]
3726 set newhead [$patchtop.tohead get]
3727 foreach e [list fromsha1 fromhead tosha1 tohead] \
3728 v [list $newid $newhead $oldid $oldhead] {
3729 $patchtop.$e conf -state normal
3730 $patchtop.$e delete 0 end
3731 $patchtop.$e insert 0 $v
3732 $patchtop.$e conf -state readonly
3736 proc mkpatchgo {} {
3737 global patchtop
3739 set oldid [$patchtop.fromsha1 get]
3740 set newid [$patchtop.tosha1 get]
3741 set fname [$patchtop.fname get]
3742 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3743 error_popup "Error creating patch: $err"
3745 catch {destroy $patchtop}
3746 unset patchtop
3749 proc mkpatchcan {} {
3750 global patchtop
3752 catch {destroy $patchtop}
3753 unset patchtop
3756 proc mktag {} {
3757 global rowmenuid mktagtop commitinfo
3759 set top .maketag
3760 set mktagtop $top
3761 catch {destroy $top}
3762 toplevel $top
3763 label $top.title -text "Create tag"
3764 grid $top.title - -pady 10
3765 label $top.id -text "ID:"
3766 entry $top.sha1 -width 40 -relief flat
3767 $top.sha1 insert 0 $rowmenuid
3768 $top.sha1 conf -state readonly
3769 grid $top.id $top.sha1 -sticky w
3770 entry $top.head -width 60 -relief flat
3771 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3772 $top.head conf -state readonly
3773 grid x $top.head -sticky w
3774 label $top.tlab -text "Tag name:"
3775 entry $top.tag -width 60
3776 grid $top.tlab $top.tag -sticky w
3777 frame $top.buts
3778 button $top.buts.gen -text "Create" -command mktaggo
3779 button $top.buts.can -text "Cancel" -command mktagcan
3780 grid $top.buts.gen $top.buts.can
3781 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3782 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3783 grid $top.buts - -pady 10 -sticky ew
3784 focus $top.tag
3787 proc domktag {} {
3788 global mktagtop env tagids idtags
3790 set id [$mktagtop.sha1 get]
3791 set tag [$mktagtop.tag get]
3792 if {$tag == {}} {
3793 error_popup "No tag name specified"
3794 return
3796 if {[info exists tagids($tag)]} {
3797 error_popup "Tag \"$tag\" already exists"
3798 return
3800 if {[catch {
3801 set dir [gitdir]
3802 set fname [file join $dir "refs/tags" $tag]
3803 set f [open $fname w]
3804 puts $f $id
3805 close $f
3806 } err]} {
3807 error_popup "Error creating tag: $err"
3808 return
3811 set tagids($tag) $id
3812 lappend idtags($id) $tag
3813 redrawtags $id
3816 proc redrawtags {id} {
3817 global canv linehtag commitrow idpos selectedline
3819 if {![info exists commitrow($id)]} return
3820 drawcmitrow $commitrow($id)
3821 $canv delete tag.$id
3822 set xt [eval drawtags $id $idpos($id)]
3823 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3824 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3825 selectline $selectedline 0
3829 proc mktagcan {} {
3830 global mktagtop
3832 catch {destroy $mktagtop}
3833 unset mktagtop
3836 proc mktaggo {} {
3837 domktag
3838 mktagcan
3841 proc writecommit {} {
3842 global rowmenuid wrcomtop commitinfo wrcomcmd
3844 set top .writecommit
3845 set wrcomtop $top
3846 catch {destroy $top}
3847 toplevel $top
3848 label $top.title -text "Write commit to file"
3849 grid $top.title - -pady 10
3850 label $top.id -text "ID:"
3851 entry $top.sha1 -width 40 -relief flat
3852 $top.sha1 insert 0 $rowmenuid
3853 $top.sha1 conf -state readonly
3854 grid $top.id $top.sha1 -sticky w
3855 entry $top.head -width 60 -relief flat
3856 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3857 $top.head conf -state readonly
3858 grid x $top.head -sticky w
3859 label $top.clab -text "Command:"
3860 entry $top.cmd -width 60 -textvariable wrcomcmd
3861 grid $top.clab $top.cmd -sticky w -pady 10
3862 label $top.flab -text "Output file:"
3863 entry $top.fname -width 60
3864 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3865 grid $top.flab $top.fname -sticky w
3866 frame $top.buts
3867 button $top.buts.gen -text "Write" -command wrcomgo
3868 button $top.buts.can -text "Cancel" -command wrcomcan
3869 grid $top.buts.gen $top.buts.can
3870 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3871 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3872 grid $top.buts - -pady 10 -sticky ew
3873 focus $top.fname
3876 proc wrcomgo {} {
3877 global wrcomtop
3879 set id [$wrcomtop.sha1 get]
3880 set cmd "echo $id | [$wrcomtop.cmd get]"
3881 set fname [$wrcomtop.fname get]
3882 if {[catch {exec sh -c $cmd >$fname &} err]} {
3883 error_popup "Error writing commit: $err"
3885 catch {destroy $wrcomtop}
3886 unset wrcomtop
3889 proc wrcomcan {} {
3890 global wrcomtop
3892 catch {destroy $wrcomtop}
3893 unset wrcomtop
3896 proc listrefs {id} {
3897 global idtags idheads idotherrefs
3899 set x {}
3900 if {[info exists idtags($id)]} {
3901 set x $idtags($id)
3903 set y {}
3904 if {[info exists idheads($id)]} {
3905 set y $idheads($id)
3907 set z {}
3908 if {[info exists idotherrefs($id)]} {
3909 set z $idotherrefs($id)
3911 return [list $x $y $z]
3914 proc rereadrefs {} {
3915 global idtags idheads idotherrefs
3917 set refids [concat [array names idtags] \
3918 [array names idheads] [array names idotherrefs]]
3919 foreach id $refids {
3920 if {![info exists ref($id)]} {
3921 set ref($id) [listrefs $id]
3924 readrefs
3925 set refids [lsort -unique [concat $refids [array names idtags] \
3926 [array names idheads] [array names idotherrefs]]]
3927 foreach id $refids {
3928 set v [listrefs $id]
3929 if {![info exists ref($id)] || $ref($id) != $v} {
3930 redrawtags $id
3935 proc showtag {tag isnew} {
3936 global ctext tagcontents tagids linknum
3938 if {$isnew} {
3939 addtohistory [list showtag $tag 0]
3941 $ctext conf -state normal
3942 $ctext delete 0.0 end
3943 set linknum 0
3944 if {[info exists tagcontents($tag)]} {
3945 set text $tagcontents($tag)
3946 } else {
3947 set text "Tag: $tag\nId: $tagids($tag)"
3949 appendwithlinks $text
3950 $ctext conf -state disabled
3951 init_flist {}
3954 proc doquit {} {
3955 global stopped
3956 set stopped 100
3957 destroy .
3960 proc doprefs {} {
3961 global maxwidth maxgraphpct diffopts findmergefiles
3962 global oldprefs prefstop
3964 set top .gitkprefs
3965 set prefstop $top
3966 if {[winfo exists $top]} {
3967 raise $top
3968 return
3970 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3971 set oldprefs($v) [set $v]
3973 toplevel $top
3974 wm title $top "Gitk preferences"
3975 label $top.ldisp -text "Commit list display options"
3976 grid $top.ldisp - -sticky w -pady 10
3977 label $top.spacer -text " "
3978 label $top.maxwidthl -text "Maximum graph width (lines)" \
3979 -font optionfont
3980 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3981 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3982 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3983 -font optionfont
3984 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3985 grid x $top.maxpctl $top.maxpct -sticky w
3986 checkbutton $top.findm -variable findmergefiles
3987 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3988 -font optionfont
3989 grid $top.findm $top.findml - -sticky w
3990 label $top.ddisp -text "Diff display options"
3991 grid $top.ddisp - -sticky w -pady 10
3992 label $top.diffoptl -text "Options for diff program" \
3993 -font optionfont
3994 entry $top.diffopt -width 20 -textvariable diffopts
3995 grid x $top.diffoptl $top.diffopt -sticky w
3996 frame $top.buts
3997 button $top.buts.ok -text "OK" -command prefsok
3998 button $top.buts.can -text "Cancel" -command prefscan
3999 grid $top.buts.ok $top.buts.can
4000 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4001 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4002 grid $top.buts - - -pady 10 -sticky ew
4005 proc prefscan {} {
4006 global maxwidth maxgraphpct diffopts findmergefiles
4007 global oldprefs prefstop
4009 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4010 set $v $oldprefs($v)
4012 catch {destroy $prefstop}
4013 unset prefstop
4016 proc prefsok {} {
4017 global maxwidth maxgraphpct
4018 global oldprefs prefstop
4020 catch {destroy $prefstop}
4021 unset prefstop
4022 if {$maxwidth != $oldprefs(maxwidth)
4023 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4024 redisplay
4028 proc formatdate {d} {
4029 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4032 # This list of encoding names and aliases is distilled from
4033 # http://www.iana.org/assignments/character-sets.
4034 # Not all of them are supported by Tcl.
4035 set encoding_aliases {
4036 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4037 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4038 { ISO-10646-UTF-1 csISO10646UTF1 }
4039 { ISO_646.basic:1983 ref csISO646basic1983 }
4040 { INVARIANT csINVARIANT }
4041 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4042 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4043 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4044 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4045 { NATS-DANO iso-ir-9-1 csNATSDANO }
4046 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4047 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4048 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4049 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4050 { ISO-2022-KR csISO2022KR }
4051 { EUC-KR csEUCKR }
4052 { ISO-2022-JP csISO2022JP }
4053 { ISO-2022-JP-2 csISO2022JP2 }
4054 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4055 csISO13JISC6220jp }
4056 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4057 { IT iso-ir-15 ISO646-IT csISO15Italian }
4058 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4059 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4060 { greek7-old iso-ir-18 csISO18Greek7Old }
4061 { latin-greek iso-ir-19 csISO19LatinGreek }
4062 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4063 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4064 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4065 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4066 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4067 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4068 { INIS iso-ir-49 csISO49INIS }
4069 { INIS-8 iso-ir-50 csISO50INIS8 }
4070 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4071 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4072 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4073 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4074 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4075 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4076 csISO60Norwegian1 }
4077 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4078 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4079 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4080 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4081 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4082 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4083 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4084 { greek7 iso-ir-88 csISO88Greek7 }
4085 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4086 { iso-ir-90 csISO90 }
4087 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4088 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4089 csISO92JISC62991984b }
4090 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4091 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4092 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4093 csISO95JIS62291984handadd }
4094 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4095 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4096 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4097 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4098 CP819 csISOLatin1 }
4099 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4100 { T.61-7bit iso-ir-102 csISO102T617bit }
4101 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4102 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4103 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4104 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4105 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4106 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4107 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4108 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4109 arabic csISOLatinArabic }
4110 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4111 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4112 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4113 greek greek8 csISOLatinGreek }
4114 { T.101-G2 iso-ir-128 csISO128T101G2 }
4115 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4116 csISOLatinHebrew }
4117 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4118 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4119 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4120 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4121 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4122 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4123 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4124 csISOLatinCyrillic }
4125 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4126 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4127 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4128 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4129 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4130 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4131 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4132 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4133 { ISO_10367-box iso-ir-155 csISO10367Box }
4134 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4135 { latin-lap lap iso-ir-158 csISO158Lap }
4136 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4137 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4138 { us-dk csUSDK }
4139 { dk-us csDKUS }
4140 { JIS_X0201 X0201 csHalfWidthKatakana }
4141 { KSC5636 ISO646-KR csKSC5636 }
4142 { ISO-10646-UCS-2 csUnicode }
4143 { ISO-10646-UCS-4 csUCS4 }
4144 { DEC-MCS dec csDECMCS }
4145 { hp-roman8 roman8 r8 csHPRoman8 }
4146 { macintosh mac csMacintosh }
4147 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4148 csIBM037 }
4149 { IBM038 EBCDIC-INT cp038 csIBM038 }
4150 { IBM273 CP273 csIBM273 }
4151 { IBM274 EBCDIC-BE CP274 csIBM274 }
4152 { IBM275 EBCDIC-BR cp275 csIBM275 }
4153 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4154 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4155 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4156 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4157 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4158 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4159 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4160 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4161 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4162 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4163 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4164 { IBM437 cp437 437 csPC8CodePage437 }
4165 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4166 { IBM775 cp775 csPC775Baltic }
4167 { IBM850 cp850 850 csPC850Multilingual }
4168 { IBM851 cp851 851 csIBM851 }
4169 { IBM852 cp852 852 csPCp852 }
4170 { IBM855 cp855 855 csIBM855 }
4171 { IBM857 cp857 857 csIBM857 }
4172 { IBM860 cp860 860 csIBM860 }
4173 { IBM861 cp861 861 cp-is csIBM861 }
4174 { IBM862 cp862 862 csPC862LatinHebrew }
4175 { IBM863 cp863 863 csIBM863 }
4176 { IBM864 cp864 csIBM864 }
4177 { IBM865 cp865 865 csIBM865 }
4178 { IBM866 cp866 866 csIBM866 }
4179 { IBM868 CP868 cp-ar csIBM868 }
4180 { IBM869 cp869 869 cp-gr csIBM869 }
4181 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4182 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4183 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4184 { IBM891 cp891 csIBM891 }
4185 { IBM903 cp903 csIBM903 }
4186 { IBM904 cp904 904 csIBBM904 }
4187 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4188 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4189 { IBM1026 CP1026 csIBM1026 }
4190 { EBCDIC-AT-DE csIBMEBCDICATDE }
4191 { EBCDIC-AT-DE-A csEBCDICATDEA }
4192 { EBCDIC-CA-FR csEBCDICCAFR }
4193 { EBCDIC-DK-NO csEBCDICDKNO }
4194 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4195 { EBCDIC-FI-SE csEBCDICFISE }
4196 { EBCDIC-FI-SE-A csEBCDICFISEA }
4197 { EBCDIC-FR csEBCDICFR }
4198 { EBCDIC-IT csEBCDICIT }
4199 { EBCDIC-PT csEBCDICPT }
4200 { EBCDIC-ES csEBCDICES }
4201 { EBCDIC-ES-A csEBCDICESA }
4202 { EBCDIC-ES-S csEBCDICESS }
4203 { EBCDIC-UK csEBCDICUK }
4204 { EBCDIC-US csEBCDICUS }
4205 { UNKNOWN-8BIT csUnknown8BiT }
4206 { MNEMONIC csMnemonic }
4207 { MNEM csMnem }
4208 { VISCII csVISCII }
4209 { VIQR csVIQR }
4210 { KOI8-R csKOI8R }
4211 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4212 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4213 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4214 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4215 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4216 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4217 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4218 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4219 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4220 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4221 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4222 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4223 { IBM1047 IBM-1047 }
4224 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4225 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4226 { UNICODE-1-1 csUnicode11 }
4227 { CESU-8 csCESU-8 }
4228 { BOCU-1 csBOCU-1 }
4229 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4230 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4231 l8 }
4232 { ISO-8859-15 ISO_8859-15 Latin-9 }
4233 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4234 { GBK CP936 MS936 windows-936 }
4235 { JIS_Encoding csJISEncoding }
4236 { Shift_JIS MS_Kanji csShiftJIS }
4237 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4238 EUC-JP }
4239 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4240 { ISO-10646-UCS-Basic csUnicodeASCII }
4241 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4242 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4243 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4244 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4245 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4246 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4247 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4248 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4249 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4250 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4251 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4252 { Ventura-US csVenturaUS }
4253 { Ventura-International csVenturaInternational }
4254 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4255 { PC8-Turkish csPC8Turkish }
4256 { IBM-Symbols csIBMSymbols }
4257 { IBM-Thai csIBMThai }
4258 { HP-Legal csHPLegal }
4259 { HP-Pi-font csHPPiFont }
4260 { HP-Math8 csHPMath8 }
4261 { Adobe-Symbol-Encoding csHPPSMath }
4262 { HP-DeskTop csHPDesktop }
4263 { Ventura-Math csVenturaMath }
4264 { Microsoft-Publishing csMicrosoftPublishing }
4265 { Windows-31J csWindows31J }
4266 { GB2312 csGB2312 }
4267 { Big5 csBig5 }
4270 proc tcl_encoding {enc} {
4271 global encoding_aliases
4272 set names [encoding names]
4273 set lcnames [string tolower $names]
4274 set enc [string tolower $enc]
4275 set i [lsearch -exact $lcnames $enc]
4276 if {$i < 0} {
4277 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4278 if {[regsub {^iso[-_]} $enc iso encx]} {
4279 set i [lsearch -exact $lcnames $encx]
4282 if {$i < 0} {
4283 foreach l $encoding_aliases {
4284 set ll [string tolower $l]
4285 if {[lsearch -exact $ll $enc] < 0} continue
4286 # look through the aliases for one that tcl knows about
4287 foreach e $ll {
4288 set i [lsearch -exact $lcnames $e]
4289 if {$i < 0} {
4290 if {[regsub {^iso[-_]} $e iso ex]} {
4291 set i [lsearch -exact $lcnames $ex]
4294 if {$i >= 0} break
4296 break
4299 if {$i >= 0} {
4300 return [lindex $names $i]
4302 return {}
4305 # defaults...
4306 set datemode 0
4307 set diffopts "-U 5 -p"
4308 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4310 set gitencoding {}
4311 catch {
4312 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4314 if {$gitencoding == ""} {
4315 set gitencoding "utf-8"
4317 set tclencoding [tcl_encoding $gitencoding]
4318 if {$tclencoding == {}} {
4319 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4322 set mainfont {Helvetica 9}
4323 set textfont {Courier 9}
4324 set uifont {Helvetica 9 bold}
4325 set findmergefiles 0
4326 set maxgraphpct 50
4327 set maxwidth 16
4328 set revlistorder 0
4329 set fastdate 0
4330 set uparrowlen 7
4331 set downarrowlen 7
4332 set mingaplen 30
4333 set flistmode "flat"
4335 set colors {green red blue magenta darkgrey brown orange}
4337 catch {source ~/.gitk}
4339 set namefont $mainfont
4341 font create optionfont -family sans-serif -size -12
4343 set revtreeargs {}
4344 foreach arg $argv {
4345 switch -regexp -- $arg {
4346 "^$" { }
4347 "^-d" { set datemode 1 }
4348 default {
4349 lappend revtreeargs $arg
4354 # check that we can find a .git directory somewhere...
4355 set gitdir [gitdir]
4356 if {![file isdirectory $gitdir]} {
4357 error_popup "Cannot find the git directory \"$gitdir\"."
4358 exit 1
4361 set history {}
4362 set historyindex 0
4364 set optim_delay 16
4366 set nextviewnum 1
4367 set curview 0
4368 set selectedview 0
4369 set viewfiles(0) {}
4370 set viewperm(0) 0
4372 set stopped 0
4373 set stuffsaved 0
4374 set patchnum 0
4375 setcoords
4376 makewindow
4377 readrefs
4379 set cmdline_files {}
4380 catch {
4381 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4382 set cmdline_files [split $fileargs "\n"]
4383 set n [llength $cmdline_files]
4384 set revtreeargs [lrange $revtreeargs 0 end-$n]
4386 if {[lindex $revtreeargs end] eq "--"} {
4387 set revtreeargs [lrange $revtreeargs 0 end-1]
4390 if {$cmdline_files ne {}} {
4391 # create a view for the files/dirs specified on the command line
4392 set curview 1
4393 set selectedview 1
4394 set nextviewnum 2
4395 set viewname(1) "Command line"
4396 set viewfiles(1) $cmdline_files
4397 set viewperm(1) 0
4398 .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4399 -variable selectedview -value 1
4400 .bar.view entryconf 2 -state normal
4401 .bar.view entryconf 3 -state normal
4404 if {[info exists permviews]} {
4405 foreach v $permviews {
4406 set n $nextviewnum
4407 incr nextviewnum
4408 set viewname($n) [lindex $v 0]
4409 set viewfiles($n) [lindex $v 1]
4410 set viewperm($n) 1
4411 .bar.view add radiobutton -label $viewname($n) \
4412 -command [list showview $n] -variable selectedview -value $n
4415 getcommits