gitk: Don't reread git-rev-list output from scratch on view switch
[git/kirr.git] / gitk
blob85f426ab2244006aea2e391dc8d24c58a3d9e080
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc parse_args {rargs} {
20 global parsed_args cmdline_files
22 set parsed_args {}
23 set cmdline_files {}
24 if {[catch {
25 set args [concat --default HEAD $rargs]
26 set args [split [eval exec git-rev-parse $args] "\n"]
27 set i 0
28 foreach arg $args {
29 if {![regexp {^[0-9a-f]{40}$} $arg]} {
30 if {$arg eq "--"} {
31 incr i
33 set cmdline_files [lrange $args $i end]
34 break
36 lappend parsed_args $arg
37 incr i
39 }]} {
40 # if git-rev-parse failed for some reason...
41 set i [lsearch -exact $rargs "--"]
42 if {$i >= 0} {
43 set cmdline_files [lrange $rargs [expr {$i+1}] end]
44 set rargs [lrange $rargs 0 [expr {$i-1}]]
46 if {$rargs == {}} {
47 set parsed_args HEAD
48 } else {
49 set parsed_args $rargs
54 proc start_rev_list {rlargs} {
55 global startmsecs nextupdate ncmupdate
56 global commfd leftover tclencoding datemode
58 set startmsecs [clock clicks -milliseconds]
59 set nextupdate [expr {$startmsecs + 100}]
60 set ncmupdate 1
61 initlayout
62 set order "--topo-order"
63 if {$datemode} {
64 set order "--date-order"
66 if {[catch {
67 set commfd [open [concat | git-rev-list --header $order \
68 --parents --boundary $rlargs] r]
69 } err]} {
70 puts stderr "Error executing git-rev-list: $err"
71 exit 1
73 set leftover {}
74 fconfigure $commfd -blocking 0 -translation lf
75 if {$tclencoding != {}} {
76 fconfigure $commfd -encoding $tclencoding
78 fileevent $commfd readable [list getcommitlines $commfd]
79 . config -cursor watch
80 settextcursor watch
83 proc stop_rev_list {} {
84 global commfd
86 if {![info exists commfd]} return
87 catch {
88 set pid [pid $commfd]
89 exec kill $pid
91 catch {close $commfd}
92 unset commfd
95 proc getcommits {rargs} {
96 global phase canv mainfont
98 set phase getcommits
99 start_rev_list $rargs
100 $canv delete all
101 $canv create text 3 3 -anchor nw -text "Reading commits..." \
102 -font $mainfont -tags textitems
105 proc getcommitlines {commfd} {
106 global commitlisted nextupdate
107 global leftover
108 global displayorder commitidx commitrow commitdata
109 global parentlist childlist children
111 set stuff [read $commfd]
112 if {$stuff == {}} {
113 if {![eof $commfd]} return
114 # set it blocking so we wait for the process to terminate
115 fconfigure $commfd -blocking 1
116 if {![catch {close $commfd} err]} {
117 after idle finishcommits
118 return
120 if {[string range $err 0 4] == "usage"} {
121 set err \
122 "Gitk: error reading commits: bad arguments to git-rev-list.\
123 (Note: arguments to gitk are passed to git-rev-list\
124 to allow selection of commits to be displayed.)"
125 } else {
126 set err "Error reading commits: $err"
128 error_popup $err
129 exit 1
131 set start 0
132 set gotsome 0
133 while 1 {
134 set i [string first "\0" $stuff $start]
135 if {$i < 0} {
136 append leftover [string range $stuff $start end]
137 break
139 if {$start == 0} {
140 set cmit $leftover
141 append cmit [string range $stuff 0 [expr {$i - 1}]]
142 set leftover {}
143 } else {
144 set cmit [string range $stuff $start [expr {$i - 1}]]
146 set start [expr {$i + 1}]
147 set j [string first "\n" $cmit]
148 set ok 0
149 set listed 1
150 if {$j >= 0} {
151 set ids [string range $cmit 0 [expr {$j - 1}]]
152 if {[string range $ids 0 0] == "-"} {
153 set listed 0
154 set ids [string range $ids 1 end]
156 set ok 1
157 foreach id $ids {
158 if {[string length $id] != 40} {
159 set ok 0
160 break
164 if {!$ok} {
165 set shortcmit $cmit
166 if {[string length $shortcmit] > 80} {
167 set shortcmit "[string range $shortcmit 0 80]..."
169 error_popup "Can't parse git-rev-list output: {$shortcmit}"
170 exit 1
172 set id [lindex $ids 0]
173 if {$listed} {
174 set olds [lrange $ids 1 end]
175 set i 0
176 foreach p $olds {
177 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
178 lappend children($p) $id
180 incr i
182 } else {
183 set olds {}
185 lappend parentlist $olds
186 if {[info exists children($id)]} {
187 lappend childlist $children($id)
188 unset children($id)
189 } else {
190 lappend childlist {}
192 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
193 set commitrow($id) $commitidx
194 incr commitidx
195 lappend displayorder $id
196 lappend commitlisted $listed
197 set gotsome 1
199 if {$gotsome} {
200 layoutmore
202 if {[clock clicks -milliseconds] >= $nextupdate} {
203 doupdate 1
207 proc doupdate {reading} {
208 global commfd nextupdate numcommits ncmupdate
210 if {$reading} {
211 fileevent $commfd readable {}
213 update
214 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
215 if {$numcommits < 100} {
216 set ncmupdate [expr {$numcommits + 1}]
217 } elseif {$numcommits < 10000} {
218 set ncmupdate [expr {$numcommits + 10}]
219 } else {
220 set ncmupdate [expr {$numcommits + 100}]
222 if {$reading} {
223 fileevent $commfd readable [list getcommitlines $commfd]
227 proc readcommit {id} {
228 if {[catch {set contents [exec git-cat-file commit $id]}]} return
229 parsecommit $id $contents 0
232 proc updatecommits {} {
233 global viewdata curview revtreeargs phase
235 if {$phase ne {}} {
236 stop_rev_list
237 set phase {}
239 set n $curview
240 set curview -1
241 catch {unset viewdata($n)}
242 parse_args $revtreeargs
243 readrefs
244 showview $n
247 proc parsecommit {id contents listed} {
248 global commitinfo cdate
250 set inhdr 1
251 set comment {}
252 set headline {}
253 set auname {}
254 set audate {}
255 set comname {}
256 set comdate {}
257 set hdrend [string first "\n\n" $contents]
258 if {$hdrend < 0} {
259 # should never happen...
260 set hdrend [string length $contents]
262 set header [string range $contents 0 [expr {$hdrend - 1}]]
263 set comment [string range $contents [expr {$hdrend + 2}] end]
264 foreach line [split $header "\n"] {
265 set tag [lindex $line 0]
266 if {$tag == "author"} {
267 set audate [lindex $line end-1]
268 set auname [lrange $line 1 end-2]
269 } elseif {$tag == "committer"} {
270 set comdate [lindex $line end-1]
271 set comname [lrange $line 1 end-2]
274 set headline {}
275 # take the first line of the comment as the headline
276 set i [string first "\n" $comment]
277 if {$i >= 0} {
278 set headline [string trim [string range $comment 0 $i]]
279 } else {
280 set headline $comment
282 if {!$listed} {
283 # git-rev-list indents the comment by 4 spaces;
284 # if we got this via git-cat-file, add the indentation
285 set newcomment {}
286 foreach line [split $comment "\n"] {
287 append newcomment " "
288 append newcomment $line
289 append newcomment "\n"
291 set comment $newcomment
293 if {$comdate != {}} {
294 set cdate($id) $comdate
296 set commitinfo($id) [list $headline $auname $audate \
297 $comname $comdate $comment]
300 proc getcommit {id} {
301 global commitdata commitinfo
303 if {[info exists commitdata($id)]} {
304 parsecommit $id $commitdata($id) 1
305 } else {
306 readcommit $id
307 if {![info exists commitinfo($id)]} {
308 set commitinfo($id) {"No commit information available"}
311 return 1
314 proc readrefs {} {
315 global tagids idtags headids idheads tagcontents
316 global otherrefids idotherrefs
318 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
319 catch {unset $v}
321 set refd [open [list | git ls-remote [gitdir]] r]
322 while {0 <= [set n [gets $refd line]]} {
323 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
324 match id path]} {
325 continue
327 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
328 set type others
329 set name $path
331 if {$type == "tags"} {
332 set tagids($name) $id
333 lappend idtags($id) $name
334 set obj {}
335 set type {}
336 set tag {}
337 catch {
338 set commit [exec git-rev-parse "$id^0"]
339 if {"$commit" != "$id"} {
340 set tagids($name) $commit
341 lappend idtags($commit) $name
344 catch {
345 set tagcontents($name) [exec git-cat-file tag "$id"]
347 } elseif { $type == "heads" } {
348 set headids($name) $id
349 lappend idheads($id) $name
350 } else {
351 set otherrefids($name) $id
352 lappend idotherrefs($id) $name
355 close $refd
358 proc error_popup msg {
359 set w .error
360 toplevel $w
361 wm transient $w .
362 message $w.m -text $msg -justify center -aspect 400
363 pack $w.m -side top -fill x -padx 20 -pady 20
364 button $w.ok -text OK -command "destroy $w"
365 pack $w.ok -side bottom -fill x
366 bind $w <Visibility> "grab $w; focus $w"
367 bind $w <Key-Return> "destroy $w"
368 tkwait window $w
371 proc makewindow {} {
372 global canv canv2 canv3 linespc charspc ctext cflist
373 global textfont mainfont uifont
374 global findtype findtypemenu findloc findstring fstring geometry
375 global entries sha1entry sha1string sha1but
376 global maincursor textcursor curtextcursor
377 global rowctxmenu mergemax
379 menu .bar
380 .bar add cascade -label "File" -menu .bar.file
381 .bar configure -font $uifont
382 menu .bar.file
383 .bar.file add command -label "Update" -command updatecommits
384 .bar.file add command -label "Reread references" -command rereadrefs
385 .bar.file add command -label "Quit" -command doquit
386 .bar.file configure -font $uifont
387 menu .bar.edit
388 .bar add cascade -label "Edit" -menu .bar.edit
389 .bar.edit add command -label "Preferences" -command doprefs
390 .bar.edit configure -font $uifont
391 menu .bar.view -font $uifont
392 .bar add cascade -label "View" -menu .bar.view
393 .bar.view add command -label "New view..." -command newview
394 .bar.view add command -label "Delete view" -command delview -state disabled
395 .bar.view add separator
396 .bar.view add command -label "All files" -command {showview 0}
397 menu .bar.help
398 .bar add cascade -label "Help" -menu .bar.help
399 .bar.help add command -label "About gitk" -command about
400 .bar.help add command -label "Key bindings" -command keys
401 .bar.help configure -font $uifont
402 . configure -menu .bar
404 if {![info exists geometry(canv1)]} {
405 set geometry(canv1) [expr {45 * $charspc}]
406 set geometry(canv2) [expr {30 * $charspc}]
407 set geometry(canv3) [expr {15 * $charspc}]
408 set geometry(canvh) [expr {25 * $linespc + 4}]
409 set geometry(ctextw) 80
410 set geometry(ctexth) 30
411 set geometry(cflistw) 30
413 panedwindow .ctop -orient vertical
414 if {[info exists geometry(width)]} {
415 .ctop conf -width $geometry(width) -height $geometry(height)
416 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
417 set geometry(ctexth) [expr {($texth - 8) /
418 [font metrics $textfont -linespace]}]
420 frame .ctop.top
421 frame .ctop.top.bar
422 pack .ctop.top.bar -side bottom -fill x
423 set cscroll .ctop.top.csb
424 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
425 pack $cscroll -side right -fill y
426 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
427 pack .ctop.top.clist -side top -fill both -expand 1
428 .ctop add .ctop.top
429 set canv .ctop.top.clist.canv
430 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
431 -bg white -bd 0 \
432 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
433 .ctop.top.clist add $canv
434 set canv2 .ctop.top.clist.canv2
435 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
436 -bg white -bd 0 -yscrollincr $linespc
437 .ctop.top.clist add $canv2
438 set canv3 .ctop.top.clist.canv3
439 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
440 -bg white -bd 0 -yscrollincr $linespc
441 .ctop.top.clist add $canv3
442 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
444 set sha1entry .ctop.top.bar.sha1
445 set entries $sha1entry
446 set sha1but .ctop.top.bar.sha1label
447 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
448 -command gotocommit -width 8 -font $uifont
449 $sha1but conf -disabledforeground [$sha1but cget -foreground]
450 pack .ctop.top.bar.sha1label -side left
451 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
452 trace add variable sha1string write sha1change
453 pack $sha1entry -side left -pady 2
455 image create bitmap bm-left -data {
456 #define left_width 16
457 #define left_height 16
458 static unsigned char left_bits[] = {
459 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
460 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
461 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
463 image create bitmap bm-right -data {
464 #define right_width 16
465 #define right_height 16
466 static unsigned char right_bits[] = {
467 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
468 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
469 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
471 button .ctop.top.bar.leftbut -image bm-left -command goback \
472 -state disabled -width 26
473 pack .ctop.top.bar.leftbut -side left -fill y
474 button .ctop.top.bar.rightbut -image bm-right -command goforw \
475 -state disabled -width 26
476 pack .ctop.top.bar.rightbut -side left -fill y
478 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
479 pack .ctop.top.bar.findbut -side left
480 set findstring {}
481 set fstring .ctop.top.bar.findstring
482 lappend entries $fstring
483 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
484 pack $fstring -side left -expand 1 -fill x
485 set findtype Exact
486 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
487 findtype Exact IgnCase Regexp]
488 .ctop.top.bar.findtype configure -font $uifont
489 .ctop.top.bar.findtype.menu configure -font $uifont
490 set findloc "All fields"
491 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
492 Comments Author Committer Files Pickaxe
493 .ctop.top.bar.findloc configure -font $uifont
494 .ctop.top.bar.findloc.menu configure -font $uifont
496 pack .ctop.top.bar.findloc -side right
497 pack .ctop.top.bar.findtype -side right
498 # for making sure type==Exact whenever loc==Pickaxe
499 trace add variable findloc write findlocchange
501 panedwindow .ctop.cdet -orient horizontal
502 .ctop add .ctop.cdet
503 frame .ctop.cdet.left
504 set ctext .ctop.cdet.left.ctext
505 text $ctext -bg white -state disabled -font $textfont \
506 -width $geometry(ctextw) -height $geometry(ctexth) \
507 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
508 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
509 pack .ctop.cdet.left.sb -side right -fill y
510 pack $ctext -side left -fill both -expand 1
511 .ctop.cdet add .ctop.cdet.left
513 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
514 $ctext tag conf hunksep -fore blue
515 $ctext tag conf d0 -fore red
516 $ctext tag conf d1 -fore "#00a000"
517 $ctext tag conf m0 -fore red
518 $ctext tag conf m1 -fore blue
519 $ctext tag conf m2 -fore green
520 $ctext tag conf m3 -fore purple
521 $ctext tag conf m4 -fore brown
522 $ctext tag conf m5 -fore "#009090"
523 $ctext tag conf m6 -fore magenta
524 $ctext tag conf m7 -fore "#808000"
525 $ctext tag conf m8 -fore "#009000"
526 $ctext tag conf m9 -fore "#ff0080"
527 $ctext tag conf m10 -fore cyan
528 $ctext tag conf m11 -fore "#b07070"
529 $ctext tag conf m12 -fore "#70b0f0"
530 $ctext tag conf m13 -fore "#70f0b0"
531 $ctext tag conf m14 -fore "#f0b070"
532 $ctext tag conf m15 -fore "#ff70b0"
533 $ctext tag conf mmax -fore darkgrey
534 set mergemax 16
535 $ctext tag conf mresult -font [concat $textfont bold]
536 $ctext tag conf msep -font [concat $textfont bold]
537 $ctext tag conf found -back yellow
539 frame .ctop.cdet.right
540 set cflist .ctop.cdet.right.cfiles
541 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
542 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
543 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
544 pack .ctop.cdet.right.sb -side right -fill y
545 pack $cflist -side left -fill both -expand 1
546 .ctop.cdet add .ctop.cdet.right
547 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
549 pack .ctop -side top -fill both -expand 1
551 bindall <1> {selcanvline %W %x %y}
552 #bindall <B1-Motion> {selcanvline %W %x %y}
553 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
554 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
555 bindall <2> "canvscan mark %W %x %y"
556 bindall <B2-Motion> "canvscan dragto %W %x %y"
557 bindkey <Home> selfirstline
558 bindkey <End> sellastline
559 bind . <Key-Up> "selnextline -1"
560 bind . <Key-Down> "selnextline 1"
561 bindkey <Key-Right> "goforw"
562 bindkey <Key-Left> "goback"
563 bind . <Key-Prior> "selnextpage -1"
564 bind . <Key-Next> "selnextpage 1"
565 bind . <Control-Home> "allcanvs yview moveto 0.0"
566 bind . <Control-End> "allcanvs yview moveto 1.0"
567 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
568 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
569 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
570 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
571 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
572 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
573 bindkey <Key-space> "$ctext yview scroll 1 pages"
574 bindkey p "selnextline -1"
575 bindkey n "selnextline 1"
576 bindkey z "goback"
577 bindkey x "goforw"
578 bindkey i "selnextline -1"
579 bindkey k "selnextline 1"
580 bindkey j "goback"
581 bindkey l "goforw"
582 bindkey b "$ctext yview scroll -1 pages"
583 bindkey d "$ctext yview scroll 18 units"
584 bindkey u "$ctext yview scroll -18 units"
585 bindkey / {findnext 1}
586 bindkey <Key-Return> {findnext 0}
587 bindkey ? findprev
588 bindkey f nextfile
589 bind . <Control-q> doquit
590 bind . <Control-f> dofind
591 bind . <Control-g> {findnext 0}
592 bind . <Control-r> findprev
593 bind . <Control-equal> {incrfont 1}
594 bind . <Control-KP_Add> {incrfont 1}
595 bind . <Control-minus> {incrfont -1}
596 bind . <Control-KP_Subtract> {incrfont -1}
597 bind $cflist <<ListboxSelect>> listboxsel
598 bind . <Destroy> {savestuff %W}
599 bind . <Button-1> "click %W"
600 bind $fstring <Key-Return> dofind
601 bind $sha1entry <Key-Return> gotocommit
602 bind $sha1entry <<PasteSelection>> clearsha1
604 set maincursor [. cget -cursor]
605 set textcursor [$ctext cget -cursor]
606 set curtextcursor $textcursor
608 set rowctxmenu .rowctxmenu
609 menu $rowctxmenu -tearoff 0
610 $rowctxmenu add command -label "Diff this -> selected" \
611 -command {diffvssel 0}
612 $rowctxmenu add command -label "Diff selected -> this" \
613 -command {diffvssel 1}
614 $rowctxmenu add command -label "Make patch" -command mkpatch
615 $rowctxmenu add command -label "Create tag" -command mktag
616 $rowctxmenu add command -label "Write commit to file" -command writecommit
619 # mouse-2 makes all windows scan vertically, but only the one
620 # the cursor is in scans horizontally
621 proc canvscan {op w x y} {
622 global canv canv2 canv3
623 foreach c [list $canv $canv2 $canv3] {
624 if {$c == $w} {
625 $c scan $op $x $y
626 } else {
627 $c scan $op 0 $y
632 proc scrollcanv {cscroll f0 f1} {
633 $cscroll set $f0 $f1
634 drawfrac $f0 $f1
637 # when we make a key binding for the toplevel, make sure
638 # it doesn't get triggered when that key is pressed in the
639 # find string entry widget.
640 proc bindkey {ev script} {
641 global entries
642 bind . $ev $script
643 set escript [bind Entry $ev]
644 if {$escript == {}} {
645 set escript [bind Entry <Key>]
647 foreach e $entries {
648 bind $e $ev "$escript; break"
652 # set the focus back to the toplevel for any click outside
653 # the entry widgets
654 proc click {w} {
655 global entries
656 foreach e $entries {
657 if {$w == $e} return
659 focus .
662 proc savestuff {w} {
663 global canv canv2 canv3 ctext cflist mainfont textfont uifont
664 global stuffsaved findmergefiles maxgraphpct
665 global maxwidth
667 if {$stuffsaved} return
668 if {![winfo viewable .]} return
669 catch {
670 set f [open "~/.gitk-new" w]
671 puts $f [list set mainfont $mainfont]
672 puts $f [list set textfont $textfont]
673 puts $f [list set uifont $uifont]
674 puts $f [list set findmergefiles $findmergefiles]
675 puts $f [list set maxgraphpct $maxgraphpct]
676 puts $f [list set maxwidth $maxwidth]
677 puts $f "set geometry(width) [winfo width .ctop]"
678 puts $f "set geometry(height) [winfo height .ctop]"
679 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
680 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
681 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
682 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
683 set wid [expr {([winfo width $ctext] - 8) \
684 / [font measure $textfont "0"]}]
685 puts $f "set geometry(ctextw) $wid"
686 set wid [expr {([winfo width $cflist] - 11) \
687 / [font measure [$cflist cget -font] "0"]}]
688 puts $f "set geometry(cflistw) $wid"
689 close $f
690 file rename -force "~/.gitk-new" "~/.gitk"
692 set stuffsaved 1
695 proc resizeclistpanes {win w} {
696 global oldwidth
697 if {[info exists oldwidth($win)]} {
698 set s0 [$win sash coord 0]
699 set s1 [$win sash coord 1]
700 if {$w < 60} {
701 set sash0 [expr {int($w/2 - 2)}]
702 set sash1 [expr {int($w*5/6 - 2)}]
703 } else {
704 set factor [expr {1.0 * $w / $oldwidth($win)}]
705 set sash0 [expr {int($factor * [lindex $s0 0])}]
706 set sash1 [expr {int($factor * [lindex $s1 0])}]
707 if {$sash0 < 30} {
708 set sash0 30
710 if {$sash1 < $sash0 + 20} {
711 set sash1 [expr {$sash0 + 20}]
713 if {$sash1 > $w - 10} {
714 set sash1 [expr {$w - 10}]
715 if {$sash0 > $sash1 - 20} {
716 set sash0 [expr {$sash1 - 20}]
720 $win sash place 0 $sash0 [lindex $s0 1]
721 $win sash place 1 $sash1 [lindex $s1 1]
723 set oldwidth($win) $w
726 proc resizecdetpanes {win w} {
727 global oldwidth
728 if {[info exists oldwidth($win)]} {
729 set s0 [$win sash coord 0]
730 if {$w < 60} {
731 set sash0 [expr {int($w*3/4 - 2)}]
732 } else {
733 set factor [expr {1.0 * $w / $oldwidth($win)}]
734 set sash0 [expr {int($factor * [lindex $s0 0])}]
735 if {$sash0 < 45} {
736 set sash0 45
738 if {$sash0 > $w - 15} {
739 set sash0 [expr {$w - 15}]
742 $win sash place 0 $sash0 [lindex $s0 1]
744 set oldwidth($win) $w
747 proc allcanvs args {
748 global canv canv2 canv3
749 eval $canv $args
750 eval $canv2 $args
751 eval $canv3 $args
754 proc bindall {event action} {
755 global canv canv2 canv3
756 bind $canv $event $action
757 bind $canv2 $event $action
758 bind $canv3 $event $action
761 proc about {} {
762 set w .about
763 if {[winfo exists $w]} {
764 raise $w
765 return
767 toplevel $w
768 wm title $w "About gitk"
769 message $w.m -text {
770 Gitk - a commit viewer for git
772 Copyright © 2005-2006 Paul Mackerras
774 Use and redistribute under the terms of the GNU General Public License} \
775 -justify center -aspect 400
776 pack $w.m -side top -fill x -padx 20 -pady 20
777 button $w.ok -text Close -command "destroy $w"
778 pack $w.ok -side bottom
781 proc keys {} {
782 set w .keys
783 if {[winfo exists $w]} {
784 raise $w
785 return
787 toplevel $w
788 wm title $w "Gitk key bindings"
789 message $w.m -text {
790 Gitk key bindings:
792 <Ctrl-Q> Quit
793 <Home> Move to first commit
794 <End> Move to last commit
795 <Up>, p, i Move up one commit
796 <Down>, n, k Move down one commit
797 <Left>, z, j Go back in history list
798 <Right>, x, l Go forward in history list
799 <PageUp> Move up one page in commit list
800 <PageDown> Move down one page in commit list
801 <Ctrl-Home> Scroll to top of commit list
802 <Ctrl-End> Scroll to bottom of commit list
803 <Ctrl-Up> Scroll commit list up one line
804 <Ctrl-Down> Scroll commit list down one line
805 <Ctrl-PageUp> Scroll commit list up one page
806 <Ctrl-PageDown> Scroll commit list down one page
807 <Delete>, b Scroll diff view up one page
808 <Backspace> Scroll diff view up one page
809 <Space> Scroll diff view down one page
810 u Scroll diff view up 18 lines
811 d Scroll diff view down 18 lines
812 <Ctrl-F> Find
813 <Ctrl-G> Move to next find hit
814 <Ctrl-R> Move to previous find hit
815 <Return> Move to next find hit
816 / Move to next find hit, or redo find
817 ? Move to previous find hit
818 f Scroll diff view to next file
819 <Ctrl-KP+> Increase font size
820 <Ctrl-plus> Increase font size
821 <Ctrl-KP-> Decrease font size
822 <Ctrl-minus> Decrease font size
824 -justify left -bg white -border 2 -relief sunken
825 pack $w.m -side top -fill both
826 button $w.ok -text Close -command "destroy $w"
827 pack $w.ok -side bottom
830 proc newview {} {
831 global newviewname nextviewnum newviewtop
833 set top .gitkview
834 if {[winfo exists $top]} {
835 raise $top
836 return
838 set newviewtop $top
839 toplevel $top
840 wm title $top "Gitk view definition"
841 label $top.nl -text "Name"
842 entry $top.name -width 20 -textvariable newviewname
843 set newviewname "View $nextviewnum"
844 grid $top.nl $top.name -sticky w
845 label $top.l -text "Files and directories to include:"
846 grid $top.l - -sticky w -pady 10
847 text $top.t -width 30 -height 10
848 grid $top.t - -sticky w
849 frame $top.buts
850 button $top.buts.ok -text "OK" -command newviewok
851 button $top.buts.can -text "Cancel" -command newviewcan
852 grid $top.buts.ok $top.buts.can
853 grid columnconfigure $top.buts 0 -weight 1 -uniform a
854 grid columnconfigure $top.buts 1 -weight 1 -uniform a
855 grid $top.buts - -pady 10 -sticky ew
856 focus $top.t
859 proc newviewok {} {
860 global newviewtop nextviewnum
861 global viewname viewfiles
863 set n $nextviewnum
864 incr nextviewnum
865 set viewname($n) [$newviewtop.name get]
866 set files {}
867 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
868 set ft [string trim $f]
869 if {$ft ne {}} {
870 lappend files $ft
873 set viewfiles($n) $files
874 catch {destroy $newviewtop}
875 unset newviewtop
876 .bar.view add command -label $viewname($n) -command [list showview $n]
877 after idle showview $n
880 proc newviewcan {} {
881 global newviewtop
883 catch {destroy $newviewtop}
884 unset newviewtop
887 proc delview {} {
888 global curview viewdata
890 if {$curview == 0} return
891 set nmenu [.bar.view index end]
892 set targetcmd [list showview $curview]
893 for {set i 5} {$i <= $nmenu} {incr i} {
894 if {[.bar.view entrycget $i -command] eq $targetcmd} {
895 .bar.view delete $i
896 break
899 set viewdata($curview) {}
900 showview 0
903 proc flatten {var} {
904 global $var
906 set ret {}
907 foreach i [array names $var] {
908 lappend ret $i [set $var\($i\)]
910 return $ret
913 proc unflatten {var l} {
914 global $var
916 catch {unset $var}
917 foreach {i v} $l {
918 set $var\($i\) $v
922 proc showview {n} {
923 global curview viewdata viewfiles
924 global displayorder parentlist childlist rowidlist rowoffsets
925 global colormap rowtextx commitrow
926 global numcommits rowrangelist commitlisted idrowranges
927 global selectedline currentid canv canvy0
928 global matchinglines treediffs
929 global parsed_args
930 global pending_select phase
931 global commitidx rowlaidout rowoptim linesegends leftover
932 global commfd nextupdate
934 if {$n == $curview} return
935 set selid {}
936 if {[info exists selectedline]} {
937 set selid $currentid
938 set y [yc $selectedline]
939 set ymax [lindex [$canv cget -scrollregion] 3]
940 set span [$canv yview]
941 set ytop [expr {[lindex $span 0] * $ymax}]
942 set ybot [expr {[lindex $span 1] * $ymax}]
943 if {$ytop < $y && $y < $ybot} {
944 set yscreen [expr {$y - $ytop}]
945 } else {
946 set yscreen [expr {($ybot - $ytop) / 2}]
949 unselectline
950 normalline
951 stopfindproc
952 if {$curview >= 0} {
953 if {$phase ne {}} {
954 set viewdata($curview) \
955 [list $phase $displayorder $parentlist $childlist $rowidlist \
956 $rowoffsets $rowrangelist $commitlisted \
957 [flatten children] [flatten idrowranges] \
958 [flatten idinlist] \
959 $commitidx $rowlaidout $rowoptim $numcommits \
960 $linesegends $leftover $commfd]
961 fileevent $commfd readable {}
962 } elseif {![info exists viewdata($curview)]} {
963 set viewdata($curview) \
964 [list {} $displayorder $parentlist $childlist $rowidlist \
965 $rowoffsets $rowrangelist $commitlisted]
968 catch {unset matchinglines}
969 catch {unset treediffs}
970 clear_display
972 set curview $n
973 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
975 if {![info exists viewdata($n)]} {
976 set args $parsed_args
977 if {$viewfiles($n) ne {}} {
978 set args [concat $args "--" $viewfiles($n)]
980 set pending_select $selid
981 getcommits $args
982 return
985 set v $viewdata($n)
986 set phase [lindex $v 0]
987 set displayorder [lindex $v 1]
988 set parentlist [lindex $v 2]
989 set childlist [lindex $v 3]
990 set rowidlist [lindex $v 4]
991 set rowoffsets [lindex $v 5]
992 set rowrangelist [lindex $v 6]
993 set commitlisted [lindex $v 7]
994 if {$phase eq {}} {
995 set numcommits [llength $displayorder]
996 catch {unset idrowranges}
997 catch {unset children}
998 } else {
999 unflatten children [lindex $v 8]
1000 unflatten idrowranges [lindex $v 9]
1001 unflatten idinlist [lindex $v 10]
1002 set commitidx [lindex $v 11]
1003 set rowlaidout [lindex $v 12]
1004 set rowoptim [lindex $v 13]
1005 set numcommits [lindex $v 14]
1006 set linesegends [lindex $v 15]
1007 set leftover [lindex $v 16]
1008 set commfd [lindex $v 17]
1009 fileevent $commfd readable [list getcommitlines $commfd]
1010 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1013 catch {unset colormap}
1014 catch {unset rowtextx}
1015 catch {unset commitrow}
1016 set curview $n
1017 set row 0
1018 foreach id $displayorder {
1019 set commitrow($id) $row
1020 incr row
1022 setcanvscroll
1023 set yf 0
1024 set row 0
1025 if {$selid ne {} && [info exists commitrow($selid)]} {
1026 set row $commitrow($selid)
1027 # try to get the selected row in the same position on the screen
1028 set ymax [lindex [$canv cget -scrollregion] 3]
1029 set ytop [expr {[yc $row] - $yscreen}]
1030 if {$ytop < 0} {
1031 set ytop 0
1033 set yf [expr {$ytop * 1.0 / $ymax}]
1035 allcanvs yview moveto $yf
1036 drawvisible
1037 selectline $row 0
1040 proc shortids {ids} {
1041 set res {}
1042 foreach id $ids {
1043 if {[llength $id] > 1} {
1044 lappend res [shortids $id]
1045 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1046 lappend res [string range $id 0 7]
1047 } else {
1048 lappend res $id
1051 return $res
1054 proc incrange {l x o} {
1055 set n [llength $l]
1056 while {$x < $n} {
1057 set e [lindex $l $x]
1058 if {$e ne {}} {
1059 lset l $x [expr {$e + $o}]
1061 incr x
1063 return $l
1066 proc ntimes {n o} {
1067 set ret {}
1068 for {} {$n > 0} {incr n -1} {
1069 lappend ret $o
1071 return $ret
1074 proc usedinrange {id l1 l2} {
1075 global children commitrow childlist
1077 if {[info exists commitrow($id)]} {
1078 set r $commitrow($id)
1079 if {$l1 <= $r && $r <= $l2} {
1080 return [expr {$r - $l1 + 1}]
1082 set kids [lindex $childlist $r]
1083 } else {
1084 set kids $children($id)
1086 foreach c $kids {
1087 set r $commitrow($c)
1088 if {$l1 <= $r && $r <= $l2} {
1089 return [expr {$r - $l1 + 1}]
1092 return 0
1095 proc sanity {row {full 0}} {
1096 global rowidlist rowoffsets
1098 set col -1
1099 set ids [lindex $rowidlist $row]
1100 foreach id $ids {
1101 incr col
1102 if {$id eq {}} continue
1103 if {$col < [llength $ids] - 1 &&
1104 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1105 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1107 set o [lindex $rowoffsets $row $col]
1108 set y $row
1109 set x $col
1110 while {$o ne {}} {
1111 incr y -1
1112 incr x $o
1113 if {[lindex $rowidlist $y $x] != $id} {
1114 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1115 puts " id=[shortids $id] check started at row $row"
1116 for {set i $row} {$i >= $y} {incr i -1} {
1117 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1119 break
1121 if {!$full} break
1122 set o [lindex $rowoffsets $y $x]
1127 proc makeuparrow {oid x y z} {
1128 global rowidlist rowoffsets uparrowlen idrowranges
1130 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1131 incr y -1
1132 incr x $z
1133 set off0 [lindex $rowoffsets $y]
1134 for {set x0 $x} {1} {incr x0} {
1135 if {$x0 >= [llength $off0]} {
1136 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1137 break
1139 set z [lindex $off0 $x0]
1140 if {$z ne {}} {
1141 incr x0 $z
1142 break
1145 set z [expr {$x0 - $x}]
1146 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1147 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1149 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1150 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1151 lappend idrowranges($oid) $y
1154 proc initlayout {} {
1155 global rowidlist rowoffsets displayorder commitlisted
1156 global rowlaidout rowoptim
1157 global idinlist rowchk rowrangelist idrowranges
1158 global commitidx numcommits canvxmax canv
1159 global nextcolor
1160 global parentlist childlist children
1161 global colormap rowtextx commitrow
1162 global linesegends
1164 set commitidx 0
1165 set numcommits 0
1166 set displayorder {}
1167 set commitlisted {}
1168 set parentlist {}
1169 set childlist {}
1170 set rowrangelist {}
1171 catch {unset children}
1172 set nextcolor 0
1173 set rowidlist {{}}
1174 set rowoffsets {{}}
1175 catch {unset idinlist}
1176 catch {unset rowchk}
1177 set rowlaidout 0
1178 set rowoptim 0
1179 set canvxmax [$canv cget -width]
1180 catch {unset colormap}
1181 catch {unset rowtextx}
1182 catch {unset commitrow}
1183 catch {unset idrowranges}
1184 set linesegends {}
1187 proc setcanvscroll {} {
1188 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1190 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1191 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1192 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1193 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1196 proc visiblerows {} {
1197 global canv numcommits linespc
1199 set ymax [lindex [$canv cget -scrollregion] 3]
1200 if {$ymax eq {} || $ymax == 0} return
1201 set f [$canv yview]
1202 set y0 [expr {int([lindex $f 0] * $ymax)}]
1203 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1204 if {$r0 < 0} {
1205 set r0 0
1207 set y1 [expr {int([lindex $f 1] * $ymax)}]
1208 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1209 if {$r1 >= $numcommits} {
1210 set r1 [expr {$numcommits - 1}]
1212 return [list $r0 $r1]
1215 proc layoutmore {} {
1216 global rowlaidout rowoptim commitidx numcommits optim_delay
1217 global uparrowlen
1219 set row $rowlaidout
1220 set rowlaidout [layoutrows $row $commitidx 0]
1221 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1222 if {$orow > $rowoptim} {
1223 optimize_rows $rowoptim 0 $orow
1224 set rowoptim $orow
1226 set canshow [expr {$rowoptim - $optim_delay}]
1227 if {$canshow > $numcommits} {
1228 showstuff $canshow
1232 proc showstuff {canshow} {
1233 global numcommits commitrow pending_select selectedline
1234 global linesegends idrowranges idrangedrawn
1236 if {$numcommits == 0} {
1237 global phase
1238 set phase "incrdraw"
1239 allcanvs delete all
1241 set row $numcommits
1242 set numcommits $canshow
1243 setcanvscroll
1244 set rows [visiblerows]
1245 set r0 [lindex $rows 0]
1246 set r1 [lindex $rows 1]
1247 set selrow -1
1248 for {set r $row} {$r < $canshow} {incr r} {
1249 foreach id [lindex $linesegends [expr {$r+1}]] {
1250 set i -1
1251 foreach {s e} [rowranges $id] {
1252 incr i
1253 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1254 && ![info exists idrangedrawn($id,$i)]} {
1255 drawlineseg $id $i
1256 set idrangedrawn($id,$i) 1
1261 if {$canshow > $r1} {
1262 set canshow $r1
1264 while {$row < $canshow} {
1265 drawcmitrow $row
1266 incr row
1268 if {[info exists pending_select] &&
1269 [info exists commitrow($pending_select)] &&
1270 $commitrow($pending_select) < $numcommits} {
1271 selectline $commitrow($pending_select) 1
1273 if {![info exists selectedline] && ![info exists pending_select]} {
1274 selectline 0 1
1278 proc layoutrows {row endrow last} {
1279 global rowidlist rowoffsets displayorder
1280 global uparrowlen downarrowlen maxwidth mingaplen
1281 global childlist parentlist
1282 global idrowranges linesegends
1283 global commitidx
1284 global idinlist rowchk rowrangelist
1286 set idlist [lindex $rowidlist $row]
1287 set offs [lindex $rowoffsets $row]
1288 while {$row < $endrow} {
1289 set id [lindex $displayorder $row]
1290 set oldolds {}
1291 set newolds {}
1292 foreach p [lindex $parentlist $row] {
1293 if {![info exists idinlist($p)]} {
1294 lappend newolds $p
1295 } elseif {!$idinlist($p)} {
1296 lappend oldolds $p
1299 set lse {}
1300 set nev [expr {[llength $idlist] + [llength $newolds]
1301 + [llength $oldolds] - $maxwidth + 1}]
1302 if {$nev > 0} {
1303 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1304 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1305 set i [lindex $idlist $x]
1306 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1307 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1308 [expr {$row + $uparrowlen + $mingaplen}]]
1309 if {$r == 0} {
1310 set idlist [lreplace $idlist $x $x]
1311 set offs [lreplace $offs $x $x]
1312 set offs [incrange $offs $x 1]
1313 set idinlist($i) 0
1314 set rm1 [expr {$row - 1}]
1315 lappend lse $i
1316 lappend idrowranges($i) $rm1
1317 if {[incr nev -1] <= 0} break
1318 continue
1320 set rowchk($id) [expr {$row + $r}]
1323 lset rowidlist $row $idlist
1324 lset rowoffsets $row $offs
1326 lappend linesegends $lse
1327 set col [lsearch -exact $idlist $id]
1328 if {$col < 0} {
1329 set col [llength $idlist]
1330 lappend idlist $id
1331 lset rowidlist $row $idlist
1332 set z {}
1333 if {[lindex $childlist $row] ne {}} {
1334 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1335 unset idinlist($id)
1337 lappend offs $z
1338 lset rowoffsets $row $offs
1339 if {$z ne {}} {
1340 makeuparrow $id $col $row $z
1342 } else {
1343 unset idinlist($id)
1345 set ranges {}
1346 if {[info exists idrowranges($id)]} {
1347 set ranges $idrowranges($id)
1348 lappend ranges $row
1349 unset idrowranges($id)
1351 lappend rowrangelist $ranges
1352 incr row
1353 set offs [ntimes [llength $idlist] 0]
1354 set l [llength $newolds]
1355 set idlist [eval lreplace \$idlist $col $col $newolds]
1356 set o 0
1357 if {$l != 1} {
1358 set offs [lrange $offs 0 [expr {$col - 1}]]
1359 foreach x $newolds {
1360 lappend offs {}
1361 incr o -1
1363 incr o
1364 set tmp [expr {[llength $idlist] - [llength $offs]}]
1365 if {$tmp > 0} {
1366 set offs [concat $offs [ntimes $tmp $o]]
1368 } else {
1369 lset offs $col {}
1371 foreach i $newolds {
1372 set idinlist($i) 1
1373 set idrowranges($i) $row
1375 incr col $l
1376 foreach oid $oldolds {
1377 set idinlist($oid) 1
1378 set idlist [linsert $idlist $col $oid]
1379 set offs [linsert $offs $col $o]
1380 makeuparrow $oid $col $row $o
1381 incr col
1383 lappend rowidlist $idlist
1384 lappend rowoffsets $offs
1386 return $row
1389 proc addextraid {id row} {
1390 global displayorder commitrow commitinfo
1391 global commitidx
1392 global parentlist childlist children
1394 incr commitidx
1395 lappend displayorder $id
1396 lappend parentlist {}
1397 set commitrow($id) $row
1398 readcommit $id
1399 if {![info exists commitinfo($id)]} {
1400 set commitinfo($id) {"No commit information available"}
1402 if {[info exists children($id)]} {
1403 lappend childlist $children($id)
1404 unset children($id)
1405 } else {
1406 lappend childlist {}
1410 proc layouttail {} {
1411 global rowidlist rowoffsets idinlist commitidx
1412 global idrowranges rowrangelist
1414 set row $commitidx
1415 set idlist [lindex $rowidlist $row]
1416 while {$idlist ne {}} {
1417 set col [expr {[llength $idlist] - 1}]
1418 set id [lindex $idlist $col]
1419 addextraid $id $row
1420 unset idinlist($id)
1421 lappend idrowranges($id) $row
1422 lappend rowrangelist $idrowranges($id)
1423 unset idrowranges($id)
1424 incr row
1425 set offs [ntimes $col 0]
1426 set idlist [lreplace $idlist $col $col]
1427 lappend rowidlist $idlist
1428 lappend rowoffsets $offs
1431 foreach id [array names idinlist] {
1432 addextraid $id $row
1433 lset rowidlist $row [list $id]
1434 lset rowoffsets $row 0
1435 makeuparrow $id 0 $row 0
1436 lappend idrowranges($id) $row
1437 lappend rowrangelist $idrowranges($id)
1438 unset idrowranges($id)
1439 incr row
1440 lappend rowidlist {}
1441 lappend rowoffsets {}
1445 proc insert_pad {row col npad} {
1446 global rowidlist rowoffsets
1448 set pad [ntimes $npad {}]
1449 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1450 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1451 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1454 proc optimize_rows {row col endrow} {
1455 global rowidlist rowoffsets idrowranges displayorder
1457 for {} {$row < $endrow} {incr row} {
1458 set idlist [lindex $rowidlist $row]
1459 set offs [lindex $rowoffsets $row]
1460 set haspad 0
1461 for {} {$col < [llength $offs]} {incr col} {
1462 if {[lindex $idlist $col] eq {}} {
1463 set haspad 1
1464 continue
1466 set z [lindex $offs $col]
1467 if {$z eq {}} continue
1468 set isarrow 0
1469 set x0 [expr {$col + $z}]
1470 set y0 [expr {$row - 1}]
1471 set z0 [lindex $rowoffsets $y0 $x0]
1472 if {$z0 eq {}} {
1473 set id [lindex $idlist $col]
1474 set ranges [rowranges $id]
1475 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1476 set isarrow 1
1479 if {$z < -1 || ($z < 0 && $isarrow)} {
1480 set npad [expr {-1 - $z + $isarrow}]
1481 set offs [incrange $offs $col $npad]
1482 insert_pad $y0 $x0 $npad
1483 if {$y0 > 0} {
1484 optimize_rows $y0 $x0 $row
1486 set z [lindex $offs $col]
1487 set x0 [expr {$col + $z}]
1488 set z0 [lindex $rowoffsets $y0 $x0]
1489 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1490 set npad [expr {$z - 1 + $isarrow}]
1491 set y1 [expr {$row + 1}]
1492 set offs2 [lindex $rowoffsets $y1]
1493 set x1 -1
1494 foreach z $offs2 {
1495 incr x1
1496 if {$z eq {} || $x1 + $z < $col} continue
1497 if {$x1 + $z > $col} {
1498 incr npad
1500 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1501 break
1503 set pad [ntimes $npad {}]
1504 set idlist [eval linsert \$idlist $col $pad]
1505 set tmp [eval linsert \$offs $col $pad]
1506 incr col $npad
1507 set offs [incrange $tmp $col [expr {-$npad}]]
1508 set z [lindex $offs $col]
1509 set haspad 1
1511 if {$z0 eq {} && !$isarrow} {
1512 # this line links to its first child on row $row-2
1513 set rm2 [expr {$row - 2}]
1514 set id [lindex $displayorder $rm2]
1515 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1516 if {$xc >= 0} {
1517 set z0 [expr {$xc - $x0}]
1520 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1521 insert_pad $y0 $x0 1
1522 set offs [incrange $offs $col 1]
1523 optimize_rows $y0 [expr {$x0 + 1}] $row
1526 if {!$haspad} {
1527 set o {}
1528 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1529 set o [lindex $offs $col]
1530 if {$o eq {}} {
1531 # check if this is the link to the first child
1532 set id [lindex $idlist $col]
1533 set ranges [rowranges $id]
1534 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1535 # it is, work out offset to child
1536 set y0 [expr {$row - 1}]
1537 set id [lindex $displayorder $y0]
1538 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1539 if {$x0 >= 0} {
1540 set o [expr {$x0 - $col}]
1544 if {$o eq {} || $o <= 0} break
1546 if {$o ne {} && [incr col] < [llength $idlist]} {
1547 set y1 [expr {$row + 1}]
1548 set offs2 [lindex $rowoffsets $y1]
1549 set x1 -1
1550 foreach z $offs2 {
1551 incr x1
1552 if {$z eq {} || $x1 + $z < $col} continue
1553 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1554 break
1556 set idlist [linsert $idlist $col {}]
1557 set tmp [linsert $offs $col {}]
1558 incr col
1559 set offs [incrange $tmp $col -1]
1562 lset rowidlist $row $idlist
1563 lset rowoffsets $row $offs
1564 set col 0
1568 proc xc {row col} {
1569 global canvx0 linespc
1570 return [expr {$canvx0 + $col * $linespc}]
1573 proc yc {row} {
1574 global canvy0 linespc
1575 return [expr {$canvy0 + $row * $linespc}]
1578 proc linewidth {id} {
1579 global thickerline lthickness
1581 set wid $lthickness
1582 if {[info exists thickerline] && $id eq $thickerline} {
1583 set wid [expr {2 * $lthickness}]
1585 return $wid
1588 proc rowranges {id} {
1589 global phase idrowranges commitrow rowlaidout rowrangelist
1591 set ranges {}
1592 if {$phase eq {} ||
1593 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1594 set ranges [lindex $rowrangelist $commitrow($id)]
1595 } elseif {[info exists idrowranges($id)]} {
1596 set ranges $idrowranges($id)
1598 return $ranges
1601 proc drawlineseg {id i} {
1602 global rowoffsets rowidlist
1603 global displayorder
1604 global canv colormap linespc
1605 global numcommits commitrow
1607 set ranges [rowranges $id]
1608 set downarrow 1
1609 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1610 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1611 } else {
1612 set downarrow 1
1614 set startrow [lindex $ranges [expr {2 * $i}]]
1615 set row [lindex $ranges [expr {2 * $i + 1}]]
1616 if {$startrow == $row} return
1617 assigncolor $id
1618 set coords {}
1619 set col [lsearch -exact [lindex $rowidlist $row] $id]
1620 if {$col < 0} {
1621 puts "oops: drawline: id $id not on row $row"
1622 return
1624 set lasto {}
1625 set ns 0
1626 while {1} {
1627 set o [lindex $rowoffsets $row $col]
1628 if {$o eq {}} break
1629 if {$o ne $lasto} {
1630 # changing direction
1631 set x [xc $row $col]
1632 set y [yc $row]
1633 lappend coords $x $y
1634 set lasto $o
1636 incr col $o
1637 incr row -1
1639 set x [xc $row $col]
1640 set y [yc $row]
1641 lappend coords $x $y
1642 if {$i == 0} {
1643 # draw the link to the first child as part of this line
1644 incr row -1
1645 set child [lindex $displayorder $row]
1646 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1647 if {$ccol >= 0} {
1648 set x [xc $row $ccol]
1649 set y [yc $row]
1650 if {$ccol < $col - 1} {
1651 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1652 } elseif {$ccol > $col + 1} {
1653 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1655 lappend coords $x $y
1658 if {[llength $coords] < 4} return
1659 if {$downarrow} {
1660 # This line has an arrow at the lower end: check if the arrow is
1661 # on a diagonal segment, and if so, work around the Tk 8.4
1662 # refusal to draw arrows on diagonal lines.
1663 set x0 [lindex $coords 0]
1664 set x1 [lindex $coords 2]
1665 if {$x0 != $x1} {
1666 set y0 [lindex $coords 1]
1667 set y1 [lindex $coords 3]
1668 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1669 # we have a nearby vertical segment, just trim off the diag bit
1670 set coords [lrange $coords 2 end]
1671 } else {
1672 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1673 set xi [expr {$x0 - $slope * $linespc / 2}]
1674 set yi [expr {$y0 - $linespc / 2}]
1675 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1679 set arrow [expr {2 * ($i > 0) + $downarrow}]
1680 set arrow [lindex {none first last both} $arrow]
1681 set t [$canv create line $coords -width [linewidth $id] \
1682 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1683 $canv lower $t
1684 bindline $t $id
1687 proc drawparentlinks {id row col olds} {
1688 global rowidlist canv colormap
1690 set row2 [expr {$row + 1}]
1691 set x [xc $row $col]
1692 set y [yc $row]
1693 set y2 [yc $row2]
1694 set ids [lindex $rowidlist $row2]
1695 # rmx = right-most X coord used
1696 set rmx 0
1697 foreach p $olds {
1698 set i [lsearch -exact $ids $p]
1699 if {$i < 0} {
1700 puts "oops, parent $p of $id not in list"
1701 continue
1703 set x2 [xc $row2 $i]
1704 if {$x2 > $rmx} {
1705 set rmx $x2
1707 set ranges [rowranges $p]
1708 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1709 && $row2 < [lindex $ranges 1]} {
1710 # drawlineseg will do this one for us
1711 continue
1713 assigncolor $p
1714 # should handle duplicated parents here...
1715 set coords [list $x $y]
1716 if {$i < $col - 1} {
1717 lappend coords [xc $row [expr {$i + 1}]] $y
1718 } elseif {$i > $col + 1} {
1719 lappend coords [xc $row [expr {$i - 1}]] $y
1721 lappend coords $x2 $y2
1722 set t [$canv create line $coords -width [linewidth $p] \
1723 -fill $colormap($p) -tags lines.$p]
1724 $canv lower $t
1725 bindline $t $p
1727 return $rmx
1730 proc drawlines {id} {
1731 global colormap canv
1732 global idrangedrawn
1733 global childlist iddrawn commitrow rowidlist
1735 $canv delete lines.$id
1736 set nr [expr {[llength [rowranges $id]] / 2}]
1737 for {set i 0} {$i < $nr} {incr i} {
1738 if {[info exists idrangedrawn($id,$i)]} {
1739 drawlineseg $id $i
1742 foreach child [lindex $childlist $commitrow($id)] {
1743 if {[info exists iddrawn($child)]} {
1744 set row $commitrow($child)
1745 set col [lsearch -exact [lindex $rowidlist $row] $child]
1746 if {$col >= 0} {
1747 drawparentlinks $child $row $col [list $id]
1753 proc drawcmittext {id row col rmx} {
1754 global linespc canv canv2 canv3 canvy0
1755 global commitlisted commitinfo rowidlist
1756 global rowtextx idpos idtags idheads idotherrefs
1757 global linehtag linentag linedtag
1758 global mainfont namefont canvxmax
1760 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1761 set x [xc $row $col]
1762 set y [yc $row]
1763 set orad [expr {$linespc / 3}]
1764 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1765 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1766 -fill $ofill -outline black -width 1]
1767 $canv raise $t
1768 $canv bind $t <1> {selcanvline {} %x %y}
1769 set xt [xc $row [llength [lindex $rowidlist $row]]]
1770 if {$xt < $rmx} {
1771 set xt $rmx
1773 set rowtextx($row) $xt
1774 set idpos($id) [list $x $xt $y]
1775 if {[info exists idtags($id)] || [info exists idheads($id)]
1776 || [info exists idotherrefs($id)]} {
1777 set xt [drawtags $id $x $xt $y]
1779 set headline [lindex $commitinfo($id) 0]
1780 set name [lindex $commitinfo($id) 1]
1781 set date [lindex $commitinfo($id) 2]
1782 set date [formatdate $date]
1783 set linehtag($row) [$canv create text $xt $y -anchor w \
1784 -text $headline -font $mainfont ]
1785 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1786 set linentag($row) [$canv2 create text 3 $y -anchor w \
1787 -text $name -font $namefont]
1788 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1789 -text $date -font $mainfont]
1790 set xr [expr {$xt + [font measure $mainfont $headline]}]
1791 if {$xr > $canvxmax} {
1792 set canvxmax $xr
1793 setcanvscroll
1797 proc drawcmitrow {row} {
1798 global displayorder rowidlist
1799 global idrangedrawn iddrawn
1800 global commitinfo commitlisted parentlist numcommits
1802 if {$row >= $numcommits} return
1803 foreach id [lindex $rowidlist $row] {
1804 if {$id eq {}} continue
1805 set i -1
1806 foreach {s e} [rowranges $id] {
1807 incr i
1808 if {$row < $s} continue
1809 if {$e eq {}} break
1810 if {$row <= $e} {
1811 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1812 drawlineseg $id $i
1813 set idrangedrawn($id,$i) 1
1815 break
1820 set id [lindex $displayorder $row]
1821 if {[info exists iddrawn($id)]} return
1822 set col [lsearch -exact [lindex $rowidlist $row] $id]
1823 if {$col < 0} {
1824 puts "oops, row $row id $id not in list"
1825 return
1827 if {![info exists commitinfo($id)]} {
1828 getcommit $id
1830 assigncolor $id
1831 set olds [lindex $parentlist $row]
1832 if {$olds ne {}} {
1833 set rmx [drawparentlinks $id $row $col $olds]
1834 } else {
1835 set rmx 0
1837 drawcmittext $id $row $col $rmx
1838 set iddrawn($id) 1
1841 proc drawfrac {f0 f1} {
1842 global numcommits canv
1843 global linespc
1845 set ymax [lindex [$canv cget -scrollregion] 3]
1846 if {$ymax eq {} || $ymax == 0} return
1847 set y0 [expr {int($f0 * $ymax)}]
1848 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1849 if {$row < 0} {
1850 set row 0
1852 set y1 [expr {int($f1 * $ymax)}]
1853 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1854 if {$endrow >= $numcommits} {
1855 set endrow [expr {$numcommits - 1}]
1857 for {} {$row <= $endrow} {incr row} {
1858 drawcmitrow $row
1862 proc drawvisible {} {
1863 global canv
1864 eval drawfrac [$canv yview]
1867 proc clear_display {} {
1868 global iddrawn idrangedrawn
1870 allcanvs delete all
1871 catch {unset iddrawn}
1872 catch {unset idrangedrawn}
1875 proc findcrossings {id} {
1876 global rowidlist parentlist numcommits rowoffsets displayorder
1878 set cross {}
1879 set ccross {}
1880 foreach {s e} [rowranges $id] {
1881 if {$e >= $numcommits} {
1882 set e [expr {$numcommits - 1}]
1884 if {$e <= $s} continue
1885 set x [lsearch -exact [lindex $rowidlist $e] $id]
1886 if {$x < 0} {
1887 puts "findcrossings: oops, no [shortids $id] in row $e"
1888 continue
1890 for {set row $e} {[incr row -1] >= $s} {} {
1891 set olds [lindex $parentlist $row]
1892 set kid [lindex $displayorder $row]
1893 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1894 if {$kidx < 0} continue
1895 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1896 foreach p $olds {
1897 set px [lsearch -exact $nextrow $p]
1898 if {$px < 0} continue
1899 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1900 if {[lsearch -exact $ccross $p] >= 0} continue
1901 if {$x == $px + ($kidx < $px? -1: 1)} {
1902 lappend ccross $p
1903 } elseif {[lsearch -exact $cross $p] < 0} {
1904 lappend cross $p
1908 set inc [lindex $rowoffsets $row $x]
1909 if {$inc eq {}} break
1910 incr x $inc
1913 return [concat $ccross {{}} $cross]
1916 proc assigncolor {id} {
1917 global colormap colors nextcolor
1918 global commitrow parentlist children childlist
1920 if {[info exists colormap($id)]} return
1921 set ncolors [llength $colors]
1922 if {[info exists commitrow($id)]} {
1923 set kids [lindex $childlist $commitrow($id)]
1924 } elseif {[info exists children($id)]} {
1925 set kids $children($id)
1926 } else {
1927 set kids {}
1929 if {[llength $kids] == 1} {
1930 set child [lindex $kids 0]
1931 if {[info exists colormap($child)]
1932 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1933 set colormap($id) $colormap($child)
1934 return
1937 set badcolors {}
1938 set origbad {}
1939 foreach x [findcrossings $id] {
1940 if {$x eq {}} {
1941 # delimiter between corner crossings and other crossings
1942 if {[llength $badcolors] >= $ncolors - 1} break
1943 set origbad $badcolors
1945 if {[info exists colormap($x)]
1946 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1947 lappend badcolors $colormap($x)
1950 if {[llength $badcolors] >= $ncolors} {
1951 set badcolors $origbad
1953 set origbad $badcolors
1954 if {[llength $badcolors] < $ncolors - 1} {
1955 foreach child $kids {
1956 if {[info exists colormap($child)]
1957 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1958 lappend badcolors $colormap($child)
1960 foreach p [lindex $parentlist $commitrow($child)] {
1961 if {[info exists colormap($p)]
1962 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1963 lappend badcolors $colormap($p)
1967 if {[llength $badcolors] >= $ncolors} {
1968 set badcolors $origbad
1971 for {set i 0} {$i <= $ncolors} {incr i} {
1972 set c [lindex $colors $nextcolor]
1973 if {[incr nextcolor] >= $ncolors} {
1974 set nextcolor 0
1976 if {[lsearch -exact $badcolors $c]} break
1978 set colormap($id) $c
1981 proc bindline {t id} {
1982 global canv
1984 $canv bind $t <Enter> "lineenter %x %y $id"
1985 $canv bind $t <Motion> "linemotion %x %y $id"
1986 $canv bind $t <Leave> "lineleave $id"
1987 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1990 proc drawtags {id x xt y1} {
1991 global idtags idheads idotherrefs
1992 global linespc lthickness
1993 global canv mainfont commitrow rowtextx
1995 set marks {}
1996 set ntags 0
1997 set nheads 0
1998 if {[info exists idtags($id)]} {
1999 set marks $idtags($id)
2000 set ntags [llength $marks]
2002 if {[info exists idheads($id)]} {
2003 set marks [concat $marks $idheads($id)]
2004 set nheads [llength $idheads($id)]
2006 if {[info exists idotherrefs($id)]} {
2007 set marks [concat $marks $idotherrefs($id)]
2009 if {$marks eq {}} {
2010 return $xt
2013 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2014 set yt [expr {$y1 - 0.5 * $linespc}]
2015 set yb [expr {$yt + $linespc - 1}]
2016 set xvals {}
2017 set wvals {}
2018 foreach tag $marks {
2019 set wid [font measure $mainfont $tag]
2020 lappend xvals $xt
2021 lappend wvals $wid
2022 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2024 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2025 -width $lthickness -fill black -tags tag.$id]
2026 $canv lower $t
2027 foreach tag $marks x $xvals wid $wvals {
2028 set xl [expr {$x + $delta}]
2029 set xr [expr {$x + $delta + $wid + $lthickness}]
2030 if {[incr ntags -1] >= 0} {
2031 # draw a tag
2032 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2033 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2034 -width 1 -outline black -fill yellow -tags tag.$id]
2035 $canv bind $t <1> [list showtag $tag 1]
2036 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2037 } else {
2038 # draw a head or other ref
2039 if {[incr nheads -1] >= 0} {
2040 set col green
2041 } else {
2042 set col "#ddddff"
2044 set xl [expr {$xl - $delta/2}]
2045 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2046 -width 1 -outline black -fill $col -tags tag.$id
2048 set t [$canv create text $xl $y1 -anchor w -text $tag \
2049 -font $mainfont -tags tag.$id]
2050 if {$ntags >= 0} {
2051 $canv bind $t <1> [list showtag $tag 1]
2054 return $xt
2057 proc xcoord {i level ln} {
2058 global canvx0 xspc1 xspc2
2060 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2061 if {$i > 0 && $i == $level} {
2062 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2063 } elseif {$i > $level} {
2064 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2066 return $x
2069 proc finishcommits {} {
2070 global commitidx phase
2071 global canv mainfont ctext maincursor textcursor
2072 global findinprogress pending_select
2074 if {$commitidx > 0} {
2075 drawrest
2076 } else {
2077 $canv delete all
2078 $canv create text 3 3 -anchor nw -text "No commits selected" \
2079 -font $mainfont -tags textitems
2081 if {![info exists findinprogress]} {
2082 . config -cursor $maincursor
2083 settextcursor $textcursor
2085 set phase {}
2086 catch {unset pending_select}
2089 # Don't change the text pane cursor if it is currently the hand cursor,
2090 # showing that we are over a sha1 ID link.
2091 proc settextcursor {c} {
2092 global ctext curtextcursor
2094 if {[$ctext cget -cursor] == $curtextcursor} {
2095 $ctext config -cursor $c
2097 set curtextcursor $c
2100 proc drawrest {} {
2101 global numcommits
2102 global startmsecs
2103 global canvy0 numcommits linespc
2104 global rowlaidout commitidx
2105 global pending_select
2107 set row $rowlaidout
2108 layoutrows $rowlaidout $commitidx 1
2109 layouttail
2110 optimize_rows $row 0 $commitidx
2111 showstuff $commitidx
2112 if {[info exists pending_select]} {
2113 selectline 0 1
2116 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2117 #puts "overall $drawmsecs ms for $numcommits commits"
2120 proc findmatches {f} {
2121 global findtype foundstring foundstrlen
2122 if {$findtype == "Regexp"} {
2123 set matches [regexp -indices -all -inline $foundstring $f]
2124 } else {
2125 if {$findtype == "IgnCase"} {
2126 set str [string tolower $f]
2127 } else {
2128 set str $f
2130 set matches {}
2131 set i 0
2132 while {[set j [string first $foundstring $str $i]] >= 0} {
2133 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2134 set i [expr {$j + $foundstrlen}]
2137 return $matches
2140 proc dofind {} {
2141 global findtype findloc findstring markedmatches commitinfo
2142 global numcommits displayorder linehtag linentag linedtag
2143 global mainfont namefont canv canv2 canv3 selectedline
2144 global matchinglines foundstring foundstrlen matchstring
2145 global commitdata
2147 stopfindproc
2148 unmarkmatches
2149 focus .
2150 set matchinglines {}
2151 if {$findloc == "Pickaxe"} {
2152 findpatches
2153 return
2155 if {$findtype == "IgnCase"} {
2156 set foundstring [string tolower $findstring]
2157 } else {
2158 set foundstring $findstring
2160 set foundstrlen [string length $findstring]
2161 if {$foundstrlen == 0} return
2162 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2163 set matchstring "*$matchstring*"
2164 if {$findloc == "Files"} {
2165 findfiles
2166 return
2168 if {![info exists selectedline]} {
2169 set oldsel -1
2170 } else {
2171 set oldsel $selectedline
2173 set didsel 0
2174 set fldtypes {Headline Author Date Committer CDate Comment}
2175 set l -1
2176 foreach id $displayorder {
2177 set d $commitdata($id)
2178 incr l
2179 if {$findtype == "Regexp"} {
2180 set doesmatch [regexp $foundstring $d]
2181 } elseif {$findtype == "IgnCase"} {
2182 set doesmatch [string match -nocase $matchstring $d]
2183 } else {
2184 set doesmatch [string match $matchstring $d]
2186 if {!$doesmatch} continue
2187 if {![info exists commitinfo($id)]} {
2188 getcommit $id
2190 set info $commitinfo($id)
2191 set doesmatch 0
2192 foreach f $info ty $fldtypes {
2193 if {$findloc != "All fields" && $findloc != $ty} {
2194 continue
2196 set matches [findmatches $f]
2197 if {$matches == {}} continue
2198 set doesmatch 1
2199 if {$ty == "Headline"} {
2200 drawcmitrow $l
2201 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2202 } elseif {$ty == "Author"} {
2203 drawcmitrow $l
2204 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2205 } elseif {$ty == "Date"} {
2206 drawcmitrow $l
2207 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2210 if {$doesmatch} {
2211 lappend matchinglines $l
2212 if {!$didsel && $l > $oldsel} {
2213 findselectline $l
2214 set didsel 1
2218 if {$matchinglines == {}} {
2219 bell
2220 } elseif {!$didsel} {
2221 findselectline [lindex $matchinglines 0]
2225 proc findselectline {l} {
2226 global findloc commentend ctext
2227 selectline $l 1
2228 if {$findloc == "All fields" || $findloc == "Comments"} {
2229 # highlight the matches in the comments
2230 set f [$ctext get 1.0 $commentend]
2231 set matches [findmatches $f]
2232 foreach match $matches {
2233 set start [lindex $match 0]
2234 set end [expr {[lindex $match 1] + 1}]
2235 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2240 proc findnext {restart} {
2241 global matchinglines selectedline
2242 if {![info exists matchinglines]} {
2243 if {$restart} {
2244 dofind
2246 return
2248 if {![info exists selectedline]} return
2249 foreach l $matchinglines {
2250 if {$l > $selectedline} {
2251 findselectline $l
2252 return
2255 bell
2258 proc findprev {} {
2259 global matchinglines selectedline
2260 if {![info exists matchinglines]} {
2261 dofind
2262 return
2264 if {![info exists selectedline]} return
2265 set prev {}
2266 foreach l $matchinglines {
2267 if {$l >= $selectedline} break
2268 set prev $l
2270 if {$prev != {}} {
2271 findselectline $prev
2272 } else {
2273 bell
2277 proc findlocchange {name ix op} {
2278 global findloc findtype findtypemenu
2279 if {$findloc == "Pickaxe"} {
2280 set findtype Exact
2281 set state disabled
2282 } else {
2283 set state normal
2285 $findtypemenu entryconf 1 -state $state
2286 $findtypemenu entryconf 2 -state $state
2289 proc stopfindproc {{done 0}} {
2290 global findprocpid findprocfile findids
2291 global ctext findoldcursor phase maincursor textcursor
2292 global findinprogress
2294 catch {unset findids}
2295 if {[info exists findprocpid]} {
2296 if {!$done} {
2297 catch {exec kill $findprocpid}
2299 catch {close $findprocfile}
2300 unset findprocpid
2302 if {[info exists findinprogress]} {
2303 unset findinprogress
2304 if {$phase != "incrdraw"} {
2305 . config -cursor $maincursor
2306 settextcursor $textcursor
2311 proc findpatches {} {
2312 global findstring selectedline numcommits
2313 global findprocpid findprocfile
2314 global finddidsel ctext displayorder findinprogress
2315 global findinsertpos
2317 if {$numcommits == 0} return
2319 # make a list of all the ids to search, starting at the one
2320 # after the selected line (if any)
2321 if {[info exists selectedline]} {
2322 set l $selectedline
2323 } else {
2324 set l -1
2326 set inputids {}
2327 for {set i 0} {$i < $numcommits} {incr i} {
2328 if {[incr l] >= $numcommits} {
2329 set l 0
2331 append inputids [lindex $displayorder $l] "\n"
2334 if {[catch {
2335 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2336 << $inputids] r]
2337 } err]} {
2338 error_popup "Error starting search process: $err"
2339 return
2342 set findinsertpos end
2343 set findprocfile $f
2344 set findprocpid [pid $f]
2345 fconfigure $f -blocking 0
2346 fileevent $f readable readfindproc
2347 set finddidsel 0
2348 . config -cursor watch
2349 settextcursor watch
2350 set findinprogress 1
2353 proc readfindproc {} {
2354 global findprocfile finddidsel
2355 global commitrow matchinglines findinsertpos
2357 set n [gets $findprocfile line]
2358 if {$n < 0} {
2359 if {[eof $findprocfile]} {
2360 stopfindproc 1
2361 if {!$finddidsel} {
2362 bell
2365 return
2367 if {![regexp {^[0-9a-f]{40}} $line id]} {
2368 error_popup "Can't parse git-diff-tree output: $line"
2369 stopfindproc
2370 return
2372 if {![info exists commitrow($id)]} {
2373 puts stderr "spurious id: $id"
2374 return
2376 set l $commitrow($id)
2377 insertmatch $l $id
2380 proc insertmatch {l id} {
2381 global matchinglines findinsertpos finddidsel
2383 if {$findinsertpos == "end"} {
2384 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2385 set matchinglines [linsert $matchinglines 0 $l]
2386 set findinsertpos 1
2387 } else {
2388 lappend matchinglines $l
2390 } else {
2391 set matchinglines [linsert $matchinglines $findinsertpos $l]
2392 incr findinsertpos
2394 markheadline $l $id
2395 if {!$finddidsel} {
2396 findselectline $l
2397 set finddidsel 1
2401 proc findfiles {} {
2402 global selectedline numcommits displayorder ctext
2403 global ffileline finddidsel parentlist
2404 global findinprogress findstartline findinsertpos
2405 global treediffs fdiffid fdiffsneeded fdiffpos
2406 global findmergefiles
2408 if {$numcommits == 0} return
2410 if {[info exists selectedline]} {
2411 set l [expr {$selectedline + 1}]
2412 } else {
2413 set l 0
2415 set ffileline $l
2416 set findstartline $l
2417 set diffsneeded {}
2418 set fdiffsneeded {}
2419 while 1 {
2420 set id [lindex $displayorder $l]
2421 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2422 if {![info exists treediffs($id)]} {
2423 append diffsneeded "$id\n"
2424 lappend fdiffsneeded $id
2427 if {[incr l] >= $numcommits} {
2428 set l 0
2430 if {$l == $findstartline} break
2433 # start off a git-diff-tree process if needed
2434 if {$diffsneeded ne {}} {
2435 if {[catch {
2436 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2437 } err ]} {
2438 error_popup "Error starting search process: $err"
2439 return
2441 catch {unset fdiffid}
2442 set fdiffpos 0
2443 fconfigure $df -blocking 0
2444 fileevent $df readable [list readfilediffs $df]
2447 set finddidsel 0
2448 set findinsertpos end
2449 set id [lindex $displayorder $l]
2450 . config -cursor watch
2451 settextcursor watch
2452 set findinprogress 1
2453 findcont
2454 update
2457 proc readfilediffs {df} {
2458 global findid fdiffid fdiffs
2460 set n [gets $df line]
2461 if {$n < 0} {
2462 if {[eof $df]} {
2463 donefilediff
2464 if {[catch {close $df} err]} {
2465 stopfindproc
2466 bell
2467 error_popup "Error in git-diff-tree: $err"
2468 } elseif {[info exists findid]} {
2469 set id $findid
2470 stopfindproc
2471 bell
2472 error_popup "Couldn't find diffs for $id"
2475 return
2477 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2478 # start of a new string of diffs
2479 donefilediff
2480 set fdiffid $id
2481 set fdiffs {}
2482 } elseif {[string match ":*" $line]} {
2483 lappend fdiffs [lindex $line 5]
2487 proc donefilediff {} {
2488 global fdiffid fdiffs treediffs findid
2489 global fdiffsneeded fdiffpos
2491 if {[info exists fdiffid]} {
2492 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2493 && $fdiffpos < [llength $fdiffsneeded]} {
2494 # git-diff-tree doesn't output anything for a commit
2495 # which doesn't change anything
2496 set nullid [lindex $fdiffsneeded $fdiffpos]
2497 set treediffs($nullid) {}
2498 if {[info exists findid] && $nullid eq $findid} {
2499 unset findid
2500 findcont
2502 incr fdiffpos
2504 incr fdiffpos
2506 if {![info exists treediffs($fdiffid)]} {
2507 set treediffs($fdiffid) $fdiffs
2509 if {[info exists findid] && $fdiffid eq $findid} {
2510 unset findid
2511 findcont
2516 proc findcont {} {
2517 global findid treediffs parentlist
2518 global ffileline findstartline finddidsel
2519 global displayorder numcommits matchinglines findinprogress
2520 global findmergefiles
2522 set l $ffileline
2523 while {1} {
2524 set id [lindex $displayorder $l]
2525 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2526 if {![info exists treediffs($id)]} {
2527 set findid $id
2528 set ffileline $l
2529 return
2531 set doesmatch 0
2532 foreach f $treediffs($id) {
2533 set x [findmatches $f]
2534 if {$x != {}} {
2535 set doesmatch 1
2536 break
2539 if {$doesmatch} {
2540 insertmatch $l $id
2543 if {[incr l] >= $numcommits} {
2544 set l 0
2546 if {$l == $findstartline} break
2548 stopfindproc
2549 if {!$finddidsel} {
2550 bell
2554 # mark a commit as matching by putting a yellow background
2555 # behind the headline
2556 proc markheadline {l id} {
2557 global canv mainfont linehtag
2559 drawcmitrow $l
2560 set bbox [$canv bbox $linehtag($l)]
2561 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2562 $canv lower $t
2565 # mark the bits of a headline, author or date that match a find string
2566 proc markmatches {canv l str tag matches font} {
2567 set bbox [$canv bbox $tag]
2568 set x0 [lindex $bbox 0]
2569 set y0 [lindex $bbox 1]
2570 set y1 [lindex $bbox 3]
2571 foreach match $matches {
2572 set start [lindex $match 0]
2573 set end [lindex $match 1]
2574 if {$start > $end} continue
2575 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2576 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2577 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2578 [expr {$x0+$xlen+2}] $y1 \
2579 -outline {} -tags matches -fill yellow]
2580 $canv lower $t
2584 proc unmarkmatches {} {
2585 global matchinglines findids
2586 allcanvs delete matches
2587 catch {unset matchinglines}
2588 catch {unset findids}
2591 proc selcanvline {w x y} {
2592 global canv canvy0 ctext linespc
2593 global rowtextx
2594 set ymax [lindex [$canv cget -scrollregion] 3]
2595 if {$ymax == {}} return
2596 set yfrac [lindex [$canv yview] 0]
2597 set y [expr {$y + $yfrac * $ymax}]
2598 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2599 if {$l < 0} {
2600 set l 0
2602 if {$w eq $canv} {
2603 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2605 unmarkmatches
2606 selectline $l 1
2609 proc commit_descriptor {p} {
2610 global commitinfo
2611 set l "..."
2612 if {[info exists commitinfo($p)]} {
2613 set l [lindex $commitinfo($p) 0]
2615 return "$p ($l)"
2618 # append some text to the ctext widget, and make any SHA1 ID
2619 # that we know about be a clickable link.
2620 proc appendwithlinks {text} {
2621 global ctext commitrow linknum
2623 set start [$ctext index "end - 1c"]
2624 $ctext insert end $text
2625 $ctext insert end "\n"
2626 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2627 foreach l $links {
2628 set s [lindex $l 0]
2629 set e [lindex $l 1]
2630 set linkid [string range $text $s $e]
2631 if {![info exists commitrow($linkid)]} continue
2632 incr e
2633 $ctext tag add link "$start + $s c" "$start + $e c"
2634 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2635 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2636 incr linknum
2638 $ctext tag conf link -foreground blue -underline 1
2639 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2640 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2643 proc viewnextline {dir} {
2644 global canv linespc
2646 $canv delete hover
2647 set ymax [lindex [$canv cget -scrollregion] 3]
2648 set wnow [$canv yview]
2649 set wtop [expr {[lindex $wnow 0] * $ymax}]
2650 set newtop [expr {$wtop + $dir * $linespc}]
2651 if {$newtop < 0} {
2652 set newtop 0
2653 } elseif {$newtop > $ymax} {
2654 set newtop $ymax
2656 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2659 proc selectline {l isnew} {
2660 global canv canv2 canv3 ctext commitinfo selectedline
2661 global displayorder linehtag linentag linedtag
2662 global canvy0 linespc parentlist childlist
2663 global cflist currentid sha1entry
2664 global commentend idtags linknum
2665 global mergemax numcommits pending_select
2667 catch {unset pending_select}
2668 $canv delete hover
2669 normalline
2670 if {$l < 0 || $l >= $numcommits} return
2671 set y [expr {$canvy0 + $l * $linespc}]
2672 set ymax [lindex [$canv cget -scrollregion] 3]
2673 set ytop [expr {$y - $linespc - 1}]
2674 set ybot [expr {$y + $linespc + 1}]
2675 set wnow [$canv yview]
2676 set wtop [expr {[lindex $wnow 0] * $ymax}]
2677 set wbot [expr {[lindex $wnow 1] * $ymax}]
2678 set wh [expr {$wbot - $wtop}]
2679 set newtop $wtop
2680 if {$ytop < $wtop} {
2681 if {$ybot < $wtop} {
2682 set newtop [expr {$y - $wh / 2.0}]
2683 } else {
2684 set newtop $ytop
2685 if {$newtop > $wtop - $linespc} {
2686 set newtop [expr {$wtop - $linespc}]
2689 } elseif {$ybot > $wbot} {
2690 if {$ytop > $wbot} {
2691 set newtop [expr {$y - $wh / 2.0}]
2692 } else {
2693 set newtop [expr {$ybot - $wh}]
2694 if {$newtop < $wtop + $linespc} {
2695 set newtop [expr {$wtop + $linespc}]
2699 if {$newtop != $wtop} {
2700 if {$newtop < 0} {
2701 set newtop 0
2703 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2704 drawvisible
2707 if {![info exists linehtag($l)]} return
2708 $canv delete secsel
2709 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2710 -tags secsel -fill [$canv cget -selectbackground]]
2711 $canv lower $t
2712 $canv2 delete secsel
2713 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2714 -tags secsel -fill [$canv2 cget -selectbackground]]
2715 $canv2 lower $t
2716 $canv3 delete secsel
2717 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2718 -tags secsel -fill [$canv3 cget -selectbackground]]
2719 $canv3 lower $t
2721 if {$isnew} {
2722 addtohistory [list selectline $l 0]
2725 set selectedline $l
2727 set id [lindex $displayorder $l]
2728 set currentid $id
2729 $sha1entry delete 0 end
2730 $sha1entry insert 0 $id
2731 $sha1entry selection from 0
2732 $sha1entry selection to end
2734 $ctext conf -state normal
2735 $ctext delete 0.0 end
2736 set linknum 0
2737 $ctext mark set fmark.0 0.0
2738 $ctext mark gravity fmark.0 left
2739 set info $commitinfo($id)
2740 set date [formatdate [lindex $info 2]]
2741 $ctext insert end "Author: [lindex $info 1] $date\n"
2742 set date [formatdate [lindex $info 4]]
2743 $ctext insert end "Committer: [lindex $info 3] $date\n"
2744 if {[info exists idtags($id)]} {
2745 $ctext insert end "Tags:"
2746 foreach tag $idtags($id) {
2747 $ctext insert end " $tag"
2749 $ctext insert end "\n"
2752 set comment {}
2753 set olds [lindex $parentlist $l]
2754 if {[llength $olds] > 1} {
2755 set np 0
2756 foreach p $olds {
2757 if {$np >= $mergemax} {
2758 set tag mmax
2759 } else {
2760 set tag m$np
2762 $ctext insert end "Parent: " $tag
2763 appendwithlinks [commit_descriptor $p]
2764 incr np
2766 } else {
2767 foreach p $olds {
2768 append comment "Parent: [commit_descriptor $p]\n"
2772 foreach c [lindex $childlist $l] {
2773 append comment "Child: [commit_descriptor $c]\n"
2775 append comment "\n"
2776 append comment [lindex $info 5]
2778 # make anything that looks like a SHA1 ID be a clickable link
2779 appendwithlinks $comment
2781 $ctext tag delete Comments
2782 $ctext tag remove found 1.0 end
2783 $ctext conf -state disabled
2784 set commentend [$ctext index "end - 1c"]
2786 $cflist delete 0 end
2787 $cflist insert end "Comments"
2788 if {[llength $olds] <= 1} {
2789 startdiff $id
2790 } else {
2791 mergediff $id $l
2795 proc selfirstline {} {
2796 unmarkmatches
2797 selectline 0 1
2800 proc sellastline {} {
2801 global numcommits
2802 unmarkmatches
2803 set l [expr {$numcommits - 1}]
2804 selectline $l 1
2807 proc selnextline {dir} {
2808 global selectedline
2809 if {![info exists selectedline]} return
2810 set l [expr {$selectedline + $dir}]
2811 unmarkmatches
2812 selectline $l 1
2815 proc selnextpage {dir} {
2816 global canv linespc selectedline numcommits
2818 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2819 if {$lpp < 1} {
2820 set lpp 1
2822 allcanvs yview scroll [expr {$dir * $lpp}] units
2823 if {![info exists selectedline]} return
2824 set l [expr {$selectedline + $dir * $lpp}]
2825 if {$l < 0} {
2826 set l 0
2827 } elseif {$l >= $numcommits} {
2828 set l [expr $numcommits - 1]
2830 unmarkmatches
2831 selectline $l 1
2834 proc unselectline {} {
2835 global selectedline currentid
2837 catch {unset selectedline}
2838 catch {unset currentid}
2839 allcanvs delete secsel
2842 proc addtohistory {cmd} {
2843 global history historyindex
2845 if {$historyindex > 0
2846 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2847 return
2850 if {$historyindex < [llength $history]} {
2851 set history [lreplace $history $historyindex end $cmd]
2852 } else {
2853 lappend history $cmd
2855 incr historyindex
2856 if {$historyindex > 1} {
2857 .ctop.top.bar.leftbut conf -state normal
2858 } else {
2859 .ctop.top.bar.leftbut conf -state disabled
2861 .ctop.top.bar.rightbut conf -state disabled
2864 proc goback {} {
2865 global history historyindex
2867 if {$historyindex > 1} {
2868 incr historyindex -1
2869 set cmd [lindex $history [expr {$historyindex - 1}]]
2870 eval $cmd
2871 .ctop.top.bar.rightbut conf -state normal
2873 if {$historyindex <= 1} {
2874 .ctop.top.bar.leftbut conf -state disabled
2878 proc goforw {} {
2879 global history historyindex
2881 if {$historyindex < [llength $history]} {
2882 set cmd [lindex $history $historyindex]
2883 incr historyindex
2884 eval $cmd
2885 .ctop.top.bar.leftbut conf -state normal
2887 if {$historyindex >= [llength $history]} {
2888 .ctop.top.bar.rightbut conf -state disabled
2892 proc mergediff {id l} {
2893 global diffmergeid diffopts mdifffd
2894 global difffilestart diffids
2895 global parentlist
2897 set diffmergeid $id
2898 set diffids $id
2899 catch {unset difffilestart}
2900 # this doesn't seem to actually affect anything...
2901 set env(GIT_DIFF_OPTS) $diffopts
2902 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2903 if {[catch {set mdf [open $cmd r]} err]} {
2904 error_popup "Error getting merge diffs: $err"
2905 return
2907 fconfigure $mdf -blocking 0
2908 set mdifffd($id) $mdf
2909 set np [llength [lindex $parentlist $l]]
2910 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2911 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2914 proc getmergediffline {mdf id np} {
2915 global diffmergeid ctext cflist nextupdate mergemax
2916 global difffilestart mdifffd
2918 set n [gets $mdf line]
2919 if {$n < 0} {
2920 if {[eof $mdf]} {
2921 close $mdf
2923 return
2925 if {![info exists diffmergeid] || $id != $diffmergeid
2926 || $mdf != $mdifffd($id)} {
2927 return
2929 $ctext conf -state normal
2930 if {[regexp {^diff --cc (.*)} $line match fname]} {
2931 # start of a new file
2932 $ctext insert end "\n"
2933 set here [$ctext index "end - 1c"]
2934 set i [$cflist index end]
2935 $ctext mark set fmark.$i $here
2936 $ctext mark gravity fmark.$i left
2937 set difffilestart([expr {$i-1}]) $here
2938 $cflist insert end $fname
2939 set l [expr {(78 - [string length $fname]) / 2}]
2940 set pad [string range "----------------------------------------" 1 $l]
2941 $ctext insert end "$pad $fname $pad\n" filesep
2942 } elseif {[regexp {^@@} $line]} {
2943 $ctext insert end "$line\n" hunksep
2944 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2945 # do nothing
2946 } else {
2947 # parse the prefix - one ' ', '-' or '+' for each parent
2948 set spaces {}
2949 set minuses {}
2950 set pluses {}
2951 set isbad 0
2952 for {set j 0} {$j < $np} {incr j} {
2953 set c [string range $line $j $j]
2954 if {$c == " "} {
2955 lappend spaces $j
2956 } elseif {$c == "-"} {
2957 lappend minuses $j
2958 } elseif {$c == "+"} {
2959 lappend pluses $j
2960 } else {
2961 set isbad 1
2962 break
2965 set tags {}
2966 set num {}
2967 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2968 # line doesn't appear in result, parents in $minuses have the line
2969 set num [lindex $minuses 0]
2970 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2971 # line appears in result, parents in $pluses don't have the line
2972 lappend tags mresult
2973 set num [lindex $spaces 0]
2975 if {$num ne {}} {
2976 if {$num >= $mergemax} {
2977 set num "max"
2979 lappend tags m$num
2981 $ctext insert end "$line\n" $tags
2983 $ctext conf -state disabled
2984 if {[clock clicks -milliseconds] >= $nextupdate} {
2985 incr nextupdate 100
2986 fileevent $mdf readable {}
2987 update
2988 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2992 proc startdiff {ids} {
2993 global treediffs diffids treepending diffmergeid
2995 set diffids $ids
2996 catch {unset diffmergeid}
2997 if {![info exists treediffs($ids)]} {
2998 if {![info exists treepending]} {
2999 gettreediffs $ids
3001 } else {
3002 addtocflist $ids
3006 proc addtocflist {ids} {
3007 global treediffs cflist
3008 foreach f $treediffs($ids) {
3009 $cflist insert end $f
3011 getblobdiffs $ids
3014 proc gettreediffs {ids} {
3015 global treediff treepending
3016 set treepending $ids
3017 set treediff {}
3018 if {[catch \
3019 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3020 ]} return
3021 fconfigure $gdtf -blocking 0
3022 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3025 proc gettreediffline {gdtf ids} {
3026 global treediff treediffs treepending diffids diffmergeid
3028 set n [gets $gdtf line]
3029 if {$n < 0} {
3030 if {![eof $gdtf]} return
3031 close $gdtf
3032 set treediffs($ids) $treediff
3033 unset treepending
3034 if {$ids != $diffids} {
3035 if {![info exists diffmergeid]} {
3036 gettreediffs $diffids
3038 } else {
3039 addtocflist $ids
3041 return
3043 set file [lindex $line 5]
3044 lappend treediff $file
3047 proc getblobdiffs {ids} {
3048 global diffopts blobdifffd diffids env curdifftag curtagstart
3049 global difffilestart nextupdate diffinhdr treediffs
3051 set env(GIT_DIFF_OPTS) $diffopts
3052 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3053 if {[catch {set bdf [open $cmd r]} err]} {
3054 puts "error getting diffs: $err"
3055 return
3057 set diffinhdr 0
3058 fconfigure $bdf -blocking 0
3059 set blobdifffd($ids) $bdf
3060 set curdifftag Comments
3061 set curtagstart 0.0
3062 catch {unset difffilestart}
3063 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3064 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3067 proc getblobdiffline {bdf ids} {
3068 global diffids blobdifffd ctext curdifftag curtagstart
3069 global diffnexthead diffnextnote difffilestart
3070 global nextupdate diffinhdr treediffs
3072 set n [gets $bdf line]
3073 if {$n < 0} {
3074 if {[eof $bdf]} {
3075 close $bdf
3076 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3077 $ctext tag add $curdifftag $curtagstart end
3080 return
3082 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3083 return
3085 $ctext conf -state normal
3086 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3087 # start of a new file
3088 $ctext insert end "\n"
3089 $ctext tag add $curdifftag $curtagstart end
3090 set curtagstart [$ctext index "end - 1c"]
3091 set header $newname
3092 set here [$ctext index "end - 1c"]
3093 set i [lsearch -exact $treediffs($diffids) $fname]
3094 if {$i >= 0} {
3095 set difffilestart($i) $here
3096 incr i
3097 $ctext mark set fmark.$i $here
3098 $ctext mark gravity fmark.$i left
3100 if {$newname != $fname} {
3101 set i [lsearch -exact $treediffs($diffids) $newname]
3102 if {$i >= 0} {
3103 set difffilestart($i) $here
3104 incr i
3105 $ctext mark set fmark.$i $here
3106 $ctext mark gravity fmark.$i left
3109 set curdifftag "f:$fname"
3110 $ctext tag delete $curdifftag
3111 set l [expr {(78 - [string length $header]) / 2}]
3112 set pad [string range "----------------------------------------" 1 $l]
3113 $ctext insert end "$pad $header $pad\n" filesep
3114 set diffinhdr 1
3115 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3116 # do nothing
3117 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3118 set diffinhdr 0
3119 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3120 $line match f1l f1c f2l f2c rest]} {
3121 $ctext insert end "$line\n" hunksep
3122 set diffinhdr 0
3123 } else {
3124 set x [string range $line 0 0]
3125 if {$x == "-" || $x == "+"} {
3126 set tag [expr {$x == "+"}]
3127 $ctext insert end "$line\n" d$tag
3128 } elseif {$x == " "} {
3129 $ctext insert end "$line\n"
3130 } elseif {$diffinhdr || $x == "\\"} {
3131 # e.g. "\ No newline at end of file"
3132 $ctext insert end "$line\n" filesep
3133 } else {
3134 # Something else we don't recognize
3135 if {$curdifftag != "Comments"} {
3136 $ctext insert end "\n"
3137 $ctext tag add $curdifftag $curtagstart end
3138 set curtagstart [$ctext index "end - 1c"]
3139 set curdifftag Comments
3141 $ctext insert end "$line\n" filesep
3144 $ctext conf -state disabled
3145 if {[clock clicks -milliseconds] >= $nextupdate} {
3146 incr nextupdate 100
3147 fileevent $bdf readable {}
3148 update
3149 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3153 proc nextfile {} {
3154 global difffilestart ctext
3155 set here [$ctext index @0,0]
3156 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3157 if {[$ctext compare $difffilestart($i) > $here]} {
3158 if {![info exists pos]
3159 || [$ctext compare $difffilestart($i) < $pos]} {
3160 set pos $difffilestart($i)
3164 if {[info exists pos]} {
3165 $ctext yview $pos
3169 proc listboxsel {} {
3170 global ctext cflist currentid
3171 if {![info exists currentid]} return
3172 set sel [lsort [$cflist curselection]]
3173 if {$sel eq {}} return
3174 set first [lindex $sel 0]
3175 catch {$ctext yview fmark.$first}
3178 proc setcoords {} {
3179 global linespc charspc canvx0 canvy0 mainfont
3180 global xspc1 xspc2 lthickness
3182 set linespc [font metrics $mainfont -linespace]
3183 set charspc [font measure $mainfont "m"]
3184 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3185 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3186 set lthickness [expr {int($linespc / 9) + 1}]
3187 set xspc1(0) $linespc
3188 set xspc2 $linespc
3191 proc redisplay {} {
3192 global canv
3193 global selectedline
3195 set ymax [lindex [$canv cget -scrollregion] 3]
3196 if {$ymax eq {} || $ymax == 0} return
3197 set span [$canv yview]
3198 clear_display
3199 setcanvscroll
3200 allcanvs yview moveto [lindex $span 0]
3201 drawvisible
3202 if {[info exists selectedline]} {
3203 selectline $selectedline 0
3207 proc incrfont {inc} {
3208 global mainfont namefont textfont ctext canv phase
3209 global stopped entries
3210 unmarkmatches
3211 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3212 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3213 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3214 setcoords
3215 $ctext conf -font $textfont
3216 $ctext tag conf filesep -font [concat $textfont bold]
3217 foreach e $entries {
3218 $e conf -font $mainfont
3220 if {$phase eq "getcommits"} {
3221 $canv itemconf textitems -font $mainfont
3223 redisplay
3226 proc clearsha1 {} {
3227 global sha1entry sha1string
3228 if {[string length $sha1string] == 40} {
3229 $sha1entry delete 0 end
3233 proc sha1change {n1 n2 op} {
3234 global sha1string currentid sha1but
3235 if {$sha1string == {}
3236 || ([info exists currentid] && $sha1string == $currentid)} {
3237 set state disabled
3238 } else {
3239 set state normal
3241 if {[$sha1but cget -state] == $state} return
3242 if {$state == "normal"} {
3243 $sha1but conf -state normal -relief raised -text "Goto: "
3244 } else {
3245 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3249 proc gotocommit {} {
3250 global sha1string currentid commitrow tagids headids
3251 global displayorder numcommits
3253 if {$sha1string == {}
3254 || ([info exists currentid] && $sha1string == $currentid)} return
3255 if {[info exists tagids($sha1string)]} {
3256 set id $tagids($sha1string)
3257 } elseif {[info exists headids($sha1string)]} {
3258 set id $headids($sha1string)
3259 } else {
3260 set id [string tolower $sha1string]
3261 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3262 set matches {}
3263 foreach i $displayorder {
3264 if {[string match $id* $i]} {
3265 lappend matches $i
3268 if {$matches ne {}} {
3269 if {[llength $matches] > 1} {
3270 error_popup "Short SHA1 id $id is ambiguous"
3271 return
3273 set id [lindex $matches 0]
3277 if {[info exists commitrow($id)]} {
3278 selectline $commitrow($id) 1
3279 return
3281 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3282 set type "SHA1 id"
3283 } else {
3284 set type "Tag/Head"
3286 error_popup "$type $sha1string is not known"
3289 proc lineenter {x y id} {
3290 global hoverx hovery hoverid hovertimer
3291 global commitinfo canv
3293 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3294 set hoverx $x
3295 set hovery $y
3296 set hoverid $id
3297 if {[info exists hovertimer]} {
3298 after cancel $hovertimer
3300 set hovertimer [after 500 linehover]
3301 $canv delete hover
3304 proc linemotion {x y id} {
3305 global hoverx hovery hoverid hovertimer
3307 if {[info exists hoverid] && $id == $hoverid} {
3308 set hoverx $x
3309 set hovery $y
3310 if {[info exists hovertimer]} {
3311 after cancel $hovertimer
3313 set hovertimer [after 500 linehover]
3317 proc lineleave {id} {
3318 global hoverid hovertimer canv
3320 if {[info exists hoverid] && $id == $hoverid} {
3321 $canv delete hover
3322 if {[info exists hovertimer]} {
3323 after cancel $hovertimer
3324 unset hovertimer
3326 unset hoverid
3330 proc linehover {} {
3331 global hoverx hovery hoverid hovertimer
3332 global canv linespc lthickness
3333 global commitinfo mainfont
3335 set text [lindex $commitinfo($hoverid) 0]
3336 set ymax [lindex [$canv cget -scrollregion] 3]
3337 if {$ymax == {}} return
3338 set yfrac [lindex [$canv yview] 0]
3339 set x [expr {$hoverx + 2 * $linespc}]
3340 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3341 set x0 [expr {$x - 2 * $lthickness}]
3342 set y0 [expr {$y - 2 * $lthickness}]
3343 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3344 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3345 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3346 -fill \#ffff80 -outline black -width 1 -tags hover]
3347 $canv raise $t
3348 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3349 $canv raise $t
3352 proc clickisonarrow {id y} {
3353 global lthickness
3355 set ranges [rowranges $id]
3356 set thresh [expr {2 * $lthickness + 6}]
3357 set n [expr {[llength $ranges] - 1}]
3358 for {set i 1} {$i < $n} {incr i} {
3359 set row [lindex $ranges $i]
3360 if {abs([yc $row] - $y) < $thresh} {
3361 return $i
3364 return {}
3367 proc arrowjump {id n y} {
3368 global canv
3370 # 1 <-> 2, 3 <-> 4, etc...
3371 set n [expr {(($n - 1) ^ 1) + 1}]
3372 set row [lindex [rowranges $id] $n]
3373 set yt [yc $row]
3374 set ymax [lindex [$canv cget -scrollregion] 3]
3375 if {$ymax eq {} || $ymax <= 0} return
3376 set view [$canv yview]
3377 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3378 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3379 if {$yfrac < 0} {
3380 set yfrac 0
3382 allcanvs yview moveto $yfrac
3385 proc lineclick {x y id isnew} {
3386 global ctext commitinfo childlist commitrow cflist canv thickerline
3388 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3389 unmarkmatches
3390 unselectline
3391 normalline
3392 $canv delete hover
3393 # draw this line thicker than normal
3394 set thickerline $id
3395 drawlines $id
3396 if {$isnew} {
3397 set ymax [lindex [$canv cget -scrollregion] 3]
3398 if {$ymax eq {}} return
3399 set yfrac [lindex [$canv yview] 0]
3400 set y [expr {$y + $yfrac * $ymax}]
3402 set dirn [clickisonarrow $id $y]
3403 if {$dirn ne {}} {
3404 arrowjump $id $dirn $y
3405 return
3408 if {$isnew} {
3409 addtohistory [list lineclick $x $y $id 0]
3411 # fill the details pane with info about this line
3412 $ctext conf -state normal
3413 $ctext delete 0.0 end
3414 $ctext tag conf link -foreground blue -underline 1
3415 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3416 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3417 $ctext insert end "Parent:\t"
3418 $ctext insert end $id [list link link0]
3419 $ctext tag bind link0 <1> [list selbyid $id]
3420 set info $commitinfo($id)
3421 $ctext insert end "\n\t[lindex $info 0]\n"
3422 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3423 set date [formatdate [lindex $info 2]]
3424 $ctext insert end "\tDate:\t$date\n"
3425 set kids [lindex $childlist $commitrow($id)]
3426 if {$kids ne {}} {
3427 $ctext insert end "\nChildren:"
3428 set i 0
3429 foreach child $kids {
3430 incr i
3431 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3432 set info $commitinfo($child)
3433 $ctext insert end "\n\t"
3434 $ctext insert end $child [list link link$i]
3435 $ctext tag bind link$i <1> [list selbyid $child]
3436 $ctext insert end "\n\t[lindex $info 0]"
3437 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3438 set date [formatdate [lindex $info 2]]
3439 $ctext insert end "\n\tDate:\t$date\n"
3442 $ctext conf -state disabled
3444 $cflist delete 0 end
3447 proc normalline {} {
3448 global thickerline
3449 if {[info exists thickerline]} {
3450 set id $thickerline
3451 unset thickerline
3452 drawlines $id
3456 proc selbyid {id} {
3457 global commitrow
3458 if {[info exists commitrow($id)]} {
3459 selectline $commitrow($id) 1
3463 proc mstime {} {
3464 global startmstime
3465 if {![info exists startmstime]} {
3466 set startmstime [clock clicks -milliseconds]
3468 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3471 proc rowmenu {x y id} {
3472 global rowctxmenu commitrow selectedline rowmenuid
3474 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3475 set state disabled
3476 } else {
3477 set state normal
3479 $rowctxmenu entryconfigure 0 -state $state
3480 $rowctxmenu entryconfigure 1 -state $state
3481 $rowctxmenu entryconfigure 2 -state $state
3482 set rowmenuid $id
3483 tk_popup $rowctxmenu $x $y
3486 proc diffvssel {dirn} {
3487 global rowmenuid selectedline displayorder
3489 if {![info exists selectedline]} return
3490 if {$dirn} {
3491 set oldid [lindex $displayorder $selectedline]
3492 set newid $rowmenuid
3493 } else {
3494 set oldid $rowmenuid
3495 set newid [lindex $displayorder $selectedline]
3497 addtohistory [list doseldiff $oldid $newid]
3498 doseldiff $oldid $newid
3501 proc doseldiff {oldid newid} {
3502 global ctext cflist
3503 global commitinfo
3505 $ctext conf -state normal
3506 $ctext delete 0.0 end
3507 $ctext mark set fmark.0 0.0
3508 $ctext mark gravity fmark.0 left
3509 $cflist delete 0 end
3510 $cflist insert end "Top"
3511 $ctext insert end "From "
3512 $ctext tag conf link -foreground blue -underline 1
3513 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3514 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3515 $ctext tag bind link0 <1> [list selbyid $oldid]
3516 $ctext insert end $oldid [list link link0]
3517 $ctext insert end "\n "
3518 $ctext insert end [lindex $commitinfo($oldid) 0]
3519 $ctext insert end "\n\nTo "
3520 $ctext tag bind link1 <1> [list selbyid $newid]
3521 $ctext insert end $newid [list link link1]
3522 $ctext insert end "\n "
3523 $ctext insert end [lindex $commitinfo($newid) 0]
3524 $ctext insert end "\n"
3525 $ctext conf -state disabled
3526 $ctext tag delete Comments
3527 $ctext tag remove found 1.0 end
3528 startdiff [list $oldid $newid]
3531 proc mkpatch {} {
3532 global rowmenuid currentid commitinfo patchtop patchnum
3534 if {![info exists currentid]} return
3535 set oldid $currentid
3536 set oldhead [lindex $commitinfo($oldid) 0]
3537 set newid $rowmenuid
3538 set newhead [lindex $commitinfo($newid) 0]
3539 set top .patch
3540 set patchtop $top
3541 catch {destroy $top}
3542 toplevel $top
3543 label $top.title -text "Generate patch"
3544 grid $top.title - -pady 10
3545 label $top.from -text "From:"
3546 entry $top.fromsha1 -width 40 -relief flat
3547 $top.fromsha1 insert 0 $oldid
3548 $top.fromsha1 conf -state readonly
3549 grid $top.from $top.fromsha1 -sticky w
3550 entry $top.fromhead -width 60 -relief flat
3551 $top.fromhead insert 0 $oldhead
3552 $top.fromhead conf -state readonly
3553 grid x $top.fromhead -sticky w
3554 label $top.to -text "To:"
3555 entry $top.tosha1 -width 40 -relief flat
3556 $top.tosha1 insert 0 $newid
3557 $top.tosha1 conf -state readonly
3558 grid $top.to $top.tosha1 -sticky w
3559 entry $top.tohead -width 60 -relief flat
3560 $top.tohead insert 0 $newhead
3561 $top.tohead conf -state readonly
3562 grid x $top.tohead -sticky w
3563 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3564 grid $top.rev x -pady 10
3565 label $top.flab -text "Output file:"
3566 entry $top.fname -width 60
3567 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3568 incr patchnum
3569 grid $top.flab $top.fname -sticky w
3570 frame $top.buts
3571 button $top.buts.gen -text "Generate" -command mkpatchgo
3572 button $top.buts.can -text "Cancel" -command mkpatchcan
3573 grid $top.buts.gen $top.buts.can
3574 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3575 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3576 grid $top.buts - -pady 10 -sticky ew
3577 focus $top.fname
3580 proc mkpatchrev {} {
3581 global patchtop
3583 set oldid [$patchtop.fromsha1 get]
3584 set oldhead [$patchtop.fromhead get]
3585 set newid [$patchtop.tosha1 get]
3586 set newhead [$patchtop.tohead get]
3587 foreach e [list fromsha1 fromhead tosha1 tohead] \
3588 v [list $newid $newhead $oldid $oldhead] {
3589 $patchtop.$e conf -state normal
3590 $patchtop.$e delete 0 end
3591 $patchtop.$e insert 0 $v
3592 $patchtop.$e conf -state readonly
3596 proc mkpatchgo {} {
3597 global patchtop
3599 set oldid [$patchtop.fromsha1 get]
3600 set newid [$patchtop.tosha1 get]
3601 set fname [$patchtop.fname get]
3602 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3603 error_popup "Error creating patch: $err"
3605 catch {destroy $patchtop}
3606 unset patchtop
3609 proc mkpatchcan {} {
3610 global patchtop
3612 catch {destroy $patchtop}
3613 unset patchtop
3616 proc mktag {} {
3617 global rowmenuid mktagtop commitinfo
3619 set top .maketag
3620 set mktagtop $top
3621 catch {destroy $top}
3622 toplevel $top
3623 label $top.title -text "Create tag"
3624 grid $top.title - -pady 10
3625 label $top.id -text "ID:"
3626 entry $top.sha1 -width 40 -relief flat
3627 $top.sha1 insert 0 $rowmenuid
3628 $top.sha1 conf -state readonly
3629 grid $top.id $top.sha1 -sticky w
3630 entry $top.head -width 60 -relief flat
3631 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3632 $top.head conf -state readonly
3633 grid x $top.head -sticky w
3634 label $top.tlab -text "Tag name:"
3635 entry $top.tag -width 60
3636 grid $top.tlab $top.tag -sticky w
3637 frame $top.buts
3638 button $top.buts.gen -text "Create" -command mktaggo
3639 button $top.buts.can -text "Cancel" -command mktagcan
3640 grid $top.buts.gen $top.buts.can
3641 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3642 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3643 grid $top.buts - -pady 10 -sticky ew
3644 focus $top.tag
3647 proc domktag {} {
3648 global mktagtop env tagids idtags
3650 set id [$mktagtop.sha1 get]
3651 set tag [$mktagtop.tag get]
3652 if {$tag == {}} {
3653 error_popup "No tag name specified"
3654 return
3656 if {[info exists tagids($tag)]} {
3657 error_popup "Tag \"$tag\" already exists"
3658 return
3660 if {[catch {
3661 set dir [gitdir]
3662 set fname [file join $dir "refs/tags" $tag]
3663 set f [open $fname w]
3664 puts $f $id
3665 close $f
3666 } err]} {
3667 error_popup "Error creating tag: $err"
3668 return
3671 set tagids($tag) $id
3672 lappend idtags($id) $tag
3673 redrawtags $id
3676 proc redrawtags {id} {
3677 global canv linehtag commitrow idpos selectedline
3679 if {![info exists commitrow($id)]} return
3680 drawcmitrow $commitrow($id)
3681 $canv delete tag.$id
3682 set xt [eval drawtags $id $idpos($id)]
3683 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3684 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3685 selectline $selectedline 0
3689 proc mktagcan {} {
3690 global mktagtop
3692 catch {destroy $mktagtop}
3693 unset mktagtop
3696 proc mktaggo {} {
3697 domktag
3698 mktagcan
3701 proc writecommit {} {
3702 global rowmenuid wrcomtop commitinfo wrcomcmd
3704 set top .writecommit
3705 set wrcomtop $top
3706 catch {destroy $top}
3707 toplevel $top
3708 label $top.title -text "Write commit to file"
3709 grid $top.title - -pady 10
3710 label $top.id -text "ID:"
3711 entry $top.sha1 -width 40 -relief flat
3712 $top.sha1 insert 0 $rowmenuid
3713 $top.sha1 conf -state readonly
3714 grid $top.id $top.sha1 -sticky w
3715 entry $top.head -width 60 -relief flat
3716 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3717 $top.head conf -state readonly
3718 grid x $top.head -sticky w
3719 label $top.clab -text "Command:"
3720 entry $top.cmd -width 60 -textvariable wrcomcmd
3721 grid $top.clab $top.cmd -sticky w -pady 10
3722 label $top.flab -text "Output file:"
3723 entry $top.fname -width 60
3724 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3725 grid $top.flab $top.fname -sticky w
3726 frame $top.buts
3727 button $top.buts.gen -text "Write" -command wrcomgo
3728 button $top.buts.can -text "Cancel" -command wrcomcan
3729 grid $top.buts.gen $top.buts.can
3730 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3731 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3732 grid $top.buts - -pady 10 -sticky ew
3733 focus $top.fname
3736 proc wrcomgo {} {
3737 global wrcomtop
3739 set id [$wrcomtop.sha1 get]
3740 set cmd "echo $id | [$wrcomtop.cmd get]"
3741 set fname [$wrcomtop.fname get]
3742 if {[catch {exec sh -c $cmd >$fname &} err]} {
3743 error_popup "Error writing commit: $err"
3745 catch {destroy $wrcomtop}
3746 unset wrcomtop
3749 proc wrcomcan {} {
3750 global wrcomtop
3752 catch {destroy $wrcomtop}
3753 unset wrcomtop
3756 proc listrefs {id} {
3757 global idtags idheads idotherrefs
3759 set x {}
3760 if {[info exists idtags($id)]} {
3761 set x $idtags($id)
3763 set y {}
3764 if {[info exists idheads($id)]} {
3765 set y $idheads($id)
3767 set z {}
3768 if {[info exists idotherrefs($id)]} {
3769 set z $idotherrefs($id)
3771 return [list $x $y $z]
3774 proc rereadrefs {} {
3775 global idtags idheads idotherrefs
3777 set refids [concat [array names idtags] \
3778 [array names idheads] [array names idotherrefs]]
3779 foreach id $refids {
3780 if {![info exists ref($id)]} {
3781 set ref($id) [listrefs $id]
3784 readrefs
3785 set refids [lsort -unique [concat $refids [array names idtags] \
3786 [array names idheads] [array names idotherrefs]]]
3787 foreach id $refids {
3788 set v [listrefs $id]
3789 if {![info exists ref($id)] || $ref($id) != $v} {
3790 redrawtags $id
3795 proc showtag {tag isnew} {
3796 global ctext cflist tagcontents tagids linknum
3798 if {$isnew} {
3799 addtohistory [list showtag $tag 0]
3801 $ctext conf -state normal
3802 $ctext delete 0.0 end
3803 set linknum 0
3804 if {[info exists tagcontents($tag)]} {
3805 set text $tagcontents($tag)
3806 } else {
3807 set text "Tag: $tag\nId: $tagids($tag)"
3809 appendwithlinks $text
3810 $ctext conf -state disabled
3811 $cflist delete 0 end
3814 proc doquit {} {
3815 global stopped
3816 set stopped 100
3817 destroy .
3820 proc doprefs {} {
3821 global maxwidth maxgraphpct diffopts findmergefiles
3822 global oldprefs prefstop
3824 set top .gitkprefs
3825 set prefstop $top
3826 if {[winfo exists $top]} {
3827 raise $top
3828 return
3830 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3831 set oldprefs($v) [set $v]
3833 toplevel $top
3834 wm title $top "Gitk preferences"
3835 label $top.ldisp -text "Commit list display options"
3836 grid $top.ldisp - -sticky w -pady 10
3837 label $top.spacer -text " "
3838 label $top.maxwidthl -text "Maximum graph width (lines)" \
3839 -font optionfont
3840 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3841 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3842 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3843 -font optionfont
3844 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3845 grid x $top.maxpctl $top.maxpct -sticky w
3846 checkbutton $top.findm -variable findmergefiles
3847 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3848 -font optionfont
3849 grid $top.findm $top.findml - -sticky w
3850 label $top.ddisp -text "Diff display options"
3851 grid $top.ddisp - -sticky w -pady 10
3852 label $top.diffoptl -text "Options for diff program" \
3853 -font optionfont
3854 entry $top.diffopt -width 20 -textvariable diffopts
3855 grid x $top.diffoptl $top.diffopt -sticky w
3856 frame $top.buts
3857 button $top.buts.ok -text "OK" -command prefsok
3858 button $top.buts.can -text "Cancel" -command prefscan
3859 grid $top.buts.ok $top.buts.can
3860 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3861 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3862 grid $top.buts - - -pady 10 -sticky ew
3865 proc prefscan {} {
3866 global maxwidth maxgraphpct diffopts findmergefiles
3867 global oldprefs prefstop
3869 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3870 set $v $oldprefs($v)
3872 catch {destroy $prefstop}
3873 unset prefstop
3876 proc prefsok {} {
3877 global maxwidth maxgraphpct
3878 global oldprefs prefstop
3880 catch {destroy $prefstop}
3881 unset prefstop
3882 if {$maxwidth != $oldprefs(maxwidth)
3883 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3884 redisplay
3888 proc formatdate {d} {
3889 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3892 # This list of encoding names and aliases is distilled from
3893 # http://www.iana.org/assignments/character-sets.
3894 # Not all of them are supported by Tcl.
3895 set encoding_aliases {
3896 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3897 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3898 { ISO-10646-UTF-1 csISO10646UTF1 }
3899 { ISO_646.basic:1983 ref csISO646basic1983 }
3900 { INVARIANT csINVARIANT }
3901 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3902 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3903 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3904 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3905 { NATS-DANO iso-ir-9-1 csNATSDANO }
3906 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3907 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3908 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3909 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3910 { ISO-2022-KR csISO2022KR }
3911 { EUC-KR csEUCKR }
3912 { ISO-2022-JP csISO2022JP }
3913 { ISO-2022-JP-2 csISO2022JP2 }
3914 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3915 csISO13JISC6220jp }
3916 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3917 { IT iso-ir-15 ISO646-IT csISO15Italian }
3918 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3919 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3920 { greek7-old iso-ir-18 csISO18Greek7Old }
3921 { latin-greek iso-ir-19 csISO19LatinGreek }
3922 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3923 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3924 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3925 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3926 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3927 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3928 { INIS iso-ir-49 csISO49INIS }
3929 { INIS-8 iso-ir-50 csISO50INIS8 }
3930 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3931 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3932 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3933 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3934 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3935 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3936 csISO60Norwegian1 }
3937 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3938 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3939 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3940 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3941 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3942 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3943 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3944 { greek7 iso-ir-88 csISO88Greek7 }
3945 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3946 { iso-ir-90 csISO90 }
3947 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3948 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3949 csISO92JISC62991984b }
3950 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3951 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3952 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3953 csISO95JIS62291984handadd }
3954 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3955 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3956 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3957 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3958 CP819 csISOLatin1 }
3959 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3960 { T.61-7bit iso-ir-102 csISO102T617bit }
3961 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3962 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3963 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3964 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3965 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3966 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3967 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3968 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3969 arabic csISOLatinArabic }
3970 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3971 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3972 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3973 greek greek8 csISOLatinGreek }
3974 { T.101-G2 iso-ir-128 csISO128T101G2 }
3975 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3976 csISOLatinHebrew }
3977 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3978 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3979 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3980 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3981 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3982 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3983 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3984 csISOLatinCyrillic }
3985 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3986 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3987 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3988 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3989 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3990 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3991 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3992 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3993 { ISO_10367-box iso-ir-155 csISO10367Box }
3994 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3995 { latin-lap lap iso-ir-158 csISO158Lap }
3996 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3997 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3998 { us-dk csUSDK }
3999 { dk-us csDKUS }
4000 { JIS_X0201 X0201 csHalfWidthKatakana }
4001 { KSC5636 ISO646-KR csKSC5636 }
4002 { ISO-10646-UCS-2 csUnicode }
4003 { ISO-10646-UCS-4 csUCS4 }
4004 { DEC-MCS dec csDECMCS }
4005 { hp-roman8 roman8 r8 csHPRoman8 }
4006 { macintosh mac csMacintosh }
4007 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4008 csIBM037 }
4009 { IBM038 EBCDIC-INT cp038 csIBM038 }
4010 { IBM273 CP273 csIBM273 }
4011 { IBM274 EBCDIC-BE CP274 csIBM274 }
4012 { IBM275 EBCDIC-BR cp275 csIBM275 }
4013 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4014 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4015 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4016 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4017 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4018 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4019 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4020 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4021 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4022 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4023 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4024 { IBM437 cp437 437 csPC8CodePage437 }
4025 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4026 { IBM775 cp775 csPC775Baltic }
4027 { IBM850 cp850 850 csPC850Multilingual }
4028 { IBM851 cp851 851 csIBM851 }
4029 { IBM852 cp852 852 csPCp852 }
4030 { IBM855 cp855 855 csIBM855 }
4031 { IBM857 cp857 857 csIBM857 }
4032 { IBM860 cp860 860 csIBM860 }
4033 { IBM861 cp861 861 cp-is csIBM861 }
4034 { IBM862 cp862 862 csPC862LatinHebrew }
4035 { IBM863 cp863 863 csIBM863 }
4036 { IBM864 cp864 csIBM864 }
4037 { IBM865 cp865 865 csIBM865 }
4038 { IBM866 cp866 866 csIBM866 }
4039 { IBM868 CP868 cp-ar csIBM868 }
4040 { IBM869 cp869 869 cp-gr csIBM869 }
4041 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4042 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4043 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4044 { IBM891 cp891 csIBM891 }
4045 { IBM903 cp903 csIBM903 }
4046 { IBM904 cp904 904 csIBBM904 }
4047 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4048 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4049 { IBM1026 CP1026 csIBM1026 }
4050 { EBCDIC-AT-DE csIBMEBCDICATDE }
4051 { EBCDIC-AT-DE-A csEBCDICATDEA }
4052 { EBCDIC-CA-FR csEBCDICCAFR }
4053 { EBCDIC-DK-NO csEBCDICDKNO }
4054 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4055 { EBCDIC-FI-SE csEBCDICFISE }
4056 { EBCDIC-FI-SE-A csEBCDICFISEA }
4057 { EBCDIC-FR csEBCDICFR }
4058 { EBCDIC-IT csEBCDICIT }
4059 { EBCDIC-PT csEBCDICPT }
4060 { EBCDIC-ES csEBCDICES }
4061 { EBCDIC-ES-A csEBCDICESA }
4062 { EBCDIC-ES-S csEBCDICESS }
4063 { EBCDIC-UK csEBCDICUK }
4064 { EBCDIC-US csEBCDICUS }
4065 { UNKNOWN-8BIT csUnknown8BiT }
4066 { MNEMONIC csMnemonic }
4067 { MNEM csMnem }
4068 { VISCII csVISCII }
4069 { VIQR csVIQR }
4070 { KOI8-R csKOI8R }
4071 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4072 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4073 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4074 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4075 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4076 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4077 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4078 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4079 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4080 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4081 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4082 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4083 { IBM1047 IBM-1047 }
4084 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4085 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4086 { UNICODE-1-1 csUnicode11 }
4087 { CESU-8 csCESU-8 }
4088 { BOCU-1 csBOCU-1 }
4089 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4090 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4091 l8 }
4092 { ISO-8859-15 ISO_8859-15 Latin-9 }
4093 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4094 { GBK CP936 MS936 windows-936 }
4095 { JIS_Encoding csJISEncoding }
4096 { Shift_JIS MS_Kanji csShiftJIS }
4097 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4098 EUC-JP }
4099 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4100 { ISO-10646-UCS-Basic csUnicodeASCII }
4101 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4102 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4103 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4104 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4105 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4106 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4107 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4108 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4109 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4110 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4111 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4112 { Ventura-US csVenturaUS }
4113 { Ventura-International csVenturaInternational }
4114 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4115 { PC8-Turkish csPC8Turkish }
4116 { IBM-Symbols csIBMSymbols }
4117 { IBM-Thai csIBMThai }
4118 { HP-Legal csHPLegal }
4119 { HP-Pi-font csHPPiFont }
4120 { HP-Math8 csHPMath8 }
4121 { Adobe-Symbol-Encoding csHPPSMath }
4122 { HP-DeskTop csHPDesktop }
4123 { Ventura-Math csVenturaMath }
4124 { Microsoft-Publishing csMicrosoftPublishing }
4125 { Windows-31J csWindows31J }
4126 { GB2312 csGB2312 }
4127 { Big5 csBig5 }
4130 proc tcl_encoding {enc} {
4131 global encoding_aliases
4132 set names [encoding names]
4133 set lcnames [string tolower $names]
4134 set enc [string tolower $enc]
4135 set i [lsearch -exact $lcnames $enc]
4136 if {$i < 0} {
4137 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4138 if {[regsub {^iso[-_]} $enc iso encx]} {
4139 set i [lsearch -exact $lcnames $encx]
4142 if {$i < 0} {
4143 foreach l $encoding_aliases {
4144 set ll [string tolower $l]
4145 if {[lsearch -exact $ll $enc] < 0} continue
4146 # look through the aliases for one that tcl knows about
4147 foreach e $ll {
4148 set i [lsearch -exact $lcnames $e]
4149 if {$i < 0} {
4150 if {[regsub {^iso[-_]} $e iso ex]} {
4151 set i [lsearch -exact $lcnames $ex]
4154 if {$i >= 0} break
4156 break
4159 if {$i >= 0} {
4160 return [lindex $names $i]
4162 return {}
4165 # defaults...
4166 set datemode 0
4167 set diffopts "-U 5 -p"
4168 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4170 set gitencoding {}
4171 catch {
4172 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4174 if {$gitencoding == ""} {
4175 set gitencoding "utf-8"
4177 set tclencoding [tcl_encoding $gitencoding]
4178 if {$tclencoding == {}} {
4179 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4182 set mainfont {Helvetica 9}
4183 set textfont {Courier 9}
4184 set uifont {Helvetica 9 bold}
4185 set findmergefiles 0
4186 set maxgraphpct 50
4187 set maxwidth 16
4188 set revlistorder 0
4189 set fastdate 0
4190 set uparrowlen 7
4191 set downarrowlen 7
4192 set mingaplen 30
4194 set colors {green red blue magenta darkgrey brown orange}
4196 catch {source ~/.gitk}
4198 set namefont $mainfont
4200 font create optionfont -family sans-serif -size -12
4202 set revtreeargs {}
4203 foreach arg $argv {
4204 switch -regexp -- $arg {
4205 "^$" { }
4206 "^-d" { set datemode 1 }
4207 default {
4208 lappend revtreeargs $arg
4213 # check that we can find a .git directory somewhere...
4214 set gitdir [gitdir]
4215 if {![file isdirectory $gitdir]} {
4216 error_popup "Cannot find the git directory \"$gitdir\"."
4217 exit 1
4220 set history {}
4221 set historyindex 0
4223 set optim_delay 16
4225 set nextviewnum 1
4226 set curview 0
4227 set viewfiles(0) {}
4229 set stopped 0
4230 set stuffsaved 0
4231 set patchnum 0
4232 setcoords
4233 makewindow
4234 readrefs
4235 parse_args $revtreeargs
4236 set args $parsed_args
4237 if {$cmdline_files ne {}} {
4238 # create a view for the files/dirs specified on the command line
4239 set curview 1
4240 set nextviewnum 2
4241 set viewname(1) "Command line"
4242 set viewfiles(1) $cmdline_files
4243 .bar.view add command -label $viewname(1) -command {showview 1}
4244 .bar.view entryconf 2 -state normal
4245 set args [concat $args "--" $cmdline_files]
4247 getcommits $args