gitk: Fix various bugs in the view support
[git/dscho.git] / gitk
blob093213f24dfe57bc9f9259581d541829fcaf3184
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 proc gitdir {} {
11 global env
12 if {[info exists env(GIT_DIR)]} {
13 return $env(GIT_DIR)
14 } else {
15 return ".git"
19 proc parse_args {rargs} {
20 global parsed_args cmdline_files
22 set parsed_args {}
23 set cmdline_files {}
24 if {[catch {
25 set args [concat --default HEAD $rargs]
26 set args [split [eval exec git-rev-parse $args] "\n"]
27 set i 0
28 foreach arg $args {
29 if {![regexp {^[0-9a-f]{40}$} $arg]} {
30 if {$arg eq "--"} {
31 incr i
33 set cmdline_files [lrange $args $i end]
34 break
36 lappend parsed_args $arg
37 incr i
39 }]} {
40 # if git-rev-parse failed for some reason...
41 set i [lsearch -exact $rargs "--"]
42 if {$i >= 0} {
43 set cmdline_files [lrange $rargs [expr {$i+1}] end]
44 set rargs [lrange $rargs 0 [expr {$i-1}]]
46 if {$rargs == {}} {
47 set parsed_args HEAD
48 } else {
49 set parsed_args $rargs
54 proc start_rev_list {rlargs} {
55 global startmsecs nextupdate ncmupdate
56 global commfd leftover tclencoding datemode
58 set startmsecs [clock clicks -milliseconds]
59 set nextupdate [expr {$startmsecs + 100}]
60 set ncmupdate 1
61 initlayout
62 set order "--topo-order"
63 if {$datemode} {
64 set order "--date-order"
66 if {[catch {
67 set commfd [open [concat | git-rev-list --header $order \
68 --parents --boundary $rlargs] r]
69 } err]} {
70 puts stderr "Error executing git-rev-list: $err"
71 exit 1
73 set leftover {}
74 fconfigure $commfd -blocking 0 -translation lf
75 if {$tclencoding != {}} {
76 fconfigure $commfd -encoding $tclencoding
78 fileevent $commfd readable [list getcommitlines $commfd]
79 . config -cursor watch
80 settextcursor watch
83 proc getcommits {rargs} {
84 global phase canv mainfont
86 set phase getcommits
87 start_rev_list $rargs
88 $canv delete all
89 $canv create text 3 3 -anchor nw -text "Reading commits..." \
90 -font $mainfont -tags textitems
93 proc getcommitlines {commfd} {
94 global commitlisted nextupdate
95 global leftover
96 global displayorder commitidx commitrow commitdata
97 global parentlist childlist children
99 set stuff [read $commfd]
100 if {$stuff == {}} {
101 if {![eof $commfd]} return
102 # set it blocking so we wait for the process to terminate
103 fconfigure $commfd -blocking 1
104 if {![catch {close $commfd} err]} {
105 after idle finishcommits
106 return
108 if {[string range $err 0 4] == "usage"} {
109 set err \
110 "Gitk: error reading commits: bad arguments to git-rev-list.\
111 (Note: arguments to gitk are passed to git-rev-list\
112 to allow selection of commits to be displayed.)"
113 } else {
114 set err "Error reading commits: $err"
116 error_popup $err
117 exit 1
119 set start 0
120 set gotsome 0
121 while 1 {
122 set i [string first "\0" $stuff $start]
123 if {$i < 0} {
124 append leftover [string range $stuff $start end]
125 break
127 if {$start == 0} {
128 set cmit $leftover
129 append cmit [string range $stuff 0 [expr {$i - 1}]]
130 set leftover {}
131 } else {
132 set cmit [string range $stuff $start [expr {$i - 1}]]
134 set start [expr {$i + 1}]
135 set j [string first "\n" $cmit]
136 set ok 0
137 set listed 1
138 if {$j >= 0} {
139 set ids [string range $cmit 0 [expr {$j - 1}]]
140 if {[string range $ids 0 0] == "-"} {
141 set listed 0
142 set ids [string range $ids 1 end]
144 set ok 1
145 foreach id $ids {
146 if {[string length $id] != 40} {
147 set ok 0
148 break
152 if {!$ok} {
153 set shortcmit $cmit
154 if {[string length $shortcmit] > 80} {
155 set shortcmit "[string range $shortcmit 0 80]..."
157 error_popup "Can't parse git-rev-list output: {$shortcmit}"
158 exit 1
160 set id [lindex $ids 0]
161 if {$listed} {
162 set olds [lrange $ids 1 end]
163 set i 0
164 foreach p $olds {
165 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
166 lappend children($p) $id
168 incr i
170 } else {
171 set olds {}
173 lappend parentlist $olds
174 if {[info exists children($id)]} {
175 lappend childlist $children($id)
176 } else {
177 lappend childlist {}
179 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
180 set commitrow($id) $commitidx
181 incr commitidx
182 lappend displayorder $id
183 lappend commitlisted $listed
184 set gotsome 1
186 if {$gotsome} {
187 layoutmore
189 if {[clock clicks -milliseconds] >= $nextupdate} {
190 doupdate 1
194 proc doupdate {reading} {
195 global commfd nextupdate numcommits ncmupdate
197 if {$reading} {
198 fileevent $commfd readable {}
200 update
201 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
202 if {$numcommits < 100} {
203 set ncmupdate [expr {$numcommits + 1}]
204 } elseif {$numcommits < 10000} {
205 set ncmupdate [expr {$numcommits + 10}]
206 } else {
207 set ncmupdate [expr {$numcommits + 100}]
209 if {$reading} {
210 fileevent $commfd readable [list getcommitlines $commfd]
214 proc readcommit {id} {
215 if {[catch {set contents [exec git-cat-file commit $id]}]} return
216 parsecommit $id $contents 0
219 proc updatecommits {} {
220 global viewdata curview revtreeargs
222 set n $curview
223 set curview -1
224 catch {unset viewdata($n)}
225 parse_args $revtreeargs
226 readrefs
227 showview $n
230 proc parsecommit {id contents listed} {
231 global commitinfo cdate
233 set inhdr 1
234 set comment {}
235 set headline {}
236 set auname {}
237 set audate {}
238 set comname {}
239 set comdate {}
240 set hdrend [string first "\n\n" $contents]
241 if {$hdrend < 0} {
242 # should never happen...
243 set hdrend [string length $contents]
245 set header [string range $contents 0 [expr {$hdrend - 1}]]
246 set comment [string range $contents [expr {$hdrend + 2}] end]
247 foreach line [split $header "\n"] {
248 set tag [lindex $line 0]
249 if {$tag == "author"} {
250 set audate [lindex $line end-1]
251 set auname [lrange $line 1 end-2]
252 } elseif {$tag == "committer"} {
253 set comdate [lindex $line end-1]
254 set comname [lrange $line 1 end-2]
257 set headline {}
258 # take the first line of the comment as the headline
259 set i [string first "\n" $comment]
260 if {$i >= 0} {
261 set headline [string trim [string range $comment 0 $i]]
262 } else {
263 set headline $comment
265 if {!$listed} {
266 # git-rev-list indents the comment by 4 spaces;
267 # if we got this via git-cat-file, add the indentation
268 set newcomment {}
269 foreach line [split $comment "\n"] {
270 append newcomment " "
271 append newcomment $line
272 append newcomment "\n"
274 set comment $newcomment
276 if {$comdate != {}} {
277 set cdate($id) $comdate
279 set commitinfo($id) [list $headline $auname $audate \
280 $comname $comdate $comment]
283 proc getcommit {id} {
284 global commitdata commitinfo
286 if {[info exists commitdata($id)]} {
287 parsecommit $id $commitdata($id) 1
288 } else {
289 readcommit $id
290 if {![info exists commitinfo($id)]} {
291 set commitinfo($id) {"No commit information available"}
294 return 1
297 proc readrefs {} {
298 global tagids idtags headids idheads tagcontents
299 global otherrefids idotherrefs
301 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
302 catch {unset $v}
304 set refd [open [list | git ls-remote [gitdir]] r]
305 while {0 <= [set n [gets $refd line]]} {
306 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
307 match id path]} {
308 continue
310 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
311 set type others
312 set name $path
314 if {$type == "tags"} {
315 set tagids($name) $id
316 lappend idtags($id) $name
317 set obj {}
318 set type {}
319 set tag {}
320 catch {
321 set commit [exec git-rev-parse "$id^0"]
322 if {"$commit" != "$id"} {
323 set tagids($name) $commit
324 lappend idtags($commit) $name
327 catch {
328 set tagcontents($name) [exec git-cat-file tag "$id"]
330 } elseif { $type == "heads" } {
331 set headids($name) $id
332 lappend idheads($id) $name
333 } else {
334 set otherrefids($name) $id
335 lappend idotherrefs($id) $name
338 close $refd
341 proc error_popup msg {
342 set w .error
343 toplevel $w
344 wm transient $w .
345 message $w.m -text $msg -justify center -aspect 400
346 pack $w.m -side top -fill x -padx 20 -pady 20
347 button $w.ok -text OK -command "destroy $w"
348 pack $w.ok -side bottom -fill x
349 bind $w <Visibility> "grab $w; focus $w"
350 bind $w <Key-Return> "destroy $w"
351 tkwait window $w
354 proc makewindow {} {
355 global canv canv2 canv3 linespc charspc ctext cflist
356 global textfont mainfont uifont
357 global findtype findtypemenu findloc findstring fstring geometry
358 global entries sha1entry sha1string sha1but
359 global maincursor textcursor curtextcursor
360 global rowctxmenu mergemax
362 menu .bar
363 .bar add cascade -label "File" -menu .bar.file
364 .bar configure -font $uifont
365 menu .bar.file
366 .bar.file add command -label "Update" -command updatecommits
367 .bar.file add command -label "Reread references" -command rereadrefs
368 .bar.file add command -label "Quit" -command doquit
369 .bar.file configure -font $uifont
370 menu .bar.edit
371 .bar add cascade -label "Edit" -menu .bar.edit
372 .bar.edit add command -label "Preferences" -command doprefs
373 .bar.edit configure -font $uifont
374 menu .bar.view -font $uifont
375 .bar add cascade -label "View" -menu .bar.view
376 .bar.view add command -label "New view..." -command newview
377 .bar.view add command -label "Delete view" -command delview -state disabled
378 .bar.view add separator
379 .bar.view add command -label "All files" -command {showview 0}
380 menu .bar.help
381 .bar add cascade -label "Help" -menu .bar.help
382 .bar.help add command -label "About gitk" -command about
383 .bar.help add command -label "Key bindings" -command keys
384 .bar.help configure -font $uifont
385 . configure -menu .bar
387 if {![info exists geometry(canv1)]} {
388 set geometry(canv1) [expr {45 * $charspc}]
389 set geometry(canv2) [expr {30 * $charspc}]
390 set geometry(canv3) [expr {15 * $charspc}]
391 set geometry(canvh) [expr {25 * $linespc + 4}]
392 set geometry(ctextw) 80
393 set geometry(ctexth) 30
394 set geometry(cflistw) 30
396 panedwindow .ctop -orient vertical
397 if {[info exists geometry(width)]} {
398 .ctop conf -width $geometry(width) -height $geometry(height)
399 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
400 set geometry(ctexth) [expr {($texth - 8) /
401 [font metrics $textfont -linespace]}]
403 frame .ctop.top
404 frame .ctop.top.bar
405 pack .ctop.top.bar -side bottom -fill x
406 set cscroll .ctop.top.csb
407 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
408 pack $cscroll -side right -fill y
409 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
410 pack .ctop.top.clist -side top -fill both -expand 1
411 .ctop add .ctop.top
412 set canv .ctop.top.clist.canv
413 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
414 -bg white -bd 0 \
415 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
416 .ctop.top.clist add $canv
417 set canv2 .ctop.top.clist.canv2
418 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
419 -bg white -bd 0 -yscrollincr $linespc
420 .ctop.top.clist add $canv2
421 set canv3 .ctop.top.clist.canv3
422 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
423 -bg white -bd 0 -yscrollincr $linespc
424 .ctop.top.clist add $canv3
425 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
427 set sha1entry .ctop.top.bar.sha1
428 set entries $sha1entry
429 set sha1but .ctop.top.bar.sha1label
430 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
431 -command gotocommit -width 8 -font $uifont
432 $sha1but conf -disabledforeground [$sha1but cget -foreground]
433 pack .ctop.top.bar.sha1label -side left
434 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
435 trace add variable sha1string write sha1change
436 pack $sha1entry -side left -pady 2
438 image create bitmap bm-left -data {
439 #define left_width 16
440 #define left_height 16
441 static unsigned char left_bits[] = {
442 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
443 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
444 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
446 image create bitmap bm-right -data {
447 #define right_width 16
448 #define right_height 16
449 static unsigned char right_bits[] = {
450 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
451 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
452 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
454 button .ctop.top.bar.leftbut -image bm-left -command goback \
455 -state disabled -width 26
456 pack .ctop.top.bar.leftbut -side left -fill y
457 button .ctop.top.bar.rightbut -image bm-right -command goforw \
458 -state disabled -width 26
459 pack .ctop.top.bar.rightbut -side left -fill y
461 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
462 pack .ctop.top.bar.findbut -side left
463 set findstring {}
464 set fstring .ctop.top.bar.findstring
465 lappend entries $fstring
466 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
467 pack $fstring -side left -expand 1 -fill x
468 set findtype Exact
469 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
470 findtype Exact IgnCase Regexp]
471 .ctop.top.bar.findtype configure -font $uifont
472 .ctop.top.bar.findtype.menu configure -font $uifont
473 set findloc "All fields"
474 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
475 Comments Author Committer Files Pickaxe
476 .ctop.top.bar.findloc configure -font $uifont
477 .ctop.top.bar.findloc.menu configure -font $uifont
479 pack .ctop.top.bar.findloc -side right
480 pack .ctop.top.bar.findtype -side right
481 # for making sure type==Exact whenever loc==Pickaxe
482 trace add variable findloc write findlocchange
484 panedwindow .ctop.cdet -orient horizontal
485 .ctop add .ctop.cdet
486 frame .ctop.cdet.left
487 set ctext .ctop.cdet.left.ctext
488 text $ctext -bg white -state disabled -font $textfont \
489 -width $geometry(ctextw) -height $geometry(ctexth) \
490 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
491 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
492 pack .ctop.cdet.left.sb -side right -fill y
493 pack $ctext -side left -fill both -expand 1
494 .ctop.cdet add .ctop.cdet.left
496 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
497 $ctext tag conf hunksep -fore blue
498 $ctext tag conf d0 -fore red
499 $ctext tag conf d1 -fore "#00a000"
500 $ctext tag conf m0 -fore red
501 $ctext tag conf m1 -fore blue
502 $ctext tag conf m2 -fore green
503 $ctext tag conf m3 -fore purple
504 $ctext tag conf m4 -fore brown
505 $ctext tag conf m5 -fore "#009090"
506 $ctext tag conf m6 -fore magenta
507 $ctext tag conf m7 -fore "#808000"
508 $ctext tag conf m8 -fore "#009000"
509 $ctext tag conf m9 -fore "#ff0080"
510 $ctext tag conf m10 -fore cyan
511 $ctext tag conf m11 -fore "#b07070"
512 $ctext tag conf m12 -fore "#70b0f0"
513 $ctext tag conf m13 -fore "#70f0b0"
514 $ctext tag conf m14 -fore "#f0b070"
515 $ctext tag conf m15 -fore "#ff70b0"
516 $ctext tag conf mmax -fore darkgrey
517 set mergemax 16
518 $ctext tag conf mresult -font [concat $textfont bold]
519 $ctext tag conf msep -font [concat $textfont bold]
520 $ctext tag conf found -back yellow
522 frame .ctop.cdet.right
523 set cflist .ctop.cdet.right.cfiles
524 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
525 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
526 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
527 pack .ctop.cdet.right.sb -side right -fill y
528 pack $cflist -side left -fill both -expand 1
529 .ctop.cdet add .ctop.cdet.right
530 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
532 pack .ctop -side top -fill both -expand 1
534 bindall <1> {selcanvline %W %x %y}
535 #bindall <B1-Motion> {selcanvline %W %x %y}
536 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
537 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
538 bindall <2> "canvscan mark %W %x %y"
539 bindall <B2-Motion> "canvscan dragto %W %x %y"
540 bindkey <Home> selfirstline
541 bindkey <End> sellastline
542 bind . <Key-Up> "selnextline -1"
543 bind . <Key-Down> "selnextline 1"
544 bindkey <Key-Right> "goforw"
545 bindkey <Key-Left> "goback"
546 bind . <Key-Prior> "selnextpage -1"
547 bind . <Key-Next> "selnextpage 1"
548 bind . <Control-Home> "allcanvs yview moveto 0.0"
549 bind . <Control-End> "allcanvs yview moveto 1.0"
550 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
551 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
552 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
553 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
554 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
555 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
556 bindkey <Key-space> "$ctext yview scroll 1 pages"
557 bindkey p "selnextline -1"
558 bindkey n "selnextline 1"
559 bindkey z "goback"
560 bindkey x "goforw"
561 bindkey i "selnextline -1"
562 bindkey k "selnextline 1"
563 bindkey j "goback"
564 bindkey l "goforw"
565 bindkey b "$ctext yview scroll -1 pages"
566 bindkey d "$ctext yview scroll 18 units"
567 bindkey u "$ctext yview scroll -18 units"
568 bindkey / {findnext 1}
569 bindkey <Key-Return> {findnext 0}
570 bindkey ? findprev
571 bindkey f nextfile
572 bind . <Control-q> doquit
573 bind . <Control-f> dofind
574 bind . <Control-g> {findnext 0}
575 bind . <Control-r> findprev
576 bind . <Control-equal> {incrfont 1}
577 bind . <Control-KP_Add> {incrfont 1}
578 bind . <Control-minus> {incrfont -1}
579 bind . <Control-KP_Subtract> {incrfont -1}
580 bind $cflist <<ListboxSelect>> listboxsel
581 bind . <Destroy> {savestuff %W}
582 bind . <Button-1> "click %W"
583 bind $fstring <Key-Return> dofind
584 bind $sha1entry <Key-Return> gotocommit
585 bind $sha1entry <<PasteSelection>> clearsha1
587 set maincursor [. cget -cursor]
588 set textcursor [$ctext cget -cursor]
589 set curtextcursor $textcursor
591 set rowctxmenu .rowctxmenu
592 menu $rowctxmenu -tearoff 0
593 $rowctxmenu add command -label "Diff this -> selected" \
594 -command {diffvssel 0}
595 $rowctxmenu add command -label "Diff selected -> this" \
596 -command {diffvssel 1}
597 $rowctxmenu add command -label "Make patch" -command mkpatch
598 $rowctxmenu add command -label "Create tag" -command mktag
599 $rowctxmenu add command -label "Write commit to file" -command writecommit
602 # mouse-2 makes all windows scan vertically, but only the one
603 # the cursor is in scans horizontally
604 proc canvscan {op w x y} {
605 global canv canv2 canv3
606 foreach c [list $canv $canv2 $canv3] {
607 if {$c == $w} {
608 $c scan $op $x $y
609 } else {
610 $c scan $op 0 $y
615 proc scrollcanv {cscroll f0 f1} {
616 $cscroll set $f0 $f1
617 drawfrac $f0 $f1
620 # when we make a key binding for the toplevel, make sure
621 # it doesn't get triggered when that key is pressed in the
622 # find string entry widget.
623 proc bindkey {ev script} {
624 global entries
625 bind . $ev $script
626 set escript [bind Entry $ev]
627 if {$escript == {}} {
628 set escript [bind Entry <Key>]
630 foreach e $entries {
631 bind $e $ev "$escript; break"
635 # set the focus back to the toplevel for any click outside
636 # the entry widgets
637 proc click {w} {
638 global entries
639 foreach e $entries {
640 if {$w == $e} return
642 focus .
645 proc savestuff {w} {
646 global canv canv2 canv3 ctext cflist mainfont textfont uifont
647 global stuffsaved findmergefiles maxgraphpct
648 global maxwidth
650 if {$stuffsaved} return
651 if {![winfo viewable .]} return
652 catch {
653 set f [open "~/.gitk-new" w]
654 puts $f [list set mainfont $mainfont]
655 puts $f [list set textfont $textfont]
656 puts $f [list set uifont $uifont]
657 puts $f [list set findmergefiles $findmergefiles]
658 puts $f [list set maxgraphpct $maxgraphpct]
659 puts $f [list set maxwidth $maxwidth]
660 puts $f "set geometry(width) [winfo width .ctop]"
661 puts $f "set geometry(height) [winfo height .ctop]"
662 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
663 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
664 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
665 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
666 set wid [expr {([winfo width $ctext] - 8) \
667 / [font measure $textfont "0"]}]
668 puts $f "set geometry(ctextw) $wid"
669 set wid [expr {([winfo width $cflist] - 11) \
670 / [font measure [$cflist cget -font] "0"]}]
671 puts $f "set geometry(cflistw) $wid"
672 close $f
673 file rename -force "~/.gitk-new" "~/.gitk"
675 set stuffsaved 1
678 proc resizeclistpanes {win w} {
679 global oldwidth
680 if {[info exists oldwidth($win)]} {
681 set s0 [$win sash coord 0]
682 set s1 [$win sash coord 1]
683 if {$w < 60} {
684 set sash0 [expr {int($w/2 - 2)}]
685 set sash1 [expr {int($w*5/6 - 2)}]
686 } else {
687 set factor [expr {1.0 * $w / $oldwidth($win)}]
688 set sash0 [expr {int($factor * [lindex $s0 0])}]
689 set sash1 [expr {int($factor * [lindex $s1 0])}]
690 if {$sash0 < 30} {
691 set sash0 30
693 if {$sash1 < $sash0 + 20} {
694 set sash1 [expr {$sash0 + 20}]
696 if {$sash1 > $w - 10} {
697 set sash1 [expr {$w - 10}]
698 if {$sash0 > $sash1 - 20} {
699 set sash0 [expr {$sash1 - 20}]
703 $win sash place 0 $sash0 [lindex $s0 1]
704 $win sash place 1 $sash1 [lindex $s1 1]
706 set oldwidth($win) $w
709 proc resizecdetpanes {win w} {
710 global oldwidth
711 if {[info exists oldwidth($win)]} {
712 set s0 [$win sash coord 0]
713 if {$w < 60} {
714 set sash0 [expr {int($w*3/4 - 2)}]
715 } else {
716 set factor [expr {1.0 * $w / $oldwidth($win)}]
717 set sash0 [expr {int($factor * [lindex $s0 0])}]
718 if {$sash0 < 45} {
719 set sash0 45
721 if {$sash0 > $w - 15} {
722 set sash0 [expr {$w - 15}]
725 $win sash place 0 $sash0 [lindex $s0 1]
727 set oldwidth($win) $w
730 proc allcanvs args {
731 global canv canv2 canv3
732 eval $canv $args
733 eval $canv2 $args
734 eval $canv3 $args
737 proc bindall {event action} {
738 global canv canv2 canv3
739 bind $canv $event $action
740 bind $canv2 $event $action
741 bind $canv3 $event $action
744 proc about {} {
745 set w .about
746 if {[winfo exists $w]} {
747 raise $w
748 return
750 toplevel $w
751 wm title $w "About gitk"
752 message $w.m -text {
753 Gitk - a commit viewer for git
755 Copyright © 2005-2006 Paul Mackerras
757 Use and redistribute under the terms of the GNU General Public License} \
758 -justify center -aspect 400
759 pack $w.m -side top -fill x -padx 20 -pady 20
760 button $w.ok -text Close -command "destroy $w"
761 pack $w.ok -side bottom
764 proc keys {} {
765 set w .keys
766 if {[winfo exists $w]} {
767 raise $w
768 return
770 toplevel $w
771 wm title $w "Gitk key bindings"
772 message $w.m -text {
773 Gitk key bindings:
775 <Ctrl-Q> Quit
776 <Home> Move to first commit
777 <End> Move to last commit
778 <Up>, p, i Move up one commit
779 <Down>, n, k Move down one commit
780 <Left>, z, j Go back in history list
781 <Right>, x, l Go forward in history list
782 <PageUp> Move up one page in commit list
783 <PageDown> Move down one page in commit list
784 <Ctrl-Home> Scroll to top of commit list
785 <Ctrl-End> Scroll to bottom of commit list
786 <Ctrl-Up> Scroll commit list up one line
787 <Ctrl-Down> Scroll commit list down one line
788 <Ctrl-PageUp> Scroll commit list up one page
789 <Ctrl-PageDown> Scroll commit list down one page
790 <Delete>, b Scroll diff view up one page
791 <Backspace> Scroll diff view up one page
792 <Space> Scroll diff view down one page
793 u Scroll diff view up 18 lines
794 d Scroll diff view down 18 lines
795 <Ctrl-F> Find
796 <Ctrl-G> Move to next find hit
797 <Ctrl-R> Move to previous find hit
798 <Return> Move to next find hit
799 / Move to next find hit, or redo find
800 ? Move to previous find hit
801 f Scroll diff view to next file
802 <Ctrl-KP+> Increase font size
803 <Ctrl-plus> Increase font size
804 <Ctrl-KP-> Decrease font size
805 <Ctrl-minus> Decrease font size
807 -justify left -bg white -border 2 -relief sunken
808 pack $w.m -side top -fill both
809 button $w.ok -text Close -command "destroy $w"
810 pack $w.ok -side bottom
813 proc newview {} {
814 global newviewname nextviewnum newviewtop
816 set top .gitkview
817 if {[winfo exists $top]} {
818 raise $top
819 return
821 set newviewtop $top
822 toplevel $top
823 wm title $top "Gitk view definition"
824 label $top.nl -text "Name"
825 entry $top.name -width 20 -textvariable newviewname
826 set newviewname "View $nextviewnum"
827 grid $top.nl $top.name -sticky w
828 label $top.l -text "Files and directories to include:"
829 grid $top.l - -sticky w -pady 10
830 text $top.t -width 30 -height 10
831 grid $top.t - -sticky w
832 frame $top.buts
833 button $top.buts.ok -text "OK" -command newviewok
834 button $top.buts.can -text "Cancel" -command newviewcan
835 grid $top.buts.ok $top.buts.can
836 grid columnconfigure $top.buts 0 -weight 1 -uniform a
837 grid columnconfigure $top.buts 1 -weight 1 -uniform a
838 grid $top.buts - -pady 10 -sticky ew
839 focus $top.t
842 proc newviewok {} {
843 global newviewtop nextviewnum
844 global viewname viewfiles
846 set n $nextviewnum
847 incr nextviewnum
848 set viewname($n) [$newviewtop.name get]
849 set files {}
850 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
851 set ft [string trim $f]
852 if {$ft ne {}} {
853 lappend files $ft
856 set viewfiles($n) $files
857 catch {destroy $newviewtop}
858 unset newviewtop
859 .bar.view add command -label $viewname($n) -command [list showview $n]
860 after idle showview $n
863 proc newviewcan {} {
864 global newviewtop
866 catch {destroy $newviewtop}
867 unset newviewtop
870 proc delview {} {
871 global curview viewdata
873 if {$curview == 0} return
874 set nmenu [.bar.view index end]
875 set targetcmd [list showview $curview]
876 for {set i 5} {$i <= $nmenu} {incr i} {
877 if {[.bar.view entrycget $i -command] eq $targetcmd} {
878 .bar.view delete $i
879 break
882 set viewdata($curview) {}
883 showview 0
886 proc showview {n} {
887 global curview viewdata viewfiles
888 global displayorder parentlist childlist rowidlist rowoffsets
889 global colormap rowtextx commitrow
890 global numcommits rowrangelist commitlisted idrowranges
891 global selectedline currentid canv canvy0
892 global matchinglines treediffs
893 global parsed_args
894 global pending_select phase
896 if {$n == $curview} return
897 set selid {}
898 if {[info exists selectedline]} {
899 set selid $currentid
900 set y [yc $selectedline]
901 set ymax [lindex [$canv cget -scrollregion] 3]
902 set span [$canv yview]
903 set ytop [expr {[lindex $span 0] * $ymax}]
904 set ybot [expr {[lindex $span 1] * $ymax}]
905 if {$ytop < $y && $y < $ybot} {
906 set yscreen [expr {$y - $ytop}]
907 } else {
908 set yscreen [expr {($ybot - $ytop) / 2}]
911 unselectline
912 normalline
913 stopfindproc
914 if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
915 set viewdata($curview) \
916 [list $displayorder $parentlist $childlist $rowidlist \
917 $rowoffsets $rowrangelist $commitlisted]
919 catch {unset matchinglines}
920 catch {unset treediffs}
921 clear_display
923 set curview $n
924 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
926 if {![info exists viewdata($n)]} {
927 set args $parsed_args
928 if {$viewfiles($n) ne {}} {
929 set args [concat $args "--" $viewfiles($n)]
931 set pending_select $selid
932 getcommits $args
933 return
936 set displayorder [lindex $viewdata($n) 0]
937 set parentlist [lindex $viewdata($n) 1]
938 set childlist [lindex $viewdata($n) 2]
939 set rowidlist [lindex $viewdata($n) 3]
940 set rowoffsets [lindex $viewdata($n) 4]
941 set rowrangelist [lindex $viewdata($n) 5]
942 set commitlisted [lindex $viewdata($n) 6]
943 set numcommits [llength $displayorder]
944 catch {unset colormap}
945 catch {unset rowtextx}
946 catch {unset commitrow}
947 catch {unset idrowranges}
948 set curview $n
949 set row 0
950 foreach id $displayorder {
951 set commitrow($id) $row
952 incr row
954 setcanvscroll
955 set yf 0
956 set row 0
957 if {$selid ne {} && [info exists commitrow($selid)]} {
958 set row $commitrow($selid)
959 # try to get the selected row in the same position on the screen
960 set ymax [lindex [$canv cget -scrollregion] 3]
961 set ytop [expr {[yc $row] - $yscreen}]
962 if {$ytop < 0} {
963 set ytop 0
965 set yf [expr {$ytop * 1.0 / $ymax}]
967 allcanvs yview moveto $yf
968 drawvisible
969 selectline $row 0
972 proc shortids {ids} {
973 set res {}
974 foreach id $ids {
975 if {[llength $id] > 1} {
976 lappend res [shortids $id]
977 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
978 lappend res [string range $id 0 7]
979 } else {
980 lappend res $id
983 return $res
986 proc incrange {l x o} {
987 set n [llength $l]
988 while {$x < $n} {
989 set e [lindex $l $x]
990 if {$e ne {}} {
991 lset l $x [expr {$e + $o}]
993 incr x
995 return $l
998 proc ntimes {n o} {
999 set ret {}
1000 for {} {$n > 0} {incr n -1} {
1001 lappend ret $o
1003 return $ret
1006 proc usedinrange {id l1 l2} {
1007 global children commitrow
1009 if {[info exists commitrow($id)]} {
1010 set r $commitrow($id)
1011 if {$l1 <= $r && $r <= $l2} {
1012 return [expr {$r - $l1 + 1}]
1015 foreach c $children($id) {
1016 if {[info exists commitrow($c)]} {
1017 set r $commitrow($c)
1018 if {$l1 <= $r && $r <= $l2} {
1019 return [expr {$r - $l1 + 1}]
1023 return 0
1026 proc sanity {row {full 0}} {
1027 global rowidlist rowoffsets
1029 set col -1
1030 set ids [lindex $rowidlist $row]
1031 foreach id $ids {
1032 incr col
1033 if {$id eq {}} continue
1034 if {$col < [llength $ids] - 1 &&
1035 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1036 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1038 set o [lindex $rowoffsets $row $col]
1039 set y $row
1040 set x $col
1041 while {$o ne {}} {
1042 incr y -1
1043 incr x $o
1044 if {[lindex $rowidlist $y $x] != $id} {
1045 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1046 puts " id=[shortids $id] check started at row $row"
1047 for {set i $row} {$i >= $y} {incr i -1} {
1048 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1050 break
1052 if {!$full} break
1053 set o [lindex $rowoffsets $y $x]
1058 proc makeuparrow {oid x y z} {
1059 global rowidlist rowoffsets uparrowlen idrowranges
1061 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1062 incr y -1
1063 incr x $z
1064 set off0 [lindex $rowoffsets $y]
1065 for {set x0 $x} {1} {incr x0} {
1066 if {$x0 >= [llength $off0]} {
1067 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1068 break
1070 set z [lindex $off0 $x0]
1071 if {$z ne {}} {
1072 incr x0 $z
1073 break
1076 set z [expr {$x0 - $x}]
1077 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1078 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1080 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1081 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1082 lappend idrowranges($oid) $y
1085 proc initlayout {} {
1086 global rowidlist rowoffsets displayorder commitlisted
1087 global rowlaidout rowoptim
1088 global idinlist rowchk rowrangelist idrowranges
1089 global commitidx numcommits canvxmax canv
1090 global nextcolor
1091 global parentlist childlist children
1092 global colormap rowtextx commitrow
1093 global linesegends
1095 set commitidx 0
1096 set numcommits 0
1097 set displayorder {}
1098 set commitlisted {}
1099 set parentlist {}
1100 set childlist {}
1101 set rowrangelist {}
1102 catch {unset children}
1103 set nextcolor 0
1104 set rowidlist {{}}
1105 set rowoffsets {{}}
1106 catch {unset idinlist}
1107 catch {unset rowchk}
1108 set rowlaidout 0
1109 set rowoptim 0
1110 set canvxmax [$canv cget -width]
1111 catch {unset colormap}
1112 catch {unset rowtextx}
1113 catch {unset commitrow}
1114 catch {unset idrowranges}
1115 catch {unset linesegends}
1118 proc setcanvscroll {} {
1119 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1121 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1122 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1123 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1124 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1127 proc visiblerows {} {
1128 global canv numcommits linespc
1130 set ymax [lindex [$canv cget -scrollregion] 3]
1131 if {$ymax eq {} || $ymax == 0} return
1132 set f [$canv yview]
1133 set y0 [expr {int([lindex $f 0] * $ymax)}]
1134 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1135 if {$r0 < 0} {
1136 set r0 0
1138 set y1 [expr {int([lindex $f 1] * $ymax)}]
1139 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1140 if {$r1 >= $numcommits} {
1141 set r1 [expr {$numcommits - 1}]
1143 return [list $r0 $r1]
1146 proc layoutmore {} {
1147 global rowlaidout rowoptim commitidx numcommits optim_delay
1148 global uparrowlen
1150 set row $rowlaidout
1151 set rowlaidout [layoutrows $row $commitidx 0]
1152 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1153 if {$orow > $rowoptim} {
1154 optimize_rows $rowoptim 0 $orow
1155 set rowoptim $orow
1157 set canshow [expr {$rowoptim - $optim_delay}]
1158 if {$canshow > $numcommits} {
1159 showstuff $canshow
1163 proc showstuff {canshow} {
1164 global numcommits commitrow pending_select selectedline
1165 global linesegends idrowranges idrangedrawn
1167 if {$numcommits == 0} {
1168 global phase
1169 set phase "incrdraw"
1170 allcanvs delete all
1172 set row $numcommits
1173 set numcommits $canshow
1174 setcanvscroll
1175 set rows [visiblerows]
1176 set r0 [lindex $rows 0]
1177 set r1 [lindex $rows 1]
1178 set selrow -1
1179 for {set r $row} {$r < $canshow} {incr r} {
1180 if {[info exists linesegends($r)]} {
1181 foreach id $linesegends($r) {
1182 set i -1
1183 foreach {s e} $idrowranges($id) {
1184 incr i
1185 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1186 && ![info exists idrangedrawn($id,$i)]} {
1187 drawlineseg $id $i
1188 set idrangedrawn($id,$i) 1
1194 if {$canshow > $r1} {
1195 set canshow $r1
1197 while {$row < $canshow} {
1198 drawcmitrow $row
1199 incr row
1201 if {[info exists pending_select] &&
1202 [info exists commitrow($pending_select)] &&
1203 $commitrow($pending_select) < $numcommits} {
1204 selectline $commitrow($pending_select) 1
1206 if {![info exists selectedline] && ![info exists pending_select]} {
1207 selectline 0 1
1211 proc layoutrows {row endrow last} {
1212 global rowidlist rowoffsets displayorder
1213 global uparrowlen downarrowlen maxwidth mingaplen
1214 global childlist parentlist
1215 global idrowranges linesegends
1216 global commitidx
1217 global idinlist rowchk rowrangelist
1219 set idlist [lindex $rowidlist $row]
1220 set offs [lindex $rowoffsets $row]
1221 while {$row < $endrow} {
1222 set id [lindex $displayorder $row]
1223 set oldolds {}
1224 set newolds {}
1225 foreach p [lindex $parentlist $row] {
1226 if {![info exists idinlist($p)]} {
1227 lappend newolds $p
1228 } elseif {!$idinlist($p)} {
1229 lappend oldolds $p
1232 set nev [expr {[llength $idlist] + [llength $newolds]
1233 + [llength $oldolds] - $maxwidth + 1}]
1234 if {$nev > 0} {
1235 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1236 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1237 set i [lindex $idlist $x]
1238 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1239 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1240 [expr {$row + $uparrowlen + $mingaplen}]]
1241 if {$r == 0} {
1242 set idlist [lreplace $idlist $x $x]
1243 set offs [lreplace $offs $x $x]
1244 set offs [incrange $offs $x 1]
1245 set idinlist($i) 0
1246 set rm1 [expr {$row - 1}]
1247 lappend linesegends($rm1) $i
1248 lappend idrowranges($i) $rm1
1249 if {[incr nev -1] <= 0} break
1250 continue
1252 set rowchk($id) [expr {$row + $r}]
1255 lset rowidlist $row $idlist
1256 lset rowoffsets $row $offs
1258 set col [lsearch -exact $idlist $id]
1259 if {$col < 0} {
1260 set col [llength $idlist]
1261 lappend idlist $id
1262 lset rowidlist $row $idlist
1263 set z {}
1264 if {[lindex $childlist $row] ne {}} {
1265 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1266 unset idinlist($id)
1268 lappend offs $z
1269 lset rowoffsets $row $offs
1270 if {$z ne {}} {
1271 makeuparrow $id $col $row $z
1273 } else {
1274 unset idinlist($id)
1276 set ranges {}
1277 if {[info exists idrowranges($id)]} {
1278 lappend idrowranges($id) $row
1279 set ranges $idrowranges($id)
1281 lappend rowrangelist $ranges
1282 incr row
1283 set offs [ntimes [llength $idlist] 0]
1284 set l [llength $newolds]
1285 set idlist [eval lreplace \$idlist $col $col $newolds]
1286 set o 0
1287 if {$l != 1} {
1288 set offs [lrange $offs 0 [expr {$col - 1}]]
1289 foreach x $newolds {
1290 lappend offs {}
1291 incr o -1
1293 incr o
1294 set tmp [expr {[llength $idlist] - [llength $offs]}]
1295 if {$tmp > 0} {
1296 set offs [concat $offs [ntimes $tmp $o]]
1298 } else {
1299 lset offs $col {}
1301 foreach i $newolds {
1302 set idinlist($i) 1
1303 set idrowranges($i) $row
1305 incr col $l
1306 foreach oid $oldolds {
1307 set idinlist($oid) 1
1308 set idlist [linsert $idlist $col $oid]
1309 set offs [linsert $offs $col $o]
1310 makeuparrow $oid $col $row $o
1311 incr col
1313 lappend rowidlist $idlist
1314 lappend rowoffsets $offs
1316 return $row
1319 proc addextraid {id row} {
1320 global displayorder commitrow commitinfo
1321 global commitidx
1322 global parentlist childlist children
1324 incr commitidx
1325 lappend displayorder $id
1326 lappend parentlist {}
1327 set commitrow($id) $row
1328 readcommit $id
1329 if {![info exists commitinfo($id)]} {
1330 set commitinfo($id) {"No commit information available"}
1332 if {[info exists children($id)]} {
1333 lappend childlist $children($id)
1334 } else {
1335 lappend childlist {}
1339 proc layouttail {} {
1340 global rowidlist rowoffsets idinlist commitidx
1341 global idrowranges rowrangelist
1343 set row $commitidx
1344 set idlist [lindex $rowidlist $row]
1345 while {$idlist ne {}} {
1346 set col [expr {[llength $idlist] - 1}]
1347 set id [lindex $idlist $col]
1348 addextraid $id $row
1349 unset idinlist($id)
1350 lappend idrowranges($id) $row
1351 lappend rowrangelist $idrowranges($id)
1352 incr row
1353 set offs [ntimes $col 0]
1354 set idlist [lreplace $idlist $col $col]
1355 lappend rowidlist $idlist
1356 lappend rowoffsets $offs
1359 foreach id [array names idinlist] {
1360 addextraid $id $row
1361 lset rowidlist $row [list $id]
1362 lset rowoffsets $row 0
1363 makeuparrow $id 0 $row 0
1364 lappend idrowranges($id) $row
1365 lappend rowrangelist $idrowranges($id)
1366 incr row
1367 lappend rowidlist {}
1368 lappend rowoffsets {}
1372 proc insert_pad {row col npad} {
1373 global rowidlist rowoffsets
1375 set pad [ntimes $npad {}]
1376 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1377 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1378 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1381 proc optimize_rows {row col endrow} {
1382 global rowidlist rowoffsets idrowranges displayorder
1384 for {} {$row < $endrow} {incr row} {
1385 set idlist [lindex $rowidlist $row]
1386 set offs [lindex $rowoffsets $row]
1387 set haspad 0
1388 for {} {$col < [llength $offs]} {incr col} {
1389 if {[lindex $idlist $col] eq {}} {
1390 set haspad 1
1391 continue
1393 set z [lindex $offs $col]
1394 if {$z eq {}} continue
1395 set isarrow 0
1396 set x0 [expr {$col + $z}]
1397 set y0 [expr {$row - 1}]
1398 set z0 [lindex $rowoffsets $y0 $x0]
1399 if {$z0 eq {}} {
1400 set id [lindex $idlist $col]
1401 if {[info exists idrowranges($id)] &&
1402 $y0 > [lindex $idrowranges($id) 0]} {
1403 set isarrow 1
1406 if {$z < -1 || ($z < 0 && $isarrow)} {
1407 set npad [expr {-1 - $z + $isarrow}]
1408 set offs [incrange $offs $col $npad]
1409 insert_pad $y0 $x0 $npad
1410 if {$y0 > 0} {
1411 optimize_rows $y0 $x0 $row
1413 set z [lindex $offs $col]
1414 set x0 [expr {$col + $z}]
1415 set z0 [lindex $rowoffsets $y0 $x0]
1416 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1417 set npad [expr {$z - 1 + $isarrow}]
1418 set y1 [expr {$row + 1}]
1419 set offs2 [lindex $rowoffsets $y1]
1420 set x1 -1
1421 foreach z $offs2 {
1422 incr x1
1423 if {$z eq {} || $x1 + $z < $col} continue
1424 if {$x1 + $z > $col} {
1425 incr npad
1427 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1428 break
1430 set pad [ntimes $npad {}]
1431 set idlist [eval linsert \$idlist $col $pad]
1432 set tmp [eval linsert \$offs $col $pad]
1433 incr col $npad
1434 set offs [incrange $tmp $col [expr {-$npad}]]
1435 set z [lindex $offs $col]
1436 set haspad 1
1438 if {$z0 eq {} && !$isarrow} {
1439 # this line links to its first child on row $row-2
1440 set rm2 [expr {$row - 2}]
1441 set id [lindex $displayorder $rm2]
1442 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1443 if {$xc >= 0} {
1444 set z0 [expr {$xc - $x0}]
1447 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1448 insert_pad $y0 $x0 1
1449 set offs [incrange $offs $col 1]
1450 optimize_rows $y0 [expr {$x0 + 1}] $row
1453 if {!$haspad} {
1454 set o {}
1455 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1456 set o [lindex $offs $col]
1457 if {$o eq {}} {
1458 # check if this is the link to the first child
1459 set id [lindex $idlist $col]
1460 if {[info exists idrowranges($id)] &&
1461 $row == [lindex $idrowranges($id) 0]} {
1462 # it is, work out offset to child
1463 set y0 [expr {$row - 1}]
1464 set id [lindex $displayorder $y0]
1465 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1466 if {$x0 >= 0} {
1467 set o [expr {$x0 - $col}]
1471 if {$o eq {} || $o <= 0} break
1473 if {$o ne {} && [incr col] < [llength $idlist]} {
1474 set y1 [expr {$row + 1}]
1475 set offs2 [lindex $rowoffsets $y1]
1476 set x1 -1
1477 foreach z $offs2 {
1478 incr x1
1479 if {$z eq {} || $x1 + $z < $col} continue
1480 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1481 break
1483 set idlist [linsert $idlist $col {}]
1484 set tmp [linsert $offs $col {}]
1485 incr col
1486 set offs [incrange $tmp $col -1]
1489 lset rowidlist $row $idlist
1490 lset rowoffsets $row $offs
1491 set col 0
1495 proc xc {row col} {
1496 global canvx0 linespc
1497 return [expr {$canvx0 + $col * $linespc}]
1500 proc yc {row} {
1501 global canvy0 linespc
1502 return [expr {$canvy0 + $row * $linespc}]
1505 proc linewidth {id} {
1506 global thickerline lthickness
1508 set wid $lthickness
1509 if {[info exists thickerline] && $id eq $thickerline} {
1510 set wid [expr {2 * $lthickness}]
1512 return $wid
1515 proc rowranges {id} {
1516 global idrowranges commitrow numcommits rowrangelist
1518 set ranges {}
1519 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1520 set ranges [lindex $rowrangelist $commitrow($id)]
1521 } elseif {[info exists idrowranges($id)]} {
1522 set ranges $idrowranges($id)
1524 return $ranges
1527 proc drawlineseg {id i} {
1528 global rowoffsets rowidlist
1529 global displayorder
1530 global canv colormap linespc
1531 global numcommits commitrow
1533 set ranges [rowranges $id]
1534 set downarrow 1
1535 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1536 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1537 } else {
1538 set downarrow 1
1540 set startrow [lindex $ranges [expr {2 * $i}]]
1541 set row [lindex $ranges [expr {2 * $i + 1}]]
1542 if {$startrow == $row} return
1543 assigncolor $id
1544 set coords {}
1545 set col [lsearch -exact [lindex $rowidlist $row] $id]
1546 if {$col < 0} {
1547 puts "oops: drawline: id $id not on row $row"
1548 return
1550 set lasto {}
1551 set ns 0
1552 while {1} {
1553 set o [lindex $rowoffsets $row $col]
1554 if {$o eq {}} break
1555 if {$o ne $lasto} {
1556 # changing direction
1557 set x [xc $row $col]
1558 set y [yc $row]
1559 lappend coords $x $y
1560 set lasto $o
1562 incr col $o
1563 incr row -1
1565 set x [xc $row $col]
1566 set y [yc $row]
1567 lappend coords $x $y
1568 if {$i == 0} {
1569 # draw the link to the first child as part of this line
1570 incr row -1
1571 set child [lindex $displayorder $row]
1572 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1573 if {$ccol >= 0} {
1574 set x [xc $row $ccol]
1575 set y [yc $row]
1576 if {$ccol < $col - 1} {
1577 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1578 } elseif {$ccol > $col + 1} {
1579 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1581 lappend coords $x $y
1584 if {[llength $coords] < 4} return
1585 if {$downarrow} {
1586 # This line has an arrow at the lower end: check if the arrow is
1587 # on a diagonal segment, and if so, work around the Tk 8.4
1588 # refusal to draw arrows on diagonal lines.
1589 set x0 [lindex $coords 0]
1590 set x1 [lindex $coords 2]
1591 if {$x0 != $x1} {
1592 set y0 [lindex $coords 1]
1593 set y1 [lindex $coords 3]
1594 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1595 # we have a nearby vertical segment, just trim off the diag bit
1596 set coords [lrange $coords 2 end]
1597 } else {
1598 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1599 set xi [expr {$x0 - $slope * $linespc / 2}]
1600 set yi [expr {$y0 - $linespc / 2}]
1601 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1605 set arrow [expr {2 * ($i > 0) + $downarrow}]
1606 set arrow [lindex {none first last both} $arrow]
1607 set t [$canv create line $coords -width [linewidth $id] \
1608 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1609 $canv lower $t
1610 bindline $t $id
1613 proc drawparentlinks {id row col olds} {
1614 global rowidlist canv colormap
1616 set row2 [expr {$row + 1}]
1617 set x [xc $row $col]
1618 set y [yc $row]
1619 set y2 [yc $row2]
1620 set ids [lindex $rowidlist $row2]
1621 # rmx = right-most X coord used
1622 set rmx 0
1623 foreach p $olds {
1624 set i [lsearch -exact $ids $p]
1625 if {$i < 0} {
1626 puts "oops, parent $p of $id not in list"
1627 continue
1629 set x2 [xc $row2 $i]
1630 if {$x2 > $rmx} {
1631 set rmx $x2
1633 set ranges [rowranges $p]
1634 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1635 && $row2 < [lindex $ranges 1]} {
1636 # drawlineseg will do this one for us
1637 continue
1639 assigncolor $p
1640 # should handle duplicated parents here...
1641 set coords [list $x $y]
1642 if {$i < $col - 1} {
1643 lappend coords [xc $row [expr {$i + 1}]] $y
1644 } elseif {$i > $col + 1} {
1645 lappend coords [xc $row [expr {$i - 1}]] $y
1647 lappend coords $x2 $y2
1648 set t [$canv create line $coords -width [linewidth $p] \
1649 -fill $colormap($p) -tags lines.$p]
1650 $canv lower $t
1651 bindline $t $p
1653 return $rmx
1656 proc drawlines {id} {
1657 global colormap canv
1658 global idrangedrawn
1659 global childlist iddrawn commitrow rowidlist
1661 $canv delete lines.$id
1662 set nr [expr {[llength [rowranges $id]] / 2}]
1663 for {set i 0} {$i < $nr} {incr i} {
1664 if {[info exists idrangedrawn($id,$i)]} {
1665 drawlineseg $id $i
1668 foreach child [lindex $childlist $commitrow($id)] {
1669 if {[info exists iddrawn($child)]} {
1670 set row $commitrow($child)
1671 set col [lsearch -exact [lindex $rowidlist $row] $child]
1672 if {$col >= 0} {
1673 drawparentlinks $child $row $col [list $id]
1679 proc drawcmittext {id row col rmx} {
1680 global linespc canv canv2 canv3 canvy0
1681 global commitlisted commitinfo rowidlist
1682 global rowtextx idpos idtags idheads idotherrefs
1683 global linehtag linentag linedtag
1684 global mainfont namefont canvxmax
1686 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1687 set x [xc $row $col]
1688 set y [yc $row]
1689 set orad [expr {$linespc / 3}]
1690 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1691 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1692 -fill $ofill -outline black -width 1]
1693 $canv raise $t
1694 $canv bind $t <1> {selcanvline {} %x %y}
1695 set xt [xc $row [llength [lindex $rowidlist $row]]]
1696 if {$xt < $rmx} {
1697 set xt $rmx
1699 set rowtextx($row) $xt
1700 set idpos($id) [list $x $xt $y]
1701 if {[info exists idtags($id)] || [info exists idheads($id)]
1702 || [info exists idotherrefs($id)]} {
1703 set xt [drawtags $id $x $xt $y]
1705 set headline [lindex $commitinfo($id) 0]
1706 set name [lindex $commitinfo($id) 1]
1707 set date [lindex $commitinfo($id) 2]
1708 set date [formatdate $date]
1709 set linehtag($row) [$canv create text $xt $y -anchor w \
1710 -text $headline -font $mainfont ]
1711 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1712 set linentag($row) [$canv2 create text 3 $y -anchor w \
1713 -text $name -font $namefont]
1714 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1715 -text $date -font $mainfont]
1716 set xr [expr {$xt + [font measure $mainfont $headline]}]
1717 if {$xr > $canvxmax} {
1718 set canvxmax $xr
1719 setcanvscroll
1723 proc drawcmitrow {row} {
1724 global displayorder rowidlist
1725 global idrangedrawn iddrawn
1726 global commitinfo commitlisted parentlist numcommits
1728 if {$row >= $numcommits} return
1729 foreach id [lindex $rowidlist $row] {
1730 set i -1
1731 foreach {s e} [rowranges $id] {
1732 incr i
1733 if {$row < $s} continue
1734 if {$e eq {}} break
1735 if {$row <= $e} {
1736 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1737 drawlineseg $id $i
1738 set idrangedrawn($id,$i) 1
1740 break
1745 set id [lindex $displayorder $row]
1746 if {[info exists iddrawn($id)]} return
1747 set col [lsearch -exact [lindex $rowidlist $row] $id]
1748 if {$col < 0} {
1749 puts "oops, row $row id $id not in list"
1750 return
1752 if {![info exists commitinfo($id)]} {
1753 getcommit $id
1755 assigncolor $id
1756 set olds [lindex $parentlist $row]
1757 if {$olds ne {}} {
1758 set rmx [drawparentlinks $id $row $col $olds]
1759 } else {
1760 set rmx 0
1762 drawcmittext $id $row $col $rmx
1763 set iddrawn($id) 1
1766 proc drawfrac {f0 f1} {
1767 global numcommits canv
1768 global linespc
1770 set ymax [lindex [$canv cget -scrollregion] 3]
1771 if {$ymax eq {} || $ymax == 0} return
1772 set y0 [expr {int($f0 * $ymax)}]
1773 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1774 if {$row < 0} {
1775 set row 0
1777 set y1 [expr {int($f1 * $ymax)}]
1778 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1779 if {$endrow >= $numcommits} {
1780 set endrow [expr {$numcommits - 1}]
1782 for {} {$row <= $endrow} {incr row} {
1783 drawcmitrow $row
1787 proc drawvisible {} {
1788 global canv
1789 eval drawfrac [$canv yview]
1792 proc clear_display {} {
1793 global iddrawn idrangedrawn
1795 allcanvs delete all
1796 catch {unset iddrawn}
1797 catch {unset idrangedrawn}
1800 proc findcrossings {id} {
1801 global rowidlist parentlist numcommits rowoffsets displayorder
1803 set cross {}
1804 set ccross {}
1805 foreach {s e} [rowranges $id] {
1806 if {$e >= $numcommits} {
1807 set e [expr {$numcommits - 1}]
1809 if {$e <= $s} continue
1810 set x [lsearch -exact [lindex $rowidlist $e] $id]
1811 if {$x < 0} {
1812 puts "findcrossings: oops, no [shortids $id] in row $e"
1813 continue
1815 for {set row $e} {[incr row -1] >= $s} {} {
1816 set olds [lindex $parentlist $row]
1817 set kid [lindex $displayorder $row]
1818 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1819 if {$kidx < 0} continue
1820 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1821 foreach p $olds {
1822 set px [lsearch -exact $nextrow $p]
1823 if {$px < 0} continue
1824 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1825 if {[lsearch -exact $ccross $p] >= 0} continue
1826 if {$x == $px + ($kidx < $px? -1: 1)} {
1827 lappend ccross $p
1828 } elseif {[lsearch -exact $cross $p] < 0} {
1829 lappend cross $p
1833 set inc [lindex $rowoffsets $row $x]
1834 if {$inc eq {}} break
1835 incr x $inc
1838 return [concat $ccross {{}} $cross]
1841 proc assigncolor {id} {
1842 global colormap colors nextcolor
1843 global commitrow parentlist children childlist
1845 if {[info exists colormap($id)]} return
1846 set ncolors [llength $colors]
1847 if {[info exists commitrow($id)]} {
1848 set kids [lindex $childlist $commitrow($id)]
1849 } elseif {[info exists children($id)]} {
1850 set kids $children($id)
1851 } else {
1852 set kids {}
1854 if {[llength $kids] == 1} {
1855 set child [lindex $kids 0]
1856 if {[info exists colormap($child)]
1857 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1858 set colormap($id) $colormap($child)
1859 return
1862 set badcolors {}
1863 set origbad {}
1864 foreach x [findcrossings $id] {
1865 if {$x eq {}} {
1866 # delimiter between corner crossings and other crossings
1867 if {[llength $badcolors] >= $ncolors - 1} break
1868 set origbad $badcolors
1870 if {[info exists colormap($x)]
1871 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1872 lappend badcolors $colormap($x)
1875 if {[llength $badcolors] >= $ncolors} {
1876 set badcolors $origbad
1878 set origbad $badcolors
1879 if {[llength $badcolors] < $ncolors - 1} {
1880 foreach child $kids {
1881 if {[info exists colormap($child)]
1882 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1883 lappend badcolors $colormap($child)
1885 foreach p [lindex $parentlist $commitrow($child)] {
1886 if {[info exists colormap($p)]
1887 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1888 lappend badcolors $colormap($p)
1892 if {[llength $badcolors] >= $ncolors} {
1893 set badcolors $origbad
1896 for {set i 0} {$i <= $ncolors} {incr i} {
1897 set c [lindex $colors $nextcolor]
1898 if {[incr nextcolor] >= $ncolors} {
1899 set nextcolor 0
1901 if {[lsearch -exact $badcolors $c]} break
1903 set colormap($id) $c
1906 proc bindline {t id} {
1907 global canv
1909 $canv bind $t <Enter> "lineenter %x %y $id"
1910 $canv bind $t <Motion> "linemotion %x %y $id"
1911 $canv bind $t <Leave> "lineleave $id"
1912 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1915 proc drawtags {id x xt y1} {
1916 global idtags idheads idotherrefs
1917 global linespc lthickness
1918 global canv mainfont commitrow rowtextx
1920 set marks {}
1921 set ntags 0
1922 set nheads 0
1923 if {[info exists idtags($id)]} {
1924 set marks $idtags($id)
1925 set ntags [llength $marks]
1927 if {[info exists idheads($id)]} {
1928 set marks [concat $marks $idheads($id)]
1929 set nheads [llength $idheads($id)]
1931 if {[info exists idotherrefs($id)]} {
1932 set marks [concat $marks $idotherrefs($id)]
1934 if {$marks eq {}} {
1935 return $xt
1938 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1939 set yt [expr {$y1 - 0.5 * $linespc}]
1940 set yb [expr {$yt + $linespc - 1}]
1941 set xvals {}
1942 set wvals {}
1943 foreach tag $marks {
1944 set wid [font measure $mainfont $tag]
1945 lappend xvals $xt
1946 lappend wvals $wid
1947 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1949 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1950 -width $lthickness -fill black -tags tag.$id]
1951 $canv lower $t
1952 foreach tag $marks x $xvals wid $wvals {
1953 set xl [expr {$x + $delta}]
1954 set xr [expr {$x + $delta + $wid + $lthickness}]
1955 if {[incr ntags -1] >= 0} {
1956 # draw a tag
1957 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1958 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1959 -width 1 -outline black -fill yellow -tags tag.$id]
1960 $canv bind $t <1> [list showtag $tag 1]
1961 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1962 } else {
1963 # draw a head or other ref
1964 if {[incr nheads -1] >= 0} {
1965 set col green
1966 } else {
1967 set col "#ddddff"
1969 set xl [expr {$xl - $delta/2}]
1970 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1971 -width 1 -outline black -fill $col -tags tag.$id
1973 set t [$canv create text $xl $y1 -anchor w -text $tag \
1974 -font $mainfont -tags tag.$id]
1975 if {$ntags >= 0} {
1976 $canv bind $t <1> [list showtag $tag 1]
1979 return $xt
1982 proc xcoord {i level ln} {
1983 global canvx0 xspc1 xspc2
1985 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1986 if {$i > 0 && $i == $level} {
1987 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1988 } elseif {$i > $level} {
1989 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1991 return $x
1994 proc finishcommits {} {
1995 global commitidx phase
1996 global canv mainfont ctext maincursor textcursor
1997 global findinprogress pending_select
1999 if {$commitidx > 0} {
2000 drawrest
2001 } else {
2002 $canv delete all
2003 $canv create text 3 3 -anchor nw -text "No commits selected" \
2004 -font $mainfont -tags textitems
2006 if {![info exists findinprogress]} {
2007 . config -cursor $maincursor
2008 settextcursor $textcursor
2010 set phase {}
2011 catch {unset pending_select}
2014 # Don't change the text pane cursor if it is currently the hand cursor,
2015 # showing that we are over a sha1 ID link.
2016 proc settextcursor {c} {
2017 global ctext curtextcursor
2019 if {[$ctext cget -cursor] == $curtextcursor} {
2020 $ctext config -cursor $c
2022 set curtextcursor $c
2025 proc drawrest {} {
2026 global numcommits
2027 global startmsecs
2028 global canvy0 numcommits linespc
2029 global rowlaidout commitidx
2030 global pending_select
2032 set row $rowlaidout
2033 layoutrows $rowlaidout $commitidx 1
2034 layouttail
2035 optimize_rows $row 0 $commitidx
2036 showstuff $commitidx
2037 if {[info exists pending_select]} {
2038 selectline 0 1
2041 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2042 #puts "overall $drawmsecs ms for $numcommits commits"
2045 proc findmatches {f} {
2046 global findtype foundstring foundstrlen
2047 if {$findtype == "Regexp"} {
2048 set matches [regexp -indices -all -inline $foundstring $f]
2049 } else {
2050 if {$findtype == "IgnCase"} {
2051 set str [string tolower $f]
2052 } else {
2053 set str $f
2055 set matches {}
2056 set i 0
2057 while {[set j [string first $foundstring $str $i]] >= 0} {
2058 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2059 set i [expr {$j + $foundstrlen}]
2062 return $matches
2065 proc dofind {} {
2066 global findtype findloc findstring markedmatches commitinfo
2067 global numcommits displayorder linehtag linentag linedtag
2068 global mainfont namefont canv canv2 canv3 selectedline
2069 global matchinglines foundstring foundstrlen matchstring
2070 global commitdata
2072 stopfindproc
2073 unmarkmatches
2074 focus .
2075 set matchinglines {}
2076 if {$findloc == "Pickaxe"} {
2077 findpatches
2078 return
2080 if {$findtype == "IgnCase"} {
2081 set foundstring [string tolower $findstring]
2082 } else {
2083 set foundstring $findstring
2085 set foundstrlen [string length $findstring]
2086 if {$foundstrlen == 0} return
2087 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2088 set matchstring "*$matchstring*"
2089 if {$findloc == "Files"} {
2090 findfiles
2091 return
2093 if {![info exists selectedline]} {
2094 set oldsel -1
2095 } else {
2096 set oldsel $selectedline
2098 set didsel 0
2099 set fldtypes {Headline Author Date Committer CDate Comment}
2100 set l -1
2101 foreach id $displayorder {
2102 set d $commitdata($id)
2103 incr l
2104 if {$findtype == "Regexp"} {
2105 set doesmatch [regexp $foundstring $d]
2106 } elseif {$findtype == "IgnCase"} {
2107 set doesmatch [string match -nocase $matchstring $d]
2108 } else {
2109 set doesmatch [string match $matchstring $d]
2111 if {!$doesmatch} continue
2112 if {![info exists commitinfo($id)]} {
2113 getcommit $id
2115 set info $commitinfo($id)
2116 set doesmatch 0
2117 foreach f $info ty $fldtypes {
2118 if {$findloc != "All fields" && $findloc != $ty} {
2119 continue
2121 set matches [findmatches $f]
2122 if {$matches == {}} continue
2123 set doesmatch 1
2124 if {$ty == "Headline"} {
2125 drawcmitrow $l
2126 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2127 } elseif {$ty == "Author"} {
2128 drawcmitrow $l
2129 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2130 } elseif {$ty == "Date"} {
2131 drawcmitrow $l
2132 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2135 if {$doesmatch} {
2136 lappend matchinglines $l
2137 if {!$didsel && $l > $oldsel} {
2138 findselectline $l
2139 set didsel 1
2143 if {$matchinglines == {}} {
2144 bell
2145 } elseif {!$didsel} {
2146 findselectline [lindex $matchinglines 0]
2150 proc findselectline {l} {
2151 global findloc commentend ctext
2152 selectline $l 1
2153 if {$findloc == "All fields" || $findloc == "Comments"} {
2154 # highlight the matches in the comments
2155 set f [$ctext get 1.0 $commentend]
2156 set matches [findmatches $f]
2157 foreach match $matches {
2158 set start [lindex $match 0]
2159 set end [expr {[lindex $match 1] + 1}]
2160 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2165 proc findnext {restart} {
2166 global matchinglines selectedline
2167 if {![info exists matchinglines]} {
2168 if {$restart} {
2169 dofind
2171 return
2173 if {![info exists selectedline]} return
2174 foreach l $matchinglines {
2175 if {$l > $selectedline} {
2176 findselectline $l
2177 return
2180 bell
2183 proc findprev {} {
2184 global matchinglines selectedline
2185 if {![info exists matchinglines]} {
2186 dofind
2187 return
2189 if {![info exists selectedline]} return
2190 set prev {}
2191 foreach l $matchinglines {
2192 if {$l >= $selectedline} break
2193 set prev $l
2195 if {$prev != {}} {
2196 findselectline $prev
2197 } else {
2198 bell
2202 proc findlocchange {name ix op} {
2203 global findloc findtype findtypemenu
2204 if {$findloc == "Pickaxe"} {
2205 set findtype Exact
2206 set state disabled
2207 } else {
2208 set state normal
2210 $findtypemenu entryconf 1 -state $state
2211 $findtypemenu entryconf 2 -state $state
2214 proc stopfindproc {{done 0}} {
2215 global findprocpid findprocfile findids
2216 global ctext findoldcursor phase maincursor textcursor
2217 global findinprogress
2219 catch {unset findids}
2220 if {[info exists findprocpid]} {
2221 if {!$done} {
2222 catch {exec kill $findprocpid}
2224 catch {close $findprocfile}
2225 unset findprocpid
2227 if {[info exists findinprogress]} {
2228 unset findinprogress
2229 if {$phase != "incrdraw"} {
2230 . config -cursor $maincursor
2231 settextcursor $textcursor
2236 proc findpatches {} {
2237 global findstring selectedline numcommits
2238 global findprocpid findprocfile
2239 global finddidsel ctext displayorder findinprogress
2240 global findinsertpos
2242 if {$numcommits == 0} return
2244 # make a list of all the ids to search, starting at the one
2245 # after the selected line (if any)
2246 if {[info exists selectedline]} {
2247 set l $selectedline
2248 } else {
2249 set l -1
2251 set inputids {}
2252 for {set i 0} {$i < $numcommits} {incr i} {
2253 if {[incr l] >= $numcommits} {
2254 set l 0
2256 append inputids [lindex $displayorder $l] "\n"
2259 if {[catch {
2260 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2261 << $inputids] r]
2262 } err]} {
2263 error_popup "Error starting search process: $err"
2264 return
2267 set findinsertpos end
2268 set findprocfile $f
2269 set findprocpid [pid $f]
2270 fconfigure $f -blocking 0
2271 fileevent $f readable readfindproc
2272 set finddidsel 0
2273 . config -cursor watch
2274 settextcursor watch
2275 set findinprogress 1
2278 proc readfindproc {} {
2279 global findprocfile finddidsel
2280 global commitrow matchinglines findinsertpos
2282 set n [gets $findprocfile line]
2283 if {$n < 0} {
2284 if {[eof $findprocfile]} {
2285 stopfindproc 1
2286 if {!$finddidsel} {
2287 bell
2290 return
2292 if {![regexp {^[0-9a-f]{40}} $line id]} {
2293 error_popup "Can't parse git-diff-tree output: $line"
2294 stopfindproc
2295 return
2297 if {![info exists commitrow($id)]} {
2298 puts stderr "spurious id: $id"
2299 return
2301 set l $commitrow($id)
2302 insertmatch $l $id
2305 proc insertmatch {l id} {
2306 global matchinglines findinsertpos finddidsel
2308 if {$findinsertpos == "end"} {
2309 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2310 set matchinglines [linsert $matchinglines 0 $l]
2311 set findinsertpos 1
2312 } else {
2313 lappend matchinglines $l
2315 } else {
2316 set matchinglines [linsert $matchinglines $findinsertpos $l]
2317 incr findinsertpos
2319 markheadline $l $id
2320 if {!$finddidsel} {
2321 findselectline $l
2322 set finddidsel 1
2326 proc findfiles {} {
2327 global selectedline numcommits displayorder ctext
2328 global ffileline finddidsel parentlist
2329 global findinprogress findstartline findinsertpos
2330 global treediffs fdiffid fdiffsneeded fdiffpos
2331 global findmergefiles
2333 if {$numcommits == 0} return
2335 if {[info exists selectedline]} {
2336 set l [expr {$selectedline + 1}]
2337 } else {
2338 set l 0
2340 set ffileline $l
2341 set findstartline $l
2342 set diffsneeded {}
2343 set fdiffsneeded {}
2344 while 1 {
2345 set id [lindex $displayorder $l]
2346 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2347 if {![info exists treediffs($id)]} {
2348 append diffsneeded "$id\n"
2349 lappend fdiffsneeded $id
2352 if {[incr l] >= $numcommits} {
2353 set l 0
2355 if {$l == $findstartline} break
2358 # start off a git-diff-tree process if needed
2359 if {$diffsneeded ne {}} {
2360 if {[catch {
2361 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2362 } err ]} {
2363 error_popup "Error starting search process: $err"
2364 return
2366 catch {unset fdiffid}
2367 set fdiffpos 0
2368 fconfigure $df -blocking 0
2369 fileevent $df readable [list readfilediffs $df]
2372 set finddidsel 0
2373 set findinsertpos end
2374 set id [lindex $displayorder $l]
2375 . config -cursor watch
2376 settextcursor watch
2377 set findinprogress 1
2378 findcont
2379 update
2382 proc readfilediffs {df} {
2383 global findid fdiffid fdiffs
2385 set n [gets $df line]
2386 if {$n < 0} {
2387 if {[eof $df]} {
2388 donefilediff
2389 if {[catch {close $df} err]} {
2390 stopfindproc
2391 bell
2392 error_popup "Error in git-diff-tree: $err"
2393 } elseif {[info exists findid]} {
2394 set id $findid
2395 stopfindproc
2396 bell
2397 error_popup "Couldn't find diffs for $id"
2400 return
2402 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2403 # start of a new string of diffs
2404 donefilediff
2405 set fdiffid $id
2406 set fdiffs {}
2407 } elseif {[string match ":*" $line]} {
2408 lappend fdiffs [lindex $line 5]
2412 proc donefilediff {} {
2413 global fdiffid fdiffs treediffs findid
2414 global fdiffsneeded fdiffpos
2416 if {[info exists fdiffid]} {
2417 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2418 && $fdiffpos < [llength $fdiffsneeded]} {
2419 # git-diff-tree doesn't output anything for a commit
2420 # which doesn't change anything
2421 set nullid [lindex $fdiffsneeded $fdiffpos]
2422 set treediffs($nullid) {}
2423 if {[info exists findid] && $nullid eq $findid} {
2424 unset findid
2425 findcont
2427 incr fdiffpos
2429 incr fdiffpos
2431 if {![info exists treediffs($fdiffid)]} {
2432 set treediffs($fdiffid) $fdiffs
2434 if {[info exists findid] && $fdiffid eq $findid} {
2435 unset findid
2436 findcont
2441 proc findcont {} {
2442 global findid treediffs parentlist
2443 global ffileline findstartline finddidsel
2444 global displayorder numcommits matchinglines findinprogress
2445 global findmergefiles
2447 set l $ffileline
2448 while {1} {
2449 set id [lindex $displayorder $l]
2450 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2451 if {![info exists treediffs($id)]} {
2452 set findid $id
2453 set ffileline $l
2454 return
2456 set doesmatch 0
2457 foreach f $treediffs($id) {
2458 set x [findmatches $f]
2459 if {$x != {}} {
2460 set doesmatch 1
2461 break
2464 if {$doesmatch} {
2465 insertmatch $l $id
2468 if {[incr l] >= $numcommits} {
2469 set l 0
2471 if {$l == $findstartline} break
2473 stopfindproc
2474 if {!$finddidsel} {
2475 bell
2479 # mark a commit as matching by putting a yellow background
2480 # behind the headline
2481 proc markheadline {l id} {
2482 global canv mainfont linehtag
2484 drawcmitrow $l
2485 set bbox [$canv bbox $linehtag($l)]
2486 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2487 $canv lower $t
2490 # mark the bits of a headline, author or date that match a find string
2491 proc markmatches {canv l str tag matches font} {
2492 set bbox [$canv bbox $tag]
2493 set x0 [lindex $bbox 0]
2494 set y0 [lindex $bbox 1]
2495 set y1 [lindex $bbox 3]
2496 foreach match $matches {
2497 set start [lindex $match 0]
2498 set end [lindex $match 1]
2499 if {$start > $end} continue
2500 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2501 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2502 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2503 [expr {$x0+$xlen+2}] $y1 \
2504 -outline {} -tags matches -fill yellow]
2505 $canv lower $t
2509 proc unmarkmatches {} {
2510 global matchinglines findids
2511 allcanvs delete matches
2512 catch {unset matchinglines}
2513 catch {unset findids}
2516 proc selcanvline {w x y} {
2517 global canv canvy0 ctext linespc
2518 global rowtextx
2519 set ymax [lindex [$canv cget -scrollregion] 3]
2520 if {$ymax == {}} return
2521 set yfrac [lindex [$canv yview] 0]
2522 set y [expr {$y + $yfrac * $ymax}]
2523 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2524 if {$l < 0} {
2525 set l 0
2527 if {$w eq $canv} {
2528 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2530 unmarkmatches
2531 selectline $l 1
2534 proc commit_descriptor {p} {
2535 global commitinfo
2536 set l "..."
2537 if {[info exists commitinfo($p)]} {
2538 set l [lindex $commitinfo($p) 0]
2540 return "$p ($l)"
2543 # append some text to the ctext widget, and make any SHA1 ID
2544 # that we know about be a clickable link.
2545 proc appendwithlinks {text} {
2546 global ctext commitrow linknum
2548 set start [$ctext index "end - 1c"]
2549 $ctext insert end $text
2550 $ctext insert end "\n"
2551 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2552 foreach l $links {
2553 set s [lindex $l 0]
2554 set e [lindex $l 1]
2555 set linkid [string range $text $s $e]
2556 if {![info exists commitrow($linkid)]} continue
2557 incr e
2558 $ctext tag add link "$start + $s c" "$start + $e c"
2559 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2560 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2561 incr linknum
2563 $ctext tag conf link -foreground blue -underline 1
2564 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2565 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2568 proc viewnextline {dir} {
2569 global canv linespc
2571 $canv delete hover
2572 set ymax [lindex [$canv cget -scrollregion] 3]
2573 set wnow [$canv yview]
2574 set wtop [expr {[lindex $wnow 0] * $ymax}]
2575 set newtop [expr {$wtop + $dir * $linespc}]
2576 if {$newtop < 0} {
2577 set newtop 0
2578 } elseif {$newtop > $ymax} {
2579 set newtop $ymax
2581 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2584 proc selectline {l isnew} {
2585 global canv canv2 canv3 ctext commitinfo selectedline
2586 global displayorder linehtag linentag linedtag
2587 global canvy0 linespc parentlist childlist
2588 global cflist currentid sha1entry
2589 global commentend idtags linknum
2590 global mergemax numcommits pending_select
2592 catch {unset pending_select}
2593 $canv delete hover
2594 normalline
2595 if {$l < 0 || $l >= $numcommits} return
2596 set y [expr {$canvy0 + $l * $linespc}]
2597 set ymax [lindex [$canv cget -scrollregion] 3]
2598 set ytop [expr {$y - $linespc - 1}]
2599 set ybot [expr {$y + $linespc + 1}]
2600 set wnow [$canv yview]
2601 set wtop [expr {[lindex $wnow 0] * $ymax}]
2602 set wbot [expr {[lindex $wnow 1] * $ymax}]
2603 set wh [expr {$wbot - $wtop}]
2604 set newtop $wtop
2605 if {$ytop < $wtop} {
2606 if {$ybot < $wtop} {
2607 set newtop [expr {$y - $wh / 2.0}]
2608 } else {
2609 set newtop $ytop
2610 if {$newtop > $wtop - $linespc} {
2611 set newtop [expr {$wtop - $linespc}]
2614 } elseif {$ybot > $wbot} {
2615 if {$ytop > $wbot} {
2616 set newtop [expr {$y - $wh / 2.0}]
2617 } else {
2618 set newtop [expr {$ybot - $wh}]
2619 if {$newtop < $wtop + $linespc} {
2620 set newtop [expr {$wtop + $linespc}]
2624 if {$newtop != $wtop} {
2625 if {$newtop < 0} {
2626 set newtop 0
2628 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2629 drawvisible
2632 if {![info exists linehtag($l)]} return
2633 $canv delete secsel
2634 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2635 -tags secsel -fill [$canv cget -selectbackground]]
2636 $canv lower $t
2637 $canv2 delete secsel
2638 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2639 -tags secsel -fill [$canv2 cget -selectbackground]]
2640 $canv2 lower $t
2641 $canv3 delete secsel
2642 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2643 -tags secsel -fill [$canv3 cget -selectbackground]]
2644 $canv3 lower $t
2646 if {$isnew} {
2647 addtohistory [list selectline $l 0]
2650 set selectedline $l
2652 set id [lindex $displayorder $l]
2653 set currentid $id
2654 $sha1entry delete 0 end
2655 $sha1entry insert 0 $id
2656 $sha1entry selection from 0
2657 $sha1entry selection to end
2659 $ctext conf -state normal
2660 $ctext delete 0.0 end
2661 set linknum 0
2662 $ctext mark set fmark.0 0.0
2663 $ctext mark gravity fmark.0 left
2664 set info $commitinfo($id)
2665 set date [formatdate [lindex $info 2]]
2666 $ctext insert end "Author: [lindex $info 1] $date\n"
2667 set date [formatdate [lindex $info 4]]
2668 $ctext insert end "Committer: [lindex $info 3] $date\n"
2669 if {[info exists idtags($id)]} {
2670 $ctext insert end "Tags:"
2671 foreach tag $idtags($id) {
2672 $ctext insert end " $tag"
2674 $ctext insert end "\n"
2677 set comment {}
2678 set olds [lindex $parentlist $l]
2679 if {[llength $olds] > 1} {
2680 set np 0
2681 foreach p $olds {
2682 if {$np >= $mergemax} {
2683 set tag mmax
2684 } else {
2685 set tag m$np
2687 $ctext insert end "Parent: " $tag
2688 appendwithlinks [commit_descriptor $p]
2689 incr np
2691 } else {
2692 foreach p $olds {
2693 append comment "Parent: [commit_descriptor $p]\n"
2697 foreach c [lindex $childlist $l] {
2698 append comment "Child: [commit_descriptor $c]\n"
2700 append comment "\n"
2701 append comment [lindex $info 5]
2703 # make anything that looks like a SHA1 ID be a clickable link
2704 appendwithlinks $comment
2706 $ctext tag delete Comments
2707 $ctext tag remove found 1.0 end
2708 $ctext conf -state disabled
2709 set commentend [$ctext index "end - 1c"]
2711 $cflist delete 0 end
2712 $cflist insert end "Comments"
2713 if {[llength $olds] <= 1} {
2714 startdiff $id
2715 } else {
2716 mergediff $id $l
2720 proc selfirstline {} {
2721 unmarkmatches
2722 selectline 0 1
2725 proc sellastline {} {
2726 global numcommits
2727 unmarkmatches
2728 set l [expr {$numcommits - 1}]
2729 selectline $l 1
2732 proc selnextline {dir} {
2733 global selectedline
2734 if {![info exists selectedline]} return
2735 set l [expr {$selectedline + $dir}]
2736 unmarkmatches
2737 selectline $l 1
2740 proc selnextpage {dir} {
2741 global canv linespc selectedline numcommits
2743 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2744 if {$lpp < 1} {
2745 set lpp 1
2747 allcanvs yview scroll [expr {$dir * $lpp}] units
2748 if {![info exists selectedline]} return
2749 set l [expr {$selectedline + $dir * $lpp}]
2750 if {$l < 0} {
2751 set l 0
2752 } elseif {$l >= $numcommits} {
2753 set l [expr $numcommits - 1]
2755 unmarkmatches
2756 selectline $l 1
2759 proc unselectline {} {
2760 global selectedline currentid
2762 catch {unset selectedline}
2763 catch {unset currentid}
2764 allcanvs delete secsel
2767 proc addtohistory {cmd} {
2768 global history historyindex
2770 if {$historyindex > 0
2771 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2772 return
2775 if {$historyindex < [llength $history]} {
2776 set history [lreplace $history $historyindex end $cmd]
2777 } else {
2778 lappend history $cmd
2780 incr historyindex
2781 if {$historyindex > 1} {
2782 .ctop.top.bar.leftbut conf -state normal
2783 } else {
2784 .ctop.top.bar.leftbut conf -state disabled
2786 .ctop.top.bar.rightbut conf -state disabled
2789 proc goback {} {
2790 global history historyindex
2792 if {$historyindex > 1} {
2793 incr historyindex -1
2794 set cmd [lindex $history [expr {$historyindex - 1}]]
2795 eval $cmd
2796 .ctop.top.bar.rightbut conf -state normal
2798 if {$historyindex <= 1} {
2799 .ctop.top.bar.leftbut conf -state disabled
2803 proc goforw {} {
2804 global history historyindex
2806 if {$historyindex < [llength $history]} {
2807 set cmd [lindex $history $historyindex]
2808 incr historyindex
2809 eval $cmd
2810 .ctop.top.bar.leftbut conf -state normal
2812 if {$historyindex >= [llength $history]} {
2813 .ctop.top.bar.rightbut conf -state disabled
2817 proc mergediff {id l} {
2818 global diffmergeid diffopts mdifffd
2819 global difffilestart diffids
2820 global parentlist
2822 set diffmergeid $id
2823 set diffids $id
2824 catch {unset difffilestart}
2825 # this doesn't seem to actually affect anything...
2826 set env(GIT_DIFF_OPTS) $diffopts
2827 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2828 if {[catch {set mdf [open $cmd r]} err]} {
2829 error_popup "Error getting merge diffs: $err"
2830 return
2832 fconfigure $mdf -blocking 0
2833 set mdifffd($id) $mdf
2834 set np [llength [lindex $parentlist $l]]
2835 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2836 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2839 proc getmergediffline {mdf id np} {
2840 global diffmergeid ctext cflist nextupdate mergemax
2841 global difffilestart mdifffd
2843 set n [gets $mdf line]
2844 if {$n < 0} {
2845 if {[eof $mdf]} {
2846 close $mdf
2848 return
2850 if {![info exists diffmergeid] || $id != $diffmergeid
2851 || $mdf != $mdifffd($id)} {
2852 return
2854 $ctext conf -state normal
2855 if {[regexp {^diff --cc (.*)} $line match fname]} {
2856 # start of a new file
2857 $ctext insert end "\n"
2858 set here [$ctext index "end - 1c"]
2859 set i [$cflist index end]
2860 $ctext mark set fmark.$i $here
2861 $ctext mark gravity fmark.$i left
2862 set difffilestart([expr {$i-1}]) $here
2863 $cflist insert end $fname
2864 set l [expr {(78 - [string length $fname]) / 2}]
2865 set pad [string range "----------------------------------------" 1 $l]
2866 $ctext insert end "$pad $fname $pad\n" filesep
2867 } elseif {[regexp {^@@} $line]} {
2868 $ctext insert end "$line\n" hunksep
2869 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2870 # do nothing
2871 } else {
2872 # parse the prefix - one ' ', '-' or '+' for each parent
2873 set spaces {}
2874 set minuses {}
2875 set pluses {}
2876 set isbad 0
2877 for {set j 0} {$j < $np} {incr j} {
2878 set c [string range $line $j $j]
2879 if {$c == " "} {
2880 lappend spaces $j
2881 } elseif {$c == "-"} {
2882 lappend minuses $j
2883 } elseif {$c == "+"} {
2884 lappend pluses $j
2885 } else {
2886 set isbad 1
2887 break
2890 set tags {}
2891 set num {}
2892 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2893 # line doesn't appear in result, parents in $minuses have the line
2894 set num [lindex $minuses 0]
2895 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2896 # line appears in result, parents in $pluses don't have the line
2897 lappend tags mresult
2898 set num [lindex $spaces 0]
2900 if {$num ne {}} {
2901 if {$num >= $mergemax} {
2902 set num "max"
2904 lappend tags m$num
2906 $ctext insert end "$line\n" $tags
2908 $ctext conf -state disabled
2909 if {[clock clicks -milliseconds] >= $nextupdate} {
2910 incr nextupdate 100
2911 fileevent $mdf readable {}
2912 update
2913 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2917 proc startdiff {ids} {
2918 global treediffs diffids treepending diffmergeid
2920 set diffids $ids
2921 catch {unset diffmergeid}
2922 if {![info exists treediffs($ids)]} {
2923 if {![info exists treepending]} {
2924 gettreediffs $ids
2926 } else {
2927 addtocflist $ids
2931 proc addtocflist {ids} {
2932 global treediffs cflist
2933 foreach f $treediffs($ids) {
2934 $cflist insert end $f
2936 getblobdiffs $ids
2939 proc gettreediffs {ids} {
2940 global treediff treepending
2941 set treepending $ids
2942 set treediff {}
2943 if {[catch \
2944 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2945 ]} return
2946 fconfigure $gdtf -blocking 0
2947 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2950 proc gettreediffline {gdtf ids} {
2951 global treediff treediffs treepending diffids diffmergeid
2953 set n [gets $gdtf line]
2954 if {$n < 0} {
2955 if {![eof $gdtf]} return
2956 close $gdtf
2957 set treediffs($ids) $treediff
2958 unset treepending
2959 if {$ids != $diffids} {
2960 if {![info exists diffmergeid]} {
2961 gettreediffs $diffids
2963 } else {
2964 addtocflist $ids
2966 return
2968 set file [lindex $line 5]
2969 lappend treediff $file
2972 proc getblobdiffs {ids} {
2973 global diffopts blobdifffd diffids env curdifftag curtagstart
2974 global difffilestart nextupdate diffinhdr treediffs
2976 set env(GIT_DIFF_OPTS) $diffopts
2977 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2978 if {[catch {set bdf [open $cmd r]} err]} {
2979 puts "error getting diffs: $err"
2980 return
2982 set diffinhdr 0
2983 fconfigure $bdf -blocking 0
2984 set blobdifffd($ids) $bdf
2985 set curdifftag Comments
2986 set curtagstart 0.0
2987 catch {unset difffilestart}
2988 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2989 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2992 proc getblobdiffline {bdf ids} {
2993 global diffids blobdifffd ctext curdifftag curtagstart
2994 global diffnexthead diffnextnote difffilestart
2995 global nextupdate diffinhdr treediffs
2997 set n [gets $bdf line]
2998 if {$n < 0} {
2999 if {[eof $bdf]} {
3000 close $bdf
3001 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3002 $ctext tag add $curdifftag $curtagstart end
3005 return
3007 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3008 return
3010 $ctext conf -state normal
3011 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3012 # start of a new file
3013 $ctext insert end "\n"
3014 $ctext tag add $curdifftag $curtagstart end
3015 set curtagstart [$ctext index "end - 1c"]
3016 set header $newname
3017 set here [$ctext index "end - 1c"]
3018 set i [lsearch -exact $treediffs($diffids) $fname]
3019 if {$i >= 0} {
3020 set difffilestart($i) $here
3021 incr i
3022 $ctext mark set fmark.$i $here
3023 $ctext mark gravity fmark.$i left
3025 if {$newname != $fname} {
3026 set i [lsearch -exact $treediffs($diffids) $newname]
3027 if {$i >= 0} {
3028 set difffilestart($i) $here
3029 incr i
3030 $ctext mark set fmark.$i $here
3031 $ctext mark gravity fmark.$i left
3034 set curdifftag "f:$fname"
3035 $ctext tag delete $curdifftag
3036 set l [expr {(78 - [string length $header]) / 2}]
3037 set pad [string range "----------------------------------------" 1 $l]
3038 $ctext insert end "$pad $header $pad\n" filesep
3039 set diffinhdr 1
3040 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3041 # do nothing
3042 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3043 set diffinhdr 0
3044 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3045 $line match f1l f1c f2l f2c rest]} {
3046 $ctext insert end "$line\n" hunksep
3047 set diffinhdr 0
3048 } else {
3049 set x [string range $line 0 0]
3050 if {$x == "-" || $x == "+"} {
3051 set tag [expr {$x == "+"}]
3052 $ctext insert end "$line\n" d$tag
3053 } elseif {$x == " "} {
3054 $ctext insert end "$line\n"
3055 } elseif {$diffinhdr || $x == "\\"} {
3056 # e.g. "\ No newline at end of file"
3057 $ctext insert end "$line\n" filesep
3058 } else {
3059 # Something else we don't recognize
3060 if {$curdifftag != "Comments"} {
3061 $ctext insert end "\n"
3062 $ctext tag add $curdifftag $curtagstart end
3063 set curtagstart [$ctext index "end - 1c"]
3064 set curdifftag Comments
3066 $ctext insert end "$line\n" filesep
3069 $ctext conf -state disabled
3070 if {[clock clicks -milliseconds] >= $nextupdate} {
3071 incr nextupdate 100
3072 fileevent $bdf readable {}
3073 update
3074 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3078 proc nextfile {} {
3079 global difffilestart ctext
3080 set here [$ctext index @0,0]
3081 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3082 if {[$ctext compare $difffilestart($i) > $here]} {
3083 if {![info exists pos]
3084 || [$ctext compare $difffilestart($i) < $pos]} {
3085 set pos $difffilestart($i)
3089 if {[info exists pos]} {
3090 $ctext yview $pos
3094 proc listboxsel {} {
3095 global ctext cflist currentid
3096 if {![info exists currentid]} return
3097 set sel [lsort [$cflist curselection]]
3098 if {$sel eq {}} return
3099 set first [lindex $sel 0]
3100 catch {$ctext yview fmark.$first}
3103 proc setcoords {} {
3104 global linespc charspc canvx0 canvy0 mainfont
3105 global xspc1 xspc2 lthickness
3107 set linespc [font metrics $mainfont -linespace]
3108 set charspc [font measure $mainfont "m"]
3109 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3110 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3111 set lthickness [expr {int($linespc / 9) + 1}]
3112 set xspc1(0) $linespc
3113 set xspc2 $linespc
3116 proc redisplay {} {
3117 global canv
3118 global selectedline
3120 set ymax [lindex [$canv cget -scrollregion] 3]
3121 if {$ymax eq {} || $ymax == 0} return
3122 set span [$canv yview]
3123 clear_display
3124 setcanvscroll
3125 allcanvs yview moveto [lindex $span 0]
3126 drawvisible
3127 if {[info exists selectedline]} {
3128 selectline $selectedline 0
3132 proc incrfont {inc} {
3133 global mainfont namefont textfont ctext canv phase
3134 global stopped entries
3135 unmarkmatches
3136 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3137 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3138 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3139 setcoords
3140 $ctext conf -font $textfont
3141 $ctext tag conf filesep -font [concat $textfont bold]
3142 foreach e $entries {
3143 $e conf -font $mainfont
3145 if {$phase == "getcommits"} {
3146 $canv itemconf textitems -font $mainfont
3148 redisplay
3151 proc clearsha1 {} {
3152 global sha1entry sha1string
3153 if {[string length $sha1string] == 40} {
3154 $sha1entry delete 0 end
3158 proc sha1change {n1 n2 op} {
3159 global sha1string currentid sha1but
3160 if {$sha1string == {}
3161 || ([info exists currentid] && $sha1string == $currentid)} {
3162 set state disabled
3163 } else {
3164 set state normal
3166 if {[$sha1but cget -state] == $state} return
3167 if {$state == "normal"} {
3168 $sha1but conf -state normal -relief raised -text "Goto: "
3169 } else {
3170 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3174 proc gotocommit {} {
3175 global sha1string currentid commitrow tagids headids
3176 global displayorder numcommits
3178 if {$sha1string == {}
3179 || ([info exists currentid] && $sha1string == $currentid)} return
3180 if {[info exists tagids($sha1string)]} {
3181 set id $tagids($sha1string)
3182 } elseif {[info exists headids($sha1string)]} {
3183 set id $headids($sha1string)
3184 } else {
3185 set id [string tolower $sha1string]
3186 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3187 set matches {}
3188 foreach i $displayorder {
3189 if {[string match $id* $i]} {
3190 lappend matches $i
3193 if {$matches ne {}} {
3194 if {[llength $matches] > 1} {
3195 error_popup "Short SHA1 id $id is ambiguous"
3196 return
3198 set id [lindex $matches 0]
3202 if {[info exists commitrow($id)]} {
3203 selectline $commitrow($id) 1
3204 return
3206 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3207 set type "SHA1 id"
3208 } else {
3209 set type "Tag/Head"
3211 error_popup "$type $sha1string is not known"
3214 proc lineenter {x y id} {
3215 global hoverx hovery hoverid hovertimer
3216 global commitinfo canv
3218 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3219 set hoverx $x
3220 set hovery $y
3221 set hoverid $id
3222 if {[info exists hovertimer]} {
3223 after cancel $hovertimer
3225 set hovertimer [after 500 linehover]
3226 $canv delete hover
3229 proc linemotion {x y id} {
3230 global hoverx hovery hoverid hovertimer
3232 if {[info exists hoverid] && $id == $hoverid} {
3233 set hoverx $x
3234 set hovery $y
3235 if {[info exists hovertimer]} {
3236 after cancel $hovertimer
3238 set hovertimer [after 500 linehover]
3242 proc lineleave {id} {
3243 global hoverid hovertimer canv
3245 if {[info exists hoverid] && $id == $hoverid} {
3246 $canv delete hover
3247 if {[info exists hovertimer]} {
3248 after cancel $hovertimer
3249 unset hovertimer
3251 unset hoverid
3255 proc linehover {} {
3256 global hoverx hovery hoverid hovertimer
3257 global canv linespc lthickness
3258 global commitinfo mainfont
3260 set text [lindex $commitinfo($hoverid) 0]
3261 set ymax [lindex [$canv cget -scrollregion] 3]
3262 if {$ymax == {}} return
3263 set yfrac [lindex [$canv yview] 0]
3264 set x [expr {$hoverx + 2 * $linespc}]
3265 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3266 set x0 [expr {$x - 2 * $lthickness}]
3267 set y0 [expr {$y - 2 * $lthickness}]
3268 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3269 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3270 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3271 -fill \#ffff80 -outline black -width 1 -tags hover]
3272 $canv raise $t
3273 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3274 $canv raise $t
3277 proc clickisonarrow {id y} {
3278 global lthickness
3280 set ranges [rowranges $id]
3281 set thresh [expr {2 * $lthickness + 6}]
3282 set n [expr {[llength $ranges] - 1}]
3283 for {set i 1} {$i < $n} {incr i} {
3284 set row [lindex $ranges $i]
3285 if {abs([yc $row] - $y) < $thresh} {
3286 return $i
3289 return {}
3292 proc arrowjump {id n y} {
3293 global canv
3295 # 1 <-> 2, 3 <-> 4, etc...
3296 set n [expr {(($n - 1) ^ 1) + 1}]
3297 set row [lindex [rowranges $id] $n]
3298 set yt [yc $row]
3299 set ymax [lindex [$canv cget -scrollregion] 3]
3300 if {$ymax eq {} || $ymax <= 0} return
3301 set view [$canv yview]
3302 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3303 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3304 if {$yfrac < 0} {
3305 set yfrac 0
3307 allcanvs yview moveto $yfrac
3310 proc lineclick {x y id isnew} {
3311 global ctext commitinfo childlist commitrow cflist canv thickerline
3313 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3314 unmarkmatches
3315 unselectline
3316 normalline
3317 $canv delete hover
3318 # draw this line thicker than normal
3319 set thickerline $id
3320 drawlines $id
3321 if {$isnew} {
3322 set ymax [lindex [$canv cget -scrollregion] 3]
3323 if {$ymax eq {}} return
3324 set yfrac [lindex [$canv yview] 0]
3325 set y [expr {$y + $yfrac * $ymax}]
3327 set dirn [clickisonarrow $id $y]
3328 if {$dirn ne {}} {
3329 arrowjump $id $dirn $y
3330 return
3333 if {$isnew} {
3334 addtohistory [list lineclick $x $y $id 0]
3336 # fill the details pane with info about this line
3337 $ctext conf -state normal
3338 $ctext delete 0.0 end
3339 $ctext tag conf link -foreground blue -underline 1
3340 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3341 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3342 $ctext insert end "Parent:\t"
3343 $ctext insert end $id [list link link0]
3344 $ctext tag bind link0 <1> [list selbyid $id]
3345 set info $commitinfo($id)
3346 $ctext insert end "\n\t[lindex $info 0]\n"
3347 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3348 set date [formatdate [lindex $info 2]]
3349 $ctext insert end "\tDate:\t$date\n"
3350 set kids [lindex $childlist $commitrow($id)]
3351 if {$kids ne {}} {
3352 $ctext insert end "\nChildren:"
3353 set i 0
3354 foreach child $kids {
3355 incr i
3356 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3357 set info $commitinfo($child)
3358 $ctext insert end "\n\t"
3359 $ctext insert end $child [list link link$i]
3360 $ctext tag bind link$i <1> [list selbyid $child]
3361 $ctext insert end "\n\t[lindex $info 0]"
3362 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3363 set date [formatdate [lindex $info 2]]
3364 $ctext insert end "\n\tDate:\t$date\n"
3367 $ctext conf -state disabled
3369 $cflist delete 0 end
3372 proc normalline {} {
3373 global thickerline
3374 if {[info exists thickerline]} {
3375 set id $thickerline
3376 unset thickerline
3377 drawlines $id
3381 proc selbyid {id} {
3382 global commitrow
3383 if {[info exists commitrow($id)]} {
3384 selectline $commitrow($id) 1
3388 proc mstime {} {
3389 global startmstime
3390 if {![info exists startmstime]} {
3391 set startmstime [clock clicks -milliseconds]
3393 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3396 proc rowmenu {x y id} {
3397 global rowctxmenu commitrow selectedline rowmenuid
3399 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3400 set state disabled
3401 } else {
3402 set state normal
3404 $rowctxmenu entryconfigure 0 -state $state
3405 $rowctxmenu entryconfigure 1 -state $state
3406 $rowctxmenu entryconfigure 2 -state $state
3407 set rowmenuid $id
3408 tk_popup $rowctxmenu $x $y
3411 proc diffvssel {dirn} {
3412 global rowmenuid selectedline displayorder
3414 if {![info exists selectedline]} return
3415 if {$dirn} {
3416 set oldid [lindex $displayorder $selectedline]
3417 set newid $rowmenuid
3418 } else {
3419 set oldid $rowmenuid
3420 set newid [lindex $displayorder $selectedline]
3422 addtohistory [list doseldiff $oldid $newid]
3423 doseldiff $oldid $newid
3426 proc doseldiff {oldid newid} {
3427 global ctext cflist
3428 global commitinfo
3430 $ctext conf -state normal
3431 $ctext delete 0.0 end
3432 $ctext mark set fmark.0 0.0
3433 $ctext mark gravity fmark.0 left
3434 $cflist delete 0 end
3435 $cflist insert end "Top"
3436 $ctext insert end "From "
3437 $ctext tag conf link -foreground blue -underline 1
3438 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3439 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3440 $ctext tag bind link0 <1> [list selbyid $oldid]
3441 $ctext insert end $oldid [list link link0]
3442 $ctext insert end "\n "
3443 $ctext insert end [lindex $commitinfo($oldid) 0]
3444 $ctext insert end "\n\nTo "
3445 $ctext tag bind link1 <1> [list selbyid $newid]
3446 $ctext insert end $newid [list link link1]
3447 $ctext insert end "\n "
3448 $ctext insert end [lindex $commitinfo($newid) 0]
3449 $ctext insert end "\n"
3450 $ctext conf -state disabled
3451 $ctext tag delete Comments
3452 $ctext tag remove found 1.0 end
3453 startdiff [list $oldid $newid]
3456 proc mkpatch {} {
3457 global rowmenuid currentid commitinfo patchtop patchnum
3459 if {![info exists currentid]} return
3460 set oldid $currentid
3461 set oldhead [lindex $commitinfo($oldid) 0]
3462 set newid $rowmenuid
3463 set newhead [lindex $commitinfo($newid) 0]
3464 set top .patch
3465 set patchtop $top
3466 catch {destroy $top}
3467 toplevel $top
3468 label $top.title -text "Generate patch"
3469 grid $top.title - -pady 10
3470 label $top.from -text "From:"
3471 entry $top.fromsha1 -width 40 -relief flat
3472 $top.fromsha1 insert 0 $oldid
3473 $top.fromsha1 conf -state readonly
3474 grid $top.from $top.fromsha1 -sticky w
3475 entry $top.fromhead -width 60 -relief flat
3476 $top.fromhead insert 0 $oldhead
3477 $top.fromhead conf -state readonly
3478 grid x $top.fromhead -sticky w
3479 label $top.to -text "To:"
3480 entry $top.tosha1 -width 40 -relief flat
3481 $top.tosha1 insert 0 $newid
3482 $top.tosha1 conf -state readonly
3483 grid $top.to $top.tosha1 -sticky w
3484 entry $top.tohead -width 60 -relief flat
3485 $top.tohead insert 0 $newhead
3486 $top.tohead conf -state readonly
3487 grid x $top.tohead -sticky w
3488 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3489 grid $top.rev x -pady 10
3490 label $top.flab -text "Output file:"
3491 entry $top.fname -width 60
3492 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3493 incr patchnum
3494 grid $top.flab $top.fname -sticky w
3495 frame $top.buts
3496 button $top.buts.gen -text "Generate" -command mkpatchgo
3497 button $top.buts.can -text "Cancel" -command mkpatchcan
3498 grid $top.buts.gen $top.buts.can
3499 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3500 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3501 grid $top.buts - -pady 10 -sticky ew
3502 focus $top.fname
3505 proc mkpatchrev {} {
3506 global patchtop
3508 set oldid [$patchtop.fromsha1 get]
3509 set oldhead [$patchtop.fromhead get]
3510 set newid [$patchtop.tosha1 get]
3511 set newhead [$patchtop.tohead get]
3512 foreach e [list fromsha1 fromhead tosha1 tohead] \
3513 v [list $newid $newhead $oldid $oldhead] {
3514 $patchtop.$e conf -state normal
3515 $patchtop.$e delete 0 end
3516 $patchtop.$e insert 0 $v
3517 $patchtop.$e conf -state readonly
3521 proc mkpatchgo {} {
3522 global patchtop
3524 set oldid [$patchtop.fromsha1 get]
3525 set newid [$patchtop.tosha1 get]
3526 set fname [$patchtop.fname get]
3527 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3528 error_popup "Error creating patch: $err"
3530 catch {destroy $patchtop}
3531 unset patchtop
3534 proc mkpatchcan {} {
3535 global patchtop
3537 catch {destroy $patchtop}
3538 unset patchtop
3541 proc mktag {} {
3542 global rowmenuid mktagtop commitinfo
3544 set top .maketag
3545 set mktagtop $top
3546 catch {destroy $top}
3547 toplevel $top
3548 label $top.title -text "Create tag"
3549 grid $top.title - -pady 10
3550 label $top.id -text "ID:"
3551 entry $top.sha1 -width 40 -relief flat
3552 $top.sha1 insert 0 $rowmenuid
3553 $top.sha1 conf -state readonly
3554 grid $top.id $top.sha1 -sticky w
3555 entry $top.head -width 60 -relief flat
3556 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3557 $top.head conf -state readonly
3558 grid x $top.head -sticky w
3559 label $top.tlab -text "Tag name:"
3560 entry $top.tag -width 60
3561 grid $top.tlab $top.tag -sticky w
3562 frame $top.buts
3563 button $top.buts.gen -text "Create" -command mktaggo
3564 button $top.buts.can -text "Cancel" -command mktagcan
3565 grid $top.buts.gen $top.buts.can
3566 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3567 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3568 grid $top.buts - -pady 10 -sticky ew
3569 focus $top.tag
3572 proc domktag {} {
3573 global mktagtop env tagids idtags
3575 set id [$mktagtop.sha1 get]
3576 set tag [$mktagtop.tag get]
3577 if {$tag == {}} {
3578 error_popup "No tag name specified"
3579 return
3581 if {[info exists tagids($tag)]} {
3582 error_popup "Tag \"$tag\" already exists"
3583 return
3585 if {[catch {
3586 set dir [gitdir]
3587 set fname [file join $dir "refs/tags" $tag]
3588 set f [open $fname w]
3589 puts $f $id
3590 close $f
3591 } err]} {
3592 error_popup "Error creating tag: $err"
3593 return
3596 set tagids($tag) $id
3597 lappend idtags($id) $tag
3598 redrawtags $id
3601 proc redrawtags {id} {
3602 global canv linehtag commitrow idpos selectedline
3604 if {![info exists commitrow($id)]} return
3605 drawcmitrow $commitrow($id)
3606 $canv delete tag.$id
3607 set xt [eval drawtags $id $idpos($id)]
3608 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3609 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3610 selectline $selectedline 0
3614 proc mktagcan {} {
3615 global mktagtop
3617 catch {destroy $mktagtop}
3618 unset mktagtop
3621 proc mktaggo {} {
3622 domktag
3623 mktagcan
3626 proc writecommit {} {
3627 global rowmenuid wrcomtop commitinfo wrcomcmd
3629 set top .writecommit
3630 set wrcomtop $top
3631 catch {destroy $top}
3632 toplevel $top
3633 label $top.title -text "Write commit to file"
3634 grid $top.title - -pady 10
3635 label $top.id -text "ID:"
3636 entry $top.sha1 -width 40 -relief flat
3637 $top.sha1 insert 0 $rowmenuid
3638 $top.sha1 conf -state readonly
3639 grid $top.id $top.sha1 -sticky w
3640 entry $top.head -width 60 -relief flat
3641 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3642 $top.head conf -state readonly
3643 grid x $top.head -sticky w
3644 label $top.clab -text "Command:"
3645 entry $top.cmd -width 60 -textvariable wrcomcmd
3646 grid $top.clab $top.cmd -sticky w -pady 10
3647 label $top.flab -text "Output file:"
3648 entry $top.fname -width 60
3649 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3650 grid $top.flab $top.fname -sticky w
3651 frame $top.buts
3652 button $top.buts.gen -text "Write" -command wrcomgo
3653 button $top.buts.can -text "Cancel" -command wrcomcan
3654 grid $top.buts.gen $top.buts.can
3655 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3656 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3657 grid $top.buts - -pady 10 -sticky ew
3658 focus $top.fname
3661 proc wrcomgo {} {
3662 global wrcomtop
3664 set id [$wrcomtop.sha1 get]
3665 set cmd "echo $id | [$wrcomtop.cmd get]"
3666 set fname [$wrcomtop.fname get]
3667 if {[catch {exec sh -c $cmd >$fname &} err]} {
3668 error_popup "Error writing commit: $err"
3670 catch {destroy $wrcomtop}
3671 unset wrcomtop
3674 proc wrcomcan {} {
3675 global wrcomtop
3677 catch {destroy $wrcomtop}
3678 unset wrcomtop
3681 proc listrefs {id} {
3682 global idtags idheads idotherrefs
3684 set x {}
3685 if {[info exists idtags($id)]} {
3686 set x $idtags($id)
3688 set y {}
3689 if {[info exists idheads($id)]} {
3690 set y $idheads($id)
3692 set z {}
3693 if {[info exists idotherrefs($id)]} {
3694 set z $idotherrefs($id)
3696 return [list $x $y $z]
3699 proc rereadrefs {} {
3700 global idtags idheads idotherrefs
3702 set refids [concat [array names idtags] \
3703 [array names idheads] [array names idotherrefs]]
3704 foreach id $refids {
3705 if {![info exists ref($id)]} {
3706 set ref($id) [listrefs $id]
3709 readrefs
3710 set refids [lsort -unique [concat $refids [array names idtags] \
3711 [array names idheads] [array names idotherrefs]]]
3712 foreach id $refids {
3713 set v [listrefs $id]
3714 if {![info exists ref($id)] || $ref($id) != $v} {
3715 redrawtags $id
3720 proc showtag {tag isnew} {
3721 global ctext cflist tagcontents tagids linknum
3723 if {$isnew} {
3724 addtohistory [list showtag $tag 0]
3726 $ctext conf -state normal
3727 $ctext delete 0.0 end
3728 set linknum 0
3729 if {[info exists tagcontents($tag)]} {
3730 set text $tagcontents($tag)
3731 } else {
3732 set text "Tag: $tag\nId: $tagids($tag)"
3734 appendwithlinks $text
3735 $ctext conf -state disabled
3736 $cflist delete 0 end
3739 proc doquit {} {
3740 global stopped
3741 set stopped 100
3742 destroy .
3745 proc doprefs {} {
3746 global maxwidth maxgraphpct diffopts findmergefiles
3747 global oldprefs prefstop
3749 set top .gitkprefs
3750 set prefstop $top
3751 if {[winfo exists $top]} {
3752 raise $top
3753 return
3755 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3756 set oldprefs($v) [set $v]
3758 toplevel $top
3759 wm title $top "Gitk preferences"
3760 label $top.ldisp -text "Commit list display options"
3761 grid $top.ldisp - -sticky w -pady 10
3762 label $top.spacer -text " "
3763 label $top.maxwidthl -text "Maximum graph width (lines)" \
3764 -font optionfont
3765 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3766 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3767 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3768 -font optionfont
3769 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3770 grid x $top.maxpctl $top.maxpct -sticky w
3771 checkbutton $top.findm -variable findmergefiles
3772 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3773 -font optionfont
3774 grid $top.findm $top.findml - -sticky w
3775 label $top.ddisp -text "Diff display options"
3776 grid $top.ddisp - -sticky w -pady 10
3777 label $top.diffoptl -text "Options for diff program" \
3778 -font optionfont
3779 entry $top.diffopt -width 20 -textvariable diffopts
3780 grid x $top.diffoptl $top.diffopt -sticky w
3781 frame $top.buts
3782 button $top.buts.ok -text "OK" -command prefsok
3783 button $top.buts.can -text "Cancel" -command prefscan
3784 grid $top.buts.ok $top.buts.can
3785 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3786 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3787 grid $top.buts - - -pady 10 -sticky ew
3790 proc prefscan {} {
3791 global maxwidth maxgraphpct diffopts findmergefiles
3792 global oldprefs prefstop
3794 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3795 set $v $oldprefs($v)
3797 catch {destroy $prefstop}
3798 unset prefstop
3801 proc prefsok {} {
3802 global maxwidth maxgraphpct
3803 global oldprefs prefstop
3805 catch {destroy $prefstop}
3806 unset prefstop
3807 if {$maxwidth != $oldprefs(maxwidth)
3808 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3809 redisplay
3813 proc formatdate {d} {
3814 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3817 # This list of encoding names and aliases is distilled from
3818 # http://www.iana.org/assignments/character-sets.
3819 # Not all of them are supported by Tcl.
3820 set encoding_aliases {
3821 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3822 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3823 { ISO-10646-UTF-1 csISO10646UTF1 }
3824 { ISO_646.basic:1983 ref csISO646basic1983 }
3825 { INVARIANT csINVARIANT }
3826 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3827 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3828 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3829 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3830 { NATS-DANO iso-ir-9-1 csNATSDANO }
3831 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3832 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3833 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3834 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3835 { ISO-2022-KR csISO2022KR }
3836 { EUC-KR csEUCKR }
3837 { ISO-2022-JP csISO2022JP }
3838 { ISO-2022-JP-2 csISO2022JP2 }
3839 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3840 csISO13JISC6220jp }
3841 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3842 { IT iso-ir-15 ISO646-IT csISO15Italian }
3843 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3844 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3845 { greek7-old iso-ir-18 csISO18Greek7Old }
3846 { latin-greek iso-ir-19 csISO19LatinGreek }
3847 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3848 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3849 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3850 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3851 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3852 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3853 { INIS iso-ir-49 csISO49INIS }
3854 { INIS-8 iso-ir-50 csISO50INIS8 }
3855 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3856 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3857 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3858 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3859 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3860 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3861 csISO60Norwegian1 }
3862 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3863 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3864 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3865 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3866 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3867 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3868 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3869 { greek7 iso-ir-88 csISO88Greek7 }
3870 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3871 { iso-ir-90 csISO90 }
3872 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3873 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3874 csISO92JISC62991984b }
3875 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3876 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3877 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3878 csISO95JIS62291984handadd }
3879 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3880 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3881 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3882 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3883 CP819 csISOLatin1 }
3884 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3885 { T.61-7bit iso-ir-102 csISO102T617bit }
3886 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3887 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3888 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3889 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3890 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3891 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3892 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3893 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3894 arabic csISOLatinArabic }
3895 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3896 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3897 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3898 greek greek8 csISOLatinGreek }
3899 { T.101-G2 iso-ir-128 csISO128T101G2 }
3900 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3901 csISOLatinHebrew }
3902 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3903 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3904 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3905 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3906 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3907 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3908 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3909 csISOLatinCyrillic }
3910 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3911 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3912 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3913 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3914 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3915 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3916 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3917 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3918 { ISO_10367-box iso-ir-155 csISO10367Box }
3919 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3920 { latin-lap lap iso-ir-158 csISO158Lap }
3921 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3922 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3923 { us-dk csUSDK }
3924 { dk-us csDKUS }
3925 { JIS_X0201 X0201 csHalfWidthKatakana }
3926 { KSC5636 ISO646-KR csKSC5636 }
3927 { ISO-10646-UCS-2 csUnicode }
3928 { ISO-10646-UCS-4 csUCS4 }
3929 { DEC-MCS dec csDECMCS }
3930 { hp-roman8 roman8 r8 csHPRoman8 }
3931 { macintosh mac csMacintosh }
3932 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3933 csIBM037 }
3934 { IBM038 EBCDIC-INT cp038 csIBM038 }
3935 { IBM273 CP273 csIBM273 }
3936 { IBM274 EBCDIC-BE CP274 csIBM274 }
3937 { IBM275 EBCDIC-BR cp275 csIBM275 }
3938 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3939 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3940 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3941 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3942 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3943 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3944 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3945 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3946 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3947 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3948 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3949 { IBM437 cp437 437 csPC8CodePage437 }
3950 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3951 { IBM775 cp775 csPC775Baltic }
3952 { IBM850 cp850 850 csPC850Multilingual }
3953 { IBM851 cp851 851 csIBM851 }
3954 { IBM852 cp852 852 csPCp852 }
3955 { IBM855 cp855 855 csIBM855 }
3956 { IBM857 cp857 857 csIBM857 }
3957 { IBM860 cp860 860 csIBM860 }
3958 { IBM861 cp861 861 cp-is csIBM861 }
3959 { IBM862 cp862 862 csPC862LatinHebrew }
3960 { IBM863 cp863 863 csIBM863 }
3961 { IBM864 cp864 csIBM864 }
3962 { IBM865 cp865 865 csIBM865 }
3963 { IBM866 cp866 866 csIBM866 }
3964 { IBM868 CP868 cp-ar csIBM868 }
3965 { IBM869 cp869 869 cp-gr csIBM869 }
3966 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3967 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3968 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3969 { IBM891 cp891 csIBM891 }
3970 { IBM903 cp903 csIBM903 }
3971 { IBM904 cp904 904 csIBBM904 }
3972 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3973 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3974 { IBM1026 CP1026 csIBM1026 }
3975 { EBCDIC-AT-DE csIBMEBCDICATDE }
3976 { EBCDIC-AT-DE-A csEBCDICATDEA }
3977 { EBCDIC-CA-FR csEBCDICCAFR }
3978 { EBCDIC-DK-NO csEBCDICDKNO }
3979 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3980 { EBCDIC-FI-SE csEBCDICFISE }
3981 { EBCDIC-FI-SE-A csEBCDICFISEA }
3982 { EBCDIC-FR csEBCDICFR }
3983 { EBCDIC-IT csEBCDICIT }
3984 { EBCDIC-PT csEBCDICPT }
3985 { EBCDIC-ES csEBCDICES }
3986 { EBCDIC-ES-A csEBCDICESA }
3987 { EBCDIC-ES-S csEBCDICESS }
3988 { EBCDIC-UK csEBCDICUK }
3989 { EBCDIC-US csEBCDICUS }
3990 { UNKNOWN-8BIT csUnknown8BiT }
3991 { MNEMONIC csMnemonic }
3992 { MNEM csMnem }
3993 { VISCII csVISCII }
3994 { VIQR csVIQR }
3995 { KOI8-R csKOI8R }
3996 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3997 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3998 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3999 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4000 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4001 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4002 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4003 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4004 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4005 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4006 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4007 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4008 { IBM1047 IBM-1047 }
4009 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4010 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4011 { UNICODE-1-1 csUnicode11 }
4012 { CESU-8 csCESU-8 }
4013 { BOCU-1 csBOCU-1 }
4014 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4015 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4016 l8 }
4017 { ISO-8859-15 ISO_8859-15 Latin-9 }
4018 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4019 { GBK CP936 MS936 windows-936 }
4020 { JIS_Encoding csJISEncoding }
4021 { Shift_JIS MS_Kanji csShiftJIS }
4022 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4023 EUC-JP }
4024 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4025 { ISO-10646-UCS-Basic csUnicodeASCII }
4026 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4027 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4028 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4029 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4030 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4031 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4032 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4033 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4034 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4035 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4036 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4037 { Ventura-US csVenturaUS }
4038 { Ventura-International csVenturaInternational }
4039 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4040 { PC8-Turkish csPC8Turkish }
4041 { IBM-Symbols csIBMSymbols }
4042 { IBM-Thai csIBMThai }
4043 { HP-Legal csHPLegal }
4044 { HP-Pi-font csHPPiFont }
4045 { HP-Math8 csHPMath8 }
4046 { Adobe-Symbol-Encoding csHPPSMath }
4047 { HP-DeskTop csHPDesktop }
4048 { Ventura-Math csVenturaMath }
4049 { Microsoft-Publishing csMicrosoftPublishing }
4050 { Windows-31J csWindows31J }
4051 { GB2312 csGB2312 }
4052 { Big5 csBig5 }
4055 proc tcl_encoding {enc} {
4056 global encoding_aliases
4057 set names [encoding names]
4058 set lcnames [string tolower $names]
4059 set enc [string tolower $enc]
4060 set i [lsearch -exact $lcnames $enc]
4061 if {$i < 0} {
4062 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4063 if {[regsub {^iso[-_]} $enc iso encx]} {
4064 set i [lsearch -exact $lcnames $encx]
4067 if {$i < 0} {
4068 foreach l $encoding_aliases {
4069 set ll [string tolower $l]
4070 if {[lsearch -exact $ll $enc] < 0} continue
4071 # look through the aliases for one that tcl knows about
4072 foreach e $ll {
4073 set i [lsearch -exact $lcnames $e]
4074 if {$i < 0} {
4075 if {[regsub {^iso[-_]} $e iso ex]} {
4076 set i [lsearch -exact $lcnames $ex]
4079 if {$i >= 0} break
4081 break
4084 if {$i >= 0} {
4085 return [lindex $names $i]
4087 return {}
4090 # defaults...
4091 set datemode 0
4092 set diffopts "-U 5 -p"
4093 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4095 set gitencoding {}
4096 catch {
4097 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4099 if {$gitencoding == ""} {
4100 set gitencoding "utf-8"
4102 set tclencoding [tcl_encoding $gitencoding]
4103 if {$tclencoding == {}} {
4104 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4107 set mainfont {Helvetica 9}
4108 set textfont {Courier 9}
4109 set uifont {Helvetica 9 bold}
4110 set findmergefiles 0
4111 set maxgraphpct 50
4112 set maxwidth 16
4113 set revlistorder 0
4114 set fastdate 0
4115 set uparrowlen 7
4116 set downarrowlen 7
4117 set mingaplen 30
4119 set colors {green red blue magenta darkgrey brown orange}
4121 catch {source ~/.gitk}
4123 set namefont $mainfont
4125 font create optionfont -family sans-serif -size -12
4127 set revtreeargs {}
4128 foreach arg $argv {
4129 switch -regexp -- $arg {
4130 "^$" { }
4131 "^-d" { set datemode 1 }
4132 default {
4133 lappend revtreeargs $arg
4138 # check that we can find a .git directory somewhere...
4139 set gitdir [gitdir]
4140 if {![file isdirectory $gitdir]} {
4141 error_popup "Cannot find the git directory \"$gitdir\"."
4142 exit 1
4145 set history {}
4146 set historyindex 0
4148 set optim_delay 16
4150 set nextviewnum 1
4151 set curview 0
4152 set viewfiles(0) {}
4154 set stopped 0
4155 set stuffsaved 0
4156 set patchnum 0
4157 setcoords
4158 makewindow
4159 readrefs
4160 parse_args $revtreeargs
4161 set args $parsed_args
4162 if {$cmdline_files ne {}} {
4163 # create a view for the files/dirs specified on the command line
4164 set curview 1
4165 set nextviewnum 2
4166 set viewname(1) "Command line"
4167 set viewfiles(1) $cmdline_files
4168 .bar.view add command -label $viewname(1) -command {showview 1}
4169 .bar.view entryconf 2 -state normal
4170 set args [concat $args "--" $cmdline_files]
4172 getcommits $args