gitk: Make File->Update work properly again
[git/debian.git] / gitk
blobc6649a56d43bd8e4380a74117973a483d3a1d588
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc parse_args {rargs} {
20 global parsed_args cmdline_files
22 set parsed_args {}
23 set cmdline_files {}
24 if {[catch {
25 set args [concat --default HEAD $rargs]
26 set args [split [eval exec git-rev-parse $args] "\n"]
27 set i 0
28 foreach arg $args {
29 if {![regexp {^[0-9a-f]{40}$} $arg]} {
30 if {$arg eq "--"} {
31 incr i
33 set cmdline_files [lrange $args $i end]
34 break
36 lappend parsed_args $arg
37 incr i
39 }]} {
40 # if git-rev-parse failed for some reason...
41 set i [lsearch -exact $rargs "--"]
42 if {$i >= 0} {
43 set cmdline_files [lrange $rargs [expr {$i+1}] end]
44 set rargs [lrange $rargs 0 [expr {$i-1}]]
46 if {$rargs == {}} {
47 set parsed_args HEAD
48 } else {
49 set parsed_args $rargs
54 proc start_rev_list {rlargs} {
55 global startmsecs nextupdate ncmupdate
56 global commfd leftover tclencoding datemode
58 set startmsecs [clock clicks -milliseconds]
59 set nextupdate [expr {$startmsecs + 100}]
60 set ncmupdate 1
61 initlayout
62 set order "--topo-order"
63 if {$datemode} {
64 set order "--date-order"
66 if {[catch {
67 set commfd [open [concat | git-rev-list --header $order \
68 --parents --boundary $rlargs] r]
69 } err]} {
70 puts stderr "Error executing git-rev-list: $err"
71 exit 1
73 set leftover {}
74 fconfigure $commfd -blocking 0 -translation lf
75 if {$tclencoding != {}} {
76 fconfigure $commfd -encoding $tclencoding
78 fileevent $commfd readable [list getcommitlines $commfd]
79 . config -cursor watch
80 settextcursor watch
83 proc getcommits {rargs} {
84 global phase canv mainfont
86 set phase getcommits
87 start_rev_list $rargs
88 $canv delete all
89 $canv create text 3 3 -anchor nw -text "Reading commits..." \
90 -font $mainfont -tags textitems
93 proc getcommitlines {commfd} {
94 global commitlisted nextupdate
95 global leftover
96 global displayorder commitidx commitrow commitdata
97 global parentlist childlist children
99 set stuff [read $commfd]
100 if {$stuff == {}} {
101 if {![eof $commfd]} return
102 # set it blocking so we wait for the process to terminate
103 fconfigure $commfd -blocking 1
104 if {![catch {close $commfd} err]} {
105 after idle finishcommits
106 return
108 if {[string range $err 0 4] == "usage"} {
109 set err \
110 "Gitk: error reading commits: bad arguments to git-rev-list.\
111 (Note: arguments to gitk are passed to git-rev-list\
112 to allow selection of commits to be displayed.)"
113 } else {
114 set err "Error reading commits: $err"
116 error_popup $err
117 exit 1
119 set start 0
120 set gotsome 0
121 while 1 {
122 set i [string first "\0" $stuff $start]
123 if {$i < 0} {
124 append leftover [string range $stuff $start end]
125 break
127 if {$start == 0} {
128 set cmit $leftover
129 append cmit [string range $stuff 0 [expr {$i - 1}]]
130 set leftover {}
131 } else {
132 set cmit [string range $stuff $start [expr {$i - 1}]]
134 set start [expr {$i + 1}]
135 set j [string first "\n" $cmit]
136 set ok 0
137 set listed 1
138 if {$j >= 0} {
139 set ids [string range $cmit 0 [expr {$j - 1}]]
140 if {[string range $ids 0 0] == "-"} {
141 set listed 0
142 set ids [string range $ids 1 end]
144 set ok 1
145 foreach id $ids {
146 if {[string length $id] != 40} {
147 set ok 0
148 break
152 if {!$ok} {
153 set shortcmit $cmit
154 if {[string length $shortcmit] > 80} {
155 set shortcmit "[string range $shortcmit 0 80]..."
157 error_popup "Can't parse git-rev-list output: {$shortcmit}"
158 exit 1
160 set id [lindex $ids 0]
161 if {$listed} {
162 set olds [lrange $ids 1 end]
163 set i 0
164 foreach p $olds {
165 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
166 lappend children($p) $id
168 incr i
170 } else {
171 set olds {}
173 lappend parentlist $olds
174 if {[info exists children($id)]} {
175 lappend childlist $children($id)
176 } else {
177 lappend childlist {}
179 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
180 set commitrow($id) $commitidx
181 incr commitidx
182 lappend displayorder $id
183 lappend commitlisted $listed
184 set gotsome 1
186 if {$gotsome} {
187 layoutmore
189 if {[clock clicks -milliseconds] >= $nextupdate} {
190 doupdate 1
194 proc doupdate {reading} {
195 global commfd nextupdate numcommits ncmupdate
197 if {$reading} {
198 fileevent $commfd readable {}
200 update
201 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
202 if {$numcommits < 100} {
203 set ncmupdate [expr {$numcommits + 1}]
204 } elseif {$numcommits < 10000} {
205 set ncmupdate [expr {$numcommits + 10}]
206 } else {
207 set ncmupdate [expr {$numcommits + 100}]
209 if {$reading} {
210 fileevent $commfd readable [list getcommitlines $commfd]
214 proc readcommit {id} {
215 if {[catch {set contents [exec git-cat-file commit $id]}]} return
216 parsecommit $id $contents 0
219 proc updatecommits {} {
220 global viewdata curview revtreeargs
222 set n $curview
223 set curview -1
224 catch {unset viewdata($n)}
225 parse_args $revtreeargs
226 showview $n
229 proc parsecommit {id contents listed} {
230 global commitinfo cdate
232 set inhdr 1
233 set comment {}
234 set headline {}
235 set auname {}
236 set audate {}
237 set comname {}
238 set comdate {}
239 set hdrend [string first "\n\n" $contents]
240 if {$hdrend < 0} {
241 # should never happen...
242 set hdrend [string length $contents]
244 set header [string range $contents 0 [expr {$hdrend - 1}]]
245 set comment [string range $contents [expr {$hdrend + 2}] end]
246 foreach line [split $header "\n"] {
247 set tag [lindex $line 0]
248 if {$tag == "author"} {
249 set audate [lindex $line end-1]
250 set auname [lrange $line 1 end-2]
251 } elseif {$tag == "committer"} {
252 set comdate [lindex $line end-1]
253 set comname [lrange $line 1 end-2]
256 set headline {}
257 # take the first line of the comment as the headline
258 set i [string first "\n" $comment]
259 if {$i >= 0} {
260 set headline [string trim [string range $comment 0 $i]]
261 } else {
262 set headline $comment
264 if {!$listed} {
265 # git-rev-list indents the comment by 4 spaces;
266 # if we got this via git-cat-file, add the indentation
267 set newcomment {}
268 foreach line [split $comment "\n"] {
269 append newcomment " "
270 append newcomment $line
271 append newcomment "\n"
273 set comment $newcomment
275 if {$comdate != {}} {
276 set cdate($id) $comdate
278 set commitinfo($id) [list $headline $auname $audate \
279 $comname $comdate $comment]
282 proc getcommit {id} {
283 global commitdata commitinfo
285 if {[info exists commitdata($id)]} {
286 parsecommit $id $commitdata($id) 1
287 } else {
288 readcommit $id
289 if {![info exists commitinfo($id)]} {
290 set commitinfo($id) {"No commit information available"}
293 return 1
296 proc readrefs {} {
297 global tagids idtags headids idheads tagcontents
298 global otherrefids idotherrefs
300 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
301 catch {unset $v}
303 set refd [open [list | git-ls-remote [gitdir]] r]
304 while {0 <= [set n [gets $refd line]]} {
305 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
306 match id path]} {
307 continue
309 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
310 set type others
311 set name $path
313 if {$type == "tags"} {
314 set tagids($name) $id
315 lappend idtags($id) $name
316 set obj {}
317 set type {}
318 set tag {}
319 catch {
320 set commit [exec git-rev-parse "$id^0"]
321 if {"$commit" != "$id"} {
322 set tagids($name) $commit
323 lappend idtags($commit) $name
326 catch {
327 set tagcontents($name) [exec git-cat-file tag "$id"]
329 } elseif { $type == "heads" } {
330 set headids($name) $id
331 lappend idheads($id) $name
332 } else {
333 set otherrefids($name) $id
334 lappend idotherrefs($id) $name
337 close $refd
340 proc error_popup msg {
341 set w .error
342 toplevel $w
343 wm transient $w .
344 message $w.m -text $msg -justify center -aspect 400
345 pack $w.m -side top -fill x -padx 20 -pady 20
346 button $w.ok -text OK -command "destroy $w"
347 pack $w.ok -side bottom -fill x
348 bind $w <Visibility> "grab $w; focus $w"
349 bind $w <Key-Return> "destroy $w"
350 tkwait window $w
353 proc makewindow {} {
354 global canv canv2 canv3 linespc charspc ctext cflist textfont
355 global findtype findtypemenu findloc findstring fstring geometry
356 global entries sha1entry sha1string sha1but
357 global maincursor textcursor curtextcursor
358 global rowctxmenu mergemax
360 menu .bar
361 .bar add cascade -label "File" -menu .bar.file
362 menu .bar.file
363 .bar.file add command -label "Update" -command updatecommits
364 .bar.file add command -label "Reread references" -command rereadrefs
365 .bar.file add command -label "Quit" -command doquit
366 menu .bar.edit
367 .bar add cascade -label "Edit" -menu .bar.edit
368 .bar.edit add command -label "Preferences" -command doprefs
369 menu .bar.view
370 .bar add cascade -label "View" -menu .bar.view
371 .bar.view add command -label "New view..." -command newview
372 .bar.view add command -label "Delete view" -command delview -state disabled
373 .bar.view add separator
374 .bar.view add command -label "All files" -command {showview 0}
375 menu .bar.help
376 .bar add cascade -label "Help" -menu .bar.help
377 .bar.help add command -label "About gitk" -command about
378 . configure -menu .bar
380 if {![info exists geometry(canv1)]} {
381 set geometry(canv1) [expr {45 * $charspc}]
382 set geometry(canv2) [expr {30 * $charspc}]
383 set geometry(canv3) [expr {15 * $charspc}]
384 set geometry(canvh) [expr {25 * $linespc + 4}]
385 set geometry(ctextw) 80
386 set geometry(ctexth) 30
387 set geometry(cflistw) 30
389 panedwindow .ctop -orient vertical
390 if {[info exists geometry(width)]} {
391 .ctop conf -width $geometry(width) -height $geometry(height)
392 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
393 set geometry(ctexth) [expr {($texth - 8) /
394 [font metrics $textfont -linespace]}]
396 frame .ctop.top
397 frame .ctop.top.bar
398 pack .ctop.top.bar -side bottom -fill x
399 set cscroll .ctop.top.csb
400 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
401 pack $cscroll -side right -fill y
402 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
403 pack .ctop.top.clist -side top -fill both -expand 1
404 .ctop add .ctop.top
405 set canv .ctop.top.clist.canv
406 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
407 -bg white -bd 0 \
408 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
409 .ctop.top.clist add $canv
410 set canv2 .ctop.top.clist.canv2
411 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
412 -bg white -bd 0 -yscrollincr $linespc
413 .ctop.top.clist add $canv2
414 set canv3 .ctop.top.clist.canv3
415 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
416 -bg white -bd 0 -yscrollincr $linespc
417 .ctop.top.clist add $canv3
418 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
420 set sha1entry .ctop.top.bar.sha1
421 set entries $sha1entry
422 set sha1but .ctop.top.bar.sha1label
423 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
424 -command gotocommit -width 8
425 $sha1but conf -disabledforeground [$sha1but cget -foreground]
426 pack .ctop.top.bar.sha1label -side left
427 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
428 trace add variable sha1string write sha1change
429 pack $sha1entry -side left -pady 2
431 image create bitmap bm-left -data {
432 #define left_width 16
433 #define left_height 16
434 static unsigned char left_bits[] = {
435 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
436 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
437 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
439 image create bitmap bm-right -data {
440 #define right_width 16
441 #define right_height 16
442 static unsigned char right_bits[] = {
443 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
444 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
445 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
447 button .ctop.top.bar.leftbut -image bm-left -command goback \
448 -state disabled -width 26
449 pack .ctop.top.bar.leftbut -side left -fill y
450 button .ctop.top.bar.rightbut -image bm-right -command goforw \
451 -state disabled -width 26
452 pack .ctop.top.bar.rightbut -side left -fill y
454 button .ctop.top.bar.findbut -text "Find" -command dofind
455 pack .ctop.top.bar.findbut -side left
456 set findstring {}
457 set fstring .ctop.top.bar.findstring
458 lappend entries $fstring
459 entry $fstring -width 30 -font $textfont -textvariable findstring
460 pack $fstring -side left -expand 1 -fill x
461 set findtype Exact
462 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
463 findtype Exact IgnCase Regexp]
464 set findloc "All fields"
465 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
466 Comments Author Committer Files Pickaxe
467 pack .ctop.top.bar.findloc -side right
468 pack .ctop.top.bar.findtype -side right
469 # for making sure type==Exact whenever loc==Pickaxe
470 trace add variable findloc write findlocchange
472 panedwindow .ctop.cdet -orient horizontal
473 .ctop add .ctop.cdet
474 frame .ctop.cdet.left
475 set ctext .ctop.cdet.left.ctext
476 text $ctext -bg white -state disabled -font $textfont \
477 -width $geometry(ctextw) -height $geometry(ctexth) \
478 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
479 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
480 pack .ctop.cdet.left.sb -side right -fill y
481 pack $ctext -side left -fill both -expand 1
482 .ctop.cdet add .ctop.cdet.left
484 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
485 $ctext tag conf hunksep -fore blue
486 $ctext tag conf d0 -fore red
487 $ctext tag conf d1 -fore "#00a000"
488 $ctext tag conf m0 -fore red
489 $ctext tag conf m1 -fore blue
490 $ctext tag conf m2 -fore green
491 $ctext tag conf m3 -fore purple
492 $ctext tag conf m4 -fore brown
493 $ctext tag conf m5 -fore "#009090"
494 $ctext tag conf m6 -fore magenta
495 $ctext tag conf m7 -fore "#808000"
496 $ctext tag conf m8 -fore "#009000"
497 $ctext tag conf m9 -fore "#ff0080"
498 $ctext tag conf m10 -fore cyan
499 $ctext tag conf m11 -fore "#b07070"
500 $ctext tag conf m12 -fore "#70b0f0"
501 $ctext tag conf m13 -fore "#70f0b0"
502 $ctext tag conf m14 -fore "#f0b070"
503 $ctext tag conf m15 -fore "#ff70b0"
504 $ctext tag conf mmax -fore darkgrey
505 set mergemax 16
506 $ctext tag conf mresult -font [concat $textfont bold]
507 $ctext tag conf msep -font [concat $textfont bold]
508 $ctext tag conf found -back yellow
510 frame .ctop.cdet.right
511 set cflist .ctop.cdet.right.cfiles
512 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
513 -yscrollcommand ".ctop.cdet.right.sb set"
514 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
515 pack .ctop.cdet.right.sb -side right -fill y
516 pack $cflist -side left -fill both -expand 1
517 .ctop.cdet add .ctop.cdet.right
518 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
520 pack .ctop -side top -fill both -expand 1
522 bindall <1> {selcanvline %W %x %y}
523 #bindall <B1-Motion> {selcanvline %W %x %y}
524 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
525 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
526 bindall <2> "canvscan mark %W %x %y"
527 bindall <B2-Motion> "canvscan dragto %W %x %y"
528 bind . <Key-Up> "selnextline -1"
529 bind . <Key-Down> "selnextline 1"
530 bind . <Key-Right> "goforw"
531 bind . <Key-Left> "goback"
532 bind . <Key-Prior> "allcanvs yview scroll -1 pages"
533 bind . <Key-Next> "allcanvs yview scroll 1 pages"
534 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
535 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
536 bindkey <Key-space> "$ctext yview scroll 1 pages"
537 bindkey p "selnextline -1"
538 bindkey n "selnextline 1"
539 bindkey z "goback"
540 bindkey x "goforw"
541 bindkey i "selnextline -1"
542 bindkey k "selnextline 1"
543 bindkey j "goback"
544 bindkey l "goforw"
545 bindkey b "$ctext yview scroll -1 pages"
546 bindkey d "$ctext yview scroll 18 units"
547 bindkey u "$ctext yview scroll -18 units"
548 bindkey / {findnext 1}
549 bindkey <Key-Return> {findnext 0}
550 bindkey ? findprev
551 bindkey f nextfile
552 bind . <Control-q> doquit
553 bind . <Control-f> dofind
554 bind . <Control-g> {findnext 0}
555 bind . <Control-r> findprev
556 bind . <Control-equal> {incrfont 1}
557 bind . <Control-KP_Add> {incrfont 1}
558 bind . <Control-minus> {incrfont -1}
559 bind . <Control-KP_Subtract> {incrfont -1}
560 bind $cflist <<ListboxSelect>> listboxsel
561 bind . <Destroy> {savestuff %W}
562 bind . <Button-1> "click %W"
563 bind $fstring <Key-Return> dofind
564 bind $sha1entry <Key-Return> gotocommit
565 bind $sha1entry <<PasteSelection>> clearsha1
567 set maincursor [. cget -cursor]
568 set textcursor [$ctext cget -cursor]
569 set curtextcursor $textcursor
571 set rowctxmenu .rowctxmenu
572 menu $rowctxmenu -tearoff 0
573 $rowctxmenu add command -label "Diff this -> selected" \
574 -command {diffvssel 0}
575 $rowctxmenu add command -label "Diff selected -> this" \
576 -command {diffvssel 1}
577 $rowctxmenu add command -label "Make patch" -command mkpatch
578 $rowctxmenu add command -label "Create tag" -command mktag
579 $rowctxmenu add command -label "Write commit to file" -command writecommit
582 # mouse-2 makes all windows scan vertically, but only the one
583 # the cursor is in scans horizontally
584 proc canvscan {op w x y} {
585 global canv canv2 canv3
586 foreach c [list $canv $canv2 $canv3] {
587 if {$c == $w} {
588 $c scan $op $x $y
589 } else {
590 $c scan $op 0 $y
595 proc scrollcanv {cscroll f0 f1} {
596 $cscroll set $f0 $f1
597 drawfrac $f0 $f1
600 # when we make a key binding for the toplevel, make sure
601 # it doesn't get triggered when that key is pressed in the
602 # find string entry widget.
603 proc bindkey {ev script} {
604 global entries
605 bind . $ev $script
606 set escript [bind Entry $ev]
607 if {$escript == {}} {
608 set escript [bind Entry <Key>]
610 foreach e $entries {
611 bind $e $ev "$escript; break"
615 # set the focus back to the toplevel for any click outside
616 # the entry widgets
617 proc click {w} {
618 global entries
619 foreach e $entries {
620 if {$w == $e} return
622 focus .
625 proc savestuff {w} {
626 global canv canv2 canv3 ctext cflist mainfont textfont
627 global stuffsaved findmergefiles maxgraphpct
628 global maxwidth
630 if {$stuffsaved} return
631 if {![winfo viewable .]} return
632 catch {
633 set f [open "~/.gitk-new" w]
634 puts $f [list set mainfont $mainfont]
635 puts $f [list set textfont $textfont]
636 puts $f [list set findmergefiles $findmergefiles]
637 puts $f [list set maxgraphpct $maxgraphpct]
638 puts $f [list set maxwidth $maxwidth]
639 puts $f "set geometry(width) [winfo width .ctop]"
640 puts $f "set geometry(height) [winfo height .ctop]"
641 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
642 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
643 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
644 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
645 set wid [expr {([winfo width $ctext] - 8) \
646 / [font measure $textfont "0"]}]
647 puts $f "set geometry(ctextw) $wid"
648 set wid [expr {([winfo width $cflist] - 11) \
649 / [font measure [$cflist cget -font] "0"]}]
650 puts $f "set geometry(cflistw) $wid"
651 close $f
652 file rename -force "~/.gitk-new" "~/.gitk"
654 set stuffsaved 1
657 proc resizeclistpanes {win w} {
658 global oldwidth
659 if {[info exists oldwidth($win)]} {
660 set s0 [$win sash coord 0]
661 set s1 [$win sash coord 1]
662 if {$w < 60} {
663 set sash0 [expr {int($w/2 - 2)}]
664 set sash1 [expr {int($w*5/6 - 2)}]
665 } else {
666 set factor [expr {1.0 * $w / $oldwidth($win)}]
667 set sash0 [expr {int($factor * [lindex $s0 0])}]
668 set sash1 [expr {int($factor * [lindex $s1 0])}]
669 if {$sash0 < 30} {
670 set sash0 30
672 if {$sash1 < $sash0 + 20} {
673 set sash1 [expr {$sash0 + 20}]
675 if {$sash1 > $w - 10} {
676 set sash1 [expr {$w - 10}]
677 if {$sash0 > $sash1 - 20} {
678 set sash0 [expr {$sash1 - 20}]
682 $win sash place 0 $sash0 [lindex $s0 1]
683 $win sash place 1 $sash1 [lindex $s1 1]
685 set oldwidth($win) $w
688 proc resizecdetpanes {win w} {
689 global oldwidth
690 if {[info exists oldwidth($win)]} {
691 set s0 [$win sash coord 0]
692 if {$w < 60} {
693 set sash0 [expr {int($w*3/4 - 2)}]
694 } else {
695 set factor [expr {1.0 * $w / $oldwidth($win)}]
696 set sash0 [expr {int($factor * [lindex $s0 0])}]
697 if {$sash0 < 45} {
698 set sash0 45
700 if {$sash0 > $w - 15} {
701 set sash0 [expr {$w - 15}]
704 $win sash place 0 $sash0 [lindex $s0 1]
706 set oldwidth($win) $w
709 proc allcanvs args {
710 global canv canv2 canv3
711 eval $canv $args
712 eval $canv2 $args
713 eval $canv3 $args
716 proc bindall {event action} {
717 global canv canv2 canv3
718 bind $canv $event $action
719 bind $canv2 $event $action
720 bind $canv3 $event $action
723 proc about {} {
724 set w .about
725 if {[winfo exists $w]} {
726 raise $w
727 return
729 toplevel $w
730 wm title $w "About gitk"
731 message $w.m -text {
732 Gitk - a commit viewer for git
734 Copyright © 2005-2006 Paul Mackerras
736 Use and redistribute under the terms of the GNU General Public License} \
737 -justify center -aspect 400
738 pack $w.m -side top -fill x -padx 20 -pady 20
739 button $w.ok -text Close -command "destroy $w"
740 pack $w.ok -side bottom
743 proc newview {} {
744 global newviewname nextviewnum newviewtop
746 set top .gitkview
747 if {[winfo exists $top]} {
748 raise $top
749 return
751 set newviewtop $top
752 toplevel $top
753 wm title $top "Gitk view definition"
754 label $top.nl -text "Name"
755 entry $top.name -width 20 -textvariable newviewname
756 set newviewname "View $nextviewnum"
757 grid $top.nl $top.name -sticky w
758 label $top.l -text "Files and directories to include:"
759 grid $top.l - -sticky w -pady 10
760 text $top.t -width 30 -height 10
761 grid $top.t - -sticky w
762 frame $top.buts
763 button $top.buts.ok -text "OK" -command newviewok
764 button $top.buts.can -text "Cancel" -command newviewcan
765 grid $top.buts.ok $top.buts.can
766 grid columnconfigure $top.buts 0 -weight 1 -uniform a
767 grid columnconfigure $top.buts 1 -weight 1 -uniform a
768 grid $top.buts - -pady 10 -sticky ew
769 focus $top.t
772 proc newviewok {} {
773 global newviewtop nextviewnum
774 global viewname viewfiles
776 set n $nextviewnum
777 incr nextviewnum
778 set viewname($n) [$newviewtop.name get]
779 set files {}
780 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
781 set ft [string trim $f]
782 if {$ft ne {}} {
783 lappend files $ft
786 set viewfiles($n) $files
787 catch {destroy $newviewtop}
788 unset newviewtop
789 .bar.view add command -label $viewname($n) -command [list showview $n]
790 after idle showview $n
793 proc newviewcan {} {
794 global newviewtop
796 catch {destroy $newviewtop}
797 unset newviewtop
800 proc delview {} {
801 global curview viewdata
803 if {$curview == 0} return
804 set nmenu [.bar.view index end]
805 set targetcmd [list showview $curview]
806 for {set i 5} {$i <= $nmenu} {incr i} {
807 if {[.bar.view entrycget $i -command] eq $targetcmd} {
808 .bar.view delete $i
809 break
812 set viewdata($curview) {}
813 showview 0
816 proc showview {n} {
817 global curview viewdata viewfiles
818 global displayorder parentlist childlist rowidlist rowoffsets
819 global colormap rowtextx commitrow
820 global numcommits rowrangelist commitlisted idrowranges
821 global selectedline currentid canv canvy0
822 global matchinglines treediffs
823 global parsed_args
824 global pending_select phase
826 if {$n == $curview} return
827 set selid {}
828 if {[info exists selectedline]} {
829 set selid $currentid
830 set y [yc $selectedline]
831 set ymax [lindex [$canv cget -scrollregion] 3]
832 set span [$canv yview]
833 set ytop [expr {[lindex $span 0] * $ymax}]
834 set ybot [expr {[lindex $span 1] * $ymax}]
835 if {$ytop < $y && $y < $ybot} {
836 set yscreen [expr {$y - $ytop}]
837 } else {
838 set yscreen [expr {($ybot - $ytop) / 2}]
841 unselectline
842 stopfindproc
843 if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
844 set viewdata($curview) \
845 [list $displayorder $parentlist $childlist $rowidlist \
846 $rowoffsets $rowrangelist $commitlisted]
848 catch {unset matchinglines}
849 catch {unset treediffs}
850 clear_display
851 readrefs
853 set curview $n
854 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
856 if {![info exists viewdata($n)]} {
857 set args $parsed_args
858 if {$viewfiles($n) ne {}} {
859 set args [concat $args "--" $viewfiles($n)]
861 set pending_select $selid
862 getcommits $args
863 return
866 set displayorder [lindex $viewdata($n) 0]
867 set parentlist [lindex $viewdata($n) 1]
868 set childlist [lindex $viewdata($n) 2]
869 set rowidlist [lindex $viewdata($n) 3]
870 set rowoffsets [lindex $viewdata($n) 4]
871 set rowrangelist [lindex $viewdata($n) 5]
872 set commitlisted [lindex $viewdata($n) 6]
873 set numcommits [llength $displayorder]
874 catch {unset colormap}
875 catch {unset rowtextx}
876 catch {unset commitrow}
877 catch {unset idrowranges}
878 set curview $n
879 set row 0
880 foreach id $displayorder {
881 set commitrow($id) $row
882 incr row
884 setcanvscroll
885 set yf 0
886 set row 0
887 if {$selid ne {} && [info exists commitrow($selid)]} {
888 set row $commitrow($selid)
889 # try to get the selected row in the same position on the screen
890 set ymax [lindex [$canv cget -scrollregion] 3]
891 set ytop [expr {[yc $row] - $yscreen}]
892 if {$ytop < 0} {
893 set ytop 0
895 set yf [expr {$ytop * 1.0 / $ymax}]
897 allcanvs yview moveto $yf
898 drawvisible
899 selectline $row 0
902 proc shortids {ids} {
903 set res {}
904 foreach id $ids {
905 if {[llength $id] > 1} {
906 lappend res [shortids $id]
907 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
908 lappend res [string range $id 0 7]
909 } else {
910 lappend res $id
913 return $res
916 proc incrange {l x o} {
917 set n [llength $l]
918 while {$x < $n} {
919 set e [lindex $l $x]
920 if {$e ne {}} {
921 lset l $x [expr {$e + $o}]
923 incr x
925 return $l
928 proc ntimes {n o} {
929 set ret {}
930 for {} {$n > 0} {incr n -1} {
931 lappend ret $o
933 return $ret
936 proc usedinrange {id l1 l2} {
937 global children commitrow
939 if {[info exists commitrow($id)]} {
940 set r $commitrow($id)
941 if {$l1 <= $r && $r <= $l2} {
942 return [expr {$r - $l1 + 1}]
945 foreach c $children($id) {
946 if {[info exists commitrow($c)]} {
947 set r $commitrow($c)
948 if {$l1 <= $r && $r <= $l2} {
949 return [expr {$r - $l1 + 1}]
953 return 0
956 proc sanity {row {full 0}} {
957 global rowidlist rowoffsets
959 set col -1
960 set ids [lindex $rowidlist $row]
961 foreach id $ids {
962 incr col
963 if {$id eq {}} continue
964 if {$col < [llength $ids] - 1 &&
965 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
966 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
968 set o [lindex $rowoffsets $row $col]
969 set y $row
970 set x $col
971 while {$o ne {}} {
972 incr y -1
973 incr x $o
974 if {[lindex $rowidlist $y $x] != $id} {
975 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
976 puts " id=[shortids $id] check started at row $row"
977 for {set i $row} {$i >= $y} {incr i -1} {
978 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
980 break
982 if {!$full} break
983 set o [lindex $rowoffsets $y $x]
988 proc makeuparrow {oid x y z} {
989 global rowidlist rowoffsets uparrowlen idrowranges
991 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
992 incr y -1
993 incr x $z
994 set off0 [lindex $rowoffsets $y]
995 for {set x0 $x} {1} {incr x0} {
996 if {$x0 >= [llength $off0]} {
997 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
998 break
1000 set z [lindex $off0 $x0]
1001 if {$z ne {}} {
1002 incr x0 $z
1003 break
1006 set z [expr {$x0 - $x}]
1007 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1008 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1010 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1011 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1012 lappend idrowranges($oid) $y
1015 proc initlayout {} {
1016 global rowidlist rowoffsets displayorder commitlisted
1017 global rowlaidout rowoptim
1018 global idinlist rowchk rowrangelist idrowranges
1019 global commitidx numcommits canvxmax canv
1020 global nextcolor
1021 global parentlist childlist children
1022 global colormap rowtextx commitrow
1023 global linesegends
1025 set commitidx 0
1026 set numcommits 0
1027 set displayorder {}
1028 set commitlisted {}
1029 set parentlist {}
1030 set childlist {}
1031 set rowrangelist {}
1032 catch {unset children}
1033 set nextcolor 0
1034 set rowidlist {{}}
1035 set rowoffsets {{}}
1036 catch {unset idinlist}
1037 catch {unset rowchk}
1038 set rowlaidout 0
1039 set rowoptim 0
1040 set canvxmax [$canv cget -width]
1041 catch {unset colormap}
1042 catch {unset rowtextx}
1043 catch {unset commitrow}
1044 catch {unset idrowranges}
1045 catch {unset linesegends}
1048 proc setcanvscroll {} {
1049 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1051 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1052 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1053 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1054 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1057 proc visiblerows {} {
1058 global canv numcommits linespc
1060 set ymax [lindex [$canv cget -scrollregion] 3]
1061 if {$ymax eq {} || $ymax == 0} return
1062 set f [$canv yview]
1063 set y0 [expr {int([lindex $f 0] * $ymax)}]
1064 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1065 if {$r0 < 0} {
1066 set r0 0
1068 set y1 [expr {int([lindex $f 1] * $ymax)}]
1069 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1070 if {$r1 >= $numcommits} {
1071 set r1 [expr {$numcommits - 1}]
1073 return [list $r0 $r1]
1076 proc layoutmore {} {
1077 global rowlaidout rowoptim commitidx numcommits optim_delay
1078 global uparrowlen
1080 set row $rowlaidout
1081 set rowlaidout [layoutrows $row $commitidx 0]
1082 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1083 if {$orow > $rowoptim} {
1084 optimize_rows $rowoptim 0 $orow
1085 set rowoptim $orow
1087 set canshow [expr {$rowoptim - $optim_delay}]
1088 if {$canshow > $numcommits} {
1089 showstuff $canshow
1093 proc showstuff {canshow} {
1094 global numcommits commitrow pending_select
1095 global linesegends idrowranges idrangedrawn
1097 if {$numcommits == 0} {
1098 global phase
1099 set phase "incrdraw"
1100 allcanvs delete all
1102 set row $numcommits
1103 set numcommits $canshow
1104 setcanvscroll
1105 set rows [visiblerows]
1106 set r0 [lindex $rows 0]
1107 set r1 [lindex $rows 1]
1108 set selrow -1
1109 for {set r $row} {$r < $canshow} {incr r} {
1110 if {[info exists linesegends($r)]} {
1111 foreach id $linesegends($r) {
1112 set i -1
1113 foreach {s e} $idrowranges($id) {
1114 incr i
1115 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1116 && ![info exists idrangedrawn($id,$i)]} {
1117 drawlineseg $id $i
1118 set idrangedrawn($id,$i) 1
1124 if {$canshow > $r1} {
1125 set canshow $r1
1127 while {$row < $canshow} {
1128 drawcmitrow $row
1129 incr row
1131 if {[info exists pending_select] &&
1132 [info exists commitrow($pending_select)] &&
1133 $commitrow($pending_select) < $numcommits} {
1134 selectline $commitrow($pending_select) 1
1138 proc layoutrows {row endrow last} {
1139 global rowidlist rowoffsets displayorder
1140 global uparrowlen downarrowlen maxwidth mingaplen
1141 global childlist parentlist
1142 global idrowranges linesegends
1143 global commitidx
1144 global idinlist rowchk rowrangelist
1146 set idlist [lindex $rowidlist $row]
1147 set offs [lindex $rowoffsets $row]
1148 while {$row < $endrow} {
1149 set id [lindex $displayorder $row]
1150 set oldolds {}
1151 set newolds {}
1152 foreach p [lindex $parentlist $row] {
1153 if {![info exists idinlist($p)]} {
1154 lappend newolds $p
1155 } elseif {!$idinlist($p)} {
1156 lappend oldolds $p
1159 set nev [expr {[llength $idlist] + [llength $newolds]
1160 + [llength $oldolds] - $maxwidth + 1}]
1161 if {$nev > 0} {
1162 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1163 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1164 set i [lindex $idlist $x]
1165 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1166 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1167 [expr {$row + $uparrowlen + $mingaplen}]]
1168 if {$r == 0} {
1169 set idlist [lreplace $idlist $x $x]
1170 set offs [lreplace $offs $x $x]
1171 set offs [incrange $offs $x 1]
1172 set idinlist($i) 0
1173 set rm1 [expr {$row - 1}]
1174 lappend linesegends($rm1) $i
1175 lappend idrowranges($i) $rm1
1176 if {[incr nev -1] <= 0} break
1177 continue
1179 set rowchk($id) [expr {$row + $r}]
1182 lset rowidlist $row $idlist
1183 lset rowoffsets $row $offs
1185 set col [lsearch -exact $idlist $id]
1186 if {$col < 0} {
1187 set col [llength $idlist]
1188 lappend idlist $id
1189 lset rowidlist $row $idlist
1190 set z {}
1191 if {[lindex $childlist $row] ne {}} {
1192 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1193 unset idinlist($id)
1195 lappend offs $z
1196 lset rowoffsets $row $offs
1197 if {$z ne {}} {
1198 makeuparrow $id $col $row $z
1200 } else {
1201 unset idinlist($id)
1203 set ranges {}
1204 if {[info exists idrowranges($id)]} {
1205 lappend idrowranges($id) $row
1206 set ranges $idrowranges($id)
1208 lappend rowrangelist $ranges
1209 incr row
1210 set offs [ntimes [llength $idlist] 0]
1211 set l [llength $newolds]
1212 set idlist [eval lreplace \$idlist $col $col $newolds]
1213 set o 0
1214 if {$l != 1} {
1215 set offs [lrange $offs 0 [expr {$col - 1}]]
1216 foreach x $newolds {
1217 lappend offs {}
1218 incr o -1
1220 incr o
1221 set tmp [expr {[llength $idlist] - [llength $offs]}]
1222 if {$tmp > 0} {
1223 set offs [concat $offs [ntimes $tmp $o]]
1225 } else {
1226 lset offs $col {}
1228 foreach i $newolds {
1229 set idinlist($i) 1
1230 set idrowranges($i) $row
1232 incr col $l
1233 foreach oid $oldolds {
1234 set idinlist($oid) 1
1235 set idlist [linsert $idlist $col $oid]
1236 set offs [linsert $offs $col $o]
1237 makeuparrow $oid $col $row $o
1238 incr col
1240 lappend rowidlist $idlist
1241 lappend rowoffsets $offs
1243 return $row
1246 proc addextraid {id row} {
1247 global displayorder commitrow commitinfo
1248 global commitidx
1249 global parentlist childlist children
1251 incr commitidx
1252 lappend displayorder $id
1253 lappend parentlist {}
1254 set commitrow($id) $row
1255 readcommit $id
1256 if {![info exists commitinfo($id)]} {
1257 set commitinfo($id) {"No commit information available"}
1259 if {[info exists children($id)]} {
1260 lappend childlist $children($id)
1261 } else {
1262 lappend childlist {}
1266 proc layouttail {} {
1267 global rowidlist rowoffsets idinlist commitidx
1268 global idrowranges rowrangelist
1270 set row $commitidx
1271 set idlist [lindex $rowidlist $row]
1272 while {$idlist ne {}} {
1273 set col [expr {[llength $idlist] - 1}]
1274 set id [lindex $idlist $col]
1275 addextraid $id $row
1276 unset idinlist($id)
1277 lappend idrowranges($id) $row
1278 lappend rowrangelist $idrowranges($id)
1279 incr row
1280 set offs [ntimes $col 0]
1281 set idlist [lreplace $idlist $col $col]
1282 lappend rowidlist $idlist
1283 lappend rowoffsets $offs
1286 foreach id [array names idinlist] {
1287 addextraid $id $row
1288 lset rowidlist $row [list $id]
1289 lset rowoffsets $row 0
1290 makeuparrow $id 0 $row 0
1291 lappend idrowranges($id) $row
1292 lappend rowrangelist $idrowranges($id)
1293 incr row
1294 lappend rowidlist {}
1295 lappend rowoffsets {}
1299 proc insert_pad {row col npad} {
1300 global rowidlist rowoffsets
1302 set pad [ntimes $npad {}]
1303 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1304 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1305 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1308 proc optimize_rows {row col endrow} {
1309 global rowidlist rowoffsets idrowranges displayorder
1311 for {} {$row < $endrow} {incr row} {
1312 set idlist [lindex $rowidlist $row]
1313 set offs [lindex $rowoffsets $row]
1314 set haspad 0
1315 for {} {$col < [llength $offs]} {incr col} {
1316 if {[lindex $idlist $col] eq {}} {
1317 set haspad 1
1318 continue
1320 set z [lindex $offs $col]
1321 if {$z eq {}} continue
1322 set isarrow 0
1323 set x0 [expr {$col + $z}]
1324 set y0 [expr {$row - 1}]
1325 set z0 [lindex $rowoffsets $y0 $x0]
1326 if {$z0 eq {}} {
1327 set id [lindex $idlist $col]
1328 if {[info exists idrowranges($id)] &&
1329 $y0 > [lindex $idrowranges($id) 0]} {
1330 set isarrow 1
1333 if {$z < -1 || ($z < 0 && $isarrow)} {
1334 set npad [expr {-1 - $z + $isarrow}]
1335 set offs [incrange $offs $col $npad]
1336 insert_pad $y0 $x0 $npad
1337 if {$y0 > 0} {
1338 optimize_rows $y0 $x0 $row
1340 set z [lindex $offs $col]
1341 set x0 [expr {$col + $z}]
1342 set z0 [lindex $rowoffsets $y0 $x0]
1343 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1344 set npad [expr {$z - 1 + $isarrow}]
1345 set y1 [expr {$row + 1}]
1346 set offs2 [lindex $rowoffsets $y1]
1347 set x1 -1
1348 foreach z $offs2 {
1349 incr x1
1350 if {$z eq {} || $x1 + $z < $col} continue
1351 if {$x1 + $z > $col} {
1352 incr npad
1354 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1355 break
1357 set pad [ntimes $npad {}]
1358 set idlist [eval linsert \$idlist $col $pad]
1359 set tmp [eval linsert \$offs $col $pad]
1360 incr col $npad
1361 set offs [incrange $tmp $col [expr {-$npad}]]
1362 set z [lindex $offs $col]
1363 set haspad 1
1365 if {$z0 eq {} && !$isarrow} {
1366 # this line links to its first child on row $row-2
1367 set rm2 [expr {$row - 2}]
1368 set id [lindex $displayorder $rm2]
1369 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1370 if {$xc >= 0} {
1371 set z0 [expr {$xc - $x0}]
1374 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1375 insert_pad $y0 $x0 1
1376 set offs [incrange $offs $col 1]
1377 optimize_rows $y0 [expr {$x0 + 1}] $row
1380 if {!$haspad} {
1381 set o {}
1382 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1383 set o [lindex $offs $col]
1384 if {$o eq {}} {
1385 # check if this is the link to the first child
1386 set id [lindex $idlist $col]
1387 if {[info exists idrowranges($id)] &&
1388 $row == [lindex $idrowranges($id) 0]} {
1389 # it is, work out offset to child
1390 set y0 [expr {$row - 1}]
1391 set id [lindex $displayorder $y0]
1392 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1393 if {$x0 >= 0} {
1394 set o [expr {$x0 - $col}]
1398 if {$o eq {} || $o <= 0} break
1400 if {$o ne {} && [incr col] < [llength $idlist]} {
1401 set y1 [expr {$row + 1}]
1402 set offs2 [lindex $rowoffsets $y1]
1403 set x1 -1
1404 foreach z $offs2 {
1405 incr x1
1406 if {$z eq {} || $x1 + $z < $col} continue
1407 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1408 break
1410 set idlist [linsert $idlist $col {}]
1411 set tmp [linsert $offs $col {}]
1412 incr col
1413 set offs [incrange $tmp $col -1]
1416 lset rowidlist $row $idlist
1417 lset rowoffsets $row $offs
1418 set col 0
1422 proc xc {row col} {
1423 global canvx0 linespc
1424 return [expr {$canvx0 + $col * $linespc}]
1427 proc yc {row} {
1428 global canvy0 linespc
1429 return [expr {$canvy0 + $row * $linespc}]
1432 proc linewidth {id} {
1433 global thickerline lthickness
1435 set wid $lthickness
1436 if {[info exists thickerline] && $id eq $thickerline} {
1437 set wid [expr {2 * $lthickness}]
1439 return $wid
1442 proc rowranges {id} {
1443 global idrowranges commitrow numcommits rowrangelist
1445 set ranges {}
1446 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1447 set ranges [lindex $rowrangelist $commitrow($id)]
1448 } elseif {[info exists idrowranges($id)]} {
1449 set ranges $idrowranges($id)
1451 return $ranges
1454 proc drawlineseg {id i} {
1455 global rowoffsets rowidlist
1456 global displayorder
1457 global canv colormap linespc
1458 global numcommits commitrow
1460 set ranges [rowranges $id]
1461 set downarrow 1
1462 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1463 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1464 } else {
1465 set downarrow 1
1467 set startrow [lindex $ranges [expr {2 * $i}]]
1468 set row [lindex $ranges [expr {2 * $i + 1}]]
1469 if {$startrow == $row} return
1470 assigncolor $id
1471 set coords {}
1472 set col [lsearch -exact [lindex $rowidlist $row] $id]
1473 if {$col < 0} {
1474 puts "oops: drawline: id $id not on row $row"
1475 return
1477 set lasto {}
1478 set ns 0
1479 while {1} {
1480 set o [lindex $rowoffsets $row $col]
1481 if {$o eq {}} break
1482 if {$o ne $lasto} {
1483 # changing direction
1484 set x [xc $row $col]
1485 set y [yc $row]
1486 lappend coords $x $y
1487 set lasto $o
1489 incr col $o
1490 incr row -1
1492 set x [xc $row $col]
1493 set y [yc $row]
1494 lappend coords $x $y
1495 if {$i == 0} {
1496 # draw the link to the first child as part of this line
1497 incr row -1
1498 set child [lindex $displayorder $row]
1499 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1500 if {$ccol >= 0} {
1501 set x [xc $row $ccol]
1502 set y [yc $row]
1503 if {$ccol < $col - 1} {
1504 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1505 } elseif {$ccol > $col + 1} {
1506 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1508 lappend coords $x $y
1511 if {[llength $coords] < 4} return
1512 if {$downarrow} {
1513 # This line has an arrow at the lower end: check if the arrow is
1514 # on a diagonal segment, and if so, work around the Tk 8.4
1515 # refusal to draw arrows on diagonal lines.
1516 set x0 [lindex $coords 0]
1517 set x1 [lindex $coords 2]
1518 if {$x0 != $x1} {
1519 set y0 [lindex $coords 1]
1520 set y1 [lindex $coords 3]
1521 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1522 # we have a nearby vertical segment, just trim off the diag bit
1523 set coords [lrange $coords 2 end]
1524 } else {
1525 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1526 set xi [expr {$x0 - $slope * $linespc / 2}]
1527 set yi [expr {$y0 - $linespc / 2}]
1528 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1532 set arrow [expr {2 * ($i > 0) + $downarrow}]
1533 set arrow [lindex {none first last both} $arrow]
1534 set t [$canv create line $coords -width [linewidth $id] \
1535 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1536 $canv lower $t
1537 bindline $t $id
1540 proc drawparentlinks {id row col olds} {
1541 global rowidlist canv colormap
1543 set row2 [expr {$row + 1}]
1544 set x [xc $row $col]
1545 set y [yc $row]
1546 set y2 [yc $row2]
1547 set ids [lindex $rowidlist $row2]
1548 # rmx = right-most X coord used
1549 set rmx 0
1550 foreach p $olds {
1551 set i [lsearch -exact $ids $p]
1552 if {$i < 0} {
1553 puts "oops, parent $p of $id not in list"
1554 continue
1556 set x2 [xc $row2 $i]
1557 if {$x2 > $rmx} {
1558 set rmx $x2
1560 set ranges [rowranges $p]
1561 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1562 && $row2 < [lindex $ranges 1]} {
1563 # drawlineseg will do this one for us
1564 continue
1566 assigncolor $p
1567 # should handle duplicated parents here...
1568 set coords [list $x $y]
1569 if {$i < $col - 1} {
1570 lappend coords [xc $row [expr {$i + 1}]] $y
1571 } elseif {$i > $col + 1} {
1572 lappend coords [xc $row [expr {$i - 1}]] $y
1574 lappend coords $x2 $y2
1575 set t [$canv create line $coords -width [linewidth $p] \
1576 -fill $colormap($p) -tags lines.$p]
1577 $canv lower $t
1578 bindline $t $p
1580 return $rmx
1583 proc drawlines {id} {
1584 global colormap canv
1585 global idrangedrawn
1586 global childlist iddrawn commitrow rowidlist
1588 $canv delete lines.$id
1589 set nr [expr {[llength [rowranges $id]] / 2}]
1590 for {set i 0} {$i < $nr} {incr i} {
1591 if {[info exists idrangedrawn($id,$i)]} {
1592 drawlineseg $id $i
1595 foreach child [lindex $childlist $commitrow($id)] {
1596 if {[info exists iddrawn($child)]} {
1597 set row $commitrow($child)
1598 set col [lsearch -exact [lindex $rowidlist $row] $child]
1599 if {$col >= 0} {
1600 drawparentlinks $child $row $col [list $id]
1606 proc drawcmittext {id row col rmx} {
1607 global linespc canv canv2 canv3 canvy0
1608 global commitlisted commitinfo rowidlist
1609 global rowtextx idpos idtags idheads idotherrefs
1610 global linehtag linentag linedtag
1611 global mainfont namefont canvxmax
1613 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1614 set x [xc $row $col]
1615 set y [yc $row]
1616 set orad [expr {$linespc / 3}]
1617 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1618 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1619 -fill $ofill -outline black -width 1]
1620 $canv raise $t
1621 $canv bind $t <1> {selcanvline {} %x %y}
1622 set xt [xc $row [llength [lindex $rowidlist $row]]]
1623 if {$xt < $rmx} {
1624 set xt $rmx
1626 set rowtextx($row) $xt
1627 set idpos($id) [list $x $xt $y]
1628 if {[info exists idtags($id)] || [info exists idheads($id)]
1629 || [info exists idotherrefs($id)]} {
1630 set xt [drawtags $id $x $xt $y]
1632 set headline [lindex $commitinfo($id) 0]
1633 set name [lindex $commitinfo($id) 1]
1634 set date [lindex $commitinfo($id) 2]
1635 set date [formatdate $date]
1636 set linehtag($row) [$canv create text $xt $y -anchor w \
1637 -text $headline -font $mainfont ]
1638 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1639 set linentag($row) [$canv2 create text 3 $y -anchor w \
1640 -text $name -font $namefont]
1641 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1642 -text $date -font $mainfont]
1643 set xr [expr {$xt + [font measure $mainfont $headline]}]
1644 if {$xr > $canvxmax} {
1645 set canvxmax $xr
1646 setcanvscroll
1650 proc drawcmitrow {row} {
1651 global displayorder rowidlist
1652 global idrangedrawn iddrawn
1653 global commitinfo commitlisted parentlist numcommits
1655 if {$row >= $numcommits} return
1656 foreach id [lindex $rowidlist $row] {
1657 set i -1
1658 foreach {s e} [rowranges $id] {
1659 incr i
1660 if {$row < $s} continue
1661 if {$e eq {}} break
1662 if {$row <= $e} {
1663 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1664 drawlineseg $id $i
1665 set idrangedrawn($id,$i) 1
1667 break
1672 set id [lindex $displayorder $row]
1673 if {[info exists iddrawn($id)]} return
1674 set col [lsearch -exact [lindex $rowidlist $row] $id]
1675 if {$col < 0} {
1676 puts "oops, row $row id $id not in list"
1677 return
1679 if {![info exists commitinfo($id)]} {
1680 getcommit $id
1682 assigncolor $id
1683 set olds [lindex $parentlist $row]
1684 if {$olds ne {}} {
1685 set rmx [drawparentlinks $id $row $col $olds]
1686 } else {
1687 set rmx 0
1689 drawcmittext $id $row $col $rmx
1690 set iddrawn($id) 1
1693 proc drawfrac {f0 f1} {
1694 global numcommits canv
1695 global linespc
1697 set ymax [lindex [$canv cget -scrollregion] 3]
1698 if {$ymax eq {} || $ymax == 0} return
1699 set y0 [expr {int($f0 * $ymax)}]
1700 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1701 if {$row < 0} {
1702 set row 0
1704 set y1 [expr {int($f1 * $ymax)}]
1705 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1706 if {$endrow >= $numcommits} {
1707 set endrow [expr {$numcommits - 1}]
1709 for {} {$row <= $endrow} {incr row} {
1710 drawcmitrow $row
1714 proc drawvisible {} {
1715 global canv
1716 eval drawfrac [$canv yview]
1719 proc clear_display {} {
1720 global iddrawn idrangedrawn
1722 allcanvs delete all
1723 catch {unset iddrawn}
1724 catch {unset idrangedrawn}
1727 proc findcrossings {id} {
1728 global rowidlist parentlist numcommits rowoffsets displayorder
1730 set cross {}
1731 set ccross {}
1732 foreach {s e} [rowranges $id] {
1733 if {$e >= $numcommits} {
1734 set e [expr {$numcommits - 1}]
1736 if {$e <= $s} continue
1737 set x [lsearch -exact [lindex $rowidlist $e] $id]
1738 if {$x < 0} {
1739 puts "findcrossings: oops, no [shortids $id] in row $e"
1740 continue
1742 for {set row $e} {[incr row -1] >= $s} {} {
1743 set olds [lindex $parentlist $row]
1744 set kid [lindex $displayorder $row]
1745 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1746 if {$kidx < 0} continue
1747 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1748 foreach p $olds {
1749 set px [lsearch -exact $nextrow $p]
1750 if {$px < 0} continue
1751 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1752 if {[lsearch -exact $ccross $p] >= 0} continue
1753 if {$x == $px + ($kidx < $px? -1: 1)} {
1754 lappend ccross $p
1755 } elseif {[lsearch -exact $cross $p] < 0} {
1756 lappend cross $p
1760 set inc [lindex $rowoffsets $row $x]
1761 if {$inc eq {}} break
1762 incr x $inc
1765 return [concat $ccross {{}} $cross]
1768 proc assigncolor {id} {
1769 global colormap colors nextcolor
1770 global commitrow parentlist children childlist
1772 if {[info exists colormap($id)]} return
1773 set ncolors [llength $colors]
1774 if {[info exists commitrow($id)]} {
1775 set kids [lindex $childlist $commitrow($id)]
1776 } elseif {[info exists children($id)]} {
1777 set kids $children($id)
1778 } else {
1779 set kids {}
1781 if {[llength $kids] == 1} {
1782 set child [lindex $kids 0]
1783 if {[info exists colormap($child)]
1784 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1785 set colormap($id) $colormap($child)
1786 return
1789 set badcolors {}
1790 set origbad {}
1791 foreach x [findcrossings $id] {
1792 if {$x eq {}} {
1793 # delimiter between corner crossings and other crossings
1794 if {[llength $badcolors] >= $ncolors - 1} break
1795 set origbad $badcolors
1797 if {[info exists colormap($x)]
1798 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1799 lappend badcolors $colormap($x)
1802 if {[llength $badcolors] >= $ncolors} {
1803 set badcolors $origbad
1805 set origbad $badcolors
1806 if {[llength $badcolors] < $ncolors - 1} {
1807 foreach child $kids {
1808 if {[info exists colormap($child)]
1809 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1810 lappend badcolors $colormap($child)
1812 foreach p [lindex $parentlist $commitrow($child)] {
1813 if {[info exists colormap($p)]
1814 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1815 lappend badcolors $colormap($p)
1819 if {[llength $badcolors] >= $ncolors} {
1820 set badcolors $origbad
1823 for {set i 0} {$i <= $ncolors} {incr i} {
1824 set c [lindex $colors $nextcolor]
1825 if {[incr nextcolor] >= $ncolors} {
1826 set nextcolor 0
1828 if {[lsearch -exact $badcolors $c]} break
1830 set colormap($id) $c
1833 proc bindline {t id} {
1834 global canv
1836 $canv bind $t <Enter> "lineenter %x %y $id"
1837 $canv bind $t <Motion> "linemotion %x %y $id"
1838 $canv bind $t <Leave> "lineleave $id"
1839 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1842 proc drawtags {id x xt y1} {
1843 global idtags idheads idotherrefs
1844 global linespc lthickness
1845 global canv mainfont commitrow rowtextx
1847 set marks {}
1848 set ntags 0
1849 set nheads 0
1850 if {[info exists idtags($id)]} {
1851 set marks $idtags($id)
1852 set ntags [llength $marks]
1854 if {[info exists idheads($id)]} {
1855 set marks [concat $marks $idheads($id)]
1856 set nheads [llength $idheads($id)]
1858 if {[info exists idotherrefs($id)]} {
1859 set marks [concat $marks $idotherrefs($id)]
1861 if {$marks eq {}} {
1862 return $xt
1865 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1866 set yt [expr {$y1 - 0.5 * $linespc}]
1867 set yb [expr {$yt + $linespc - 1}]
1868 set xvals {}
1869 set wvals {}
1870 foreach tag $marks {
1871 set wid [font measure $mainfont $tag]
1872 lappend xvals $xt
1873 lappend wvals $wid
1874 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1876 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1877 -width $lthickness -fill black -tags tag.$id]
1878 $canv lower $t
1879 foreach tag $marks x $xvals wid $wvals {
1880 set xl [expr {$x + $delta}]
1881 set xr [expr {$x + $delta + $wid + $lthickness}]
1882 if {[incr ntags -1] >= 0} {
1883 # draw a tag
1884 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1885 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1886 -width 1 -outline black -fill yellow -tags tag.$id]
1887 $canv bind $t <1> [list showtag $tag 1]
1888 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1889 } else {
1890 # draw a head or other ref
1891 if {[incr nheads -1] >= 0} {
1892 set col green
1893 } else {
1894 set col "#ddddff"
1896 set xl [expr {$xl - $delta/2}]
1897 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1898 -width 1 -outline black -fill $col -tags tag.$id
1900 set t [$canv create text $xl $y1 -anchor w -text $tag \
1901 -font $mainfont -tags tag.$id]
1902 if {$ntags >= 0} {
1903 $canv bind $t <1> [list showtag $tag 1]
1906 return $xt
1909 proc xcoord {i level ln} {
1910 global canvx0 xspc1 xspc2
1912 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1913 if {$i > 0 && $i == $level} {
1914 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1915 } elseif {$i > $level} {
1916 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1918 return $x
1921 proc finishcommits {} {
1922 global commitidx phase
1923 global canv mainfont ctext maincursor textcursor
1924 global findinprogress
1926 if {$commitidx > 0} {
1927 drawrest
1928 } else {
1929 $canv delete all
1930 $canv create text 3 3 -anchor nw -text "No commits selected" \
1931 -font $mainfont -tags textitems
1933 if {![info exists findinprogress]} {
1934 . config -cursor $maincursor
1935 settextcursor $textcursor
1937 set phase {}
1940 # Don't change the text pane cursor if it is currently the hand cursor,
1941 # showing that we are over a sha1 ID link.
1942 proc settextcursor {c} {
1943 global ctext curtextcursor
1945 if {[$ctext cget -cursor] == $curtextcursor} {
1946 $ctext config -cursor $c
1948 set curtextcursor $c
1951 proc drawrest {} {
1952 global numcommits
1953 global startmsecs
1954 global canvy0 numcommits linespc
1955 global rowlaidout commitidx
1957 set row $rowlaidout
1958 layoutrows $rowlaidout $commitidx 1
1959 layouttail
1960 optimize_rows $row 0 $commitidx
1961 showstuff $commitidx
1963 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1964 #puts "overall $drawmsecs ms for $numcommits commits"
1967 proc findmatches {f} {
1968 global findtype foundstring foundstrlen
1969 if {$findtype == "Regexp"} {
1970 set matches [regexp -indices -all -inline $foundstring $f]
1971 } else {
1972 if {$findtype == "IgnCase"} {
1973 set str [string tolower $f]
1974 } else {
1975 set str $f
1977 set matches {}
1978 set i 0
1979 while {[set j [string first $foundstring $str $i]] >= 0} {
1980 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1981 set i [expr {$j + $foundstrlen}]
1984 return $matches
1987 proc dofind {} {
1988 global findtype findloc findstring markedmatches commitinfo
1989 global numcommits displayorder linehtag linentag linedtag
1990 global mainfont namefont canv canv2 canv3 selectedline
1991 global matchinglines foundstring foundstrlen matchstring
1992 global commitdata
1994 stopfindproc
1995 unmarkmatches
1996 focus .
1997 set matchinglines {}
1998 if {$findloc == "Pickaxe"} {
1999 findpatches
2000 return
2002 if {$findtype == "IgnCase"} {
2003 set foundstring [string tolower $findstring]
2004 } else {
2005 set foundstring $findstring
2007 set foundstrlen [string length $findstring]
2008 if {$foundstrlen == 0} return
2009 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2010 set matchstring "*$matchstring*"
2011 if {$findloc == "Files"} {
2012 findfiles
2013 return
2015 if {![info exists selectedline]} {
2016 set oldsel -1
2017 } else {
2018 set oldsel $selectedline
2020 set didsel 0
2021 set fldtypes {Headline Author Date Committer CDate Comment}
2022 set l -1
2023 foreach id $displayorder {
2024 set d $commitdata($id)
2025 incr l
2026 if {$findtype == "Regexp"} {
2027 set doesmatch [regexp $foundstring $d]
2028 } elseif {$findtype == "IgnCase"} {
2029 set doesmatch [string match -nocase $matchstring $d]
2030 } else {
2031 set doesmatch [string match $matchstring $d]
2033 if {!$doesmatch} continue
2034 if {![info exists commitinfo($id)]} {
2035 getcommit $id
2037 set info $commitinfo($id)
2038 set doesmatch 0
2039 foreach f $info ty $fldtypes {
2040 if {$findloc != "All fields" && $findloc != $ty} {
2041 continue
2043 set matches [findmatches $f]
2044 if {$matches == {}} continue
2045 set doesmatch 1
2046 if {$ty == "Headline"} {
2047 drawcmitrow $l
2048 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2049 } elseif {$ty == "Author"} {
2050 drawcmitrow $l
2051 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2052 } elseif {$ty == "Date"} {
2053 drawcmitrow $l
2054 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2057 if {$doesmatch} {
2058 lappend matchinglines $l
2059 if {!$didsel && $l > $oldsel} {
2060 findselectline $l
2061 set didsel 1
2065 if {$matchinglines == {}} {
2066 bell
2067 } elseif {!$didsel} {
2068 findselectline [lindex $matchinglines 0]
2072 proc findselectline {l} {
2073 global findloc commentend ctext
2074 selectline $l 1
2075 if {$findloc == "All fields" || $findloc == "Comments"} {
2076 # highlight the matches in the comments
2077 set f [$ctext get 1.0 $commentend]
2078 set matches [findmatches $f]
2079 foreach match $matches {
2080 set start [lindex $match 0]
2081 set end [expr {[lindex $match 1] + 1}]
2082 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2087 proc findnext {restart} {
2088 global matchinglines selectedline
2089 if {![info exists matchinglines]} {
2090 if {$restart} {
2091 dofind
2093 return
2095 if {![info exists selectedline]} return
2096 foreach l $matchinglines {
2097 if {$l > $selectedline} {
2098 findselectline $l
2099 return
2102 bell
2105 proc findprev {} {
2106 global matchinglines selectedline
2107 if {![info exists matchinglines]} {
2108 dofind
2109 return
2111 if {![info exists selectedline]} return
2112 set prev {}
2113 foreach l $matchinglines {
2114 if {$l >= $selectedline} break
2115 set prev $l
2117 if {$prev != {}} {
2118 findselectline $prev
2119 } else {
2120 bell
2124 proc findlocchange {name ix op} {
2125 global findloc findtype findtypemenu
2126 if {$findloc == "Pickaxe"} {
2127 set findtype Exact
2128 set state disabled
2129 } else {
2130 set state normal
2132 $findtypemenu entryconf 1 -state $state
2133 $findtypemenu entryconf 2 -state $state
2136 proc stopfindproc {{done 0}} {
2137 global findprocpid findprocfile findids
2138 global ctext findoldcursor phase maincursor textcursor
2139 global findinprogress
2141 catch {unset findids}
2142 if {[info exists findprocpid]} {
2143 if {!$done} {
2144 catch {exec kill $findprocpid}
2146 catch {close $findprocfile}
2147 unset findprocpid
2149 if {[info exists findinprogress]} {
2150 unset findinprogress
2151 if {$phase != "incrdraw"} {
2152 . config -cursor $maincursor
2153 settextcursor $textcursor
2158 proc findpatches {} {
2159 global findstring selectedline numcommits
2160 global findprocpid findprocfile
2161 global finddidsel ctext displayorder findinprogress
2162 global findinsertpos
2164 if {$numcommits == 0} return
2166 # make a list of all the ids to search, starting at the one
2167 # after the selected line (if any)
2168 if {[info exists selectedline]} {
2169 set l $selectedline
2170 } else {
2171 set l -1
2173 set inputids {}
2174 for {set i 0} {$i < $numcommits} {incr i} {
2175 if {[incr l] >= $numcommits} {
2176 set l 0
2178 append inputids [lindex $displayorder $l] "\n"
2181 if {[catch {
2182 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2183 << $inputids] r]
2184 } err]} {
2185 error_popup "Error starting search process: $err"
2186 return
2189 set findinsertpos end
2190 set findprocfile $f
2191 set findprocpid [pid $f]
2192 fconfigure $f -blocking 0
2193 fileevent $f readable readfindproc
2194 set finddidsel 0
2195 . config -cursor watch
2196 settextcursor watch
2197 set findinprogress 1
2200 proc readfindproc {} {
2201 global findprocfile finddidsel
2202 global commitrow matchinglines findinsertpos
2204 set n [gets $findprocfile line]
2205 if {$n < 0} {
2206 if {[eof $findprocfile]} {
2207 stopfindproc 1
2208 if {!$finddidsel} {
2209 bell
2212 return
2214 if {![regexp {^[0-9a-f]{40}} $line id]} {
2215 error_popup "Can't parse git-diff-tree output: $line"
2216 stopfindproc
2217 return
2219 if {![info exists commitrow($id)]} {
2220 puts stderr "spurious id: $id"
2221 return
2223 set l $commitrow($id)
2224 insertmatch $l $id
2227 proc insertmatch {l id} {
2228 global matchinglines findinsertpos finddidsel
2230 if {$findinsertpos == "end"} {
2231 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2232 set matchinglines [linsert $matchinglines 0 $l]
2233 set findinsertpos 1
2234 } else {
2235 lappend matchinglines $l
2237 } else {
2238 set matchinglines [linsert $matchinglines $findinsertpos $l]
2239 incr findinsertpos
2241 markheadline $l $id
2242 if {!$finddidsel} {
2243 findselectline $l
2244 set finddidsel 1
2248 proc findfiles {} {
2249 global selectedline numcommits displayorder ctext
2250 global ffileline finddidsel parentlist
2251 global findinprogress findstartline findinsertpos
2252 global treediffs fdiffid fdiffsneeded fdiffpos
2253 global findmergefiles
2255 if {$numcommits == 0} return
2257 if {[info exists selectedline]} {
2258 set l [expr {$selectedline + 1}]
2259 } else {
2260 set l 0
2262 set ffileline $l
2263 set findstartline $l
2264 set diffsneeded {}
2265 set fdiffsneeded {}
2266 while 1 {
2267 set id [lindex $displayorder $l]
2268 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2269 if {![info exists treediffs($id)]} {
2270 append diffsneeded "$id\n"
2271 lappend fdiffsneeded $id
2274 if {[incr l] >= $numcommits} {
2275 set l 0
2277 if {$l == $findstartline} break
2280 # start off a git-diff-tree process if needed
2281 if {$diffsneeded ne {}} {
2282 if {[catch {
2283 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2284 } err ]} {
2285 error_popup "Error starting search process: $err"
2286 return
2288 catch {unset fdiffid}
2289 set fdiffpos 0
2290 fconfigure $df -blocking 0
2291 fileevent $df readable [list readfilediffs $df]
2294 set finddidsel 0
2295 set findinsertpos end
2296 set id [lindex $displayorder $l]
2297 . config -cursor watch
2298 settextcursor watch
2299 set findinprogress 1
2300 findcont
2301 update
2304 proc readfilediffs {df} {
2305 global findid fdiffid fdiffs
2307 set n [gets $df line]
2308 if {$n < 0} {
2309 if {[eof $df]} {
2310 donefilediff
2311 if {[catch {close $df} err]} {
2312 stopfindproc
2313 bell
2314 error_popup "Error in git-diff-tree: $err"
2315 } elseif {[info exists findid]} {
2316 set id $findid
2317 stopfindproc
2318 bell
2319 error_popup "Couldn't find diffs for $id"
2322 return
2324 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2325 # start of a new string of diffs
2326 donefilediff
2327 set fdiffid $id
2328 set fdiffs {}
2329 } elseif {[string match ":*" $line]} {
2330 lappend fdiffs [lindex $line 5]
2334 proc donefilediff {} {
2335 global fdiffid fdiffs treediffs findid
2336 global fdiffsneeded fdiffpos
2338 if {[info exists fdiffid]} {
2339 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2340 && $fdiffpos < [llength $fdiffsneeded]} {
2341 # git-diff-tree doesn't output anything for a commit
2342 # which doesn't change anything
2343 set nullid [lindex $fdiffsneeded $fdiffpos]
2344 set treediffs($nullid) {}
2345 if {[info exists findid] && $nullid eq $findid} {
2346 unset findid
2347 findcont
2349 incr fdiffpos
2351 incr fdiffpos
2353 if {![info exists treediffs($fdiffid)]} {
2354 set treediffs($fdiffid) $fdiffs
2356 if {[info exists findid] && $fdiffid eq $findid} {
2357 unset findid
2358 findcont
2363 proc findcont {} {
2364 global findid treediffs parentlist
2365 global ffileline findstartline finddidsel
2366 global displayorder numcommits matchinglines findinprogress
2367 global findmergefiles
2369 set l $ffileline
2370 while {1} {
2371 set id [lindex $displayorder $l]
2372 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2373 if {![info exists treediffs($id)]} {
2374 set findid $id
2375 set ffileline $l
2376 return
2378 set doesmatch 0
2379 foreach f $treediffs($id) {
2380 set x [findmatches $f]
2381 if {$x != {}} {
2382 set doesmatch 1
2383 break
2386 if {$doesmatch} {
2387 insertmatch $l $id
2390 if {[incr l] >= $numcommits} {
2391 set l 0
2393 if {$l == $findstartline} break
2395 stopfindproc
2396 if {!$finddidsel} {
2397 bell
2401 # mark a commit as matching by putting a yellow background
2402 # behind the headline
2403 proc markheadline {l id} {
2404 global canv mainfont linehtag
2406 drawcmitrow $l
2407 set bbox [$canv bbox $linehtag($l)]
2408 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2409 $canv lower $t
2412 # mark the bits of a headline, author or date that match a find string
2413 proc markmatches {canv l str tag matches font} {
2414 set bbox [$canv bbox $tag]
2415 set x0 [lindex $bbox 0]
2416 set y0 [lindex $bbox 1]
2417 set y1 [lindex $bbox 3]
2418 foreach match $matches {
2419 set start [lindex $match 0]
2420 set end [lindex $match 1]
2421 if {$start > $end} continue
2422 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2423 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2424 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2425 [expr {$x0+$xlen+2}] $y1 \
2426 -outline {} -tags matches -fill yellow]
2427 $canv lower $t
2431 proc unmarkmatches {} {
2432 global matchinglines findids
2433 allcanvs delete matches
2434 catch {unset matchinglines}
2435 catch {unset findids}
2438 proc selcanvline {w x y} {
2439 global canv canvy0 ctext linespc
2440 global rowtextx
2441 set ymax [lindex [$canv cget -scrollregion] 3]
2442 if {$ymax == {}} return
2443 set yfrac [lindex [$canv yview] 0]
2444 set y [expr {$y + $yfrac * $ymax}]
2445 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2446 if {$l < 0} {
2447 set l 0
2449 if {$w eq $canv} {
2450 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2452 unmarkmatches
2453 selectline $l 1
2456 proc commit_descriptor {p} {
2457 global commitinfo
2458 set l "..."
2459 if {[info exists commitinfo($p)]} {
2460 set l [lindex $commitinfo($p) 0]
2462 return "$p ($l)"
2465 # append some text to the ctext widget, and make any SHA1 ID
2466 # that we know about be a clickable link.
2467 proc appendwithlinks {text} {
2468 global ctext commitrow linknum
2470 set start [$ctext index "end - 1c"]
2471 $ctext insert end $text
2472 $ctext insert end "\n"
2473 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2474 foreach l $links {
2475 set s [lindex $l 0]
2476 set e [lindex $l 1]
2477 set linkid [string range $text $s $e]
2478 if {![info exists commitrow($linkid)]} continue
2479 incr e
2480 $ctext tag add link "$start + $s c" "$start + $e c"
2481 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2482 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2483 incr linknum
2485 $ctext tag conf link -foreground blue -underline 1
2486 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2487 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2490 proc selectline {l isnew} {
2491 global canv canv2 canv3 ctext commitinfo selectedline
2492 global displayorder linehtag linentag linedtag
2493 global canvy0 linespc parentlist childlist
2494 global cflist currentid sha1entry
2495 global commentend idtags linknum
2496 global mergemax numcommits pending_select
2498 catch {unset pending_select}
2499 $canv delete hover
2500 normalline
2501 if {$l < 0 || $l >= $numcommits} return
2502 set y [expr {$canvy0 + $l * $linespc}]
2503 set ymax [lindex [$canv cget -scrollregion] 3]
2504 set ytop [expr {$y - $linespc - 1}]
2505 set ybot [expr {$y + $linespc + 1}]
2506 set wnow [$canv yview]
2507 set wtop [expr {[lindex $wnow 0] * $ymax}]
2508 set wbot [expr {[lindex $wnow 1] * $ymax}]
2509 set wh [expr {$wbot - $wtop}]
2510 set newtop $wtop
2511 if {$ytop < $wtop} {
2512 if {$ybot < $wtop} {
2513 set newtop [expr {$y - $wh / 2.0}]
2514 } else {
2515 set newtop $ytop
2516 if {$newtop > $wtop - $linespc} {
2517 set newtop [expr {$wtop - $linespc}]
2520 } elseif {$ybot > $wbot} {
2521 if {$ytop > $wbot} {
2522 set newtop [expr {$y - $wh / 2.0}]
2523 } else {
2524 set newtop [expr {$ybot - $wh}]
2525 if {$newtop < $wtop + $linespc} {
2526 set newtop [expr {$wtop + $linespc}]
2530 if {$newtop != $wtop} {
2531 if {$newtop < 0} {
2532 set newtop 0
2534 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2535 drawvisible
2538 if {![info exists linehtag($l)]} return
2539 $canv delete secsel
2540 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2541 -tags secsel -fill [$canv cget -selectbackground]]
2542 $canv lower $t
2543 $canv2 delete secsel
2544 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2545 -tags secsel -fill [$canv2 cget -selectbackground]]
2546 $canv2 lower $t
2547 $canv3 delete secsel
2548 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2549 -tags secsel -fill [$canv3 cget -selectbackground]]
2550 $canv3 lower $t
2552 if {$isnew} {
2553 addtohistory [list selectline $l 0]
2556 set selectedline $l
2558 set id [lindex $displayorder $l]
2559 set currentid $id
2560 $sha1entry delete 0 end
2561 $sha1entry insert 0 $id
2562 $sha1entry selection from 0
2563 $sha1entry selection to end
2565 $ctext conf -state normal
2566 $ctext delete 0.0 end
2567 set linknum 0
2568 $ctext mark set fmark.0 0.0
2569 $ctext mark gravity fmark.0 left
2570 set info $commitinfo($id)
2571 set date [formatdate [lindex $info 2]]
2572 $ctext insert end "Author: [lindex $info 1] $date\n"
2573 set date [formatdate [lindex $info 4]]
2574 $ctext insert end "Committer: [lindex $info 3] $date\n"
2575 if {[info exists idtags($id)]} {
2576 $ctext insert end "Tags:"
2577 foreach tag $idtags($id) {
2578 $ctext insert end " $tag"
2580 $ctext insert end "\n"
2583 set comment {}
2584 set olds [lindex $parentlist $l]
2585 if {[llength $olds] > 1} {
2586 set np 0
2587 foreach p $olds {
2588 if {$np >= $mergemax} {
2589 set tag mmax
2590 } else {
2591 set tag m$np
2593 $ctext insert end "Parent: " $tag
2594 appendwithlinks [commit_descriptor $p]
2595 incr np
2597 } else {
2598 foreach p $olds {
2599 append comment "Parent: [commit_descriptor $p]\n"
2603 foreach c [lindex $childlist $l] {
2604 append comment "Child: [commit_descriptor $c]\n"
2606 append comment "\n"
2607 append comment [lindex $info 5]
2609 # make anything that looks like a SHA1 ID be a clickable link
2610 appendwithlinks $comment
2612 $ctext tag delete Comments
2613 $ctext tag remove found 1.0 end
2614 $ctext conf -state disabled
2615 set commentend [$ctext index "end - 1c"]
2617 $cflist delete 0 end
2618 $cflist insert end "Comments"
2619 if {[llength $olds] <= 1} {
2620 startdiff $id
2621 } else {
2622 mergediff $id $l
2626 proc selnextline {dir} {
2627 global selectedline
2628 if {![info exists selectedline]} return
2629 set l [expr {$selectedline + $dir}]
2630 unmarkmatches
2631 selectline $l 1
2634 proc unselectline {} {
2635 global selectedline currentid
2637 catch {unset selectedline}
2638 catch {unset currentid}
2639 allcanvs delete secsel
2642 proc addtohistory {cmd} {
2643 global history historyindex
2645 if {$historyindex > 0
2646 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2647 return
2650 if {$historyindex < [llength $history]} {
2651 set history [lreplace $history $historyindex end $cmd]
2652 } else {
2653 lappend history $cmd
2655 incr historyindex
2656 if {$historyindex > 1} {
2657 .ctop.top.bar.leftbut conf -state normal
2658 } else {
2659 .ctop.top.bar.leftbut conf -state disabled
2661 .ctop.top.bar.rightbut conf -state disabled
2664 proc goback {} {
2665 global history historyindex
2667 if {$historyindex > 1} {
2668 incr historyindex -1
2669 set cmd [lindex $history [expr {$historyindex - 1}]]
2670 eval $cmd
2671 .ctop.top.bar.rightbut conf -state normal
2673 if {$historyindex <= 1} {
2674 .ctop.top.bar.leftbut conf -state disabled
2678 proc goforw {} {
2679 global history historyindex
2681 if {$historyindex < [llength $history]} {
2682 set cmd [lindex $history $historyindex]
2683 incr historyindex
2684 eval $cmd
2685 .ctop.top.bar.leftbut conf -state normal
2687 if {$historyindex >= [llength $history]} {
2688 .ctop.top.bar.rightbut conf -state disabled
2692 proc mergediff {id l} {
2693 global diffmergeid diffopts mdifffd
2694 global difffilestart diffids
2695 global parentlist
2697 set diffmergeid $id
2698 set diffids $id
2699 catch {unset difffilestart}
2700 # this doesn't seem to actually affect anything...
2701 set env(GIT_DIFF_OPTS) $diffopts
2702 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2703 if {[catch {set mdf [open $cmd r]} err]} {
2704 error_popup "Error getting merge diffs: $err"
2705 return
2707 fconfigure $mdf -blocking 0
2708 set mdifffd($id) $mdf
2709 set np [llength [lindex $parentlist $l]]
2710 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2711 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2714 proc getmergediffline {mdf id np} {
2715 global diffmergeid ctext cflist nextupdate mergemax
2716 global difffilestart mdifffd
2718 set n [gets $mdf line]
2719 if {$n < 0} {
2720 if {[eof $mdf]} {
2721 close $mdf
2723 return
2725 if {![info exists diffmergeid] || $id != $diffmergeid
2726 || $mdf != $mdifffd($id)} {
2727 return
2729 $ctext conf -state normal
2730 if {[regexp {^diff --cc (.*)} $line match fname]} {
2731 # start of a new file
2732 $ctext insert end "\n"
2733 set here [$ctext index "end - 1c"]
2734 set i [$cflist index end]
2735 $ctext mark set fmark.$i $here
2736 $ctext mark gravity fmark.$i left
2737 set difffilestart([expr {$i-1}]) $here
2738 $cflist insert end $fname
2739 set l [expr {(78 - [string length $fname]) / 2}]
2740 set pad [string range "----------------------------------------" 1 $l]
2741 $ctext insert end "$pad $fname $pad\n" filesep
2742 } elseif {[regexp {^@@} $line]} {
2743 $ctext insert end "$line\n" hunksep
2744 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2745 # do nothing
2746 } else {
2747 # parse the prefix - one ' ', '-' or '+' for each parent
2748 set spaces {}
2749 set minuses {}
2750 set pluses {}
2751 set isbad 0
2752 for {set j 0} {$j < $np} {incr j} {
2753 set c [string range $line $j $j]
2754 if {$c == " "} {
2755 lappend spaces $j
2756 } elseif {$c == "-"} {
2757 lappend minuses $j
2758 } elseif {$c == "+"} {
2759 lappend pluses $j
2760 } else {
2761 set isbad 1
2762 break
2765 set tags {}
2766 set num {}
2767 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2768 # line doesn't appear in result, parents in $minuses have the line
2769 set num [lindex $minuses 0]
2770 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2771 # line appears in result, parents in $pluses don't have the line
2772 lappend tags mresult
2773 set num [lindex $spaces 0]
2775 if {$num ne {}} {
2776 if {$num >= $mergemax} {
2777 set num "max"
2779 lappend tags m$num
2781 $ctext insert end "$line\n" $tags
2783 $ctext conf -state disabled
2784 if {[clock clicks -milliseconds] >= $nextupdate} {
2785 incr nextupdate 100
2786 fileevent $mdf readable {}
2787 update
2788 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2792 proc startdiff {ids} {
2793 global treediffs diffids treepending diffmergeid
2795 set diffids $ids
2796 catch {unset diffmergeid}
2797 if {![info exists treediffs($ids)]} {
2798 if {![info exists treepending]} {
2799 gettreediffs $ids
2801 } else {
2802 addtocflist $ids
2806 proc addtocflist {ids} {
2807 global treediffs cflist
2808 foreach f $treediffs($ids) {
2809 $cflist insert end $f
2811 getblobdiffs $ids
2814 proc gettreediffs {ids} {
2815 global treediff treepending
2816 set treepending $ids
2817 set treediff {}
2818 if {[catch \
2819 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2820 ]} return
2821 fconfigure $gdtf -blocking 0
2822 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2825 proc gettreediffline {gdtf ids} {
2826 global treediff treediffs treepending diffids diffmergeid
2828 set n [gets $gdtf line]
2829 if {$n < 0} {
2830 if {![eof $gdtf]} return
2831 close $gdtf
2832 set treediffs($ids) $treediff
2833 unset treepending
2834 if {$ids != $diffids} {
2835 if {![info exists diffmergeid]} {
2836 gettreediffs $diffids
2838 } else {
2839 addtocflist $ids
2841 return
2843 set file [lindex $line 5]
2844 lappend treediff $file
2847 proc getblobdiffs {ids} {
2848 global diffopts blobdifffd diffids env curdifftag curtagstart
2849 global difffilestart nextupdate diffinhdr treediffs
2851 set env(GIT_DIFF_OPTS) $diffopts
2852 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2853 if {[catch {set bdf [open $cmd r]} err]} {
2854 puts "error getting diffs: $err"
2855 return
2857 set diffinhdr 0
2858 fconfigure $bdf -blocking 0
2859 set blobdifffd($ids) $bdf
2860 set curdifftag Comments
2861 set curtagstart 0.0
2862 catch {unset difffilestart}
2863 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2864 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2867 proc getblobdiffline {bdf ids} {
2868 global diffids blobdifffd ctext curdifftag curtagstart
2869 global diffnexthead diffnextnote difffilestart
2870 global nextupdate diffinhdr treediffs
2872 set n [gets $bdf line]
2873 if {$n < 0} {
2874 if {[eof $bdf]} {
2875 close $bdf
2876 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2877 $ctext tag add $curdifftag $curtagstart end
2880 return
2882 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2883 return
2885 $ctext conf -state normal
2886 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2887 # start of a new file
2888 $ctext insert end "\n"
2889 $ctext tag add $curdifftag $curtagstart end
2890 set curtagstart [$ctext index "end - 1c"]
2891 set header $newname
2892 set here [$ctext index "end - 1c"]
2893 set i [lsearch -exact $treediffs($diffids) $fname]
2894 if {$i >= 0} {
2895 set difffilestart($i) $here
2896 incr i
2897 $ctext mark set fmark.$i $here
2898 $ctext mark gravity fmark.$i left
2900 if {$newname != $fname} {
2901 set i [lsearch -exact $treediffs($diffids) $newname]
2902 if {$i >= 0} {
2903 set difffilestart($i) $here
2904 incr i
2905 $ctext mark set fmark.$i $here
2906 $ctext mark gravity fmark.$i left
2909 set curdifftag "f:$fname"
2910 $ctext tag delete $curdifftag
2911 set l [expr {(78 - [string length $header]) / 2}]
2912 set pad [string range "----------------------------------------" 1 $l]
2913 $ctext insert end "$pad $header $pad\n" filesep
2914 set diffinhdr 1
2915 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2916 # do nothing
2917 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2918 set diffinhdr 0
2919 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2920 $line match f1l f1c f2l f2c rest]} {
2921 $ctext insert end "$line\n" hunksep
2922 set diffinhdr 0
2923 } else {
2924 set x [string range $line 0 0]
2925 if {$x == "-" || $x == "+"} {
2926 set tag [expr {$x == "+"}]
2927 $ctext insert end "$line\n" d$tag
2928 } elseif {$x == " "} {
2929 $ctext insert end "$line\n"
2930 } elseif {$diffinhdr || $x == "\\"} {
2931 # e.g. "\ No newline at end of file"
2932 $ctext insert end "$line\n" filesep
2933 } else {
2934 # Something else we don't recognize
2935 if {$curdifftag != "Comments"} {
2936 $ctext insert end "\n"
2937 $ctext tag add $curdifftag $curtagstart end
2938 set curtagstart [$ctext index "end - 1c"]
2939 set curdifftag Comments
2941 $ctext insert end "$line\n" filesep
2944 $ctext conf -state disabled
2945 if {[clock clicks -milliseconds] >= $nextupdate} {
2946 incr nextupdate 100
2947 fileevent $bdf readable {}
2948 update
2949 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2953 proc nextfile {} {
2954 global difffilestart ctext
2955 set here [$ctext index @0,0]
2956 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2957 if {[$ctext compare $difffilestart($i) > $here]} {
2958 if {![info exists pos]
2959 || [$ctext compare $difffilestart($i) < $pos]} {
2960 set pos $difffilestart($i)
2964 if {[info exists pos]} {
2965 $ctext yview $pos
2969 proc listboxsel {} {
2970 global ctext cflist currentid
2971 if {![info exists currentid]} return
2972 set sel [lsort [$cflist curselection]]
2973 if {$sel eq {}} return
2974 set first [lindex $sel 0]
2975 catch {$ctext yview fmark.$first}
2978 proc setcoords {} {
2979 global linespc charspc canvx0 canvy0 mainfont
2980 global xspc1 xspc2 lthickness
2982 set linespc [font metrics $mainfont -linespace]
2983 set charspc [font measure $mainfont "m"]
2984 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2985 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2986 set lthickness [expr {int($linespc / 9) + 1}]
2987 set xspc1(0) $linespc
2988 set xspc2 $linespc
2991 proc redisplay {} {
2992 global canv
2993 global selectedline
2995 set ymax [lindex [$canv cget -scrollregion] 3]
2996 if {$ymax eq {} || $ymax == 0} return
2997 set span [$canv yview]
2998 clear_display
2999 setcanvscroll
3000 allcanvs yview moveto [lindex $span 0]
3001 drawvisible
3002 if {[info exists selectedline]} {
3003 selectline $selectedline 0
3007 proc incrfont {inc} {
3008 global mainfont namefont textfont ctext canv phase
3009 global stopped entries
3010 unmarkmatches
3011 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3012 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3013 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3014 setcoords
3015 $ctext conf -font $textfont
3016 $ctext tag conf filesep -font [concat $textfont bold]
3017 foreach e $entries {
3018 $e conf -font $mainfont
3020 if {$phase == "getcommits"} {
3021 $canv itemconf textitems -font $mainfont
3023 redisplay
3026 proc clearsha1 {} {
3027 global sha1entry sha1string
3028 if {[string length $sha1string] == 40} {
3029 $sha1entry delete 0 end
3033 proc sha1change {n1 n2 op} {
3034 global sha1string currentid sha1but
3035 if {$sha1string == {}
3036 || ([info exists currentid] && $sha1string == $currentid)} {
3037 set state disabled
3038 } else {
3039 set state normal
3041 if {[$sha1but cget -state] == $state} return
3042 if {$state == "normal"} {
3043 $sha1but conf -state normal -relief raised -text "Goto: "
3044 } else {
3045 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3049 proc gotocommit {} {
3050 global sha1string currentid commitrow tagids
3051 global displayorder numcommits
3053 if {$sha1string == {}
3054 || ([info exists currentid] && $sha1string == $currentid)} return
3055 if {[info exists tagids($sha1string)]} {
3056 set id $tagids($sha1string)
3057 } else {
3058 set id [string tolower $sha1string]
3059 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3060 set matches {}
3061 foreach i $displayorder {
3062 if {[string match $id* $i]} {
3063 lappend matches $i
3066 if {$matches ne {}} {
3067 if {[llength $matches] > 1} {
3068 error_popup "Short SHA1 id $id is ambiguous"
3069 return
3071 set id [lindex $matches 0]
3075 if {[info exists commitrow($id)]} {
3076 selectline $commitrow($id) 1
3077 return
3079 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3080 set type "SHA1 id"
3081 } else {
3082 set type "Tag"
3084 error_popup "$type $sha1string is not known"
3087 proc lineenter {x y id} {
3088 global hoverx hovery hoverid hovertimer
3089 global commitinfo canv
3091 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3092 set hoverx $x
3093 set hovery $y
3094 set hoverid $id
3095 if {[info exists hovertimer]} {
3096 after cancel $hovertimer
3098 set hovertimer [after 500 linehover]
3099 $canv delete hover
3102 proc linemotion {x y id} {
3103 global hoverx hovery hoverid hovertimer
3105 if {[info exists hoverid] && $id == $hoverid} {
3106 set hoverx $x
3107 set hovery $y
3108 if {[info exists hovertimer]} {
3109 after cancel $hovertimer
3111 set hovertimer [after 500 linehover]
3115 proc lineleave {id} {
3116 global hoverid hovertimer canv
3118 if {[info exists hoverid] && $id == $hoverid} {
3119 $canv delete hover
3120 if {[info exists hovertimer]} {
3121 after cancel $hovertimer
3122 unset hovertimer
3124 unset hoverid
3128 proc linehover {} {
3129 global hoverx hovery hoverid hovertimer
3130 global canv linespc lthickness
3131 global commitinfo mainfont
3133 set text [lindex $commitinfo($hoverid) 0]
3134 set ymax [lindex [$canv cget -scrollregion] 3]
3135 if {$ymax == {}} return
3136 set yfrac [lindex [$canv yview] 0]
3137 set x [expr {$hoverx + 2 * $linespc}]
3138 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3139 set x0 [expr {$x - 2 * $lthickness}]
3140 set y0 [expr {$y - 2 * $lthickness}]
3141 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3142 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3143 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3144 -fill \#ffff80 -outline black -width 1 -tags hover]
3145 $canv raise $t
3146 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3147 $canv raise $t
3150 proc clickisonarrow {id y} {
3151 global lthickness
3153 set ranges [rowranges $id]
3154 set thresh [expr {2 * $lthickness + 6}]
3155 set n [expr {[llength $ranges] - 1}]
3156 for {set i 1} {$i < $n} {incr i} {
3157 set row [lindex $ranges $i]
3158 if {abs([yc $row] - $y) < $thresh} {
3159 return $i
3162 return {}
3165 proc arrowjump {id n y} {
3166 global canv
3168 # 1 <-> 2, 3 <-> 4, etc...
3169 set n [expr {(($n - 1) ^ 1) + 1}]
3170 set row [lindex [rowranges $id] $n]
3171 set yt [yc $row]
3172 set ymax [lindex [$canv cget -scrollregion] 3]
3173 if {$ymax eq {} || $ymax <= 0} return
3174 set view [$canv yview]
3175 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3176 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3177 if {$yfrac < 0} {
3178 set yfrac 0
3180 allcanvs yview moveto $yfrac
3183 proc lineclick {x y id isnew} {
3184 global ctext commitinfo childlist commitrow cflist canv thickerline
3186 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3187 unmarkmatches
3188 unselectline
3189 normalline
3190 $canv delete hover
3191 # draw this line thicker than normal
3192 set thickerline $id
3193 drawlines $id
3194 if {$isnew} {
3195 set ymax [lindex [$canv cget -scrollregion] 3]
3196 if {$ymax eq {}} return
3197 set yfrac [lindex [$canv yview] 0]
3198 set y [expr {$y + $yfrac * $ymax}]
3200 set dirn [clickisonarrow $id $y]
3201 if {$dirn ne {}} {
3202 arrowjump $id $dirn $y
3203 return
3206 if {$isnew} {
3207 addtohistory [list lineclick $x $y $id 0]
3209 # fill the details pane with info about this line
3210 $ctext conf -state normal
3211 $ctext delete 0.0 end
3212 $ctext tag conf link -foreground blue -underline 1
3213 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3214 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3215 $ctext insert end "Parent:\t"
3216 $ctext insert end $id [list link link0]
3217 $ctext tag bind link0 <1> [list selbyid $id]
3218 set info $commitinfo($id)
3219 $ctext insert end "\n\t[lindex $info 0]\n"
3220 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3221 set date [formatdate [lindex $info 2]]
3222 $ctext insert end "\tDate:\t$date\n"
3223 set kids [lindex $childlist $commitrow($id)]
3224 if {$kids ne {}} {
3225 $ctext insert end "\nChildren:"
3226 set i 0
3227 foreach child $kids {
3228 incr i
3229 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3230 set info $commitinfo($child)
3231 $ctext insert end "\n\t"
3232 $ctext insert end $child [list link link$i]
3233 $ctext tag bind link$i <1> [list selbyid $child]
3234 $ctext insert end "\n\t[lindex $info 0]"
3235 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3236 set date [formatdate [lindex $info 2]]
3237 $ctext insert end "\n\tDate:\t$date\n"
3240 $ctext conf -state disabled
3242 $cflist delete 0 end
3245 proc normalline {} {
3246 global thickerline
3247 if {[info exists thickerline]} {
3248 set id $thickerline
3249 unset thickerline
3250 drawlines $id
3254 proc selbyid {id} {
3255 global commitrow
3256 if {[info exists commitrow($id)]} {
3257 selectline $commitrow($id) 1
3261 proc mstime {} {
3262 global startmstime
3263 if {![info exists startmstime]} {
3264 set startmstime [clock clicks -milliseconds]
3266 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3269 proc rowmenu {x y id} {
3270 global rowctxmenu commitrow selectedline rowmenuid
3272 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3273 set state disabled
3274 } else {
3275 set state normal
3277 $rowctxmenu entryconfigure 0 -state $state
3278 $rowctxmenu entryconfigure 1 -state $state
3279 $rowctxmenu entryconfigure 2 -state $state
3280 set rowmenuid $id
3281 tk_popup $rowctxmenu $x $y
3284 proc diffvssel {dirn} {
3285 global rowmenuid selectedline displayorder
3287 if {![info exists selectedline]} return
3288 if {$dirn} {
3289 set oldid [lindex $displayorder $selectedline]
3290 set newid $rowmenuid
3291 } else {
3292 set oldid $rowmenuid
3293 set newid [lindex $displayorder $selectedline]
3295 addtohistory [list doseldiff $oldid $newid]
3296 doseldiff $oldid $newid
3299 proc doseldiff {oldid newid} {
3300 global ctext cflist
3301 global commitinfo
3303 $ctext conf -state normal
3304 $ctext delete 0.0 end
3305 $ctext mark set fmark.0 0.0
3306 $ctext mark gravity fmark.0 left
3307 $cflist delete 0 end
3308 $cflist insert end "Top"
3309 $ctext insert end "From "
3310 $ctext tag conf link -foreground blue -underline 1
3311 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3312 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3313 $ctext tag bind link0 <1> [list selbyid $oldid]
3314 $ctext insert end $oldid [list link link0]
3315 $ctext insert end "\n "
3316 $ctext insert end [lindex $commitinfo($oldid) 0]
3317 $ctext insert end "\n\nTo "
3318 $ctext tag bind link1 <1> [list selbyid $newid]
3319 $ctext insert end $newid [list link link1]
3320 $ctext insert end "\n "
3321 $ctext insert end [lindex $commitinfo($newid) 0]
3322 $ctext insert end "\n"
3323 $ctext conf -state disabled
3324 $ctext tag delete Comments
3325 $ctext tag remove found 1.0 end
3326 startdiff [list $oldid $newid]
3329 proc mkpatch {} {
3330 global rowmenuid currentid commitinfo patchtop patchnum
3332 if {![info exists currentid]} return
3333 set oldid $currentid
3334 set oldhead [lindex $commitinfo($oldid) 0]
3335 set newid $rowmenuid
3336 set newhead [lindex $commitinfo($newid) 0]
3337 set top .patch
3338 set patchtop $top
3339 catch {destroy $top}
3340 toplevel $top
3341 label $top.title -text "Generate patch"
3342 grid $top.title - -pady 10
3343 label $top.from -text "From:"
3344 entry $top.fromsha1 -width 40 -relief flat
3345 $top.fromsha1 insert 0 $oldid
3346 $top.fromsha1 conf -state readonly
3347 grid $top.from $top.fromsha1 -sticky w
3348 entry $top.fromhead -width 60 -relief flat
3349 $top.fromhead insert 0 $oldhead
3350 $top.fromhead conf -state readonly
3351 grid x $top.fromhead -sticky w
3352 label $top.to -text "To:"
3353 entry $top.tosha1 -width 40 -relief flat
3354 $top.tosha1 insert 0 $newid
3355 $top.tosha1 conf -state readonly
3356 grid $top.to $top.tosha1 -sticky w
3357 entry $top.tohead -width 60 -relief flat
3358 $top.tohead insert 0 $newhead
3359 $top.tohead conf -state readonly
3360 grid x $top.tohead -sticky w
3361 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3362 grid $top.rev x -pady 10
3363 label $top.flab -text "Output file:"
3364 entry $top.fname -width 60
3365 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3366 incr patchnum
3367 grid $top.flab $top.fname -sticky w
3368 frame $top.buts
3369 button $top.buts.gen -text "Generate" -command mkpatchgo
3370 button $top.buts.can -text "Cancel" -command mkpatchcan
3371 grid $top.buts.gen $top.buts.can
3372 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3373 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3374 grid $top.buts - -pady 10 -sticky ew
3375 focus $top.fname
3378 proc mkpatchrev {} {
3379 global patchtop
3381 set oldid [$patchtop.fromsha1 get]
3382 set oldhead [$patchtop.fromhead get]
3383 set newid [$patchtop.tosha1 get]
3384 set newhead [$patchtop.tohead get]
3385 foreach e [list fromsha1 fromhead tosha1 tohead] \
3386 v [list $newid $newhead $oldid $oldhead] {
3387 $patchtop.$e conf -state normal
3388 $patchtop.$e delete 0 end
3389 $patchtop.$e insert 0 $v
3390 $patchtop.$e conf -state readonly
3394 proc mkpatchgo {} {
3395 global patchtop
3397 set oldid [$patchtop.fromsha1 get]
3398 set newid [$patchtop.tosha1 get]
3399 set fname [$patchtop.fname get]
3400 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3401 error_popup "Error creating patch: $err"
3403 catch {destroy $patchtop}
3404 unset patchtop
3407 proc mkpatchcan {} {
3408 global patchtop
3410 catch {destroy $patchtop}
3411 unset patchtop
3414 proc mktag {} {
3415 global rowmenuid mktagtop commitinfo
3417 set top .maketag
3418 set mktagtop $top
3419 catch {destroy $top}
3420 toplevel $top
3421 label $top.title -text "Create tag"
3422 grid $top.title - -pady 10
3423 label $top.id -text "ID:"
3424 entry $top.sha1 -width 40 -relief flat
3425 $top.sha1 insert 0 $rowmenuid
3426 $top.sha1 conf -state readonly
3427 grid $top.id $top.sha1 -sticky w
3428 entry $top.head -width 60 -relief flat
3429 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3430 $top.head conf -state readonly
3431 grid x $top.head -sticky w
3432 label $top.tlab -text "Tag name:"
3433 entry $top.tag -width 60
3434 grid $top.tlab $top.tag -sticky w
3435 frame $top.buts
3436 button $top.buts.gen -text "Create" -command mktaggo
3437 button $top.buts.can -text "Cancel" -command mktagcan
3438 grid $top.buts.gen $top.buts.can
3439 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3440 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3441 grid $top.buts - -pady 10 -sticky ew
3442 focus $top.tag
3445 proc domktag {} {
3446 global mktagtop env tagids idtags
3448 set id [$mktagtop.sha1 get]
3449 set tag [$mktagtop.tag get]
3450 if {$tag == {}} {
3451 error_popup "No tag name specified"
3452 return
3454 if {[info exists tagids($tag)]} {
3455 error_popup "Tag \"$tag\" already exists"
3456 return
3458 if {[catch {
3459 set dir [gitdir]
3460 set fname [file join $dir "refs/tags" $tag]
3461 set f [open $fname w]
3462 puts $f $id
3463 close $f
3464 } err]} {
3465 error_popup "Error creating tag: $err"
3466 return
3469 set tagids($tag) $id
3470 lappend idtags($id) $tag
3471 redrawtags $id
3474 proc redrawtags {id} {
3475 global canv linehtag commitrow idpos selectedline
3477 if {![info exists commitrow($id)]} return
3478 drawcmitrow $commitrow($id)
3479 $canv delete tag.$id
3480 set xt [eval drawtags $id $idpos($id)]
3481 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3482 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3483 selectline $selectedline 0
3487 proc mktagcan {} {
3488 global mktagtop
3490 catch {destroy $mktagtop}
3491 unset mktagtop
3494 proc mktaggo {} {
3495 domktag
3496 mktagcan
3499 proc writecommit {} {
3500 global rowmenuid wrcomtop commitinfo wrcomcmd
3502 set top .writecommit
3503 set wrcomtop $top
3504 catch {destroy $top}
3505 toplevel $top
3506 label $top.title -text "Write commit to file"
3507 grid $top.title - -pady 10
3508 label $top.id -text "ID:"
3509 entry $top.sha1 -width 40 -relief flat
3510 $top.sha1 insert 0 $rowmenuid
3511 $top.sha1 conf -state readonly
3512 grid $top.id $top.sha1 -sticky w
3513 entry $top.head -width 60 -relief flat
3514 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3515 $top.head conf -state readonly
3516 grid x $top.head -sticky w
3517 label $top.clab -text "Command:"
3518 entry $top.cmd -width 60 -textvariable wrcomcmd
3519 grid $top.clab $top.cmd -sticky w -pady 10
3520 label $top.flab -text "Output file:"
3521 entry $top.fname -width 60
3522 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3523 grid $top.flab $top.fname -sticky w
3524 frame $top.buts
3525 button $top.buts.gen -text "Write" -command wrcomgo
3526 button $top.buts.can -text "Cancel" -command wrcomcan
3527 grid $top.buts.gen $top.buts.can
3528 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3529 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3530 grid $top.buts - -pady 10 -sticky ew
3531 focus $top.fname
3534 proc wrcomgo {} {
3535 global wrcomtop
3537 set id [$wrcomtop.sha1 get]
3538 set cmd "echo $id | [$wrcomtop.cmd get]"
3539 set fname [$wrcomtop.fname get]
3540 if {[catch {exec sh -c $cmd >$fname &} err]} {
3541 error_popup "Error writing commit: $err"
3543 catch {destroy $wrcomtop}
3544 unset wrcomtop
3547 proc wrcomcan {} {
3548 global wrcomtop
3550 catch {destroy $wrcomtop}
3551 unset wrcomtop
3554 proc listrefs {id} {
3555 global idtags idheads idotherrefs
3557 set x {}
3558 if {[info exists idtags($id)]} {
3559 set x $idtags($id)
3561 set y {}
3562 if {[info exists idheads($id)]} {
3563 set y $idheads($id)
3565 set z {}
3566 if {[info exists idotherrefs($id)]} {
3567 set z $idotherrefs($id)
3569 return [list $x $y $z]
3572 proc rereadrefs {} {
3573 global idtags idheads idotherrefs
3574 global tagids headids otherrefids
3576 set refids [concat [array names idtags] \
3577 [array names idheads] [array names idotherrefs]]
3578 foreach id $refids {
3579 if {![info exists ref($id)]} {
3580 set ref($id) [listrefs $id]
3583 readrefs
3584 set refids [lsort -unique [concat $refids [array names idtags] \
3585 [array names idheads] [array names idotherrefs]]]
3586 foreach id $refids {
3587 set v [listrefs $id]
3588 if {![info exists ref($id)] || $ref($id) != $v} {
3589 redrawtags $id
3594 proc showtag {tag isnew} {
3595 global ctext cflist tagcontents tagids linknum
3597 if {$isnew} {
3598 addtohistory [list showtag $tag 0]
3600 $ctext conf -state normal
3601 $ctext delete 0.0 end
3602 set linknum 0
3603 if {[info exists tagcontents($tag)]} {
3604 set text $tagcontents($tag)
3605 } else {
3606 set text "Tag: $tag\nId: $tagids($tag)"
3608 appendwithlinks $text
3609 $ctext conf -state disabled
3610 $cflist delete 0 end
3613 proc doquit {} {
3614 global stopped
3615 set stopped 100
3616 destroy .
3619 proc doprefs {} {
3620 global maxwidth maxgraphpct diffopts findmergefiles
3621 global oldprefs prefstop
3623 set top .gitkprefs
3624 set prefstop $top
3625 if {[winfo exists $top]} {
3626 raise $top
3627 return
3629 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3630 set oldprefs($v) [set $v]
3632 toplevel $top
3633 wm title $top "Gitk preferences"
3634 label $top.ldisp -text "Commit list display options"
3635 grid $top.ldisp - -sticky w -pady 10
3636 label $top.spacer -text " "
3637 label $top.maxwidthl -text "Maximum graph width (lines)" \
3638 -font optionfont
3639 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3640 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3641 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3642 -font optionfont
3643 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3644 grid x $top.maxpctl $top.maxpct -sticky w
3645 checkbutton $top.findm -variable findmergefiles
3646 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3647 -font optionfont
3648 grid $top.findm $top.findml - -sticky w
3649 label $top.ddisp -text "Diff display options"
3650 grid $top.ddisp - -sticky w -pady 10
3651 label $top.diffoptl -text "Options for diff program" \
3652 -font optionfont
3653 entry $top.diffopt -width 20 -textvariable diffopts
3654 grid x $top.diffoptl $top.diffopt -sticky w
3655 frame $top.buts
3656 button $top.buts.ok -text "OK" -command prefsok
3657 button $top.buts.can -text "Cancel" -command prefscan
3658 grid $top.buts.ok $top.buts.can
3659 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3660 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3661 grid $top.buts - - -pady 10 -sticky ew
3664 proc prefscan {} {
3665 global maxwidth maxgraphpct diffopts findmergefiles
3666 global oldprefs prefstop
3668 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3669 set $v $oldprefs($v)
3671 catch {destroy $prefstop}
3672 unset prefstop
3675 proc prefsok {} {
3676 global maxwidth maxgraphpct
3677 global oldprefs prefstop
3679 catch {destroy $prefstop}
3680 unset prefstop
3681 if {$maxwidth != $oldprefs(maxwidth)
3682 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3683 redisplay
3687 proc formatdate {d} {
3688 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3691 # This list of encoding names and aliases is distilled from
3692 # http://www.iana.org/assignments/character-sets.
3693 # Not all of them are supported by Tcl.
3694 set encoding_aliases {
3695 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3696 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3697 { ISO-10646-UTF-1 csISO10646UTF1 }
3698 { ISO_646.basic:1983 ref csISO646basic1983 }
3699 { INVARIANT csINVARIANT }
3700 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3701 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3702 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3703 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3704 { NATS-DANO iso-ir-9-1 csNATSDANO }
3705 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3706 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3707 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3708 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3709 { ISO-2022-KR csISO2022KR }
3710 { EUC-KR csEUCKR }
3711 { ISO-2022-JP csISO2022JP }
3712 { ISO-2022-JP-2 csISO2022JP2 }
3713 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3714 csISO13JISC6220jp }
3715 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3716 { IT iso-ir-15 ISO646-IT csISO15Italian }
3717 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3718 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3719 { greek7-old iso-ir-18 csISO18Greek7Old }
3720 { latin-greek iso-ir-19 csISO19LatinGreek }
3721 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3722 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3723 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3724 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3725 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3726 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3727 { INIS iso-ir-49 csISO49INIS }
3728 { INIS-8 iso-ir-50 csISO50INIS8 }
3729 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3730 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3731 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3732 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3733 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3734 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3735 csISO60Norwegian1 }
3736 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3737 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3738 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3739 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3740 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3741 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3742 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3743 { greek7 iso-ir-88 csISO88Greek7 }
3744 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3745 { iso-ir-90 csISO90 }
3746 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3747 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3748 csISO92JISC62991984b }
3749 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3750 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3751 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3752 csISO95JIS62291984handadd }
3753 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3754 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3755 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3756 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3757 CP819 csISOLatin1 }
3758 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3759 { T.61-7bit iso-ir-102 csISO102T617bit }
3760 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3761 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3762 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3763 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3764 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3765 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3766 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3767 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3768 arabic csISOLatinArabic }
3769 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3770 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3771 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3772 greek greek8 csISOLatinGreek }
3773 { T.101-G2 iso-ir-128 csISO128T101G2 }
3774 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3775 csISOLatinHebrew }
3776 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3777 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3778 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3779 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3780 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3781 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3782 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3783 csISOLatinCyrillic }
3784 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3785 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3786 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3787 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3788 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3789 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3790 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3791 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3792 { ISO_10367-box iso-ir-155 csISO10367Box }
3793 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3794 { latin-lap lap iso-ir-158 csISO158Lap }
3795 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3796 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3797 { us-dk csUSDK }
3798 { dk-us csDKUS }
3799 { JIS_X0201 X0201 csHalfWidthKatakana }
3800 { KSC5636 ISO646-KR csKSC5636 }
3801 { ISO-10646-UCS-2 csUnicode }
3802 { ISO-10646-UCS-4 csUCS4 }
3803 { DEC-MCS dec csDECMCS }
3804 { hp-roman8 roman8 r8 csHPRoman8 }
3805 { macintosh mac csMacintosh }
3806 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3807 csIBM037 }
3808 { IBM038 EBCDIC-INT cp038 csIBM038 }
3809 { IBM273 CP273 csIBM273 }
3810 { IBM274 EBCDIC-BE CP274 csIBM274 }
3811 { IBM275 EBCDIC-BR cp275 csIBM275 }
3812 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3813 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3814 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3815 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3816 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3817 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3818 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3819 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3820 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3821 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3822 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3823 { IBM437 cp437 437 csPC8CodePage437 }
3824 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3825 { IBM775 cp775 csPC775Baltic }
3826 { IBM850 cp850 850 csPC850Multilingual }
3827 { IBM851 cp851 851 csIBM851 }
3828 { IBM852 cp852 852 csPCp852 }
3829 { IBM855 cp855 855 csIBM855 }
3830 { IBM857 cp857 857 csIBM857 }
3831 { IBM860 cp860 860 csIBM860 }
3832 { IBM861 cp861 861 cp-is csIBM861 }
3833 { IBM862 cp862 862 csPC862LatinHebrew }
3834 { IBM863 cp863 863 csIBM863 }
3835 { IBM864 cp864 csIBM864 }
3836 { IBM865 cp865 865 csIBM865 }
3837 { IBM866 cp866 866 csIBM866 }
3838 { IBM868 CP868 cp-ar csIBM868 }
3839 { IBM869 cp869 869 cp-gr csIBM869 }
3840 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3841 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3842 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3843 { IBM891 cp891 csIBM891 }
3844 { IBM903 cp903 csIBM903 }
3845 { IBM904 cp904 904 csIBBM904 }
3846 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3847 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3848 { IBM1026 CP1026 csIBM1026 }
3849 { EBCDIC-AT-DE csIBMEBCDICATDE }
3850 { EBCDIC-AT-DE-A csEBCDICATDEA }
3851 { EBCDIC-CA-FR csEBCDICCAFR }
3852 { EBCDIC-DK-NO csEBCDICDKNO }
3853 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3854 { EBCDIC-FI-SE csEBCDICFISE }
3855 { EBCDIC-FI-SE-A csEBCDICFISEA }
3856 { EBCDIC-FR csEBCDICFR }
3857 { EBCDIC-IT csEBCDICIT }
3858 { EBCDIC-PT csEBCDICPT }
3859 { EBCDIC-ES csEBCDICES }
3860 { EBCDIC-ES-A csEBCDICESA }
3861 { EBCDIC-ES-S csEBCDICESS }
3862 { EBCDIC-UK csEBCDICUK }
3863 { EBCDIC-US csEBCDICUS }
3864 { UNKNOWN-8BIT csUnknown8BiT }
3865 { MNEMONIC csMnemonic }
3866 { MNEM csMnem }
3867 { VISCII csVISCII }
3868 { VIQR csVIQR }
3869 { KOI8-R csKOI8R }
3870 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3871 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3872 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3873 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3874 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3875 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3876 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3877 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3878 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3879 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3880 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3881 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3882 { IBM1047 IBM-1047 }
3883 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3884 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3885 { UNICODE-1-1 csUnicode11 }
3886 { CESU-8 csCESU-8 }
3887 { BOCU-1 csBOCU-1 }
3888 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3889 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3890 l8 }
3891 { ISO-8859-15 ISO_8859-15 Latin-9 }
3892 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3893 { GBK CP936 MS936 windows-936 }
3894 { JIS_Encoding csJISEncoding }
3895 { Shift_JIS MS_Kanji csShiftJIS }
3896 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3897 EUC-JP }
3898 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3899 { ISO-10646-UCS-Basic csUnicodeASCII }
3900 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3901 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3902 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3903 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3904 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3905 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3906 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3907 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3908 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3909 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3910 { Adobe-Standard-Encoding csAdobeStandardEncoding }
3911 { Ventura-US csVenturaUS }
3912 { Ventura-International csVenturaInternational }
3913 { PC8-Danish-Norwegian csPC8DanishNorwegian }
3914 { PC8-Turkish csPC8Turkish }
3915 { IBM-Symbols csIBMSymbols }
3916 { IBM-Thai csIBMThai }
3917 { HP-Legal csHPLegal }
3918 { HP-Pi-font csHPPiFont }
3919 { HP-Math8 csHPMath8 }
3920 { Adobe-Symbol-Encoding csHPPSMath }
3921 { HP-DeskTop csHPDesktop }
3922 { Ventura-Math csVenturaMath }
3923 { Microsoft-Publishing csMicrosoftPublishing }
3924 { Windows-31J csWindows31J }
3925 { GB2312 csGB2312 }
3926 { Big5 csBig5 }
3929 proc tcl_encoding {enc} {
3930 global encoding_aliases
3931 set names [encoding names]
3932 set lcnames [string tolower $names]
3933 set enc [string tolower $enc]
3934 set i [lsearch -exact $lcnames $enc]
3935 if {$i < 0} {
3936 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3937 if {[regsub {^iso[-_]} $enc iso encx]} {
3938 set i [lsearch -exact $lcnames $encx]
3941 if {$i < 0} {
3942 foreach l $encoding_aliases {
3943 set ll [string tolower $l]
3944 if {[lsearch -exact $ll $enc] < 0} continue
3945 # look through the aliases for one that tcl knows about
3946 foreach e $ll {
3947 set i [lsearch -exact $lcnames $e]
3948 if {$i < 0} {
3949 if {[regsub {^iso[-_]} $e iso ex]} {
3950 set i [lsearch -exact $lcnames $ex]
3953 if {$i >= 0} break
3955 break
3958 if {$i >= 0} {
3959 return [lindex $names $i]
3961 return {}
3964 # defaults...
3965 set datemode 0
3966 set diffopts "-U 5 -p"
3967 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3969 set gitencoding {}
3970 catch {
3971 set gitencoding [exec git-repo-config --get i18n.commitencoding]
3973 if {$gitencoding == ""} {
3974 set gitencoding "utf-8"
3976 set tclencoding [tcl_encoding $gitencoding]
3977 if {$tclencoding == {}} {
3978 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3981 set mainfont {Helvetica 9}
3982 set textfont {Courier 9}
3983 set findmergefiles 0
3984 set maxgraphpct 50
3985 set maxwidth 16
3986 set revlistorder 0
3987 set fastdate 0
3988 set uparrowlen 7
3989 set downarrowlen 7
3990 set mingaplen 30
3992 set colors {green red blue magenta darkgrey brown orange}
3994 catch {source ~/.gitk}
3996 set namefont $mainfont
3998 font create optionfont -family sans-serif -size -12
4000 set revtreeargs {}
4001 foreach arg $argv {
4002 switch -regexp -- $arg {
4003 "^$" { }
4004 "^-d" { set datemode 1 }
4005 default {
4006 lappend revtreeargs $arg
4011 # check that we can find a .git directory somewhere...
4012 set gitdir [gitdir]
4013 if {![file isdirectory $gitdir]} {
4014 error_popup "Cannot find the git directory \"$gitdir\"."
4015 exit 1
4018 set history {}
4019 set historyindex 0
4021 set optim_delay 16
4023 set nextviewnum 1
4024 set curview 0
4025 set viewfiles(0) {}
4027 set stopped 0
4028 set stuffsaved 0
4029 set patchnum 0
4030 setcoords
4031 makewindow
4032 readrefs
4033 parse_args $revtreeargs
4034 set args $parsed_args
4035 if {$cmdline_files ne {}} {
4036 # create a view for the files/dirs specified on the command line
4037 set curview 1
4038 set nextviewnum 2
4039 set viewname(1) "Command line"
4040 set viewfiles(1) $cmdline_files
4041 .bar.view add command -label $viewname(1) -command {showview 1}
4042 .bar.view entryconf 2 -state normal
4043 set args [concat $args "--" $cmdline_files]
4045 getcommits $args