Merge branch 'master' into new
[git/mingw.git] / gitk
blob4ee51223b7cd08a3972a245b33545139cff26597
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc start_rev_list {} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global revtreeargs curview viewfiles
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
26 set ncmupdate 1
27 initlayout
28 set args $revtreeargs
29 if {$viewfiles($curview) ne {}} {
30 set args [concat $args "--" $viewfiles($curview)]
32 set order "--topo-order"
33 if {$datemode} {
34 set order "--date-order"
36 if {[catch {
37 set commfd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
39 } err]} {
40 puts stderr "Error executing git-rev-list: $err"
41 exit 1
43 set leftover {}
44 fconfigure $commfd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure $commfd -encoding $tclencoding
48 fileevent $commfd readable [list getcommitlines $commfd]
49 . config -cursor watch
50 settextcursor watch
53 proc stop_rev_list {} {
54 global commfd
56 if {![info exists commfd]} return
57 catch {
58 set pid [pid $commfd]
59 exec kill $pid
61 catch {close $commfd}
62 unset commfd
65 proc getcommits {} {
66 global phase canv mainfont
68 set phase getcommits
69 start_rev_list
70 $canv delete all
71 $canv create text 3 3 -anchor nw -text "Reading commits..." \
72 -font $mainfont -tags textitems
75 proc getcommitlines {commfd} {
76 global commitlisted nextupdate
77 global leftover
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children
81 set stuff [read $commfd]
82 if {$stuff == {}} {
83 if {![eof $commfd]} return
84 # set it blocking so we wait for the process to terminate
85 fconfigure $commfd -blocking 1
86 if {![catch {close $commfd} err]} {
87 after idle finishcommits
88 return
90 if {[string range $err 0 4] == "usage"} {
91 set err \
92 "Gitk: error reading commits: bad arguments to git-rev-list.\
93 (Note: arguments to gitk are passed to git-rev-list\
94 to allow selection of commits to be displayed.)"
95 } else {
96 set err "Error reading commits: $err"
98 error_popup $err
99 exit 1
101 set start 0
102 set gotsome 0
103 while 1 {
104 set i [string first "\0" $stuff $start]
105 if {$i < 0} {
106 append leftover [string range $stuff $start end]
107 break
109 if {$start == 0} {
110 set cmit $leftover
111 append cmit [string range $stuff 0 [expr {$i - 1}]]
112 set leftover {}
113 } else {
114 set cmit [string range $stuff $start [expr {$i - 1}]]
116 set start [expr {$i + 1}]
117 set j [string first "\n" $cmit]
118 set ok 0
119 set listed 1
120 if {$j >= 0} {
121 set ids [string range $cmit 0 [expr {$j - 1}]]
122 if {[string range $ids 0 0] == "-"} {
123 set listed 0
124 set ids [string range $ids 1 end]
126 set ok 1
127 foreach id $ids {
128 if {[string length $id] != 40} {
129 set ok 0
130 break
134 if {!$ok} {
135 set shortcmit $cmit
136 if {[string length $shortcmit] > 80} {
137 set shortcmit "[string range $shortcmit 0 80]..."
139 error_popup "Can't parse git-rev-list output: {$shortcmit}"
140 exit 1
142 set id [lindex $ids 0]
143 if {$listed} {
144 set olds [lrange $ids 1 end]
145 set i 0
146 foreach p $olds {
147 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
148 lappend children($p) $id
150 incr i
152 } else {
153 set olds {}
155 lappend parentlist $olds
156 if {[info exists children($id)]} {
157 lappend childlist $children($id)
158 unset children($id)
159 } else {
160 lappend childlist {}
162 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
163 set commitrow($id) $commitidx
164 incr commitidx
165 lappend displayorder $id
166 lappend commitlisted $listed
167 set gotsome 1
169 if {$gotsome} {
170 layoutmore
172 if {[clock clicks -milliseconds] >= $nextupdate} {
173 doupdate 1
177 proc doupdate {reading} {
178 global commfd nextupdate numcommits ncmupdate
180 if {$reading} {
181 fileevent $commfd readable {}
183 update
184 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
185 if {$numcommits < 100} {
186 set ncmupdate [expr {$numcommits + 1}]
187 } elseif {$numcommits < 10000} {
188 set ncmupdate [expr {$numcommits + 10}]
189 } else {
190 set ncmupdate [expr {$numcommits + 100}]
192 if {$reading} {
193 fileevent $commfd readable [list getcommitlines $commfd]
197 proc readcommit {id} {
198 if {[catch {set contents [exec git-cat-file commit $id]}]} return
199 parsecommit $id $contents 0
202 proc updatecommits {} {
203 global viewdata curview revtreeargs phase
205 if {$phase ne {}} {
206 stop_rev_list
207 set phase {}
209 set n $curview
210 set curview -1
211 catch {unset viewdata($n)}
212 readrefs
213 showview $n
216 proc parsecommit {id contents listed} {
217 global commitinfo cdate
219 set inhdr 1
220 set comment {}
221 set headline {}
222 set auname {}
223 set audate {}
224 set comname {}
225 set comdate {}
226 set hdrend [string first "\n\n" $contents]
227 if {$hdrend < 0} {
228 # should never happen...
229 set hdrend [string length $contents]
231 set header [string range $contents 0 [expr {$hdrend - 1}]]
232 set comment [string range $contents [expr {$hdrend + 2}] end]
233 foreach line [split $header "\n"] {
234 set tag [lindex $line 0]
235 if {$tag == "author"} {
236 set audate [lindex $line end-1]
237 set auname [lrange $line 1 end-2]
238 } elseif {$tag == "committer"} {
239 set comdate [lindex $line end-1]
240 set comname [lrange $line 1 end-2]
243 set headline {}
244 # take the first line of the comment as the headline
245 set i [string first "\n" $comment]
246 if {$i >= 0} {
247 set headline [string trim [string range $comment 0 $i]]
248 } else {
249 set headline $comment
251 if {!$listed} {
252 # git-rev-list indents the comment by 4 spaces;
253 # if we got this via git-cat-file, add the indentation
254 set newcomment {}
255 foreach line [split $comment "\n"] {
256 append newcomment " "
257 append newcomment $line
258 append newcomment "\n"
260 set comment $newcomment
262 if {$comdate != {}} {
263 set cdate($id) $comdate
265 set commitinfo($id) [list $headline $auname $audate \
266 $comname $comdate $comment]
269 proc getcommit {id} {
270 global commitdata commitinfo
272 if {[info exists commitdata($id)]} {
273 parsecommit $id $commitdata($id) 1
274 } else {
275 readcommit $id
276 if {![info exists commitinfo($id)]} {
277 set commitinfo($id) {"No commit information available"}
280 return 1
283 proc readrefs {} {
284 global tagids idtags headids idheads tagcontents
285 global otherrefids idotherrefs
287 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
288 catch {unset $v}
290 set refd [open [list | git ls-remote [gitdir]] r]
291 while {0 <= [set n [gets $refd line]]} {
292 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
293 match id path]} {
294 continue
296 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
297 set type others
298 set name $path
300 if {$type == "tags"} {
301 set tagids($name) $id
302 lappend idtags($id) $name
303 set obj {}
304 set type {}
305 set tag {}
306 catch {
307 set commit [exec git-rev-parse "$id^0"]
308 if {"$commit" != "$id"} {
309 set tagids($name) $commit
310 lappend idtags($commit) $name
313 catch {
314 set tagcontents($name) [exec git-cat-file tag "$id"]
316 } elseif { $type == "heads" } {
317 set headids($name) $id
318 lappend idheads($id) $name
319 } else {
320 set otherrefids($name) $id
321 lappend idotherrefs($id) $name
324 close $refd
327 proc error_popup msg {
328 set w .error
329 toplevel $w
330 wm transient $w .
331 message $w.m -text $msg -justify center -aspect 400
332 pack $w.m -side top -fill x -padx 20 -pady 20
333 button $w.ok -text OK -command "destroy $w"
334 pack $w.ok -side bottom -fill x
335 bind $w <Visibility> "grab $w; focus $w"
336 bind $w <Key-Return> "destroy $w"
337 tkwait window $w
340 proc makewindow {} {
341 global canv canv2 canv3 linespc charspc ctext cflist
342 global textfont mainfont uifont
343 global findtype findtypemenu findloc findstring fstring geometry
344 global entries sha1entry sha1string sha1but
345 global maincursor textcursor curtextcursor
346 global rowctxmenu mergemax
348 menu .bar
349 .bar add cascade -label "File" -menu .bar.file
350 .bar configure -font $uifont
351 menu .bar.file
352 .bar.file add command -label "Update" -command updatecommits
353 .bar.file add command -label "Reread references" -command rereadrefs
354 .bar.file add command -label "Quit" -command doquit
355 .bar.file configure -font $uifont
356 menu .bar.edit
357 .bar add cascade -label "Edit" -menu .bar.edit
358 .bar.edit add command -label "Preferences" -command doprefs
359 .bar.edit configure -font $uifont
360 menu .bar.view -font $uifont
361 .bar add cascade -label "View" -menu .bar.view
362 .bar.view add command -label "New view..." -command newview
363 .bar.view add command -label "Delete view" -command delview -state disabled
364 .bar.view add separator
365 .bar.view add command -label "All files" -command {showview 0}
366 menu .bar.help
367 .bar add cascade -label "Help" -menu .bar.help
368 .bar.help add command -label "About gitk" -command about
369 .bar.help add command -label "Key bindings" -command keys
370 .bar.help configure -font $uifont
371 . configure -menu .bar
373 if {![info exists geometry(canv1)]} {
374 set geometry(canv1) [expr {45 * $charspc}]
375 set geometry(canv2) [expr {30 * $charspc}]
376 set geometry(canv3) [expr {15 * $charspc}]
377 set geometry(canvh) [expr {25 * $linespc + 4}]
378 set geometry(ctextw) 80
379 set geometry(ctexth) 30
380 set geometry(cflistw) 30
382 panedwindow .ctop -orient vertical
383 if {[info exists geometry(width)]} {
384 .ctop conf -width $geometry(width) -height $geometry(height)
385 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
386 set geometry(ctexth) [expr {($texth - 8) /
387 [font metrics $textfont -linespace]}]
389 frame .ctop.top
390 frame .ctop.top.bar
391 pack .ctop.top.bar -side bottom -fill x
392 set cscroll .ctop.top.csb
393 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
394 pack $cscroll -side right -fill y
395 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
396 pack .ctop.top.clist -side top -fill both -expand 1
397 .ctop add .ctop.top
398 set canv .ctop.top.clist.canv
399 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
400 -bg white -bd 0 \
401 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
402 .ctop.top.clist add $canv
403 set canv2 .ctop.top.clist.canv2
404 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
405 -bg white -bd 0 -yscrollincr $linespc
406 .ctop.top.clist add $canv2
407 set canv3 .ctop.top.clist.canv3
408 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
409 -bg white -bd 0 -yscrollincr $linespc
410 .ctop.top.clist add $canv3
411 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
413 set sha1entry .ctop.top.bar.sha1
414 set entries $sha1entry
415 set sha1but .ctop.top.bar.sha1label
416 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
417 -command gotocommit -width 8 -font $uifont
418 $sha1but conf -disabledforeground [$sha1but cget -foreground]
419 pack .ctop.top.bar.sha1label -side left
420 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
421 trace add variable sha1string write sha1change
422 pack $sha1entry -side left -pady 2
424 image create bitmap bm-left -data {
425 #define left_width 16
426 #define left_height 16
427 static unsigned char left_bits[] = {
428 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
429 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
430 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
432 image create bitmap bm-right -data {
433 #define right_width 16
434 #define right_height 16
435 static unsigned char right_bits[] = {
436 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
437 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
438 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
440 button .ctop.top.bar.leftbut -image bm-left -command goback \
441 -state disabled -width 26
442 pack .ctop.top.bar.leftbut -side left -fill y
443 button .ctop.top.bar.rightbut -image bm-right -command goforw \
444 -state disabled -width 26
445 pack .ctop.top.bar.rightbut -side left -fill y
447 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
448 pack .ctop.top.bar.findbut -side left
449 set findstring {}
450 set fstring .ctop.top.bar.findstring
451 lappend entries $fstring
452 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
453 pack $fstring -side left -expand 1 -fill x
454 set findtype Exact
455 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
456 findtype Exact IgnCase Regexp]
457 .ctop.top.bar.findtype configure -font $uifont
458 .ctop.top.bar.findtype.menu configure -font $uifont
459 set findloc "All fields"
460 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
461 Comments Author Committer Files Pickaxe
462 .ctop.top.bar.findloc configure -font $uifont
463 .ctop.top.bar.findloc.menu configure -font $uifont
465 pack .ctop.top.bar.findloc -side right
466 pack .ctop.top.bar.findtype -side right
467 # for making sure type==Exact whenever loc==Pickaxe
468 trace add variable findloc write findlocchange
470 panedwindow .ctop.cdet -orient horizontal
471 .ctop add .ctop.cdet
472 frame .ctop.cdet.left
473 set ctext .ctop.cdet.left.ctext
474 text $ctext -bg white -state disabled -font $textfont \
475 -width $geometry(ctextw) -height $geometry(ctexth) \
476 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
477 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
478 pack .ctop.cdet.left.sb -side right -fill y
479 pack $ctext -side left -fill both -expand 1
480 .ctop.cdet add .ctop.cdet.left
482 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
483 $ctext tag conf hunksep -fore blue
484 $ctext tag conf d0 -fore red
485 $ctext tag conf d1 -fore "#00a000"
486 $ctext tag conf m0 -fore red
487 $ctext tag conf m1 -fore blue
488 $ctext tag conf m2 -fore green
489 $ctext tag conf m3 -fore purple
490 $ctext tag conf m4 -fore brown
491 $ctext tag conf m5 -fore "#009090"
492 $ctext tag conf m6 -fore magenta
493 $ctext tag conf m7 -fore "#808000"
494 $ctext tag conf m8 -fore "#009000"
495 $ctext tag conf m9 -fore "#ff0080"
496 $ctext tag conf m10 -fore cyan
497 $ctext tag conf m11 -fore "#b07070"
498 $ctext tag conf m12 -fore "#70b0f0"
499 $ctext tag conf m13 -fore "#70f0b0"
500 $ctext tag conf m14 -fore "#f0b070"
501 $ctext tag conf m15 -fore "#ff70b0"
502 $ctext tag conf mmax -fore darkgrey
503 set mergemax 16
504 $ctext tag conf mresult -font [concat $textfont bold]
505 $ctext tag conf msep -font [concat $textfont bold]
506 $ctext tag conf found -back yellow
508 frame .ctop.cdet.right
509 set cflist .ctop.cdet.right.cfiles
510 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
511 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
512 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
513 pack .ctop.cdet.right.sb -side right -fill y
514 pack $cflist -side left -fill both -expand 1
515 .ctop.cdet add .ctop.cdet.right
516 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
518 pack .ctop -side top -fill both -expand 1
520 bindall <1> {selcanvline %W %x %y}
521 #bindall <B1-Motion> {selcanvline %W %x %y}
522 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
523 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
524 bindall <2> "canvscan mark %W %x %y"
525 bindall <B2-Motion> "canvscan dragto %W %x %y"
526 bindkey <Home> selfirstline
527 bindkey <End> sellastline
528 bind . <Key-Up> "selnextline -1"
529 bind . <Key-Down> "selnextline 1"
530 bindkey <Key-Right> "goforw"
531 bindkey <Key-Left> "goback"
532 bind . <Key-Prior> "selnextpage -1"
533 bind . <Key-Next> "selnextpage 1"
534 bind . <Control-Home> "allcanvs yview moveto 0.0"
535 bind . <Control-End> "allcanvs yview moveto 1.0"
536 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
537 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
538 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
539 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
540 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
541 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
542 bindkey <Key-space> "$ctext yview scroll 1 pages"
543 bindkey p "selnextline -1"
544 bindkey n "selnextline 1"
545 bindkey z "goback"
546 bindkey x "goforw"
547 bindkey i "selnextline -1"
548 bindkey k "selnextline 1"
549 bindkey j "goback"
550 bindkey l "goforw"
551 bindkey b "$ctext yview scroll -1 pages"
552 bindkey d "$ctext yview scroll 18 units"
553 bindkey u "$ctext yview scroll -18 units"
554 bindkey / {findnext 1}
555 bindkey <Key-Return> {findnext 0}
556 bindkey ? findprev
557 bindkey f nextfile
558 bind . <Control-q> doquit
559 bind . <Control-f> dofind
560 bind . <Control-g> {findnext 0}
561 bind . <Control-r> findprev
562 bind . <Control-equal> {incrfont 1}
563 bind . <Control-KP_Add> {incrfont 1}
564 bind . <Control-minus> {incrfont -1}
565 bind . <Control-KP_Subtract> {incrfont -1}
566 bind $cflist <<ListboxSelect>> listboxsel
567 bind . <Destroy> {savestuff %W}
568 bind . <Button-1> "click %W"
569 bind $fstring <Key-Return> dofind
570 bind $sha1entry <Key-Return> gotocommit
571 bind $sha1entry <<PasteSelection>> clearsha1
573 set maincursor [. cget -cursor]
574 set textcursor [$ctext cget -cursor]
575 set curtextcursor $textcursor
577 set rowctxmenu .rowctxmenu
578 menu $rowctxmenu -tearoff 0
579 $rowctxmenu add command -label "Diff this -> selected" \
580 -command {diffvssel 0}
581 $rowctxmenu add command -label "Diff selected -> this" \
582 -command {diffvssel 1}
583 $rowctxmenu add command -label "Make patch" -command mkpatch
584 $rowctxmenu add command -label "Create tag" -command mktag
585 $rowctxmenu add command -label "Write commit to file" -command writecommit
588 # mouse-2 makes all windows scan vertically, but only the one
589 # the cursor is in scans horizontally
590 proc canvscan {op w x y} {
591 global canv canv2 canv3
592 foreach c [list $canv $canv2 $canv3] {
593 if {$c == $w} {
594 $c scan $op $x $y
595 } else {
596 $c scan $op 0 $y
601 proc scrollcanv {cscroll f0 f1} {
602 $cscroll set $f0 $f1
603 drawfrac $f0 $f1
606 # when we make a key binding for the toplevel, make sure
607 # it doesn't get triggered when that key is pressed in the
608 # find string entry widget.
609 proc bindkey {ev script} {
610 global entries
611 bind . $ev $script
612 set escript [bind Entry $ev]
613 if {$escript == {}} {
614 set escript [bind Entry <Key>]
616 foreach e $entries {
617 bind $e $ev "$escript; break"
621 # set the focus back to the toplevel for any click outside
622 # the entry widgets
623 proc click {w} {
624 global entries
625 foreach e $entries {
626 if {$w == $e} return
628 focus .
631 proc savestuff {w} {
632 global canv canv2 canv3 ctext cflist mainfont textfont uifont
633 global stuffsaved findmergefiles maxgraphpct
634 global maxwidth
636 if {$stuffsaved} return
637 if {![winfo viewable .]} return
638 catch {
639 set f [open "~/.gitk-new" w]
640 puts $f [list set mainfont $mainfont]
641 puts $f [list set textfont $textfont]
642 puts $f [list set uifont $uifont]
643 puts $f [list set findmergefiles $findmergefiles]
644 puts $f [list set maxgraphpct $maxgraphpct]
645 puts $f [list set maxwidth $maxwidth]
646 puts $f "set geometry(width) [winfo width .ctop]"
647 puts $f "set geometry(height) [winfo height .ctop]"
648 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
649 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
650 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
651 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
652 set wid [expr {([winfo width $ctext] - 8) \
653 / [font measure $textfont "0"]}]
654 puts $f "set geometry(ctextw) $wid"
655 set wid [expr {([winfo width $cflist] - 11) \
656 / [font measure [$cflist cget -font] "0"]}]
657 puts $f "set geometry(cflistw) $wid"
658 close $f
659 file rename -force "~/.gitk-new" "~/.gitk"
661 set stuffsaved 1
664 proc resizeclistpanes {win w} {
665 global oldwidth
666 if {[info exists oldwidth($win)]} {
667 set s0 [$win sash coord 0]
668 set s1 [$win sash coord 1]
669 if {$w < 60} {
670 set sash0 [expr {int($w/2 - 2)}]
671 set sash1 [expr {int($w*5/6 - 2)}]
672 } else {
673 set factor [expr {1.0 * $w / $oldwidth($win)}]
674 set sash0 [expr {int($factor * [lindex $s0 0])}]
675 set sash1 [expr {int($factor * [lindex $s1 0])}]
676 if {$sash0 < 30} {
677 set sash0 30
679 if {$sash1 < $sash0 + 20} {
680 set sash1 [expr {$sash0 + 20}]
682 if {$sash1 > $w - 10} {
683 set sash1 [expr {$w - 10}]
684 if {$sash0 > $sash1 - 20} {
685 set sash0 [expr {$sash1 - 20}]
689 $win sash place 0 $sash0 [lindex $s0 1]
690 $win sash place 1 $sash1 [lindex $s1 1]
692 set oldwidth($win) $w
695 proc resizecdetpanes {win w} {
696 global oldwidth
697 if {[info exists oldwidth($win)]} {
698 set s0 [$win sash coord 0]
699 if {$w < 60} {
700 set sash0 [expr {int($w*3/4 - 2)}]
701 } else {
702 set factor [expr {1.0 * $w / $oldwidth($win)}]
703 set sash0 [expr {int($factor * [lindex $s0 0])}]
704 if {$sash0 < 45} {
705 set sash0 45
707 if {$sash0 > $w - 15} {
708 set sash0 [expr {$w - 15}]
711 $win sash place 0 $sash0 [lindex $s0 1]
713 set oldwidth($win) $w
716 proc allcanvs args {
717 global canv canv2 canv3
718 eval $canv $args
719 eval $canv2 $args
720 eval $canv3 $args
723 proc bindall {event action} {
724 global canv canv2 canv3
725 bind $canv $event $action
726 bind $canv2 $event $action
727 bind $canv3 $event $action
730 proc about {} {
731 set w .about
732 if {[winfo exists $w]} {
733 raise $w
734 return
736 toplevel $w
737 wm title $w "About gitk"
738 message $w.m -text {
739 Gitk - a commit viewer for git
741 Copyright © 2005-2006 Paul Mackerras
743 Use and redistribute under the terms of the GNU General Public License} \
744 -justify center -aspect 400
745 pack $w.m -side top -fill x -padx 20 -pady 20
746 button $w.ok -text Close -command "destroy $w"
747 pack $w.ok -side bottom
750 proc keys {} {
751 set w .keys
752 if {[winfo exists $w]} {
753 raise $w
754 return
756 toplevel $w
757 wm title $w "Gitk key bindings"
758 message $w.m -text {
759 Gitk key bindings:
761 <Ctrl-Q> Quit
762 <Home> Move to first commit
763 <End> Move to last commit
764 <Up>, p, i Move up one commit
765 <Down>, n, k Move down one commit
766 <Left>, z, j Go back in history list
767 <Right>, x, l Go forward in history list
768 <PageUp> Move up one page in commit list
769 <PageDown> Move down one page in commit list
770 <Ctrl-Home> Scroll to top of commit list
771 <Ctrl-End> Scroll to bottom of commit list
772 <Ctrl-Up> Scroll commit list up one line
773 <Ctrl-Down> Scroll commit list down one line
774 <Ctrl-PageUp> Scroll commit list up one page
775 <Ctrl-PageDown> Scroll commit list down one page
776 <Delete>, b Scroll diff view up one page
777 <Backspace> Scroll diff view up one page
778 <Space> Scroll diff view down one page
779 u Scroll diff view up 18 lines
780 d Scroll diff view down 18 lines
781 <Ctrl-F> Find
782 <Ctrl-G> Move to next find hit
783 <Ctrl-R> Move to previous find hit
784 <Return> Move to next find hit
785 / Move to next find hit, or redo find
786 ? Move to previous find hit
787 f Scroll diff view to next file
788 <Ctrl-KP+> Increase font size
789 <Ctrl-plus> Increase font size
790 <Ctrl-KP-> Decrease font size
791 <Ctrl-minus> Decrease font size
793 -justify left -bg white -border 2 -relief sunken
794 pack $w.m -side top -fill both
795 button $w.ok -text Close -command "destroy $w"
796 pack $w.ok -side bottom
799 proc newview {} {
800 global newviewname nextviewnum newviewtop
802 set top .gitkview
803 if {[winfo exists $top]} {
804 raise $top
805 return
807 set newviewtop $top
808 toplevel $top
809 wm title $top "Gitk view definition"
810 label $top.nl -text "Name"
811 entry $top.name -width 20 -textvariable newviewname
812 set newviewname "View $nextviewnum"
813 grid $top.nl $top.name -sticky w
814 label $top.l -text "Files and directories to include:"
815 grid $top.l - -sticky w -pady 10
816 text $top.t -width 30 -height 10
817 grid $top.t - -sticky w
818 frame $top.buts
819 button $top.buts.ok -text "OK" -command newviewok
820 button $top.buts.can -text "Cancel" -command newviewcan
821 grid $top.buts.ok $top.buts.can
822 grid columnconfigure $top.buts 0 -weight 1 -uniform a
823 grid columnconfigure $top.buts 1 -weight 1 -uniform a
824 grid $top.buts - -pady 10 -sticky ew
825 focus $top.t
828 proc newviewok {} {
829 global newviewtop nextviewnum
830 global viewname viewfiles
832 set n $nextviewnum
833 incr nextviewnum
834 set viewname($n) [$newviewtop.name get]
835 set files {}
836 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
837 set ft [string trim $f]
838 if {$ft ne {}} {
839 lappend files $ft
842 set viewfiles($n) $files
843 catch {destroy $newviewtop}
844 unset newviewtop
845 .bar.view add command -label $viewname($n) -command [list showview $n]
846 after idle showview $n
849 proc newviewcan {} {
850 global newviewtop
852 catch {destroy $newviewtop}
853 unset newviewtop
856 proc delview {} {
857 global curview viewdata
859 if {$curview == 0} return
860 set nmenu [.bar.view index end]
861 set targetcmd [list showview $curview]
862 for {set i 5} {$i <= $nmenu} {incr i} {
863 if {[.bar.view entrycget $i -command] eq $targetcmd} {
864 .bar.view delete $i
865 break
868 set viewdata($curview) {}
869 showview 0
872 proc flatten {var} {
873 global $var
875 set ret {}
876 foreach i [array names $var] {
877 lappend ret $i [set $var\($i\)]
879 return $ret
882 proc unflatten {var l} {
883 global $var
885 catch {unset $var}
886 foreach {i v} $l {
887 set $var\($i\) $v
891 proc showview {n} {
892 global curview viewdata viewfiles
893 global displayorder parentlist childlist rowidlist rowoffsets
894 global colormap rowtextx commitrow
895 global numcommits rowrangelist commitlisted idrowranges
896 global selectedline currentid canv canvy0
897 global matchinglines treediffs
898 global pending_select phase
899 global commitidx rowlaidout rowoptim linesegends leftover
900 global commfd nextupdate
902 if {$n == $curview} return
903 set selid {}
904 if {[info exists selectedline]} {
905 set selid $currentid
906 set y [yc $selectedline]
907 set ymax [lindex [$canv cget -scrollregion] 3]
908 set span [$canv yview]
909 set ytop [expr {[lindex $span 0] * $ymax}]
910 set ybot [expr {[lindex $span 1] * $ymax}]
911 if {$ytop < $y && $y < $ybot} {
912 set yscreen [expr {$y - $ytop}]
913 } else {
914 set yscreen [expr {($ybot - $ytop) / 2}]
917 unselectline
918 normalline
919 stopfindproc
920 if {$curview >= 0} {
921 if {$phase ne {}} {
922 set viewdata($curview) \
923 [list $phase $displayorder $parentlist $childlist $rowidlist \
924 $rowoffsets $rowrangelist $commitlisted \
925 [flatten children] [flatten idrowranges] \
926 [flatten idinlist] \
927 $commitidx $rowlaidout $rowoptim $numcommits \
928 $linesegends $leftover $commfd]
929 fileevent $commfd readable {}
930 } elseif {![info exists viewdata($curview)]
931 || [lindex $viewdata($curview) 0] ne {}} {
932 set viewdata($curview) \
933 [list {} $displayorder $parentlist $childlist $rowidlist \
934 $rowoffsets $rowrangelist $commitlisted]
937 catch {unset matchinglines}
938 catch {unset treediffs}
939 clear_display
941 set curview $n
942 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
944 if {![info exists viewdata($n)]} {
945 set pending_select $selid
946 getcommits
947 return
950 set v $viewdata($n)
951 set phase [lindex $v 0]
952 set displayorder [lindex $v 1]
953 set parentlist [lindex $v 2]
954 set childlist [lindex $v 3]
955 set rowidlist [lindex $v 4]
956 set rowoffsets [lindex $v 5]
957 set rowrangelist [lindex $v 6]
958 set commitlisted [lindex $v 7]
959 if {$phase eq {}} {
960 set numcommits [llength $displayorder]
961 catch {unset idrowranges}
962 catch {unset children}
963 } else {
964 unflatten children [lindex $v 8]
965 unflatten idrowranges [lindex $v 9]
966 unflatten idinlist [lindex $v 10]
967 set commitidx [lindex $v 11]
968 set rowlaidout [lindex $v 12]
969 set rowoptim [lindex $v 13]
970 set numcommits [lindex $v 14]
971 set linesegends [lindex $v 15]
972 set leftover [lindex $v 16]
973 set commfd [lindex $v 17]
974 fileevent $commfd readable [list getcommitlines $commfd]
975 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
978 catch {unset colormap}
979 catch {unset rowtextx}
980 catch {unset commitrow}
981 set curview $n
982 set row 0
983 foreach id $displayorder {
984 set commitrow($id) $row
985 incr row
987 setcanvscroll
988 set yf 0
989 set row 0
990 if {$selid ne {} && [info exists commitrow($selid)]} {
991 set row $commitrow($selid)
992 # try to get the selected row in the same position on the screen
993 set ymax [lindex [$canv cget -scrollregion] 3]
994 set ytop [expr {[yc $row] - $yscreen}]
995 if {$ytop < 0} {
996 set ytop 0
998 set yf [expr {$ytop * 1.0 / $ymax}]
1000 allcanvs yview moveto $yf
1001 drawvisible
1002 selectline $row 0
1003 if {$phase eq {}} {
1004 global maincursor textcursor
1005 . config -cursor $maincursor
1006 settextcursor $textcursor
1007 } else {
1008 . config -cursor watch
1009 settextcursor watch
1013 proc shortids {ids} {
1014 set res {}
1015 foreach id $ids {
1016 if {[llength $id] > 1} {
1017 lappend res [shortids $id]
1018 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1019 lappend res [string range $id 0 7]
1020 } else {
1021 lappend res $id
1024 return $res
1027 proc incrange {l x o} {
1028 set n [llength $l]
1029 while {$x < $n} {
1030 set e [lindex $l $x]
1031 if {$e ne {}} {
1032 lset l $x [expr {$e + $o}]
1034 incr x
1036 return $l
1039 proc ntimes {n o} {
1040 set ret {}
1041 for {} {$n > 0} {incr n -1} {
1042 lappend ret $o
1044 return $ret
1047 proc usedinrange {id l1 l2} {
1048 global children commitrow childlist
1050 if {[info exists commitrow($id)]} {
1051 set r $commitrow($id)
1052 if {$l1 <= $r && $r <= $l2} {
1053 return [expr {$r - $l1 + 1}]
1055 set kids [lindex $childlist $r]
1056 } else {
1057 set kids $children($id)
1059 foreach c $kids {
1060 set r $commitrow($c)
1061 if {$l1 <= $r && $r <= $l2} {
1062 return [expr {$r - $l1 + 1}]
1065 return 0
1068 proc sanity {row {full 0}} {
1069 global rowidlist rowoffsets
1071 set col -1
1072 set ids [lindex $rowidlist $row]
1073 foreach id $ids {
1074 incr col
1075 if {$id eq {}} continue
1076 if {$col < [llength $ids] - 1 &&
1077 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1078 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1080 set o [lindex $rowoffsets $row $col]
1081 set y $row
1082 set x $col
1083 while {$o ne {}} {
1084 incr y -1
1085 incr x $o
1086 if {[lindex $rowidlist $y $x] != $id} {
1087 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1088 puts " id=[shortids $id] check started at row $row"
1089 for {set i $row} {$i >= $y} {incr i -1} {
1090 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1092 break
1094 if {!$full} break
1095 set o [lindex $rowoffsets $y $x]
1100 proc makeuparrow {oid x y z} {
1101 global rowidlist rowoffsets uparrowlen idrowranges
1103 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1104 incr y -1
1105 incr x $z
1106 set off0 [lindex $rowoffsets $y]
1107 for {set x0 $x} {1} {incr x0} {
1108 if {$x0 >= [llength $off0]} {
1109 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1110 break
1112 set z [lindex $off0 $x0]
1113 if {$z ne {}} {
1114 incr x0 $z
1115 break
1118 set z [expr {$x0 - $x}]
1119 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1120 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1122 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1123 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1124 lappend idrowranges($oid) $y
1127 proc initlayout {} {
1128 global rowidlist rowoffsets displayorder commitlisted
1129 global rowlaidout rowoptim
1130 global idinlist rowchk rowrangelist idrowranges
1131 global commitidx numcommits canvxmax canv
1132 global nextcolor
1133 global parentlist childlist children
1134 global colormap rowtextx commitrow
1135 global linesegends
1137 set commitidx 0
1138 set numcommits 0
1139 set displayorder {}
1140 set commitlisted {}
1141 set parentlist {}
1142 set childlist {}
1143 set rowrangelist {}
1144 catch {unset children}
1145 set nextcolor 0
1146 set rowidlist {{}}
1147 set rowoffsets {{}}
1148 catch {unset idinlist}
1149 catch {unset rowchk}
1150 set rowlaidout 0
1151 set rowoptim 0
1152 set canvxmax [$canv cget -width]
1153 catch {unset colormap}
1154 catch {unset rowtextx}
1155 catch {unset commitrow}
1156 catch {unset idrowranges}
1157 set linesegends {}
1160 proc setcanvscroll {} {
1161 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1163 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1164 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1165 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1166 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1169 proc visiblerows {} {
1170 global canv numcommits linespc
1172 set ymax [lindex [$canv cget -scrollregion] 3]
1173 if {$ymax eq {} || $ymax == 0} return
1174 set f [$canv yview]
1175 set y0 [expr {int([lindex $f 0] * $ymax)}]
1176 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1177 if {$r0 < 0} {
1178 set r0 0
1180 set y1 [expr {int([lindex $f 1] * $ymax)}]
1181 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1182 if {$r1 >= $numcommits} {
1183 set r1 [expr {$numcommits - 1}]
1185 return [list $r0 $r1]
1188 proc layoutmore {} {
1189 global rowlaidout rowoptim commitidx numcommits optim_delay
1190 global uparrowlen
1192 set row $rowlaidout
1193 set rowlaidout [layoutrows $row $commitidx 0]
1194 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1195 if {$orow > $rowoptim} {
1196 optimize_rows $rowoptim 0 $orow
1197 set rowoptim $orow
1199 set canshow [expr {$rowoptim - $optim_delay}]
1200 if {$canshow > $numcommits} {
1201 showstuff $canshow
1205 proc showstuff {canshow} {
1206 global numcommits commitrow pending_select selectedline
1207 global linesegends idrowranges idrangedrawn
1209 if {$numcommits == 0} {
1210 global phase
1211 set phase "incrdraw"
1212 allcanvs delete all
1214 set row $numcommits
1215 set numcommits $canshow
1216 setcanvscroll
1217 set rows [visiblerows]
1218 set r0 [lindex $rows 0]
1219 set r1 [lindex $rows 1]
1220 set selrow -1
1221 for {set r $row} {$r < $canshow} {incr r} {
1222 foreach id [lindex $linesegends [expr {$r+1}]] {
1223 set i -1
1224 foreach {s e} [rowranges $id] {
1225 incr i
1226 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1227 && ![info exists idrangedrawn($id,$i)]} {
1228 drawlineseg $id $i
1229 set idrangedrawn($id,$i) 1
1234 if {$canshow > $r1} {
1235 set canshow $r1
1237 while {$row < $canshow} {
1238 drawcmitrow $row
1239 incr row
1241 if {[info exists pending_select] &&
1242 [info exists commitrow($pending_select)] &&
1243 $commitrow($pending_select) < $numcommits} {
1244 selectline $commitrow($pending_select) 1
1246 if {![info exists selectedline] && ![info exists pending_select]} {
1247 selectline 0 1
1251 proc layoutrows {row endrow last} {
1252 global rowidlist rowoffsets displayorder
1253 global uparrowlen downarrowlen maxwidth mingaplen
1254 global childlist parentlist
1255 global idrowranges linesegends
1256 global commitidx
1257 global idinlist rowchk rowrangelist
1259 set idlist [lindex $rowidlist $row]
1260 set offs [lindex $rowoffsets $row]
1261 while {$row < $endrow} {
1262 set id [lindex $displayorder $row]
1263 set oldolds {}
1264 set newolds {}
1265 foreach p [lindex $parentlist $row] {
1266 if {![info exists idinlist($p)]} {
1267 lappend newolds $p
1268 } elseif {!$idinlist($p)} {
1269 lappend oldolds $p
1272 set lse {}
1273 set nev [expr {[llength $idlist] + [llength $newolds]
1274 + [llength $oldolds] - $maxwidth + 1}]
1275 if {$nev > 0} {
1276 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1277 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1278 set i [lindex $idlist $x]
1279 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1280 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1281 [expr {$row + $uparrowlen + $mingaplen}]]
1282 if {$r == 0} {
1283 set idlist [lreplace $idlist $x $x]
1284 set offs [lreplace $offs $x $x]
1285 set offs [incrange $offs $x 1]
1286 set idinlist($i) 0
1287 set rm1 [expr {$row - 1}]
1288 lappend lse $i
1289 lappend idrowranges($i) $rm1
1290 if {[incr nev -1] <= 0} break
1291 continue
1293 set rowchk($id) [expr {$row + $r}]
1296 lset rowidlist $row $idlist
1297 lset rowoffsets $row $offs
1299 lappend linesegends $lse
1300 set col [lsearch -exact $idlist $id]
1301 if {$col < 0} {
1302 set col [llength $idlist]
1303 lappend idlist $id
1304 lset rowidlist $row $idlist
1305 set z {}
1306 if {[lindex $childlist $row] ne {}} {
1307 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1308 unset idinlist($id)
1310 lappend offs $z
1311 lset rowoffsets $row $offs
1312 if {$z ne {}} {
1313 makeuparrow $id $col $row $z
1315 } else {
1316 unset idinlist($id)
1318 set ranges {}
1319 if {[info exists idrowranges($id)]} {
1320 set ranges $idrowranges($id)
1321 lappend ranges $row
1322 unset idrowranges($id)
1324 lappend rowrangelist $ranges
1325 incr row
1326 set offs [ntimes [llength $idlist] 0]
1327 set l [llength $newolds]
1328 set idlist [eval lreplace \$idlist $col $col $newolds]
1329 set o 0
1330 if {$l != 1} {
1331 set offs [lrange $offs 0 [expr {$col - 1}]]
1332 foreach x $newolds {
1333 lappend offs {}
1334 incr o -1
1336 incr o
1337 set tmp [expr {[llength $idlist] - [llength $offs]}]
1338 if {$tmp > 0} {
1339 set offs [concat $offs [ntimes $tmp $o]]
1341 } else {
1342 lset offs $col {}
1344 foreach i $newolds {
1345 set idinlist($i) 1
1346 set idrowranges($i) $row
1348 incr col $l
1349 foreach oid $oldolds {
1350 set idinlist($oid) 1
1351 set idlist [linsert $idlist $col $oid]
1352 set offs [linsert $offs $col $o]
1353 makeuparrow $oid $col $row $o
1354 incr col
1356 lappend rowidlist $idlist
1357 lappend rowoffsets $offs
1359 return $row
1362 proc addextraid {id row} {
1363 global displayorder commitrow commitinfo
1364 global commitidx commitlisted
1365 global parentlist childlist children
1367 incr commitidx
1368 lappend displayorder $id
1369 lappend commitlisted 0
1370 lappend parentlist {}
1371 set commitrow($id) $row
1372 readcommit $id
1373 if {![info exists commitinfo($id)]} {
1374 set commitinfo($id) {"No commit information available"}
1376 if {[info exists children($id)]} {
1377 lappend childlist $children($id)
1378 unset children($id)
1379 } else {
1380 lappend childlist {}
1384 proc layouttail {} {
1385 global rowidlist rowoffsets idinlist commitidx
1386 global idrowranges rowrangelist
1388 set row $commitidx
1389 set idlist [lindex $rowidlist $row]
1390 while {$idlist ne {}} {
1391 set col [expr {[llength $idlist] - 1}]
1392 set id [lindex $idlist $col]
1393 addextraid $id $row
1394 unset idinlist($id)
1395 lappend idrowranges($id) $row
1396 lappend rowrangelist $idrowranges($id)
1397 unset idrowranges($id)
1398 incr row
1399 set offs [ntimes $col 0]
1400 set idlist [lreplace $idlist $col $col]
1401 lappend rowidlist $idlist
1402 lappend rowoffsets $offs
1405 foreach id [array names idinlist] {
1406 addextraid $id $row
1407 lset rowidlist $row [list $id]
1408 lset rowoffsets $row 0
1409 makeuparrow $id 0 $row 0
1410 lappend idrowranges($id) $row
1411 lappend rowrangelist $idrowranges($id)
1412 unset idrowranges($id)
1413 incr row
1414 lappend rowidlist {}
1415 lappend rowoffsets {}
1419 proc insert_pad {row col npad} {
1420 global rowidlist rowoffsets
1422 set pad [ntimes $npad {}]
1423 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1424 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1425 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1428 proc optimize_rows {row col endrow} {
1429 global rowidlist rowoffsets idrowranges displayorder
1431 for {} {$row < $endrow} {incr row} {
1432 set idlist [lindex $rowidlist $row]
1433 set offs [lindex $rowoffsets $row]
1434 set haspad 0
1435 for {} {$col < [llength $offs]} {incr col} {
1436 if {[lindex $idlist $col] eq {}} {
1437 set haspad 1
1438 continue
1440 set z [lindex $offs $col]
1441 if {$z eq {}} continue
1442 set isarrow 0
1443 set x0 [expr {$col + $z}]
1444 set y0 [expr {$row - 1}]
1445 set z0 [lindex $rowoffsets $y0 $x0]
1446 if {$z0 eq {}} {
1447 set id [lindex $idlist $col]
1448 set ranges [rowranges $id]
1449 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1450 set isarrow 1
1453 if {$z < -1 || ($z < 0 && $isarrow)} {
1454 set npad [expr {-1 - $z + $isarrow}]
1455 set offs [incrange $offs $col $npad]
1456 insert_pad $y0 $x0 $npad
1457 if {$y0 > 0} {
1458 optimize_rows $y0 $x0 $row
1460 set z [lindex $offs $col]
1461 set x0 [expr {$col + $z}]
1462 set z0 [lindex $rowoffsets $y0 $x0]
1463 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1464 set npad [expr {$z - 1 + $isarrow}]
1465 set y1 [expr {$row + 1}]
1466 set offs2 [lindex $rowoffsets $y1]
1467 set x1 -1
1468 foreach z $offs2 {
1469 incr x1
1470 if {$z eq {} || $x1 + $z < $col} continue
1471 if {$x1 + $z > $col} {
1472 incr npad
1474 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1475 break
1477 set pad [ntimes $npad {}]
1478 set idlist [eval linsert \$idlist $col $pad]
1479 set tmp [eval linsert \$offs $col $pad]
1480 incr col $npad
1481 set offs [incrange $tmp $col [expr {-$npad}]]
1482 set z [lindex $offs $col]
1483 set haspad 1
1485 if {$z0 eq {} && !$isarrow} {
1486 # this line links to its first child on row $row-2
1487 set rm2 [expr {$row - 2}]
1488 set id [lindex $displayorder $rm2]
1489 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1490 if {$xc >= 0} {
1491 set z0 [expr {$xc - $x0}]
1494 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1495 insert_pad $y0 $x0 1
1496 set offs [incrange $offs $col 1]
1497 optimize_rows $y0 [expr {$x0 + 1}] $row
1500 if {!$haspad} {
1501 set o {}
1502 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1503 set o [lindex $offs $col]
1504 if {$o eq {}} {
1505 # check if this is the link to the first child
1506 set id [lindex $idlist $col]
1507 set ranges [rowranges $id]
1508 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1509 # it is, work out offset to child
1510 set y0 [expr {$row - 1}]
1511 set id [lindex $displayorder $y0]
1512 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1513 if {$x0 >= 0} {
1514 set o [expr {$x0 - $col}]
1518 if {$o eq {} || $o <= 0} break
1520 if {$o ne {} && [incr col] < [llength $idlist]} {
1521 set y1 [expr {$row + 1}]
1522 set offs2 [lindex $rowoffsets $y1]
1523 set x1 -1
1524 foreach z $offs2 {
1525 incr x1
1526 if {$z eq {} || $x1 + $z < $col} continue
1527 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1528 break
1530 set idlist [linsert $idlist $col {}]
1531 set tmp [linsert $offs $col {}]
1532 incr col
1533 set offs [incrange $tmp $col -1]
1536 lset rowidlist $row $idlist
1537 lset rowoffsets $row $offs
1538 set col 0
1542 proc xc {row col} {
1543 global canvx0 linespc
1544 return [expr {$canvx0 + $col * $linespc}]
1547 proc yc {row} {
1548 global canvy0 linespc
1549 return [expr {$canvy0 + $row * $linespc}]
1552 proc linewidth {id} {
1553 global thickerline lthickness
1555 set wid $lthickness
1556 if {[info exists thickerline] && $id eq $thickerline} {
1557 set wid [expr {2 * $lthickness}]
1559 return $wid
1562 proc rowranges {id} {
1563 global phase idrowranges commitrow rowlaidout rowrangelist
1565 set ranges {}
1566 if {$phase eq {} ||
1567 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1568 set ranges [lindex $rowrangelist $commitrow($id)]
1569 } elseif {[info exists idrowranges($id)]} {
1570 set ranges $idrowranges($id)
1572 return $ranges
1575 proc drawlineseg {id i} {
1576 global rowoffsets rowidlist
1577 global displayorder
1578 global canv colormap linespc
1579 global numcommits commitrow
1581 set ranges [rowranges $id]
1582 set downarrow 1
1583 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1584 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1585 } else {
1586 set downarrow 1
1588 set startrow [lindex $ranges [expr {2 * $i}]]
1589 set row [lindex $ranges [expr {2 * $i + 1}]]
1590 if {$startrow == $row} return
1591 assigncolor $id
1592 set coords {}
1593 set col [lsearch -exact [lindex $rowidlist $row] $id]
1594 if {$col < 0} {
1595 puts "oops: drawline: id $id not on row $row"
1596 return
1598 set lasto {}
1599 set ns 0
1600 while {1} {
1601 set o [lindex $rowoffsets $row $col]
1602 if {$o eq {}} break
1603 if {$o ne $lasto} {
1604 # changing direction
1605 set x [xc $row $col]
1606 set y [yc $row]
1607 lappend coords $x $y
1608 set lasto $o
1610 incr col $o
1611 incr row -1
1613 set x [xc $row $col]
1614 set y [yc $row]
1615 lappend coords $x $y
1616 if {$i == 0} {
1617 # draw the link to the first child as part of this line
1618 incr row -1
1619 set child [lindex $displayorder $row]
1620 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1621 if {$ccol >= 0} {
1622 set x [xc $row $ccol]
1623 set y [yc $row]
1624 if {$ccol < $col - 1} {
1625 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1626 } elseif {$ccol > $col + 1} {
1627 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1629 lappend coords $x $y
1632 if {[llength $coords] < 4} return
1633 if {$downarrow} {
1634 # This line has an arrow at the lower end: check if the arrow is
1635 # on a diagonal segment, and if so, work around the Tk 8.4
1636 # refusal to draw arrows on diagonal lines.
1637 set x0 [lindex $coords 0]
1638 set x1 [lindex $coords 2]
1639 if {$x0 != $x1} {
1640 set y0 [lindex $coords 1]
1641 set y1 [lindex $coords 3]
1642 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1643 # we have a nearby vertical segment, just trim off the diag bit
1644 set coords [lrange $coords 2 end]
1645 } else {
1646 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1647 set xi [expr {$x0 - $slope * $linespc / 2}]
1648 set yi [expr {$y0 - $linespc / 2}]
1649 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1653 set arrow [expr {2 * ($i > 0) + $downarrow}]
1654 set arrow [lindex {none first last both} $arrow]
1655 set t [$canv create line $coords -width [linewidth $id] \
1656 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1657 $canv lower $t
1658 bindline $t $id
1661 proc drawparentlinks {id row col olds} {
1662 global rowidlist canv colormap
1664 set row2 [expr {$row + 1}]
1665 set x [xc $row $col]
1666 set y [yc $row]
1667 set y2 [yc $row2]
1668 set ids [lindex $rowidlist $row2]
1669 # rmx = right-most X coord used
1670 set rmx 0
1671 foreach p $olds {
1672 set i [lsearch -exact $ids $p]
1673 if {$i < 0} {
1674 puts "oops, parent $p of $id not in list"
1675 continue
1677 set x2 [xc $row2 $i]
1678 if {$x2 > $rmx} {
1679 set rmx $x2
1681 set ranges [rowranges $p]
1682 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1683 && $row2 < [lindex $ranges 1]} {
1684 # drawlineseg will do this one for us
1685 continue
1687 assigncolor $p
1688 # should handle duplicated parents here...
1689 set coords [list $x $y]
1690 if {$i < $col - 1} {
1691 lappend coords [xc $row [expr {$i + 1}]] $y
1692 } elseif {$i > $col + 1} {
1693 lappend coords [xc $row [expr {$i - 1}]] $y
1695 lappend coords $x2 $y2
1696 set t [$canv create line $coords -width [linewidth $p] \
1697 -fill $colormap($p) -tags lines.$p]
1698 $canv lower $t
1699 bindline $t $p
1701 return $rmx
1704 proc drawlines {id} {
1705 global colormap canv
1706 global idrangedrawn
1707 global childlist iddrawn commitrow rowidlist
1709 $canv delete lines.$id
1710 set nr [expr {[llength [rowranges $id]] / 2}]
1711 for {set i 0} {$i < $nr} {incr i} {
1712 if {[info exists idrangedrawn($id,$i)]} {
1713 drawlineseg $id $i
1716 foreach child [lindex $childlist $commitrow($id)] {
1717 if {[info exists iddrawn($child)]} {
1718 set row $commitrow($child)
1719 set col [lsearch -exact [lindex $rowidlist $row] $child]
1720 if {$col >= 0} {
1721 drawparentlinks $child $row $col [list $id]
1727 proc drawcmittext {id row col rmx} {
1728 global linespc canv canv2 canv3 canvy0
1729 global commitlisted commitinfo rowidlist
1730 global rowtextx idpos idtags idheads idotherrefs
1731 global linehtag linentag linedtag
1732 global mainfont namefont canvxmax
1734 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1735 set x [xc $row $col]
1736 set y [yc $row]
1737 set orad [expr {$linespc / 3}]
1738 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1739 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1740 -fill $ofill -outline black -width 1]
1741 $canv raise $t
1742 $canv bind $t <1> {selcanvline {} %x %y}
1743 set xt [xc $row [llength [lindex $rowidlist $row]]]
1744 if {$xt < $rmx} {
1745 set xt $rmx
1747 set rowtextx($row) $xt
1748 set idpos($id) [list $x $xt $y]
1749 if {[info exists idtags($id)] || [info exists idheads($id)]
1750 || [info exists idotherrefs($id)]} {
1751 set xt [drawtags $id $x $xt $y]
1753 set headline [lindex $commitinfo($id) 0]
1754 set name [lindex $commitinfo($id) 1]
1755 set date [lindex $commitinfo($id) 2]
1756 set date [formatdate $date]
1757 set linehtag($row) [$canv create text $xt $y -anchor w \
1758 -text $headline -font $mainfont ]
1759 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1760 set linentag($row) [$canv2 create text 3 $y -anchor w \
1761 -text $name -font $namefont]
1762 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1763 -text $date -font $mainfont]
1764 set xr [expr {$xt + [font measure $mainfont $headline]}]
1765 if {$xr > $canvxmax} {
1766 set canvxmax $xr
1767 setcanvscroll
1771 proc drawcmitrow {row} {
1772 global displayorder rowidlist
1773 global idrangedrawn iddrawn
1774 global commitinfo parentlist numcommits
1776 if {$row >= $numcommits} return
1777 foreach id [lindex $rowidlist $row] {
1778 if {$id eq {}} continue
1779 set i -1
1780 foreach {s e} [rowranges $id] {
1781 incr i
1782 if {$row < $s} continue
1783 if {$e eq {}} break
1784 if {$row <= $e} {
1785 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1786 drawlineseg $id $i
1787 set idrangedrawn($id,$i) 1
1789 break
1794 set id [lindex $displayorder $row]
1795 if {[info exists iddrawn($id)]} return
1796 set col [lsearch -exact [lindex $rowidlist $row] $id]
1797 if {$col < 0} {
1798 puts "oops, row $row id $id not in list"
1799 return
1801 if {![info exists commitinfo($id)]} {
1802 getcommit $id
1804 assigncolor $id
1805 set olds [lindex $parentlist $row]
1806 if {$olds ne {}} {
1807 set rmx [drawparentlinks $id $row $col $olds]
1808 } else {
1809 set rmx 0
1811 drawcmittext $id $row $col $rmx
1812 set iddrawn($id) 1
1815 proc drawfrac {f0 f1} {
1816 global numcommits canv
1817 global linespc
1819 set ymax [lindex [$canv cget -scrollregion] 3]
1820 if {$ymax eq {} || $ymax == 0} return
1821 set y0 [expr {int($f0 * $ymax)}]
1822 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1823 if {$row < 0} {
1824 set row 0
1826 set y1 [expr {int($f1 * $ymax)}]
1827 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1828 if {$endrow >= $numcommits} {
1829 set endrow [expr {$numcommits - 1}]
1831 for {} {$row <= $endrow} {incr row} {
1832 drawcmitrow $row
1836 proc drawvisible {} {
1837 global canv
1838 eval drawfrac [$canv yview]
1841 proc clear_display {} {
1842 global iddrawn idrangedrawn
1844 allcanvs delete all
1845 catch {unset iddrawn}
1846 catch {unset idrangedrawn}
1849 proc findcrossings {id} {
1850 global rowidlist parentlist numcommits rowoffsets displayorder
1852 set cross {}
1853 set ccross {}
1854 foreach {s e} [rowranges $id] {
1855 if {$e >= $numcommits} {
1856 set e [expr {$numcommits - 1}]
1858 if {$e <= $s} continue
1859 set x [lsearch -exact [lindex $rowidlist $e] $id]
1860 if {$x < 0} {
1861 puts "findcrossings: oops, no [shortids $id] in row $e"
1862 continue
1864 for {set row $e} {[incr row -1] >= $s} {} {
1865 set olds [lindex $parentlist $row]
1866 set kid [lindex $displayorder $row]
1867 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1868 if {$kidx < 0} continue
1869 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1870 foreach p $olds {
1871 set px [lsearch -exact $nextrow $p]
1872 if {$px < 0} continue
1873 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1874 if {[lsearch -exact $ccross $p] >= 0} continue
1875 if {$x == $px + ($kidx < $px? -1: 1)} {
1876 lappend ccross $p
1877 } elseif {[lsearch -exact $cross $p] < 0} {
1878 lappend cross $p
1882 set inc [lindex $rowoffsets $row $x]
1883 if {$inc eq {}} break
1884 incr x $inc
1887 return [concat $ccross {{}} $cross]
1890 proc assigncolor {id} {
1891 global colormap colors nextcolor
1892 global commitrow parentlist children childlist
1894 if {[info exists colormap($id)]} return
1895 set ncolors [llength $colors]
1896 if {[info exists commitrow($id)]} {
1897 set kids [lindex $childlist $commitrow($id)]
1898 } elseif {[info exists children($id)]} {
1899 set kids $children($id)
1900 } else {
1901 set kids {}
1903 if {[llength $kids] == 1} {
1904 set child [lindex $kids 0]
1905 if {[info exists colormap($child)]
1906 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1907 set colormap($id) $colormap($child)
1908 return
1911 set badcolors {}
1912 set origbad {}
1913 foreach x [findcrossings $id] {
1914 if {$x eq {}} {
1915 # delimiter between corner crossings and other crossings
1916 if {[llength $badcolors] >= $ncolors - 1} break
1917 set origbad $badcolors
1919 if {[info exists colormap($x)]
1920 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1921 lappend badcolors $colormap($x)
1924 if {[llength $badcolors] >= $ncolors} {
1925 set badcolors $origbad
1927 set origbad $badcolors
1928 if {[llength $badcolors] < $ncolors - 1} {
1929 foreach child $kids {
1930 if {[info exists colormap($child)]
1931 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1932 lappend badcolors $colormap($child)
1934 foreach p [lindex $parentlist $commitrow($child)] {
1935 if {[info exists colormap($p)]
1936 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1937 lappend badcolors $colormap($p)
1941 if {[llength $badcolors] >= $ncolors} {
1942 set badcolors $origbad
1945 for {set i 0} {$i <= $ncolors} {incr i} {
1946 set c [lindex $colors $nextcolor]
1947 if {[incr nextcolor] >= $ncolors} {
1948 set nextcolor 0
1950 if {[lsearch -exact $badcolors $c]} break
1952 set colormap($id) $c
1955 proc bindline {t id} {
1956 global canv
1958 $canv bind $t <Enter> "lineenter %x %y $id"
1959 $canv bind $t <Motion> "linemotion %x %y $id"
1960 $canv bind $t <Leave> "lineleave $id"
1961 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1964 proc drawtags {id x xt y1} {
1965 global idtags idheads idotherrefs
1966 global linespc lthickness
1967 global canv mainfont commitrow rowtextx
1969 set marks {}
1970 set ntags 0
1971 set nheads 0
1972 if {[info exists idtags($id)]} {
1973 set marks $idtags($id)
1974 set ntags [llength $marks]
1976 if {[info exists idheads($id)]} {
1977 set marks [concat $marks $idheads($id)]
1978 set nheads [llength $idheads($id)]
1980 if {[info exists idotherrefs($id)]} {
1981 set marks [concat $marks $idotherrefs($id)]
1983 if {$marks eq {}} {
1984 return $xt
1987 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1988 set yt [expr {$y1 - 0.5 * $linespc}]
1989 set yb [expr {$yt + $linespc - 1}]
1990 set xvals {}
1991 set wvals {}
1992 foreach tag $marks {
1993 set wid [font measure $mainfont $tag]
1994 lappend xvals $xt
1995 lappend wvals $wid
1996 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1998 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1999 -width $lthickness -fill black -tags tag.$id]
2000 $canv lower $t
2001 foreach tag $marks x $xvals wid $wvals {
2002 set xl [expr {$x + $delta}]
2003 set xr [expr {$x + $delta + $wid + $lthickness}]
2004 if {[incr ntags -1] >= 0} {
2005 # draw a tag
2006 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2007 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2008 -width 1 -outline black -fill yellow -tags tag.$id]
2009 $canv bind $t <1> [list showtag $tag 1]
2010 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2011 } else {
2012 # draw a head or other ref
2013 if {[incr nheads -1] >= 0} {
2014 set col green
2015 } else {
2016 set col "#ddddff"
2018 set xl [expr {$xl - $delta/2}]
2019 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2020 -width 1 -outline black -fill $col -tags tag.$id
2022 set t [$canv create text $xl $y1 -anchor w -text $tag \
2023 -font $mainfont -tags tag.$id]
2024 if {$ntags >= 0} {
2025 $canv bind $t <1> [list showtag $tag 1]
2028 return $xt
2031 proc xcoord {i level ln} {
2032 global canvx0 xspc1 xspc2
2034 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2035 if {$i > 0 && $i == $level} {
2036 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2037 } elseif {$i > $level} {
2038 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2040 return $x
2043 proc finishcommits {} {
2044 global commitidx phase
2045 global canv mainfont ctext maincursor textcursor
2046 global findinprogress pending_select
2048 if {$commitidx > 0} {
2049 drawrest
2050 } else {
2051 $canv delete all
2052 $canv create text 3 3 -anchor nw -text "No commits selected" \
2053 -font $mainfont -tags textitems
2055 if {![info exists findinprogress]} {
2056 . config -cursor $maincursor
2057 settextcursor $textcursor
2059 set phase {}
2060 catch {unset pending_select}
2063 # Don't change the text pane cursor if it is currently the hand cursor,
2064 # showing that we are over a sha1 ID link.
2065 proc settextcursor {c} {
2066 global ctext curtextcursor
2068 if {[$ctext cget -cursor] == $curtextcursor} {
2069 $ctext config -cursor $c
2071 set curtextcursor $c
2074 proc drawrest {} {
2075 global numcommits
2076 global startmsecs
2077 global canvy0 numcommits linespc
2078 global rowlaidout commitidx
2079 global pending_select
2081 set row $rowlaidout
2082 layoutrows $rowlaidout $commitidx 1
2083 layouttail
2084 optimize_rows $row 0 $commitidx
2085 showstuff $commitidx
2086 if {[info exists pending_select]} {
2087 selectline 0 1
2090 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2091 #puts "overall $drawmsecs ms for $numcommits commits"
2094 proc findmatches {f} {
2095 global findtype foundstring foundstrlen
2096 if {$findtype == "Regexp"} {
2097 set matches [regexp -indices -all -inline $foundstring $f]
2098 } else {
2099 if {$findtype == "IgnCase"} {
2100 set str [string tolower $f]
2101 } else {
2102 set str $f
2104 set matches {}
2105 set i 0
2106 while {[set j [string first $foundstring $str $i]] >= 0} {
2107 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2108 set i [expr {$j + $foundstrlen}]
2111 return $matches
2114 proc dofind {} {
2115 global findtype findloc findstring markedmatches commitinfo
2116 global numcommits displayorder linehtag linentag linedtag
2117 global mainfont namefont canv canv2 canv3 selectedline
2118 global matchinglines foundstring foundstrlen matchstring
2119 global commitdata
2121 stopfindproc
2122 unmarkmatches
2123 focus .
2124 set matchinglines {}
2125 if {$findloc == "Pickaxe"} {
2126 findpatches
2127 return
2129 if {$findtype == "IgnCase"} {
2130 set foundstring [string tolower $findstring]
2131 } else {
2132 set foundstring $findstring
2134 set foundstrlen [string length $findstring]
2135 if {$foundstrlen == 0} return
2136 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2137 set matchstring "*$matchstring*"
2138 if {$findloc == "Files"} {
2139 findfiles
2140 return
2142 if {![info exists selectedline]} {
2143 set oldsel -1
2144 } else {
2145 set oldsel $selectedline
2147 set didsel 0
2148 set fldtypes {Headline Author Date Committer CDate Comment}
2149 set l -1
2150 foreach id $displayorder {
2151 set d $commitdata($id)
2152 incr l
2153 if {$findtype == "Regexp"} {
2154 set doesmatch [regexp $foundstring $d]
2155 } elseif {$findtype == "IgnCase"} {
2156 set doesmatch [string match -nocase $matchstring $d]
2157 } else {
2158 set doesmatch [string match $matchstring $d]
2160 if {!$doesmatch} continue
2161 if {![info exists commitinfo($id)]} {
2162 getcommit $id
2164 set info $commitinfo($id)
2165 set doesmatch 0
2166 foreach f $info ty $fldtypes {
2167 if {$findloc != "All fields" && $findloc != $ty} {
2168 continue
2170 set matches [findmatches $f]
2171 if {$matches == {}} continue
2172 set doesmatch 1
2173 if {$ty == "Headline"} {
2174 drawcmitrow $l
2175 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2176 } elseif {$ty == "Author"} {
2177 drawcmitrow $l
2178 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2179 } elseif {$ty == "Date"} {
2180 drawcmitrow $l
2181 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2184 if {$doesmatch} {
2185 lappend matchinglines $l
2186 if {!$didsel && $l > $oldsel} {
2187 findselectline $l
2188 set didsel 1
2192 if {$matchinglines == {}} {
2193 bell
2194 } elseif {!$didsel} {
2195 findselectline [lindex $matchinglines 0]
2199 proc findselectline {l} {
2200 global findloc commentend ctext
2201 selectline $l 1
2202 if {$findloc == "All fields" || $findloc == "Comments"} {
2203 # highlight the matches in the comments
2204 set f [$ctext get 1.0 $commentend]
2205 set matches [findmatches $f]
2206 foreach match $matches {
2207 set start [lindex $match 0]
2208 set end [expr {[lindex $match 1] + 1}]
2209 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2214 proc findnext {restart} {
2215 global matchinglines selectedline
2216 if {![info exists matchinglines]} {
2217 if {$restart} {
2218 dofind
2220 return
2222 if {![info exists selectedline]} return
2223 foreach l $matchinglines {
2224 if {$l > $selectedline} {
2225 findselectline $l
2226 return
2229 bell
2232 proc findprev {} {
2233 global matchinglines selectedline
2234 if {![info exists matchinglines]} {
2235 dofind
2236 return
2238 if {![info exists selectedline]} return
2239 set prev {}
2240 foreach l $matchinglines {
2241 if {$l >= $selectedline} break
2242 set prev $l
2244 if {$prev != {}} {
2245 findselectline $prev
2246 } else {
2247 bell
2251 proc findlocchange {name ix op} {
2252 global findloc findtype findtypemenu
2253 if {$findloc == "Pickaxe"} {
2254 set findtype Exact
2255 set state disabled
2256 } else {
2257 set state normal
2259 $findtypemenu entryconf 1 -state $state
2260 $findtypemenu entryconf 2 -state $state
2263 proc stopfindproc {{done 0}} {
2264 global findprocpid findprocfile findids
2265 global ctext findoldcursor phase maincursor textcursor
2266 global findinprogress
2268 catch {unset findids}
2269 if {[info exists findprocpid]} {
2270 if {!$done} {
2271 catch {exec kill $findprocpid}
2273 catch {close $findprocfile}
2274 unset findprocpid
2276 if {[info exists findinprogress]} {
2277 unset findinprogress
2278 if {$phase eq {}} {
2279 . config -cursor $maincursor
2280 settextcursor $textcursor
2285 proc findpatches {} {
2286 global findstring selectedline numcommits
2287 global findprocpid findprocfile
2288 global finddidsel ctext displayorder findinprogress
2289 global findinsertpos
2291 if {$numcommits == 0} return
2293 # make a list of all the ids to search, starting at the one
2294 # after the selected line (if any)
2295 if {[info exists selectedline]} {
2296 set l $selectedline
2297 } else {
2298 set l -1
2300 set inputids {}
2301 for {set i 0} {$i < $numcommits} {incr i} {
2302 if {[incr l] >= $numcommits} {
2303 set l 0
2305 append inputids [lindex $displayorder $l] "\n"
2308 if {[catch {
2309 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2310 << $inputids] r]
2311 } err]} {
2312 error_popup "Error starting search process: $err"
2313 return
2316 set findinsertpos end
2317 set findprocfile $f
2318 set findprocpid [pid $f]
2319 fconfigure $f -blocking 0
2320 fileevent $f readable readfindproc
2321 set finddidsel 0
2322 . config -cursor watch
2323 settextcursor watch
2324 set findinprogress 1
2327 proc readfindproc {} {
2328 global findprocfile finddidsel
2329 global commitrow matchinglines findinsertpos
2331 set n [gets $findprocfile line]
2332 if {$n < 0} {
2333 if {[eof $findprocfile]} {
2334 stopfindproc 1
2335 if {!$finddidsel} {
2336 bell
2339 return
2341 if {![regexp {^[0-9a-f]{40}} $line id]} {
2342 error_popup "Can't parse git-diff-tree output: $line"
2343 stopfindproc
2344 return
2346 if {![info exists commitrow($id)]} {
2347 puts stderr "spurious id: $id"
2348 return
2350 set l $commitrow($id)
2351 insertmatch $l $id
2354 proc insertmatch {l id} {
2355 global matchinglines findinsertpos finddidsel
2357 if {$findinsertpos == "end"} {
2358 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2359 set matchinglines [linsert $matchinglines 0 $l]
2360 set findinsertpos 1
2361 } else {
2362 lappend matchinglines $l
2364 } else {
2365 set matchinglines [linsert $matchinglines $findinsertpos $l]
2366 incr findinsertpos
2368 markheadline $l $id
2369 if {!$finddidsel} {
2370 findselectline $l
2371 set finddidsel 1
2375 proc findfiles {} {
2376 global selectedline numcommits displayorder ctext
2377 global ffileline finddidsel parentlist
2378 global findinprogress findstartline findinsertpos
2379 global treediffs fdiffid fdiffsneeded fdiffpos
2380 global findmergefiles
2382 if {$numcommits == 0} return
2384 if {[info exists selectedline]} {
2385 set l [expr {$selectedline + 1}]
2386 } else {
2387 set l 0
2389 set ffileline $l
2390 set findstartline $l
2391 set diffsneeded {}
2392 set fdiffsneeded {}
2393 while 1 {
2394 set id [lindex $displayorder $l]
2395 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2396 if {![info exists treediffs($id)]} {
2397 append diffsneeded "$id\n"
2398 lappend fdiffsneeded $id
2401 if {[incr l] >= $numcommits} {
2402 set l 0
2404 if {$l == $findstartline} break
2407 # start off a git-diff-tree process if needed
2408 if {$diffsneeded ne {}} {
2409 if {[catch {
2410 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2411 } err ]} {
2412 error_popup "Error starting search process: $err"
2413 return
2415 catch {unset fdiffid}
2416 set fdiffpos 0
2417 fconfigure $df -blocking 0
2418 fileevent $df readable [list readfilediffs $df]
2421 set finddidsel 0
2422 set findinsertpos end
2423 set id [lindex $displayorder $l]
2424 . config -cursor watch
2425 settextcursor watch
2426 set findinprogress 1
2427 findcont
2428 update
2431 proc readfilediffs {df} {
2432 global findid fdiffid fdiffs
2434 set n [gets $df line]
2435 if {$n < 0} {
2436 if {[eof $df]} {
2437 donefilediff
2438 if {[catch {close $df} err]} {
2439 stopfindproc
2440 bell
2441 error_popup "Error in git-diff-tree: $err"
2442 } elseif {[info exists findid]} {
2443 set id $findid
2444 stopfindproc
2445 bell
2446 error_popup "Couldn't find diffs for $id"
2449 return
2451 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2452 # start of a new string of diffs
2453 donefilediff
2454 set fdiffid $id
2455 set fdiffs {}
2456 } elseif {[string match ":*" $line]} {
2457 lappend fdiffs [lindex $line 5]
2461 proc donefilediff {} {
2462 global fdiffid fdiffs treediffs findid
2463 global fdiffsneeded fdiffpos
2465 if {[info exists fdiffid]} {
2466 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2467 && $fdiffpos < [llength $fdiffsneeded]} {
2468 # git-diff-tree doesn't output anything for a commit
2469 # which doesn't change anything
2470 set nullid [lindex $fdiffsneeded $fdiffpos]
2471 set treediffs($nullid) {}
2472 if {[info exists findid] && $nullid eq $findid} {
2473 unset findid
2474 findcont
2476 incr fdiffpos
2478 incr fdiffpos
2480 if {![info exists treediffs($fdiffid)]} {
2481 set treediffs($fdiffid) $fdiffs
2483 if {[info exists findid] && $fdiffid eq $findid} {
2484 unset findid
2485 findcont
2490 proc findcont {} {
2491 global findid treediffs parentlist
2492 global ffileline findstartline finddidsel
2493 global displayorder numcommits matchinglines findinprogress
2494 global findmergefiles
2496 set l $ffileline
2497 while {1} {
2498 set id [lindex $displayorder $l]
2499 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2500 if {![info exists treediffs($id)]} {
2501 set findid $id
2502 set ffileline $l
2503 return
2505 set doesmatch 0
2506 foreach f $treediffs($id) {
2507 set x [findmatches $f]
2508 if {$x != {}} {
2509 set doesmatch 1
2510 break
2513 if {$doesmatch} {
2514 insertmatch $l $id
2517 if {[incr l] >= $numcommits} {
2518 set l 0
2520 if {$l == $findstartline} break
2522 stopfindproc
2523 if {!$finddidsel} {
2524 bell
2528 # mark a commit as matching by putting a yellow background
2529 # behind the headline
2530 proc markheadline {l id} {
2531 global canv mainfont linehtag
2533 drawcmitrow $l
2534 set bbox [$canv bbox $linehtag($l)]
2535 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2536 $canv lower $t
2539 # mark the bits of a headline, author or date that match a find string
2540 proc markmatches {canv l str tag matches font} {
2541 set bbox [$canv bbox $tag]
2542 set x0 [lindex $bbox 0]
2543 set y0 [lindex $bbox 1]
2544 set y1 [lindex $bbox 3]
2545 foreach match $matches {
2546 set start [lindex $match 0]
2547 set end [lindex $match 1]
2548 if {$start > $end} continue
2549 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2550 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2551 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2552 [expr {$x0+$xlen+2}] $y1 \
2553 -outline {} -tags matches -fill yellow]
2554 $canv lower $t
2558 proc unmarkmatches {} {
2559 global matchinglines findids
2560 allcanvs delete matches
2561 catch {unset matchinglines}
2562 catch {unset findids}
2565 proc selcanvline {w x y} {
2566 global canv canvy0 ctext linespc
2567 global rowtextx
2568 set ymax [lindex [$canv cget -scrollregion] 3]
2569 if {$ymax == {}} return
2570 set yfrac [lindex [$canv yview] 0]
2571 set y [expr {$y + $yfrac * $ymax}]
2572 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2573 if {$l < 0} {
2574 set l 0
2576 if {$w eq $canv} {
2577 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2579 unmarkmatches
2580 selectline $l 1
2583 proc commit_descriptor {p} {
2584 global commitinfo
2585 set l "..."
2586 if {[info exists commitinfo($p)]} {
2587 set l [lindex $commitinfo($p) 0]
2589 return "$p ($l)"
2592 # append some text to the ctext widget, and make any SHA1 ID
2593 # that we know about be a clickable link.
2594 proc appendwithlinks {text} {
2595 global ctext commitrow linknum
2597 set start [$ctext index "end - 1c"]
2598 $ctext insert end $text
2599 $ctext insert end "\n"
2600 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2601 foreach l $links {
2602 set s [lindex $l 0]
2603 set e [lindex $l 1]
2604 set linkid [string range $text $s $e]
2605 if {![info exists commitrow($linkid)]} continue
2606 incr e
2607 $ctext tag add link "$start + $s c" "$start + $e c"
2608 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2609 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2610 incr linknum
2612 $ctext tag conf link -foreground blue -underline 1
2613 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2614 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2617 proc viewnextline {dir} {
2618 global canv linespc
2620 $canv delete hover
2621 set ymax [lindex [$canv cget -scrollregion] 3]
2622 set wnow [$canv yview]
2623 set wtop [expr {[lindex $wnow 0] * $ymax}]
2624 set newtop [expr {$wtop + $dir * $linespc}]
2625 if {$newtop < 0} {
2626 set newtop 0
2627 } elseif {$newtop > $ymax} {
2628 set newtop $ymax
2630 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2633 proc selectline {l isnew} {
2634 global canv canv2 canv3 ctext commitinfo selectedline
2635 global displayorder linehtag linentag linedtag
2636 global canvy0 linespc parentlist childlist
2637 global cflist currentid sha1entry
2638 global commentend idtags linknum
2639 global mergemax numcommits pending_select
2641 catch {unset pending_select}
2642 $canv delete hover
2643 normalline
2644 if {$l < 0 || $l >= $numcommits} return
2645 set y [expr {$canvy0 + $l * $linespc}]
2646 set ymax [lindex [$canv cget -scrollregion] 3]
2647 set ytop [expr {$y - $linespc - 1}]
2648 set ybot [expr {$y + $linespc + 1}]
2649 set wnow [$canv yview]
2650 set wtop [expr {[lindex $wnow 0] * $ymax}]
2651 set wbot [expr {[lindex $wnow 1] * $ymax}]
2652 set wh [expr {$wbot - $wtop}]
2653 set newtop $wtop
2654 if {$ytop < $wtop} {
2655 if {$ybot < $wtop} {
2656 set newtop [expr {$y - $wh / 2.0}]
2657 } else {
2658 set newtop $ytop
2659 if {$newtop > $wtop - $linespc} {
2660 set newtop [expr {$wtop - $linespc}]
2663 } elseif {$ybot > $wbot} {
2664 if {$ytop > $wbot} {
2665 set newtop [expr {$y - $wh / 2.0}]
2666 } else {
2667 set newtop [expr {$ybot - $wh}]
2668 if {$newtop < $wtop + $linespc} {
2669 set newtop [expr {$wtop + $linespc}]
2673 if {$newtop != $wtop} {
2674 if {$newtop < 0} {
2675 set newtop 0
2677 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2678 drawvisible
2681 if {![info exists linehtag($l)]} return
2682 $canv delete secsel
2683 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2684 -tags secsel -fill [$canv cget -selectbackground]]
2685 $canv lower $t
2686 $canv2 delete secsel
2687 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2688 -tags secsel -fill [$canv2 cget -selectbackground]]
2689 $canv2 lower $t
2690 $canv3 delete secsel
2691 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2692 -tags secsel -fill [$canv3 cget -selectbackground]]
2693 $canv3 lower $t
2695 if {$isnew} {
2696 addtohistory [list selectline $l 0]
2699 set selectedline $l
2701 set id [lindex $displayorder $l]
2702 set currentid $id
2703 $sha1entry delete 0 end
2704 $sha1entry insert 0 $id
2705 $sha1entry selection from 0
2706 $sha1entry selection to end
2708 $ctext conf -state normal
2709 $ctext delete 0.0 end
2710 set linknum 0
2711 $ctext mark set fmark.0 0.0
2712 $ctext mark gravity fmark.0 left
2713 set info $commitinfo($id)
2714 set date [formatdate [lindex $info 2]]
2715 $ctext insert end "Author: [lindex $info 1] $date\n"
2716 set date [formatdate [lindex $info 4]]
2717 $ctext insert end "Committer: [lindex $info 3] $date\n"
2718 if {[info exists idtags($id)]} {
2719 $ctext insert end "Tags:"
2720 foreach tag $idtags($id) {
2721 $ctext insert end " $tag"
2723 $ctext insert end "\n"
2726 set comment {}
2727 set olds [lindex $parentlist $l]
2728 if {[llength $olds] > 1} {
2729 set np 0
2730 foreach p $olds {
2731 if {$np >= $mergemax} {
2732 set tag mmax
2733 } else {
2734 set tag m$np
2736 $ctext insert end "Parent: " $tag
2737 appendwithlinks [commit_descriptor $p]
2738 incr np
2740 } else {
2741 foreach p $olds {
2742 append comment "Parent: [commit_descriptor $p]\n"
2746 foreach c [lindex $childlist $l] {
2747 append comment "Child: [commit_descriptor $c]\n"
2749 append comment "\n"
2750 append comment [lindex $info 5]
2752 # make anything that looks like a SHA1 ID be a clickable link
2753 appendwithlinks $comment
2755 $ctext tag delete Comments
2756 $ctext tag remove found 1.0 end
2757 $ctext conf -state disabled
2758 set commentend [$ctext index "end - 1c"]
2760 $cflist delete 0 end
2761 $cflist insert end "Comments"
2762 if {[llength $olds] <= 1} {
2763 startdiff $id
2764 } else {
2765 mergediff $id $l
2769 proc selfirstline {} {
2770 unmarkmatches
2771 selectline 0 1
2774 proc sellastline {} {
2775 global numcommits
2776 unmarkmatches
2777 set l [expr {$numcommits - 1}]
2778 selectline $l 1
2781 proc selnextline {dir} {
2782 global selectedline
2783 if {![info exists selectedline]} return
2784 set l [expr {$selectedline + $dir}]
2785 unmarkmatches
2786 selectline $l 1
2789 proc selnextpage {dir} {
2790 global canv linespc selectedline numcommits
2792 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2793 if {$lpp < 1} {
2794 set lpp 1
2796 allcanvs yview scroll [expr {$dir * $lpp}] units
2797 if {![info exists selectedline]} return
2798 set l [expr {$selectedline + $dir * $lpp}]
2799 if {$l < 0} {
2800 set l 0
2801 } elseif {$l >= $numcommits} {
2802 set l [expr $numcommits - 1]
2804 unmarkmatches
2805 selectline $l 1
2808 proc unselectline {} {
2809 global selectedline currentid
2811 catch {unset selectedline}
2812 catch {unset currentid}
2813 allcanvs delete secsel
2816 proc addtohistory {cmd} {
2817 global history historyindex curview
2819 set elt [list $curview $cmd]
2820 if {$historyindex > 0
2821 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
2822 return
2825 if {$historyindex < [llength $history]} {
2826 set history [lreplace $history $historyindex end $elt]
2827 } else {
2828 lappend history $elt
2830 incr historyindex
2831 if {$historyindex > 1} {
2832 .ctop.top.bar.leftbut conf -state normal
2833 } else {
2834 .ctop.top.bar.leftbut conf -state disabled
2836 .ctop.top.bar.rightbut conf -state disabled
2839 proc godo {elt} {
2840 global curview
2842 set view [lindex $elt 0]
2843 set cmd [lindex $elt 1]
2844 if {$curview != $view} {
2845 showview $view
2847 eval $cmd
2850 proc goback {} {
2851 global history historyindex
2853 if {$historyindex > 1} {
2854 incr historyindex -1
2855 godo [lindex $history [expr {$historyindex - 1}]]
2856 .ctop.top.bar.rightbut conf -state normal
2858 if {$historyindex <= 1} {
2859 .ctop.top.bar.leftbut conf -state disabled
2863 proc goforw {} {
2864 global history historyindex
2866 if {$historyindex < [llength $history]} {
2867 set cmd [lindex $history $historyindex]
2868 incr historyindex
2869 godo $cmd
2870 .ctop.top.bar.leftbut conf -state normal
2872 if {$historyindex >= [llength $history]} {
2873 .ctop.top.bar.rightbut conf -state disabled
2877 proc mergediff {id l} {
2878 global diffmergeid diffopts mdifffd
2879 global difffilestart diffids
2880 global parentlist
2882 set diffmergeid $id
2883 set diffids $id
2884 catch {unset difffilestart}
2885 # this doesn't seem to actually affect anything...
2886 set env(GIT_DIFF_OPTS) $diffopts
2887 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2888 if {[catch {set mdf [open $cmd r]} err]} {
2889 error_popup "Error getting merge diffs: $err"
2890 return
2892 fconfigure $mdf -blocking 0
2893 set mdifffd($id) $mdf
2894 set np [llength [lindex $parentlist $l]]
2895 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2896 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2899 proc getmergediffline {mdf id np} {
2900 global diffmergeid ctext cflist nextupdate mergemax
2901 global difffilestart mdifffd
2903 set n [gets $mdf line]
2904 if {$n < 0} {
2905 if {[eof $mdf]} {
2906 close $mdf
2908 return
2910 if {![info exists diffmergeid] || $id != $diffmergeid
2911 || $mdf != $mdifffd($id)} {
2912 return
2914 $ctext conf -state normal
2915 if {[regexp {^diff --cc (.*)} $line match fname]} {
2916 # start of a new file
2917 $ctext insert end "\n"
2918 set here [$ctext index "end - 1c"]
2919 set i [$cflist index end]
2920 $ctext mark set fmark.$i $here
2921 $ctext mark gravity fmark.$i left
2922 set difffilestart([expr {$i-1}]) $here
2923 $cflist insert end $fname
2924 set l [expr {(78 - [string length $fname]) / 2}]
2925 set pad [string range "----------------------------------------" 1 $l]
2926 $ctext insert end "$pad $fname $pad\n" filesep
2927 } elseif {[regexp {^@@} $line]} {
2928 $ctext insert end "$line\n" hunksep
2929 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2930 # do nothing
2931 } else {
2932 # parse the prefix - one ' ', '-' or '+' for each parent
2933 set spaces {}
2934 set minuses {}
2935 set pluses {}
2936 set isbad 0
2937 for {set j 0} {$j < $np} {incr j} {
2938 set c [string range $line $j $j]
2939 if {$c == " "} {
2940 lappend spaces $j
2941 } elseif {$c == "-"} {
2942 lappend minuses $j
2943 } elseif {$c == "+"} {
2944 lappend pluses $j
2945 } else {
2946 set isbad 1
2947 break
2950 set tags {}
2951 set num {}
2952 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2953 # line doesn't appear in result, parents in $minuses have the line
2954 set num [lindex $minuses 0]
2955 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2956 # line appears in result, parents in $pluses don't have the line
2957 lappend tags mresult
2958 set num [lindex $spaces 0]
2960 if {$num ne {}} {
2961 if {$num >= $mergemax} {
2962 set num "max"
2964 lappend tags m$num
2966 $ctext insert end "$line\n" $tags
2968 $ctext conf -state disabled
2969 if {[clock clicks -milliseconds] >= $nextupdate} {
2970 incr nextupdate 100
2971 fileevent $mdf readable {}
2972 update
2973 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2977 proc startdiff {ids} {
2978 global treediffs diffids treepending diffmergeid
2980 set diffids $ids
2981 catch {unset diffmergeid}
2982 if {![info exists treediffs($ids)]} {
2983 if {![info exists treepending]} {
2984 gettreediffs $ids
2986 } else {
2987 addtocflist $ids
2991 proc addtocflist {ids} {
2992 global treediffs cflist
2993 foreach f $treediffs($ids) {
2994 $cflist insert end $f
2996 getblobdiffs $ids
2999 proc gettreediffs {ids} {
3000 global treediff treepending
3001 set treepending $ids
3002 set treediff {}
3003 if {[catch \
3004 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3005 ]} return
3006 fconfigure $gdtf -blocking 0
3007 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3010 proc gettreediffline {gdtf ids} {
3011 global treediff treediffs treepending diffids diffmergeid
3013 set n [gets $gdtf line]
3014 if {$n < 0} {
3015 if {![eof $gdtf]} return
3016 close $gdtf
3017 set treediffs($ids) $treediff
3018 unset treepending
3019 if {$ids != $diffids} {
3020 if {![info exists diffmergeid]} {
3021 gettreediffs $diffids
3023 } else {
3024 addtocflist $ids
3026 return
3028 set file [lindex $line 5]
3029 lappend treediff $file
3032 proc getblobdiffs {ids} {
3033 global diffopts blobdifffd diffids env curdifftag curtagstart
3034 global difffilestart nextupdate diffinhdr treediffs
3036 set env(GIT_DIFF_OPTS) $diffopts
3037 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3038 if {[catch {set bdf [open $cmd r]} err]} {
3039 puts "error getting diffs: $err"
3040 return
3042 set diffinhdr 0
3043 fconfigure $bdf -blocking 0
3044 set blobdifffd($ids) $bdf
3045 set curdifftag Comments
3046 set curtagstart 0.0
3047 catch {unset difffilestart}
3048 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3049 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3052 proc getblobdiffline {bdf ids} {
3053 global diffids blobdifffd ctext curdifftag curtagstart
3054 global diffnexthead diffnextnote difffilestart
3055 global nextupdate diffinhdr treediffs
3057 set n [gets $bdf line]
3058 if {$n < 0} {
3059 if {[eof $bdf]} {
3060 close $bdf
3061 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3062 $ctext tag add $curdifftag $curtagstart end
3065 return
3067 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3068 return
3070 $ctext conf -state normal
3071 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3072 # start of a new file
3073 $ctext insert end "\n"
3074 $ctext tag add $curdifftag $curtagstart end
3075 set curtagstart [$ctext index "end - 1c"]
3076 set header $newname
3077 set here [$ctext index "end - 1c"]
3078 set i [lsearch -exact $treediffs($diffids) $fname]
3079 if {$i >= 0} {
3080 set difffilestart($i) $here
3081 incr i
3082 $ctext mark set fmark.$i $here
3083 $ctext mark gravity fmark.$i left
3085 if {$newname != $fname} {
3086 set i [lsearch -exact $treediffs($diffids) $newname]
3087 if {$i >= 0} {
3088 set difffilestart($i) $here
3089 incr i
3090 $ctext mark set fmark.$i $here
3091 $ctext mark gravity fmark.$i left
3094 set curdifftag "f:$fname"
3095 $ctext tag delete $curdifftag
3096 set l [expr {(78 - [string length $header]) / 2}]
3097 set pad [string range "----------------------------------------" 1 $l]
3098 $ctext insert end "$pad $header $pad\n" filesep
3099 set diffinhdr 1
3100 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3101 # do nothing
3102 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3103 set diffinhdr 0
3104 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3105 $line match f1l f1c f2l f2c rest]} {
3106 $ctext insert end "$line\n" hunksep
3107 set diffinhdr 0
3108 } else {
3109 set x [string range $line 0 0]
3110 if {$x == "-" || $x == "+"} {
3111 set tag [expr {$x == "+"}]
3112 $ctext insert end "$line\n" d$tag
3113 } elseif {$x == " "} {
3114 $ctext insert end "$line\n"
3115 } elseif {$diffinhdr || $x == "\\"} {
3116 # e.g. "\ No newline at end of file"
3117 $ctext insert end "$line\n" filesep
3118 } else {
3119 # Something else we don't recognize
3120 if {$curdifftag != "Comments"} {
3121 $ctext insert end "\n"
3122 $ctext tag add $curdifftag $curtagstart end
3123 set curtagstart [$ctext index "end - 1c"]
3124 set curdifftag Comments
3126 $ctext insert end "$line\n" filesep
3129 $ctext conf -state disabled
3130 if {[clock clicks -milliseconds] >= $nextupdate} {
3131 incr nextupdate 100
3132 fileevent $bdf readable {}
3133 update
3134 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3138 proc nextfile {} {
3139 global difffilestart ctext
3140 set here [$ctext index @0,0]
3141 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3142 if {[$ctext compare $difffilestart($i) > $here]} {
3143 if {![info exists pos]
3144 || [$ctext compare $difffilestart($i) < $pos]} {
3145 set pos $difffilestart($i)
3149 if {[info exists pos]} {
3150 $ctext yview $pos
3154 proc listboxsel {} {
3155 global ctext cflist currentid
3156 if {![info exists currentid]} return
3157 set sel [lsort [$cflist curselection]]
3158 if {$sel eq {}} return
3159 set first [lindex $sel 0]
3160 catch {$ctext yview fmark.$first}
3163 proc setcoords {} {
3164 global linespc charspc canvx0 canvy0 mainfont
3165 global xspc1 xspc2 lthickness
3167 set linespc [font metrics $mainfont -linespace]
3168 set charspc [font measure $mainfont "m"]
3169 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3170 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3171 set lthickness [expr {int($linespc / 9) + 1}]
3172 set xspc1(0) $linespc
3173 set xspc2 $linespc
3176 proc redisplay {} {
3177 global canv
3178 global selectedline
3180 set ymax [lindex [$canv cget -scrollregion] 3]
3181 if {$ymax eq {} || $ymax == 0} return
3182 set span [$canv yview]
3183 clear_display
3184 setcanvscroll
3185 allcanvs yview moveto [lindex $span 0]
3186 drawvisible
3187 if {[info exists selectedline]} {
3188 selectline $selectedline 0
3192 proc incrfont {inc} {
3193 global mainfont namefont textfont ctext canv phase
3194 global stopped entries
3195 unmarkmatches
3196 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3197 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3198 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3199 setcoords
3200 $ctext conf -font $textfont
3201 $ctext tag conf filesep -font [concat $textfont bold]
3202 foreach e $entries {
3203 $e conf -font $mainfont
3205 if {$phase eq "getcommits"} {
3206 $canv itemconf textitems -font $mainfont
3208 redisplay
3211 proc clearsha1 {} {
3212 global sha1entry sha1string
3213 if {[string length $sha1string] == 40} {
3214 $sha1entry delete 0 end
3218 proc sha1change {n1 n2 op} {
3219 global sha1string currentid sha1but
3220 if {$sha1string == {}
3221 || ([info exists currentid] && $sha1string == $currentid)} {
3222 set state disabled
3223 } else {
3224 set state normal
3226 if {[$sha1but cget -state] == $state} return
3227 if {$state == "normal"} {
3228 $sha1but conf -state normal -relief raised -text "Goto: "
3229 } else {
3230 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3234 proc gotocommit {} {
3235 global sha1string currentid commitrow tagids headids
3236 global displayorder numcommits
3238 if {$sha1string == {}
3239 || ([info exists currentid] && $sha1string == $currentid)} return
3240 if {[info exists tagids($sha1string)]} {
3241 set id $tagids($sha1string)
3242 } elseif {[info exists headids($sha1string)]} {
3243 set id $headids($sha1string)
3244 } else {
3245 set id [string tolower $sha1string]
3246 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3247 set matches {}
3248 foreach i $displayorder {
3249 if {[string match $id* $i]} {
3250 lappend matches $i
3253 if {$matches ne {}} {
3254 if {[llength $matches] > 1} {
3255 error_popup "Short SHA1 id $id is ambiguous"
3256 return
3258 set id [lindex $matches 0]
3262 if {[info exists commitrow($id)]} {
3263 selectline $commitrow($id) 1
3264 return
3266 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3267 set type "SHA1 id"
3268 } else {
3269 set type "Tag/Head"
3271 error_popup "$type $sha1string is not known"
3274 proc lineenter {x y id} {
3275 global hoverx hovery hoverid hovertimer
3276 global commitinfo canv
3278 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3279 set hoverx $x
3280 set hovery $y
3281 set hoverid $id
3282 if {[info exists hovertimer]} {
3283 after cancel $hovertimer
3285 set hovertimer [after 500 linehover]
3286 $canv delete hover
3289 proc linemotion {x y id} {
3290 global hoverx hovery hoverid hovertimer
3292 if {[info exists hoverid] && $id == $hoverid} {
3293 set hoverx $x
3294 set hovery $y
3295 if {[info exists hovertimer]} {
3296 after cancel $hovertimer
3298 set hovertimer [after 500 linehover]
3302 proc lineleave {id} {
3303 global hoverid hovertimer canv
3305 if {[info exists hoverid] && $id == $hoverid} {
3306 $canv delete hover
3307 if {[info exists hovertimer]} {
3308 after cancel $hovertimer
3309 unset hovertimer
3311 unset hoverid
3315 proc linehover {} {
3316 global hoverx hovery hoverid hovertimer
3317 global canv linespc lthickness
3318 global commitinfo mainfont
3320 set text [lindex $commitinfo($hoverid) 0]
3321 set ymax [lindex [$canv cget -scrollregion] 3]
3322 if {$ymax == {}} return
3323 set yfrac [lindex [$canv yview] 0]
3324 set x [expr {$hoverx + 2 * $linespc}]
3325 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3326 set x0 [expr {$x - 2 * $lthickness}]
3327 set y0 [expr {$y - 2 * $lthickness}]
3328 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3329 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3330 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3331 -fill \#ffff80 -outline black -width 1 -tags hover]
3332 $canv raise $t
3333 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3334 $canv raise $t
3337 proc clickisonarrow {id y} {
3338 global lthickness
3340 set ranges [rowranges $id]
3341 set thresh [expr {2 * $lthickness + 6}]
3342 set n [expr {[llength $ranges] - 1}]
3343 for {set i 1} {$i < $n} {incr i} {
3344 set row [lindex $ranges $i]
3345 if {abs([yc $row] - $y) < $thresh} {
3346 return $i
3349 return {}
3352 proc arrowjump {id n y} {
3353 global canv
3355 # 1 <-> 2, 3 <-> 4, etc...
3356 set n [expr {(($n - 1) ^ 1) + 1}]
3357 set row [lindex [rowranges $id] $n]
3358 set yt [yc $row]
3359 set ymax [lindex [$canv cget -scrollregion] 3]
3360 if {$ymax eq {} || $ymax <= 0} return
3361 set view [$canv yview]
3362 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3363 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3364 if {$yfrac < 0} {
3365 set yfrac 0
3367 allcanvs yview moveto $yfrac
3370 proc lineclick {x y id isnew} {
3371 global ctext commitinfo childlist commitrow cflist canv thickerline
3373 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3374 unmarkmatches
3375 unselectline
3376 normalline
3377 $canv delete hover
3378 # draw this line thicker than normal
3379 set thickerline $id
3380 drawlines $id
3381 if {$isnew} {
3382 set ymax [lindex [$canv cget -scrollregion] 3]
3383 if {$ymax eq {}} return
3384 set yfrac [lindex [$canv yview] 0]
3385 set y [expr {$y + $yfrac * $ymax}]
3387 set dirn [clickisonarrow $id $y]
3388 if {$dirn ne {}} {
3389 arrowjump $id $dirn $y
3390 return
3393 if {$isnew} {
3394 addtohistory [list lineclick $x $y $id 0]
3396 # fill the details pane with info about this line
3397 $ctext conf -state normal
3398 $ctext delete 0.0 end
3399 $ctext tag conf link -foreground blue -underline 1
3400 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3401 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3402 $ctext insert end "Parent:\t"
3403 $ctext insert end $id [list link link0]
3404 $ctext tag bind link0 <1> [list selbyid $id]
3405 set info $commitinfo($id)
3406 $ctext insert end "\n\t[lindex $info 0]\n"
3407 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3408 set date [formatdate [lindex $info 2]]
3409 $ctext insert end "\tDate:\t$date\n"
3410 set kids [lindex $childlist $commitrow($id)]
3411 if {$kids ne {}} {
3412 $ctext insert end "\nChildren:"
3413 set i 0
3414 foreach child $kids {
3415 incr i
3416 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3417 set info $commitinfo($child)
3418 $ctext insert end "\n\t"
3419 $ctext insert end $child [list link link$i]
3420 $ctext tag bind link$i <1> [list selbyid $child]
3421 $ctext insert end "\n\t[lindex $info 0]"
3422 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3423 set date [formatdate [lindex $info 2]]
3424 $ctext insert end "\n\tDate:\t$date\n"
3427 $ctext conf -state disabled
3429 $cflist delete 0 end
3432 proc normalline {} {
3433 global thickerline
3434 if {[info exists thickerline]} {
3435 set id $thickerline
3436 unset thickerline
3437 drawlines $id
3441 proc selbyid {id} {
3442 global commitrow
3443 if {[info exists commitrow($id)]} {
3444 selectline $commitrow($id) 1
3448 proc mstime {} {
3449 global startmstime
3450 if {![info exists startmstime]} {
3451 set startmstime [clock clicks -milliseconds]
3453 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3456 proc rowmenu {x y id} {
3457 global rowctxmenu commitrow selectedline rowmenuid
3459 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3460 set state disabled
3461 } else {
3462 set state normal
3464 $rowctxmenu entryconfigure 0 -state $state
3465 $rowctxmenu entryconfigure 1 -state $state
3466 $rowctxmenu entryconfigure 2 -state $state
3467 set rowmenuid $id
3468 tk_popup $rowctxmenu $x $y
3471 proc diffvssel {dirn} {
3472 global rowmenuid selectedline displayorder
3474 if {![info exists selectedline]} return
3475 if {$dirn} {
3476 set oldid [lindex $displayorder $selectedline]
3477 set newid $rowmenuid
3478 } else {
3479 set oldid $rowmenuid
3480 set newid [lindex $displayorder $selectedline]
3482 addtohistory [list doseldiff $oldid $newid]
3483 doseldiff $oldid $newid
3486 proc doseldiff {oldid newid} {
3487 global ctext cflist
3488 global commitinfo
3490 $ctext conf -state normal
3491 $ctext delete 0.0 end
3492 $ctext mark set fmark.0 0.0
3493 $ctext mark gravity fmark.0 left
3494 $cflist delete 0 end
3495 $cflist insert end "Top"
3496 $ctext insert end "From "
3497 $ctext tag conf link -foreground blue -underline 1
3498 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3499 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3500 $ctext tag bind link0 <1> [list selbyid $oldid]
3501 $ctext insert end $oldid [list link link0]
3502 $ctext insert end "\n "
3503 $ctext insert end [lindex $commitinfo($oldid) 0]
3504 $ctext insert end "\n\nTo "
3505 $ctext tag bind link1 <1> [list selbyid $newid]
3506 $ctext insert end $newid [list link link1]
3507 $ctext insert end "\n "
3508 $ctext insert end [lindex $commitinfo($newid) 0]
3509 $ctext insert end "\n"
3510 $ctext conf -state disabled
3511 $ctext tag delete Comments
3512 $ctext tag remove found 1.0 end
3513 startdiff [list $oldid $newid]
3516 proc mkpatch {} {
3517 global rowmenuid currentid commitinfo patchtop patchnum
3519 if {![info exists currentid]} return
3520 set oldid $currentid
3521 set oldhead [lindex $commitinfo($oldid) 0]
3522 set newid $rowmenuid
3523 set newhead [lindex $commitinfo($newid) 0]
3524 set top .patch
3525 set patchtop $top
3526 catch {destroy $top}
3527 toplevel $top
3528 label $top.title -text "Generate patch"
3529 grid $top.title - -pady 10
3530 label $top.from -text "From:"
3531 entry $top.fromsha1 -width 40 -relief flat
3532 $top.fromsha1 insert 0 $oldid
3533 $top.fromsha1 conf -state readonly
3534 grid $top.from $top.fromsha1 -sticky w
3535 entry $top.fromhead -width 60 -relief flat
3536 $top.fromhead insert 0 $oldhead
3537 $top.fromhead conf -state readonly
3538 grid x $top.fromhead -sticky w
3539 label $top.to -text "To:"
3540 entry $top.tosha1 -width 40 -relief flat
3541 $top.tosha1 insert 0 $newid
3542 $top.tosha1 conf -state readonly
3543 grid $top.to $top.tosha1 -sticky w
3544 entry $top.tohead -width 60 -relief flat
3545 $top.tohead insert 0 $newhead
3546 $top.tohead conf -state readonly
3547 grid x $top.tohead -sticky w
3548 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3549 grid $top.rev x -pady 10
3550 label $top.flab -text "Output file:"
3551 entry $top.fname -width 60
3552 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3553 incr patchnum
3554 grid $top.flab $top.fname -sticky w
3555 frame $top.buts
3556 button $top.buts.gen -text "Generate" -command mkpatchgo
3557 button $top.buts.can -text "Cancel" -command mkpatchcan
3558 grid $top.buts.gen $top.buts.can
3559 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3560 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3561 grid $top.buts - -pady 10 -sticky ew
3562 focus $top.fname
3565 proc mkpatchrev {} {
3566 global patchtop
3568 set oldid [$patchtop.fromsha1 get]
3569 set oldhead [$patchtop.fromhead get]
3570 set newid [$patchtop.tosha1 get]
3571 set newhead [$patchtop.tohead get]
3572 foreach e [list fromsha1 fromhead tosha1 tohead] \
3573 v [list $newid $newhead $oldid $oldhead] {
3574 $patchtop.$e conf -state normal
3575 $patchtop.$e delete 0 end
3576 $patchtop.$e insert 0 $v
3577 $patchtop.$e conf -state readonly
3581 proc mkpatchgo {} {
3582 global patchtop
3584 set oldid [$patchtop.fromsha1 get]
3585 set newid [$patchtop.tosha1 get]
3586 set fname [$patchtop.fname get]
3587 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3588 error_popup "Error creating patch: $err"
3590 catch {destroy $patchtop}
3591 unset patchtop
3594 proc mkpatchcan {} {
3595 global patchtop
3597 catch {destroy $patchtop}
3598 unset patchtop
3601 proc mktag {} {
3602 global rowmenuid mktagtop commitinfo
3604 set top .maketag
3605 set mktagtop $top
3606 catch {destroy $top}
3607 toplevel $top
3608 label $top.title -text "Create tag"
3609 grid $top.title - -pady 10
3610 label $top.id -text "ID:"
3611 entry $top.sha1 -width 40 -relief flat
3612 $top.sha1 insert 0 $rowmenuid
3613 $top.sha1 conf -state readonly
3614 grid $top.id $top.sha1 -sticky w
3615 entry $top.head -width 60 -relief flat
3616 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3617 $top.head conf -state readonly
3618 grid x $top.head -sticky w
3619 label $top.tlab -text "Tag name:"
3620 entry $top.tag -width 60
3621 grid $top.tlab $top.tag -sticky w
3622 frame $top.buts
3623 button $top.buts.gen -text "Create" -command mktaggo
3624 button $top.buts.can -text "Cancel" -command mktagcan
3625 grid $top.buts.gen $top.buts.can
3626 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3627 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3628 grid $top.buts - -pady 10 -sticky ew
3629 focus $top.tag
3632 proc domktag {} {
3633 global mktagtop env tagids idtags
3635 set id [$mktagtop.sha1 get]
3636 set tag [$mktagtop.tag get]
3637 if {$tag == {}} {
3638 error_popup "No tag name specified"
3639 return
3641 if {[info exists tagids($tag)]} {
3642 error_popup "Tag \"$tag\" already exists"
3643 return
3645 if {[catch {
3646 set dir [gitdir]
3647 set fname [file join $dir "refs/tags" $tag]
3648 set f [open $fname w]
3649 puts $f $id
3650 close $f
3651 } err]} {
3652 error_popup "Error creating tag: $err"
3653 return
3656 set tagids($tag) $id
3657 lappend idtags($id) $tag
3658 redrawtags $id
3661 proc redrawtags {id} {
3662 global canv linehtag commitrow idpos selectedline
3664 if {![info exists commitrow($id)]} return
3665 drawcmitrow $commitrow($id)
3666 $canv delete tag.$id
3667 set xt [eval drawtags $id $idpos($id)]
3668 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3669 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3670 selectline $selectedline 0
3674 proc mktagcan {} {
3675 global mktagtop
3677 catch {destroy $mktagtop}
3678 unset mktagtop
3681 proc mktaggo {} {
3682 domktag
3683 mktagcan
3686 proc writecommit {} {
3687 global rowmenuid wrcomtop commitinfo wrcomcmd
3689 set top .writecommit
3690 set wrcomtop $top
3691 catch {destroy $top}
3692 toplevel $top
3693 label $top.title -text "Write commit to file"
3694 grid $top.title - -pady 10
3695 label $top.id -text "ID:"
3696 entry $top.sha1 -width 40 -relief flat
3697 $top.sha1 insert 0 $rowmenuid
3698 $top.sha1 conf -state readonly
3699 grid $top.id $top.sha1 -sticky w
3700 entry $top.head -width 60 -relief flat
3701 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3702 $top.head conf -state readonly
3703 grid x $top.head -sticky w
3704 label $top.clab -text "Command:"
3705 entry $top.cmd -width 60 -textvariable wrcomcmd
3706 grid $top.clab $top.cmd -sticky w -pady 10
3707 label $top.flab -text "Output file:"
3708 entry $top.fname -width 60
3709 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3710 grid $top.flab $top.fname -sticky w
3711 frame $top.buts
3712 button $top.buts.gen -text "Write" -command wrcomgo
3713 button $top.buts.can -text "Cancel" -command wrcomcan
3714 grid $top.buts.gen $top.buts.can
3715 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3716 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3717 grid $top.buts - -pady 10 -sticky ew
3718 focus $top.fname
3721 proc wrcomgo {} {
3722 global wrcomtop
3724 set id [$wrcomtop.sha1 get]
3725 set cmd "echo $id | [$wrcomtop.cmd get]"
3726 set fname [$wrcomtop.fname get]
3727 if {[catch {exec sh -c $cmd >$fname &} err]} {
3728 error_popup "Error writing commit: $err"
3730 catch {destroy $wrcomtop}
3731 unset wrcomtop
3734 proc wrcomcan {} {
3735 global wrcomtop
3737 catch {destroy $wrcomtop}
3738 unset wrcomtop
3741 proc listrefs {id} {
3742 global idtags idheads idotherrefs
3744 set x {}
3745 if {[info exists idtags($id)]} {
3746 set x $idtags($id)
3748 set y {}
3749 if {[info exists idheads($id)]} {
3750 set y $idheads($id)
3752 set z {}
3753 if {[info exists idotherrefs($id)]} {
3754 set z $idotherrefs($id)
3756 return [list $x $y $z]
3759 proc rereadrefs {} {
3760 global idtags idheads idotherrefs
3762 set refids [concat [array names idtags] \
3763 [array names idheads] [array names idotherrefs]]
3764 foreach id $refids {
3765 if {![info exists ref($id)]} {
3766 set ref($id) [listrefs $id]
3769 readrefs
3770 set refids [lsort -unique [concat $refids [array names idtags] \
3771 [array names idheads] [array names idotherrefs]]]
3772 foreach id $refids {
3773 set v [listrefs $id]
3774 if {![info exists ref($id)] || $ref($id) != $v} {
3775 redrawtags $id
3780 proc showtag {tag isnew} {
3781 global ctext cflist tagcontents tagids linknum
3783 if {$isnew} {
3784 addtohistory [list showtag $tag 0]
3786 $ctext conf -state normal
3787 $ctext delete 0.0 end
3788 set linknum 0
3789 if {[info exists tagcontents($tag)]} {
3790 set text $tagcontents($tag)
3791 } else {
3792 set text "Tag: $tag\nId: $tagids($tag)"
3794 appendwithlinks $text
3795 $ctext conf -state disabled
3796 $cflist delete 0 end
3799 proc doquit {} {
3800 global stopped
3801 set stopped 100
3802 destroy .
3805 proc doprefs {} {
3806 global maxwidth maxgraphpct diffopts findmergefiles
3807 global oldprefs prefstop
3809 set top .gitkprefs
3810 set prefstop $top
3811 if {[winfo exists $top]} {
3812 raise $top
3813 return
3815 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3816 set oldprefs($v) [set $v]
3818 toplevel $top
3819 wm title $top "Gitk preferences"
3820 label $top.ldisp -text "Commit list display options"
3821 grid $top.ldisp - -sticky w -pady 10
3822 label $top.spacer -text " "
3823 label $top.maxwidthl -text "Maximum graph width (lines)" \
3824 -font optionfont
3825 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3826 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3827 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3828 -font optionfont
3829 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3830 grid x $top.maxpctl $top.maxpct -sticky w
3831 checkbutton $top.findm -variable findmergefiles
3832 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3833 -font optionfont
3834 grid $top.findm $top.findml - -sticky w
3835 label $top.ddisp -text "Diff display options"
3836 grid $top.ddisp - -sticky w -pady 10
3837 label $top.diffoptl -text "Options for diff program" \
3838 -font optionfont
3839 entry $top.diffopt -width 20 -textvariable diffopts
3840 grid x $top.diffoptl $top.diffopt -sticky w
3841 frame $top.buts
3842 button $top.buts.ok -text "OK" -command prefsok
3843 button $top.buts.can -text "Cancel" -command prefscan
3844 grid $top.buts.ok $top.buts.can
3845 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3846 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3847 grid $top.buts - - -pady 10 -sticky ew
3850 proc prefscan {} {
3851 global maxwidth maxgraphpct diffopts findmergefiles
3852 global oldprefs prefstop
3854 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3855 set $v $oldprefs($v)
3857 catch {destroy $prefstop}
3858 unset prefstop
3861 proc prefsok {} {
3862 global maxwidth maxgraphpct
3863 global oldprefs prefstop
3865 catch {destroy $prefstop}
3866 unset prefstop
3867 if {$maxwidth != $oldprefs(maxwidth)
3868 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3869 redisplay
3873 proc formatdate {d} {
3874 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3877 # This list of encoding names and aliases is distilled from
3878 # http://www.iana.org/assignments/character-sets.
3879 # Not all of them are supported by Tcl.
3880 set encoding_aliases {
3881 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3882 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3883 { ISO-10646-UTF-1 csISO10646UTF1 }
3884 { ISO_646.basic:1983 ref csISO646basic1983 }
3885 { INVARIANT csINVARIANT }
3886 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3887 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3888 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3889 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3890 { NATS-DANO iso-ir-9-1 csNATSDANO }
3891 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3892 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3893 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3894 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3895 { ISO-2022-KR csISO2022KR }
3896 { EUC-KR csEUCKR }
3897 { ISO-2022-JP csISO2022JP }
3898 { ISO-2022-JP-2 csISO2022JP2 }
3899 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3900 csISO13JISC6220jp }
3901 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3902 { IT iso-ir-15 ISO646-IT csISO15Italian }
3903 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3904 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3905 { greek7-old iso-ir-18 csISO18Greek7Old }
3906 { latin-greek iso-ir-19 csISO19LatinGreek }
3907 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3908 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3909 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3910 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3911 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3912 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3913 { INIS iso-ir-49 csISO49INIS }
3914 { INIS-8 iso-ir-50 csISO50INIS8 }
3915 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3916 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3917 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3918 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3919 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3920 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3921 csISO60Norwegian1 }
3922 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3923 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3924 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3925 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3926 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3927 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3928 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3929 { greek7 iso-ir-88 csISO88Greek7 }
3930 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3931 { iso-ir-90 csISO90 }
3932 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3933 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3934 csISO92JISC62991984b }
3935 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3936 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3937 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3938 csISO95JIS62291984handadd }
3939 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3940 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3941 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3942 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3943 CP819 csISOLatin1 }
3944 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3945 { T.61-7bit iso-ir-102 csISO102T617bit }
3946 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3947 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3948 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3949 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3950 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3951 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3952 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3953 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3954 arabic csISOLatinArabic }
3955 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3956 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3957 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3958 greek greek8 csISOLatinGreek }
3959 { T.101-G2 iso-ir-128 csISO128T101G2 }
3960 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3961 csISOLatinHebrew }
3962 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3963 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3964 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3965 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3966 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3967 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3968 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3969 csISOLatinCyrillic }
3970 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3971 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3972 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3973 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3974 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3975 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3976 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3977 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3978 { ISO_10367-box iso-ir-155 csISO10367Box }
3979 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3980 { latin-lap lap iso-ir-158 csISO158Lap }
3981 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3982 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3983 { us-dk csUSDK }
3984 { dk-us csDKUS }
3985 { JIS_X0201 X0201 csHalfWidthKatakana }
3986 { KSC5636 ISO646-KR csKSC5636 }
3987 { ISO-10646-UCS-2 csUnicode }
3988 { ISO-10646-UCS-4 csUCS4 }
3989 { DEC-MCS dec csDECMCS }
3990 { hp-roman8 roman8 r8 csHPRoman8 }
3991 { macintosh mac csMacintosh }
3992 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3993 csIBM037 }
3994 { IBM038 EBCDIC-INT cp038 csIBM038 }
3995 { IBM273 CP273 csIBM273 }
3996 { IBM274 EBCDIC-BE CP274 csIBM274 }
3997 { IBM275 EBCDIC-BR cp275 csIBM275 }
3998 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3999 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4000 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4001 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4002 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4003 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4004 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4005 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4006 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4007 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4008 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4009 { IBM437 cp437 437 csPC8CodePage437 }
4010 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4011 { IBM775 cp775 csPC775Baltic }
4012 { IBM850 cp850 850 csPC850Multilingual }
4013 { IBM851 cp851 851 csIBM851 }
4014 { IBM852 cp852 852 csPCp852 }
4015 { IBM855 cp855 855 csIBM855 }
4016 { IBM857 cp857 857 csIBM857 }
4017 { IBM860 cp860 860 csIBM860 }
4018 { IBM861 cp861 861 cp-is csIBM861 }
4019 { IBM862 cp862 862 csPC862LatinHebrew }
4020 { IBM863 cp863 863 csIBM863 }
4021 { IBM864 cp864 csIBM864 }
4022 { IBM865 cp865 865 csIBM865 }
4023 { IBM866 cp866 866 csIBM866 }
4024 { IBM868 CP868 cp-ar csIBM868 }
4025 { IBM869 cp869 869 cp-gr csIBM869 }
4026 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4027 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4028 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4029 { IBM891 cp891 csIBM891 }
4030 { IBM903 cp903 csIBM903 }
4031 { IBM904 cp904 904 csIBBM904 }
4032 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4033 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4034 { IBM1026 CP1026 csIBM1026 }
4035 { EBCDIC-AT-DE csIBMEBCDICATDE }
4036 { EBCDIC-AT-DE-A csEBCDICATDEA }
4037 { EBCDIC-CA-FR csEBCDICCAFR }
4038 { EBCDIC-DK-NO csEBCDICDKNO }
4039 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4040 { EBCDIC-FI-SE csEBCDICFISE }
4041 { EBCDIC-FI-SE-A csEBCDICFISEA }
4042 { EBCDIC-FR csEBCDICFR }
4043 { EBCDIC-IT csEBCDICIT }
4044 { EBCDIC-PT csEBCDICPT }
4045 { EBCDIC-ES csEBCDICES }
4046 { EBCDIC-ES-A csEBCDICESA }
4047 { EBCDIC-ES-S csEBCDICESS }
4048 { EBCDIC-UK csEBCDICUK }
4049 { EBCDIC-US csEBCDICUS }
4050 { UNKNOWN-8BIT csUnknown8BiT }
4051 { MNEMONIC csMnemonic }
4052 { MNEM csMnem }
4053 { VISCII csVISCII }
4054 { VIQR csVIQR }
4055 { KOI8-R csKOI8R }
4056 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4057 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4058 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4059 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4060 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4061 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4062 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4063 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4064 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4065 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4066 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4067 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4068 { IBM1047 IBM-1047 }
4069 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4070 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4071 { UNICODE-1-1 csUnicode11 }
4072 { CESU-8 csCESU-8 }
4073 { BOCU-1 csBOCU-1 }
4074 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4075 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4076 l8 }
4077 { ISO-8859-15 ISO_8859-15 Latin-9 }
4078 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4079 { GBK CP936 MS936 windows-936 }
4080 { JIS_Encoding csJISEncoding }
4081 { Shift_JIS MS_Kanji csShiftJIS }
4082 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4083 EUC-JP }
4084 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4085 { ISO-10646-UCS-Basic csUnicodeASCII }
4086 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4087 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4088 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4089 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4090 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4091 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4092 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4093 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4094 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4095 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4096 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4097 { Ventura-US csVenturaUS }
4098 { Ventura-International csVenturaInternational }
4099 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4100 { PC8-Turkish csPC8Turkish }
4101 { IBM-Symbols csIBMSymbols }
4102 { IBM-Thai csIBMThai }
4103 { HP-Legal csHPLegal }
4104 { HP-Pi-font csHPPiFont }
4105 { HP-Math8 csHPMath8 }
4106 { Adobe-Symbol-Encoding csHPPSMath }
4107 { HP-DeskTop csHPDesktop }
4108 { Ventura-Math csVenturaMath }
4109 { Microsoft-Publishing csMicrosoftPublishing }
4110 { Windows-31J csWindows31J }
4111 { GB2312 csGB2312 }
4112 { Big5 csBig5 }
4115 proc tcl_encoding {enc} {
4116 global encoding_aliases
4117 set names [encoding names]
4118 set lcnames [string tolower $names]
4119 set enc [string tolower $enc]
4120 set i [lsearch -exact $lcnames $enc]
4121 if {$i < 0} {
4122 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4123 if {[regsub {^iso[-_]} $enc iso encx]} {
4124 set i [lsearch -exact $lcnames $encx]
4127 if {$i < 0} {
4128 foreach l $encoding_aliases {
4129 set ll [string tolower $l]
4130 if {[lsearch -exact $ll $enc] < 0} continue
4131 # look through the aliases for one that tcl knows about
4132 foreach e $ll {
4133 set i [lsearch -exact $lcnames $e]
4134 if {$i < 0} {
4135 if {[regsub {^iso[-_]} $e iso ex]} {
4136 set i [lsearch -exact $lcnames $ex]
4139 if {$i >= 0} break
4141 break
4144 if {$i >= 0} {
4145 return [lindex $names $i]
4147 return {}
4150 # defaults...
4151 set datemode 0
4152 set diffopts "-U 5 -p"
4153 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4155 set gitencoding {}
4156 catch {
4157 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4159 if {$gitencoding == ""} {
4160 set gitencoding "utf-8"
4162 set tclencoding [tcl_encoding $gitencoding]
4163 if {$tclencoding == {}} {
4164 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4167 set mainfont {Helvetica 9}
4168 set textfont {Courier 9}
4169 set uifont {Helvetica 9 bold}
4170 set findmergefiles 0
4171 set maxgraphpct 50
4172 set maxwidth 16
4173 set revlistorder 0
4174 set fastdate 0
4175 set uparrowlen 7
4176 set downarrowlen 7
4177 set mingaplen 30
4179 set colors {green red blue magenta darkgrey brown orange}
4181 catch {source ~/.gitk}
4183 set namefont $mainfont
4185 font create optionfont -family sans-serif -size -12
4187 set revtreeargs {}
4188 foreach arg $argv {
4189 switch -regexp -- $arg {
4190 "^$" { }
4191 "^-d" { set datemode 1 }
4192 default {
4193 lappend revtreeargs $arg
4198 # check that we can find a .git directory somewhere...
4199 set gitdir [gitdir]
4200 if {![file isdirectory $gitdir]} {
4201 error_popup "Cannot find the git directory \"$gitdir\"."
4202 exit 1
4205 set history {}
4206 set historyindex 0
4208 set optim_delay 16
4210 set nextviewnum 1
4211 set curview 0
4212 set viewfiles(0) {}
4214 set stopped 0
4215 set stuffsaved 0
4216 set patchnum 0
4217 setcoords
4218 makewindow
4219 readrefs
4221 set cmdline_files {}
4222 catch {
4223 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4224 set cmdline_files [split $fileargs "\n"]
4225 set n [llength $cmdline_files]
4226 set revtreeargs [lrange $revtreeargs 0 end-$n]
4228 if {[lindex $revtreeargs end] eq "--"} {
4229 set revtreeargs [lrange $revtreeargs 0 end-1]
4232 if {$cmdline_files ne {}} {
4233 # create a view for the files/dirs specified on the command line
4234 set curview 1
4235 set nextviewnum 2
4236 set viewname(1) "Command line"
4237 set viewfiles(1) $cmdline_files
4238 .bar.view add command -label $viewname(1) -command {showview 1}
4239 .bar.view entryconf 2 -state normal
4241 getcommits