2 # Tcl ignores the next line -*- tcl -*- \
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.
12 if {[info exists env
(GIT_DIR
)]} {
19 proc start_rev_list
{view
} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
27 set commitidx
($view) 0
28 set args
$viewargs($view)
29 if {$viewfiles($view) ne
{}} {
30 set args
[concat
$args "--" $viewfiles($view)]
32 set order
"--topo-order"
34 set order
"--date-order"
37 set fd
[open
[concat | git rev-list
--header $order \
38 --parents --boundary --default HEAD
$args] r
]
40 puts stderr
"Error executing git rev-list: $err"
44 set leftover
($view) {}
45 fconfigure
$fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure
$fd -encoding $tclencoding
49 fileevent
$fd readable
[list getcommitlines
$fd $view]
53 proc stop_rev_list
{} {
56 if {![info exists commfd
($curview)]} return
57 set fd
$commfd($curview)
63 unset commfd
($curview)
67 global phase canv mainfont curview
71 start_rev_list
$curview
72 show_status
"Reading commits..."
75 proc getcommitlines
{fd view
} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
84 if {![eof
$fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure
$fd -blocking 1
90 if {[catch
{close
$fd} err
]} {
92 if {$view != $curview} {
93 set fv
" for the \"$viewname($view)\" view"
95 if {[string range
$err 0 4] == "usage"} {
96 set err
"Gitk: error reading commits$fv:\
97 bad arguments to git rev-list."
98 if {$viewname($view) eq
"Command line"} {
100 " (Note: arguments to gitk are passed to git rev-list\
101 to allow selection of commits to be displayed.)"
104 set err
"Error reading commits$fv: $err"
108 if {$view == $curview} {
109 after idle finishcommits
116 set i
[string first
"\0" $stuff $start]
118 append leftover
($view) [string range
$stuff $start end
]
122 set cmit
$leftover($view)
123 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
124 set leftover
($view) {}
126 set cmit
[string range
$stuff $start [expr {$i - 1}]]
128 set start
[expr {$i + 1}]
129 set j
[string first
"\n" $cmit]
133 set ids
[string range
$cmit 0 [expr {$j - 1}]]
134 if {[string range
$ids 0 0] == "-"} {
136 set ids
[string range
$ids 1 end
]
140 if {[string length
$id] != 40} {
148 if {[string length
$shortcmit] > 80} {
149 set shortcmit
"[string range $shortcmit 0 80]..."
151 error_popup
"Can't parse git rev-list output: {$shortcmit}"
154 set id
[lindex
$ids 0]
156 set olds
[lrange
$ids 1 end
]
159 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
160 lappend children
($view,$p) $id
167 if {![info exists children
($view,$id)]} {
168 set children
($view,$id) {}
170 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
171 set commitrow
($view,$id) $commitidx($view)
172 incr commitidx
($view)
173 if {$view == $curview} {
174 lappend parentlist
$olds
175 lappend childlist
$children($view,$id)
176 lappend displayorder
$id
177 lappend commitlisted
$listed
179 lappend vparentlist
($view) $olds
180 lappend vchildlist
($view) $children($view,$id)
181 lappend vdisporder
($view) $id
182 lappend vcmitlisted
($view) $listed
187 if {$view == $curview} {
189 } elseif
{[info exists hlview
] && $view == $hlview} {
193 if {[clock clicks
-milliseconds] >= $nextupdate} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v
[array names commfd
] {
202 fileevent
$commfd($v) readable
{}
205 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate
[expr {$numcommits + 1}]
208 } elseif
{$numcommits < 10000} {
209 set ncmupdate
[expr {$numcommits + 10}]
211 set ncmupdate
[expr {$numcommits + 100}]
213 foreach v
[array names commfd
] {
215 fileevent
$fd readable
[list getcommitlines
$fd $v]
219 proc readcommit
{id
} {
220 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
221 parsecommit
$id $contents 0
224 proc updatecommits
{} {
225 global viewdata curview phase displayorder
226 global children commitrow
233 foreach id
$displayorder {
234 catch
{unset children
($n,$id)}
235 catch
{unset commitrow
($n,$id)}
238 catch
{unset viewdata
($n)}
243 proc parsecommit
{id contents listed
} {
244 global commitinfo cdate
253 set hdrend
[string first
"\n\n" $contents]
255 # should never happen...
256 set hdrend
[string length
$contents]
258 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
259 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
260 foreach line
[split $header "\n"] {
261 set tag
[lindex
$line 0]
262 if {$tag == "author"} {
263 set audate
[lindex
$line end-1
]
264 set auname
[lrange
$line 1 end-2
]
265 } elseif
{$tag == "committer"} {
266 set comdate
[lindex
$line end-1
]
267 set comname
[lrange
$line 1 end-2
]
271 # take the first line of the comment as the headline
272 set i
[string first
"\n" $comment]
274 set headline
[string trim
[string range
$comment 0 $i]]
276 set headline
$comment
279 # git rev-list indents the comment by 4 spaces;
280 # if we got this via git cat-file, add the indentation
282 foreach line
[split $comment "\n"] {
283 append newcomment
" "
284 append newcomment
$line
285 append newcomment
"\n"
287 set comment
$newcomment
289 if {$comdate != {}} {
290 set cdate
($id) $comdate
292 set commitinfo
($id) [list
$headline $auname $audate \
293 $comname $comdate $comment]
296 proc getcommit
{id
} {
297 global commitdata commitinfo
299 if {[info exists commitdata
($id)]} {
300 parsecommit
$id $commitdata($id) 1
303 if {![info exists commitinfo
($id)]} {
304 set commitinfo
($id) {"No commit information available"}
311 global tagids idtags headids idheads tagcontents
312 global otherrefids idotherrefs
314 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
317 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
318 while {0 <= [set n
[gets
$refd line
]]} {
319 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
323 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
326 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
330 if {[regexp
{^remotes
/} $path match
]} {
333 if {$type == "tags"} {
334 set tagids
($name) $id
335 lappend idtags
($id) $name
340 set commit
[exec git rev-parse
"$id^0"]
341 if {"$commit" != "$id"} {
342 set tagids
($name) $commit
343 lappend idtags
($commit) $name
347 set tagcontents
($name) [exec git cat-file tag
"$id"]
349 } elseif
{ $type == "heads" } {
350 set headids
($name) $id
351 lappend idheads
($id) $name
353 set otherrefids
($name) $id
354 lappend idotherrefs
($id) $name
360 proc show_error
{w msg
} {
361 message
$w.m
-text $msg -justify center
-aspect 400
362 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
363 button
$w.ok
-text OK
-command "destroy $w"
364 pack
$w.ok
-side bottom
-fill x
365 bind $w <Visibility
> "grab $w; focus $w"
366 bind $w <Key-Return
> "destroy $w"
370 proc error_popup msg
{
378 global canv canv2 canv3 linespc charspc ctext cflist
379 global textfont mainfont uifont
380 global findtype findtypemenu findloc findstring fstring geometry
381 global entries sha1entry sha1string sha1but
382 global maincursor textcursor curtextcursor
383 global rowctxmenu mergemax wrapcomment
386 .bar add cascade
-label "File" -menu .bar.
file
387 .bar configure
-font $uifont
389 .bar.
file add
command -label "Update" -command updatecommits
390 .bar.
file add
command -label "Reread references" -command rereadrefs
391 .bar.
file add
command -label "Quit" -command doquit
392 .bar.
file configure
-font $uifont
394 .bar add cascade
-label "Edit" -menu .bar.edit
395 .bar.edit add
command -label "Preferences" -command doprefs
396 .bar.edit configure
-font $uifont
398 menu .bar.view
-font $uifont
399 menu .bar.view.hl
-font $uifont -tearoff 0
400 .bar add cascade
-label "View" -menu .bar.view
401 .bar.view add
command -label "New view..." -command {newview
0}
402 .bar.view add
command -label "Edit view..." -command editview \
404 .bar.view add
command -label "Delete view" -command delview
-state disabled
405 .bar.view add cascade
-label "Highlight" -menu .bar.view.hl
406 .bar.view add separator
407 .bar.view add radiobutton
-label "All files" -command {showview
0} \
408 -variable selectedview
-value 0
409 .bar.view.hl add
command -label "New view..." -command {newview
1}
410 .bar.view.hl add
command -label "Remove" -command delhighlight \
412 .bar.view.hl add separator
415 .bar add cascade
-label "Help" -menu .bar.
help
416 .bar.
help add
command -label "About gitk" -command about
417 .bar.
help add
command -label "Key bindings" -command keys
418 .bar.
help configure
-font $uifont
419 . configure
-menu .bar
421 if {![info exists geometry
(canv1
)]} {
422 set geometry
(canv1
) [expr {45 * $charspc}]
423 set geometry
(canv2
) [expr {30 * $charspc}]
424 set geometry
(canv3
) [expr {15 * $charspc}]
425 set geometry
(canvh
) [expr {25 * $linespc + 4}]
426 set geometry
(ctextw
) 80
427 set geometry
(ctexth
) 30
428 set geometry
(cflistw
) 30
430 panedwindow .ctop
-orient vertical
431 if {[info exists geometry
(width
)]} {
432 .ctop conf
-width $geometry(width
) -height $geometry(height
)
433 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
434 set geometry
(ctexth
) [expr {($texth - 8) /
435 [font metrics
$textfont -linespace]}]
439 pack .ctop.top.bar
-side bottom
-fill x
440 set cscroll .ctop.top.csb
441 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
442 pack
$cscroll -side right
-fill y
443 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
444 pack .ctop.top.clist
-side top
-fill both
-expand 1
446 set canv .ctop.top.clist.canv
447 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add
$canv
451 set canv2 .ctop.top.clist.canv2
452 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
453 -bg white
-bd 0 -yscrollincr $linespc
454 .ctop.top.clist add
$canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
457 -bg white
-bd 0 -yscrollincr $linespc
458 .ctop.top.clist add
$canv3
459 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
461 set sha1entry .ctop.top.bar.sha1
462 set entries
$sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
465 -command gotocommit
-width 8 -font $uifont
466 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
467 pack .ctop.top.bar.sha1label
-side left
468 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string
write sha1change
470 pack
$sha1entry -side left
-pady 2
472 image create bitmap bm-left
-data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits
[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right
-data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits
[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
489 -state disabled
-width 26
490 pack .ctop.top.bar.leftbut
-side left
-fill y
491 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
492 -state disabled
-width 26
493 pack .ctop.top.bar.rightbut
-side left
-fill y
495 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
496 pack .ctop.top.bar.findbut
-side left
498 set fstring .ctop.top.bar.findstring
499 lappend entries
$fstring
500 entry
$fstring -width 30 -font $textfont -textvariable findstring
-font $textfont
501 pack
$fstring -side left
-expand 1 -fill x
503 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
504 findtype Exact IgnCase Regexp
]
505 .ctop.top.bar.findtype configure
-font $uifont
506 .ctop.top.bar.findtype.menu configure
-font $uifont
507 set findloc
"All fields"
508 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
509 Comments Author Committer Files Pickaxe
510 .ctop.top.bar.findloc configure
-font $uifont
511 .ctop.top.bar.findloc.menu configure
-font $uifont
513 pack .ctop.top.bar.findloc
-side right
514 pack .ctop.top.bar.findtype
-side right
515 # for making sure type==Exact whenever loc==Pickaxe
516 trace add variable findloc
write findlocchange
518 panedwindow .ctop.cdet
-orient horizontal
520 frame .ctop.cdet.left
521 set ctext .ctop.cdet.left.ctext
522 text
$ctext -bg white
-state disabled
-font $textfont \
523 -width $geometry(ctextw
) -height $geometry(ctexth
) \
524 -yscrollcommand {.ctop.cdet.left.sb
set} -wrap none
525 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
526 pack .ctop.cdet.left.sb
-side right
-fill y
527 pack
$ctext -side left
-fill both
-expand 1
528 .ctop.cdet add .ctop.cdet.left
530 $ctext tag conf comment
-wrap $wrapcomment
531 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
532 $ctext tag conf hunksep
-fore blue
533 $ctext tag conf d0
-fore red
534 $ctext tag conf d1
-fore "#00a000"
535 $ctext tag conf m0
-fore red
536 $ctext tag conf m1
-fore blue
537 $ctext tag conf m2
-fore green
538 $ctext tag conf m3
-fore purple
539 $ctext tag conf
m4 -fore brown
540 $ctext tag conf m5
-fore "#009090"
541 $ctext tag conf m6
-fore magenta
542 $ctext tag conf m7
-fore "#808000"
543 $ctext tag conf m8
-fore "#009000"
544 $ctext tag conf m9
-fore "#ff0080"
545 $ctext tag conf m10
-fore cyan
546 $ctext tag conf m11
-fore "#b07070"
547 $ctext tag conf m12
-fore "#70b0f0"
548 $ctext tag conf m13
-fore "#70f0b0"
549 $ctext tag conf m14
-fore "#f0b070"
550 $ctext tag conf m15
-fore "#ff70b0"
551 $ctext tag conf mmax
-fore darkgrey
553 $ctext tag conf mresult
-font [concat
$textfont bold
]
554 $ctext tag conf msep
-font [concat
$textfont bold
]
555 $ctext tag conf found
-back yellow
557 frame .ctop.cdet.right
558 frame .ctop.cdet.right.mode
559 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
560 -command reselectline
-variable cmitmode
-value "patch"
561 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
562 -command reselectline
-variable cmitmode
-value "tree"
563 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
564 pack .ctop.cdet.right.mode
-side top
-fill x
565 set cflist .ctop.cdet.right.cfiles
566 set indent
[font measure
$mainfont "nn"]
567 text
$cflist -width $geometry(cflistw
) -background white
-font $mainfont \
568 -tabs [list
$indent [expr {2 * $indent}]] \
569 -yscrollcommand ".ctop.cdet.right.sb set" \
570 -cursor [. cget
-cursor] \
571 -spacing1 1 -spacing3 1
572 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
573 pack .ctop.cdet.right.sb
-side right
-fill y
574 pack
$cflist -side left
-fill both
-expand 1
575 $cflist tag configure highlight \
576 -background [$cflist cget
-selectbackground]
577 .ctop.cdet add .ctop.cdet.right
578 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
580 pack .ctop
-side top
-fill both
-expand 1
582 bindall
<1> {selcanvline
%W
%x
%y
}
583 #bindall <B1-Motion> {selcanvline %W %x %y}
584 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
585 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
586 bindall
<2> "canvscan mark %W %x %y"
587 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
588 bindkey
<Home
> selfirstline
589 bindkey
<End
> sellastline
590 bind .
<Key-Up
> "selnextline -1"
591 bind .
<Key-Down
> "selnextline 1"
592 bindkey
<Key-Right
> "goforw"
593 bindkey
<Key-Left
> "goback"
594 bind .
<Key-Prior
> "selnextpage -1"
595 bind .
<Key-Next
> "selnextpage 1"
596 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
597 bind .
<Control-End
> "allcanvs yview moveto 1.0"
598 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
599 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
600 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
601 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
602 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
603 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
604 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
605 bindkey p
"selnextline -1"
606 bindkey n
"selnextline 1"
609 bindkey i
"selnextline -1"
610 bindkey k
"selnextline 1"
613 bindkey b
"$ctext yview scroll -1 pages"
614 bindkey d
"$ctext yview scroll 18 units"
615 bindkey u
"$ctext yview scroll -18 units"
616 bindkey
/ {findnext
1}
617 bindkey
<Key-Return
> {findnext
0}
620 bind .
<Control-q
> doquit
621 bind .
<Control-f
> dofind
622 bind .
<Control-g
> {findnext
0}
623 bind .
<Control-r
> findprev
624 bind .
<Control-equal
> {incrfont
1}
625 bind .
<Control-KP_Add
> {incrfont
1}
626 bind .
<Control-minus
> {incrfont
-1}
627 bind .
<Control-KP_Subtract
> {incrfont
-1}
628 bind .
<Destroy
> {savestuff
%W
}
629 bind .
<Button-1
> "click %W"
630 bind $fstring <Key-Return
> dofind
631 bind $sha1entry <Key-Return
> gotocommit
632 bind $sha1entry <<PasteSelection>> clearsha1
633 bind $cflist <1> {sel_flist %W %x %y; break}
634 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
635 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
637 set maincursor [. cget -cursor]
638 set textcursor [$ctext cget -cursor]
639 set curtextcursor $textcursor
641 set rowctxmenu .rowctxmenu
642 menu $rowctxmenu -tearoff 0
643 $rowctxmenu add command -label "Diff this -> selected" \
644 -command {diffvssel 0}
645 $rowctxmenu add command -label "Diff selected -> this" \
646 -command {diffvssel 1}
647 $rowctxmenu add command -label "Make patch" -command mkpatch
648 $rowctxmenu add command -label "Create tag" -command mktag
649 $rowctxmenu add command -label "Write commit to file" -command writecommit
652 # mouse-2 makes all windows scan vertically, but only the one
653 # the cursor is in scans horizontally
654 proc canvscan {op w x y} {
655 global canv canv2 canv3
656 foreach c [list $canv $canv2 $canv3] {
665 proc scrollcanv {cscroll f0 f1} {
670 # when we make a key binding for the toplevel, make sure
671 # it doesn't get triggered when that key is pressed in the
672 # find string entry widget.
673 proc bindkey {ev script} {
676 set escript [bind Entry $ev]
677 if {$escript == {}} {
678 set escript [bind Entry <Key>]
681 bind $e $ev "$escript; break"
685 # set the focus back to the toplevel for any click outside
696 global canv canv2 canv3 ctext cflist mainfont textfont uifont
697 global stuffsaved findmergefiles maxgraphpct
699 global viewname viewfiles viewargs viewperm nextviewnum
700 global cmitmode wrapcomment
702 if {$stuffsaved} return
703 if {![winfo viewable .]} return
705 set f [open "~/.gitk-new" w]
706 puts $f [list set mainfont $mainfont]
707 puts $f [list set textfont $textfont]
708 puts $f [list set uifont $uifont]
709 puts $f [list set findmergefiles $findmergefiles]
710 puts $f [list set maxgraphpct $maxgraphpct]
711 puts $f [list set maxwidth $maxwidth]
712 puts $f [list set cmitmode $cmitmode]
713 puts $f [list set wrapcomment $wrapcomment]
714 puts $f "set geometry(width) [winfo width .ctop]"
715 puts $f "set geometry(height) [winfo height .ctop]"
716 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
717 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
718 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
719 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
720 set wid [expr {([winfo width $ctext] - 8) \
721 / [font measure $textfont "0"]}]
722 puts $f "set geometry(ctextw) $wid"
723 set wid [expr {([winfo width $cflist] - 11) \
724 / [font measure [$cflist cget -font] "0"]}]
725 puts $f "set geometry(cflistw) $wid"
726 puts -nonewline $f "set permviews {"
727 for {set v 0} {$v < $nextviewnum} {incr v} {
729 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
734 file rename -force "~/.gitk-new" "~/.gitk"
739 proc resizeclistpanes {win w} {
741 if {[info exists oldwidth($win)]} {
742 set s0 [$win sash coord 0]
743 set s1 [$win sash coord 1]
745 set sash0 [expr {int($w/2 - 2)}]
746 set sash1 [expr {int($w*5/6 - 2)}]
748 set factor [expr {1.0 * $w / $oldwidth($win)}]
749 set sash0 [expr {int($factor * [lindex $s0 0])}]
750 set sash1 [expr {int($factor * [lindex $s1 0])}]
754 if {$sash1 < $sash0 + 20} {
755 set sash1 [expr {$sash0 + 20}]
757 if {$sash1 > $w - 10} {
758 set sash1 [expr {$w - 10}]
759 if {$sash0 > $sash1 - 20} {
760 set sash0 [expr {$sash1 - 20}]
764 $win sash place 0 $sash0 [lindex $s0 1]
765 $win sash place 1 $sash1 [lindex $s1 1]
767 set oldwidth($win) $w
770 proc resizecdetpanes {win w} {
772 if {[info exists oldwidth($win)]} {
773 set s0 [$win sash coord 0]
775 set sash0 [expr {int($w*3/4 - 2)}]
777 set factor [expr {1.0 * $w / $oldwidth($win)}]
778 set sash0 [expr {int($factor * [lindex $s0 0])}]
782 if {$sash0 > $w - 15} {
783 set sash0 [expr {$w - 15}]
786 $win sash place 0 $sash0 [lindex $s0 1]
788 set oldwidth($win) $w
792 global canv canv2 canv3
798 proc bindall {event action} {
799 global canv canv2 canv3
800 bind $canv $event $action
801 bind $canv2 $event $action
802 bind $canv3 $event $action
807 if {[winfo exists $w]} {
812 wm title $w "About gitk"
814 Gitk - a commit viewer for git
816 Copyright © 2005-2006 Paul Mackerras
818 Use and redistribute under the terms of the GNU General Public License} \
819 -justify center -aspect 400
820 pack $w.m -side top -fill x -padx 20 -pady 20
821 button $w.ok -text Close -command "destroy $w"
822 pack $w.ok -side bottom
827 if {[winfo exists $w]} {
832 wm title $w "Gitk key bindings"
837 <Home> Move to first commit
838 <End> Move to last commit
839 <Up>, p, i Move up one commit
840 <Down>, n, k Move down one commit
841 <Left>, z, j Go back in history list
842 <Right>, x, l Go forward in history list
843 <PageUp> Move up one page in commit list
844 <PageDown> Move down one page in commit list
845 <Ctrl-Home> Scroll to top of commit list
846 <Ctrl-End> Scroll to bottom of commit list
847 <Ctrl-Up> Scroll commit list up one line
848 <Ctrl-Down> Scroll commit list down one line
849 <Ctrl-PageUp> Scroll commit list up one page
850 <Ctrl-PageDown> Scroll commit list down one page
851 <Delete>, b Scroll diff view up one page
852 <Backspace> Scroll diff view up one page
853 <Space> Scroll diff view down one page
854 u Scroll diff view up 18 lines
855 d Scroll diff view down 18 lines
857 <Ctrl-G> Move to next find hit
858 <Ctrl-R> Move to previous find hit
859 <Return> Move to next find hit
860 / Move to next find hit, or redo find
861 ? Move to previous find hit
862 f Scroll diff view to next file
863 <Ctrl-KP+> Increase font size
864 <Ctrl-plus> Increase font size
865 <Ctrl-KP-> Decrease font size
866 <Ctrl-minus> Decrease font size
868 -justify left -bg white -border 2 -relief sunken
869 pack $w.m -side top -fill both
870 button $w.ok -text Close -command "destroy $w"
871 pack $w.ok -side bottom
874 # Procedures for manipulating the file list window at the
875 # bottom right of the overall window.
877 proc treeview {w l openlevs} {
878 global treecontents treediropen treeheight treeparent treeindex
888 set treecontents() {}
889 $w conf -state normal
891 while {[string range $f 0 $prefixend] ne $prefix} {
892 if {$lev <= $openlevs} {
893 $w mark set e:$treeindex($prefix) "end -1c"
894 $w mark gravity e:$treeindex($prefix) left
896 set treeheight($prefix) $ht
897 incr ht [lindex $htstack end]
898 set htstack [lreplace $htstack end end]
899 set prefixend [lindex $prefendstack end]
900 set prefendstack [lreplace $prefendstack end end]
901 set prefix [string range $prefix 0 $prefixend]
904 set tail [string range $f [expr {$prefixend+1}] end]
905 while {[set slash [string first "/" $tail]] >= 0} {
908 lappend prefendstack $prefixend
909 incr prefixend [expr {$slash + 1}]
910 set d [string range $tail 0 $slash]
911 lappend treecontents($prefix) $d
912 set oldprefix $prefix
914 set treecontents($prefix) {}
915 set treeindex($prefix) [incr ix]
916 set treeparent($prefix) $oldprefix
917 set tail [string range $tail [expr {$slash+1}] end]
918 if {$lev <= $openlevs} {
920 set treediropen($prefix) [expr {$lev < $openlevs}]
921 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
922 $w mark set d:$ix "end -1c"
923 $w mark gravity d:$ix left
925 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
927 $w image create end -align center -image $bm -padx 1 \
930 $w mark set s:$ix "end -1c"
931 $w mark gravity s:$ix left
936 if {$lev <= $openlevs} {
939 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
943 lappend treecontents($prefix) $tail
946 while {$htstack ne {}} {
947 set treeheight($prefix) $ht
948 incr ht [lindex $htstack end]
949 set htstack [lreplace $htstack end end]
951 $w conf -state disabled
955 global treeheight treecontents
960 foreach e $treecontents($prefix) {
965 if {[string index $e end] eq "/"} {
966 set n $treeheight($prefix$e)
978 proc treeclosedir {w dir} {
979 global treediropen treeheight treeparent treeindex
981 set ix $treeindex($dir)
982 $w conf -state normal
983 $w delete s:$ix e:$ix
984 set treediropen($dir) 0
985 $w image configure a:$ix -image tri-rt
986 $w conf -state disabled
987 set n [expr {1 - $treeheight($dir)}]
989 incr treeheight($dir) $n
990 set dir $treeparent($dir)
994 proc treeopendir {w dir} {
995 global treediropen treeheight treeparent treecontents treeindex
997 set ix $treeindex($dir)
998 $w conf -state normal
999 $w image configure a:$ix -image tri-dn
1000 $w mark set e:$ix s:$ix
1001 $w mark gravity e:$ix right
1004 set n [llength $treecontents($dir)]
1005 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1008 incr treeheight($x) $n
1010 foreach e $treecontents($dir) {
1011 if {[string index $e end] eq "/"} {
1013 set iy $treeindex($de)
1014 $w mark set d:$iy e:$ix
1015 $w mark gravity d:$iy left
1016 $w insert e:$ix $str
1017 set treediropen($de) 0
1018 $w image create e:$ix -align center -image tri-rt -padx 1 \
1021 $w mark set s:$iy e:$ix
1022 $w mark gravity s:$iy left
1023 set treeheight($de) 1
1025 $w insert e:$ix $str
1029 $w mark gravity e:$ix left
1030 $w conf -state disabled
1031 set treediropen($dir) 1
1032 set top [lindex [split [$w index @0,0] .] 0]
1033 set ht [$w cget -height]
1034 set l [lindex [split [$w index s:$ix] .] 0]
1037 } elseif {$l + $n + 1 > $top + $ht} {
1038 set top [expr {$l + $n + 2 - $ht}]
1046 proc treeclick {w x y} {
1047 global treediropen cmitmode ctext cflist cflist_top
1049 if {$cmitmode ne "tree"} return
1050 if {![info exists cflist_top]} return
1051 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1052 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1053 $cflist tag add highlight $l.0 "$l.0 lineend"
1059 set e [linetoelt $l]
1060 if {[string index $e end] ne "/"} {
1062 } elseif {$treediropen($e)} {
1069 proc setfilelist {id} {
1070 global treefilelist cflist
1072 treeview $cflist $treefilelist($id) 0
1075 image create bitmap tri-rt -background black -foreground blue -data {
1076 #define tri-rt_width 13
1077 #define tri-rt_height 13
1078 static unsigned char tri-rt_bits[] = {
1079 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1080 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1083 #define tri-rt-mask_width 13
1084 #define tri-rt-mask_height 13
1085 static unsigned char tri-rt-mask_bits[] = {
1086 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1087 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1090 image create bitmap tri-dn -background black -foreground blue -data {
1091 #define tri-dn_width 13
1092 #define tri-dn_height 13
1093 static unsigned char tri-dn_bits[] = {
1094 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1095 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1098 #define tri-dn-mask_width 13
1099 #define tri-dn-mask_height 13
1100 static unsigned char tri-dn-mask_bits[] = {
1101 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1102 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1106 proc init_flist {first} {
1107 global cflist cflist_top selectedline difffilestart
1109 $cflist conf -state normal
1110 $cflist delete 0.0 end
1112 $cflist insert end $first
1114 $cflist tag add highlight 1.0 "1.0 lineend"
1116 catch {unset cflist_top}
1118 $cflist conf -state disabled
1119 set difffilestart {}
1122 proc add_flist {fl} {
1123 global flistmode cflist
1125 $cflist conf -state normal
1126 if {$flistmode eq "flat"} {
1128 $cflist insert end "\n$f"
1131 $cflist conf -state disabled
1134 proc sel_flist {w x y} {
1135 global flistmode ctext difffilestart cflist cflist_top cmitmode
1137 if {$cmitmode eq "tree"} return
1138 if {![info exists cflist_top]} return
1139 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1140 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1141 $cflist tag add highlight $l.0 "$l.0 lineend"
1146 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1150 # Functions for adding and removing shell-type quoting
1152 proc shellquote {str} {
1153 if {![string match "*\['\"\\ \t]*" $str]} {
1156 if {![string match "*\['\"\\]*" $str]} {
1159 if {![string match "*'*" $str]} {
1162 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1165 proc shellarglist {l} {
1171 append str [shellquote $a]
1176 proc shelldequote {str} {
1181 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1182 append ret [string range $str $used end]
1183 set used [string length $str]
1186 set first [lindex $first 0]
1187 set ch [string index $str $first]
1188 if {$first > $used} {
1189 append ret [string range $str $used [expr {$first - 1}]]
1192 if {$ch eq " " || $ch eq "\t"} break
1195 set first [string first "'" $str $used]
1197 error "unmatched single-quote"
1199 append ret [string range $str $used [expr {$first - 1}]]
1204 if {$used >= [string length $str]} {
1205 error "trailing backslash"
1207 append ret [string index $str $used]
1212 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1213 error "unmatched double-quote"
1215 set first [lindex $first 0]
1216 set ch [string index $str $first]
1217 if {$first > $used} {
1218 append ret [string range $str $used [expr {$first - 1}]]
1221 if {$ch eq "\""} break
1223 append ret [string index $str $used]
1227 return [list $used $ret]
1230 proc shellsplit {str} {
1233 set str [string trimleft $str]
1234 if {$str eq {}} break
1235 set dq [shelldequote $str]
1236 set n [lindex $dq 0]
1237 set word [lindex $dq 1]
1238 set str [string range $str $n end]
1244 # Code to implement multiple views
1246 proc newview {ishighlight} {
1247 global nextviewnum newviewname newviewperm uifont newishighlight
1248 global newviewargs revtreeargs
1250 set newishighlight $ishighlight
1252 if {[winfo exists $top]} {
1256 set newviewname($nextviewnum) "View $nextviewnum"
1257 set newviewperm($nextviewnum) 0
1258 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1259 vieweditor $top $nextviewnum "Gitk view definition"
1264 global viewname viewperm newviewname newviewperm
1265 global viewargs newviewargs
1267 set top .gitkvedit-$curview
1268 if {[winfo exists $top]} {
1272 set newviewname($curview) $viewname($curview)
1273 set newviewperm($curview) $viewperm($curview)
1274 set newviewargs($curview) [shellarglist $viewargs($curview)]
1275 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1278 proc vieweditor {top n title} {
1279 global newviewname newviewperm viewfiles
1283 wm title $top $title
1284 label $top.nl -text "Name" -font $uifont
1285 entry $top.name -width 20 -textvariable newviewname($n)
1286 grid $top.nl $top.name -sticky w -pady 5
1287 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1288 grid $top.perm - -pady 5 -sticky w
1289 message $top.al -aspect 1000 -font $uifont \
1290 -text "Commits to include (arguments to git rev-list):"
1291 grid $top.al - -sticky w -pady 5
1292 entry $top.args -width 50 -textvariable newviewargs($n) \
1294 grid $top.args - -sticky ew -padx 5
1295 message $top.l -aspect 1000 -font $uifont \
1296 -text "Enter files and directories to include, one per line:"
1297 grid $top.l - -sticky w
1298 text $top.t -width 40 -height 10 -background white
1299 if {[info exists viewfiles($n)]} {
1300 foreach f $viewfiles($n) {
1301 $top.t insert end $f
1302 $top.t insert end "\n"
1304 $top.t delete {end - 1c} end
1305 $top.t mark set insert 0.0
1307 grid $top.t - -sticky ew -padx 5
1309 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1310 button $top.buts.can -text "Cancel" -command [list destroy $top]
1311 grid $top.buts.ok $top.buts.can
1312 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1313 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1314 grid $top.buts - -pady 10 -sticky ew
1318 proc doviewmenu {m first cmd op args} {
1319 set nmenu [$m index end]
1320 for {set i $first} {$i <= $nmenu} {incr i} {
1321 if {[$m entrycget $i -command] eq $cmd} {
1322 eval $m $op $i $args
1328 proc allviewmenus {n op args} {
1329 doviewmenu .bar.view 7 [list showview $n] $op $args
1330 doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
1333 proc newviewok {top n} {
1334 global nextviewnum newviewperm newviewname newishighlight
1335 global viewname viewfiles viewperm selectedview curview
1336 global viewargs newviewargs
1339 set newargs [shellsplit $newviewargs($n)]
1341 error_popup "Error in commit selection arguments: $err"
1347 foreach f [split [$top.t get 0.0 end] "\n"] {
1348 set ft [string trim $f]
1353 if {![info exists viewfiles($n)]} {
1354 # creating a new view
1356 set viewname($n) $newviewname($n)
1357 set viewperm($n) $newviewperm($n)
1358 set viewfiles($n) $files
1359 set viewargs($n) $newargs
1361 if {!$newishighlight} {
1362 after idle showview $n
1364 after idle addhighlight $n
1367 # editing an existing view
1368 set viewperm($n) $newviewperm($n)
1369 if {$newviewname($n) ne $viewname($n)} {
1370 set viewname($n) $newviewname($n)
1371 allviewmenus $n entryconf -label $viewname($n)
1373 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1374 set viewfiles($n) $files
1375 set viewargs($n) $newargs
1376 if {$curview == $n} {
1377 after idle updatecommits
1381 catch {destroy $top}
1385 global curview viewdata viewperm
1387 if {$curview == 0} return
1388 allviewmenus $curview delete
1389 set viewdata($curview) {}
1390 set viewperm($curview) 0
1394 proc addviewmenu {n} {
1397 .bar.view add radiobutton -label $viewname($n) \
1398 -command [list showview $n] -variable selectedview -value $n
1399 .bar.view.hl add radiobutton -label $viewname($n) \
1400 -command [list addhighlight $n] -variable selectedhlview -value $n
1403 proc flatten {var} {
1407 foreach i [array names $var] {
1408 lappend ret $i [set $var\($i\)]
1413 proc unflatten {var l} {
1423 global curview viewdata viewfiles
1424 global displayorder parentlist childlist rowidlist rowoffsets
1425 global colormap rowtextx commitrow nextcolor canvxmax
1426 global numcommits rowrangelist commitlisted idrowranges
1427 global selectedline currentid canv canvy0
1428 global matchinglines treediffs
1429 global pending_select phase
1430 global commitidx rowlaidout rowoptim linesegends
1431 global commfd nextupdate
1432 global selectedview hlview selectedhlview
1433 global vparentlist vchildlist vdisporder vcmitlisted
1435 if {$n == $curview} return
1437 if {[info exists selectedline]} {
1438 set selid $currentid
1439 set y [yc $selectedline]
1440 set ymax [lindex [$canv cget -scrollregion] 3]
1441 set span [$canv yview]
1442 set ytop [expr {[lindex $span 0] * $ymax}]
1443 set ybot [expr {[lindex $span 1] * $ymax}]
1444 if {$ytop < $y && $y < $ybot} {
1445 set yscreen [expr {$y - $ytop}]
1447 set yscreen [expr {($ybot - $ytop) / 2}]
1453 if {$curview >= 0} {
1454 set vparentlist($curview) $parentlist
1455 set vchildlist($curview) $childlist
1456 set vdisporder($curview) $displayorder
1457 set vcmitlisted($curview) $commitlisted
1459 set viewdata($curview) \
1460 [list $phase $rowidlist $rowoffsets $rowrangelist \
1461 [flatten idrowranges] [flatten idinlist] \
1462 $rowlaidout $rowoptim $numcommits $linesegends]
1463 } elseif {![info exists viewdata($curview)]
1464 || [lindex $viewdata($curview) 0] ne {}} {
1465 set viewdata($curview) \
1466 [list {} $rowidlist $rowoffsets $rowrangelist]
1469 catch {unset matchinglines}
1470 catch {unset treediffs}
1475 set selectedhlview -1
1476 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1477 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1478 catch {unset hlview}
1479 .bar.view.hl entryconf 1 -state disabled
1481 if {![info exists viewdata($n)]} {
1482 set pending_select $selid
1488 set phase [lindex $v 0]
1489 set displayorder $vdisporder($n)
1490 set parentlist $vparentlist($n)
1491 set childlist $vchildlist($n)
1492 set commitlisted $vcmitlisted($n)
1493 set rowidlist [lindex $v 1]
1494 set rowoffsets [lindex $v 2]
1495 set rowrangelist [lindex $v 3]
1497 set numcommits [llength $displayorder]
1498 catch {unset idrowranges}
1500 unflatten idrowranges [lindex $v 4]
1501 unflatten idinlist [lindex $v 5]
1502 set rowlaidout [lindex $v 6]
1503 set rowoptim [lindex $v 7]
1504 set numcommits [lindex $v 8]
1505 set linesegends [lindex $v 9]
1508 catch {unset colormap}
1509 catch {unset rowtextx}
1511 set canvxmax [$canv cget -width]
1517 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1518 set row $commitrow($n,$selid)
1519 # try to get the selected row in the same position on the screen
1520 set ymax [lindex [$canv cget -scrollregion] 3]
1521 set ytop [expr {[yc $row] - $yscreen}]
1525 set yf [expr {$ytop * 1.0 / $ymax}]
1527 allcanvs yview moveto $yf
1531 if {$phase eq "getcommits"} {
1532 show_status "Reading commits..."
1534 if {[info exists commfd($n)]} {
1539 } elseif {$numcommits == 0} {
1540 show_status "No commits selected"
1544 proc addhighlight {n} {
1545 global hlview curview viewdata highlighted highlightedrows
1546 global selectedhlview
1548 if {[info exists hlview]} {
1552 set selectedhlview $n
1553 .bar.view.hl entryconf 1 -state normal
1554 set highlighted($n) 0
1555 set highlightedrows {}
1556 if {$n != $curview && ![info exists viewdata($n)]} {
1557 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1558 set vparentlist($n) {}
1559 set vchildlist($n) {}
1560 set vdisporder($n) {}
1561 set vcmitlisted($n) {}
1568 proc delhighlight {} {
1569 global hlview highlightedrows canv linehtag mainfont
1570 global selectedhlview selectedline
1572 if {![info exists hlview]} return
1574 set selectedhlview {}
1575 .bar.view.hl entryconf 1 -state disabled
1576 foreach l $highlightedrows {
1577 $canv itemconf $linehtag($l) -font $mainfont
1578 if {$l == $selectedline} {
1580 set t [eval $canv create rect [$canv bbox $linehtag($l)] \
1581 -outline {{}} -tags secsel \
1582 -fill [$canv cget -selectbackground]]
1588 proc highlightmore {} {
1589 global hlview highlighted commitidx highlightedrows linehtag mainfont
1590 global displayorder vdisporder curview canv commitrow selectedline
1592 set font [concat $mainfont bold]
1593 set max $commitidx($hlview)
1594 if {$hlview == $curview} {
1595 set disp $displayorder
1597 set disp $vdisporder($hlview)
1599 for {set i $highlighted($hlview)} {$i < $max} {incr i} {
1600 set id [lindex $disp $i]
1601 if {[info exists commitrow($curview,$id)]} {
1602 set row $commitrow($curview,$id)
1603 if {[info exists linehtag($row)]} {
1604 $canv itemconf $linehtag($row) -font $font
1605 lappend highlightedrows $row
1606 if {$row == $selectedline} {
1608 set t [eval $canv create rect \
1609 [$canv bbox $linehtag($row)] \
1610 -outline {{}} -tags secsel \
1611 -fill [$canv cget -selectbackground]]
1617 set highlighted($hlview) $max
1620 # Graph layout functions
1622 proc shortids {ids} {
1625 if {[llength $id] > 1} {
1626 lappend res [shortids $id]
1627 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1628 lappend res [string range $id 0 7]
1636 proc incrange {l x o} {
1639 set e [lindex $l $x]
1641 lset l $x [expr {$e + $o}]
1650 for {} {$n > 0} {incr n -1} {
1656 proc usedinrange {id l1 l2} {
1657 global children commitrow childlist curview
1659 if {[info exists commitrow($curview,$id)]} {
1660 set r $commitrow($curview,$id)
1661 if {$l1 <= $r && $r <= $l2} {
1662 return [expr {$r - $l1 + 1}]
1664 set kids [lindex $childlist $r]
1666 set kids $children($curview,$id)
1669 set r $commitrow($curview,$c)
1670 if {$l1 <= $r && $r <= $l2} {
1671 return [expr {$r - $l1 + 1}]
1677 proc sanity {row {full 0}} {
1678 global rowidlist rowoffsets
1681 set ids [lindex $rowidlist $row]
1684 if {$id eq {}} continue
1685 if {$col < [llength $ids] - 1 &&
1686 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1687 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1689 set o [lindex $rowoffsets $row $col]
1695 if {[lindex $rowidlist $y $x] != $id} {
1696 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1697 puts " id=[shortids $id] check started at row $row"
1698 for {set i $row} {$i >= $y} {incr i -1} {
1699 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1704 set o [lindex $rowoffsets $y $x]
1709 proc makeuparrow {oid x y z} {
1710 global rowidlist rowoffsets uparrowlen idrowranges
1712 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1715 set off0 [lindex $rowoffsets $y]
1716 for {set x0 $x} {1} {incr x0} {
1717 if {$x0 >= [llength $off0]} {
1718 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1721 set z [lindex $off0 $x0]
1727 set z [expr {$x0 - $x}]
1728 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1729 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1731 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1732 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1733 lappend idrowranges($oid) $y
1736 proc initlayout {} {
1737 global rowidlist rowoffsets displayorder commitlisted
1738 global rowlaidout rowoptim
1739 global idinlist rowchk rowrangelist idrowranges
1740 global numcommits canvxmax canv
1742 global parentlist childlist children
1743 global colormap rowtextx
1755 catch {unset idinlist}
1756 catch {unset rowchk}
1759 set canvxmax [$canv cget -width]
1760 catch {unset colormap}
1761 catch {unset rowtextx}
1762 catch {unset idrowranges}
1766 proc setcanvscroll {} {
1767 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1769 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1770 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1771 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1772 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1775 proc visiblerows {} {
1776 global canv numcommits linespc
1778 set ymax [lindex [$canv cget -scrollregion] 3]
1779 if {$ymax eq {} || $ymax == 0} return
1781 set y0 [expr {int([lindex $f 0] * $ymax)}]
1782 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1786 set y1 [expr {int([lindex $f 1] * $ymax)}]
1787 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1788 if {$r1 >= $numcommits} {
1789 set r1 [expr {$numcommits - 1}]
1791 return [list $r0 $r1]
1794 proc layoutmore {} {
1795 global rowlaidout rowoptim commitidx numcommits optim_delay
1796 global uparrowlen curview
1799 set rowlaidout [layoutrows $row $commitidx($curview) 0]
1800 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1801 if {$orow > $rowoptim} {
1802 optimize_rows $rowoptim 0 $orow
1805 set canshow [expr {$rowoptim - $optim_delay}]
1806 if {$canshow > $numcommits} {
1811 proc showstuff {canshow} {
1812 global numcommits commitrow pending_select selectedline
1813 global linesegends idrowranges idrangedrawn curview
1815 if {$numcommits == 0} {
1817 set phase "incrdraw"
1821 set numcommits $canshow
1823 set rows [visiblerows]
1824 set r0 [lindex $rows 0]
1825 set r1 [lindex $rows 1]
1827 for {set r $row} {$r < $canshow} {incr r} {
1828 foreach id [lindex $linesegends [expr {$r+1}]] {
1830 foreach {s e} [rowranges $id] {
1832 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1833 && ![info exists idrangedrawn($id,$i)]} {
1835 set idrangedrawn($id,$i) 1
1840 if {$canshow > $r1} {
1843 while {$row < $canshow} {
1847 if {[info exists pending_select] &&
1848 [info exists commitrow($curview,$pending_select)] &&
1849 $commitrow($curview,$pending_select) < $numcommits} {
1850 selectline $commitrow($curview,$pending_select) 1
1852 if {![info exists selectedline] && ![info exists pending_select]} {
1857 proc layoutrows {row endrow last} {
1858 global rowidlist rowoffsets displayorder
1859 global uparrowlen downarrowlen maxwidth mingaplen
1860 global childlist parentlist
1861 global idrowranges linesegends
1862 global commitidx curview
1863 global idinlist rowchk rowrangelist
1865 set idlist [lindex $rowidlist $row]
1866 set offs [lindex $rowoffsets $row]
1867 while {$row < $endrow} {
1868 set id [lindex $displayorder $row]
1871 foreach p [lindex $parentlist $row] {
1872 if {![info exists idinlist($p)]} {
1874 } elseif {!$idinlist($p)} {
1879 set nev [expr {[llength $idlist] + [llength $newolds]
1880 + [llength $oldolds] - $maxwidth + 1}]
1883 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
1884 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1885 set i [lindex $idlist $x]
1886 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1887 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1888 [expr {$row + $uparrowlen + $mingaplen}]]
1890 set idlist [lreplace $idlist $x $x]
1891 set offs [lreplace $offs $x $x]
1892 set offs [incrange $offs $x 1]
1894 set rm1 [expr {$row - 1}]
1896 lappend idrowranges($i) $rm1
1897 if {[incr nev -1] <= 0} break
1900 set rowchk($id) [expr {$row + $r}]
1903 lset rowidlist $row $idlist
1904 lset rowoffsets $row $offs
1906 lappend linesegends $lse
1907 set col [lsearch -exact $idlist $id]
1909 set col [llength $idlist]
1911 lset rowidlist $row $idlist
1913 if {[lindex $childlist $row] ne {}} {
1914 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1918 lset rowoffsets $row $offs
1920 makeuparrow $id $col $row $z
1926 if {[info exists idrowranges($id)]} {
1927 set ranges $idrowranges($id)
1929 unset idrowranges($id)
1931 lappend rowrangelist $ranges
1933 set offs [ntimes [llength $idlist] 0]
1934 set l [llength $newolds]
1935 set idlist [eval lreplace \$idlist $col $col $newolds]
1938 set offs [lrange $offs 0 [expr {$col - 1}]]
1939 foreach x $newolds {
1944 set tmp [expr {[llength $idlist] - [llength $offs]}]
1946 set offs [concat $offs [ntimes $tmp $o]]
1951 foreach i $newolds {
1953 set idrowranges($i) $row
1956 foreach oid $oldolds {
1957 set idinlist($oid) 1
1958 set idlist [linsert $idlist $col $oid]
1959 set offs [linsert $offs $col $o]
1960 makeuparrow $oid $col $row $o
1963 lappend rowidlist $idlist
1964 lappend rowoffsets $offs
1969 proc addextraid {id row} {
1970 global displayorder commitrow commitinfo
1971 global commitidx commitlisted
1972 global parentlist childlist children curview
1974 incr commitidx($curview)
1975 lappend displayorder $id
1976 lappend commitlisted 0
1977 lappend parentlist {}
1978 set commitrow($curview,$id) $row
1980 if {![info exists commitinfo($id)]} {
1981 set commitinfo($id) {"No commit information available"}
1983 if {![info exists children($curview,$id)]} {
1984 set children($curview,$id) {}
1986 lappend childlist $children($curview,$id)
1989 proc layouttail {} {
1990 global rowidlist rowoffsets idinlist commitidx curview
1991 global idrowranges rowrangelist
1993 set row $commitidx($curview)
1994 set idlist [lindex $rowidlist $row]
1995 while {$idlist ne {}} {
1996 set col [expr {[llength $idlist] - 1}]
1997 set id [lindex $idlist $col]
2000 lappend idrowranges($id) $row
2001 lappend rowrangelist $idrowranges($id)
2002 unset idrowranges($id)
2004 set offs [ntimes $col 0]
2005 set idlist [lreplace $idlist $col $col]
2006 lappend rowidlist $idlist
2007 lappend rowoffsets $offs
2010 foreach id [array names idinlist] {
2012 lset rowidlist $row [list $id]
2013 lset rowoffsets $row 0
2014 makeuparrow $id 0 $row 0
2015 lappend idrowranges($id) $row
2016 lappend rowrangelist $idrowranges($id)
2017 unset idrowranges($id)
2019 lappend rowidlist {}
2020 lappend rowoffsets {}
2024 proc insert_pad {row col npad} {
2025 global rowidlist rowoffsets
2027 set pad [ntimes $npad {}]
2028 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2029 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2030 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2033 proc optimize_rows {row col endrow} {
2034 global rowidlist rowoffsets idrowranges displayorder
2036 for {} {$row < $endrow} {incr row} {
2037 set idlist [lindex $rowidlist $row]
2038 set offs [lindex $rowoffsets $row]
2040 for {} {$col < [llength $offs]} {incr col} {
2041 if {[lindex $idlist $col] eq {}} {
2045 set z [lindex $offs $col]
2046 if {$z eq {}} continue
2048 set x0 [expr {$col + $z}]
2049 set y0 [expr {$row - 1}]
2050 set z0 [lindex $rowoffsets $y0 $x0]
2052 set id [lindex $idlist $col]
2053 set ranges [rowranges $id]
2054 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2058 if {$z < -1 || ($z < 0 && $isarrow)} {
2059 set npad [expr {-1 - $z + $isarrow}]
2060 set offs [incrange $offs $col $npad]
2061 insert_pad $y0 $x0 $npad
2063 optimize_rows $y0 $x0 $row
2065 set z [lindex $offs $col]
2066 set x0 [expr {$col + $z}]
2067 set z0 [lindex $rowoffsets $y0 $x0]
2068 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2069 set npad [expr {$z - 1 + $isarrow}]
2070 set y1 [expr {$row + 1}]
2071 set offs2 [lindex $rowoffsets $y1]
2075 if {$z eq {} || $x1 + $z < $col} continue
2076 if {$x1 + $z > $col} {
2079 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2082 set pad [ntimes $npad {}]
2083 set idlist [eval linsert \$idlist $col $pad]
2084 set tmp [eval linsert \$offs $col $pad]
2086 set offs [incrange $tmp $col [expr {-$npad}]]
2087 set z [lindex $offs $col]
2090 if {$z0 eq {} && !$isarrow} {
2091 # this line links to its first child on row $row-2
2092 set rm2 [expr {$row - 2}]
2093 set id [lindex $displayorder $rm2]
2094 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2096 set z0 [expr {$xc - $x0}]
2099 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2100 insert_pad $y0 $x0 1
2101 set offs [incrange $offs $col 1]
2102 optimize_rows $y0 [expr {$x0 + 1}] $row
2107 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2108 set o [lindex $offs $col]
2110 # check if this is the link to the first child
2111 set id [lindex $idlist $col]
2112 set ranges [rowranges $id]
2113 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2114 # it is, work out offset to child
2115 set y0 [expr {$row - 1}]
2116 set id [lindex $displayorder $y0]
2117 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2119 set o [expr {$x0 - $col}]
2123 if {$o eq {} || $o <= 0} break
2125 if {$o ne {} && [incr col] < [llength $idlist]} {
2126 set y1 [expr {$row + 1}]
2127 set offs2 [lindex $rowoffsets $y1]
2131 if {$z eq {} || $x1 + $z < $col} continue
2132 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2135 set idlist [linsert $idlist $col {}]
2136 set tmp [linsert $offs $col {}]
2138 set offs [incrange $tmp $col -1]
2141 lset rowidlist $row $idlist
2142 lset rowoffsets $row $offs
2148 global canvx0 linespc
2149 return [expr {$canvx0 + $col * $linespc}]
2153 global canvy0 linespc
2154 return [expr {$canvy0 + $row * $linespc}]
2157 proc linewidth {id} {
2158 global thickerline lthickness
2161 if {[info exists thickerline] && $id eq $thickerline} {
2162 set wid [expr {2 * $lthickness}]
2167 proc rowranges {id} {
2168 global phase idrowranges commitrow rowlaidout rowrangelist curview
2172 ([info exists commitrow($curview,$id)]
2173 && $commitrow($curview,$id) < $rowlaidout)} {
2174 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2175 } elseif {[info exists idrowranges($id)]} {
2176 set ranges $idrowranges($id)
2181 proc drawlineseg {id i} {
2182 global rowoffsets rowidlist
2184 global canv colormap linespc
2185 global numcommits commitrow curview
2187 set ranges [rowranges $id]
2189 if {[info exists commitrow($curview,$id)]
2190 && $commitrow($curview,$id) < $numcommits} {
2191 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2195 set startrow [lindex $ranges [expr {2 * $i}]]
2196 set row [lindex $ranges [expr {2 * $i + 1}]]
2197 if {$startrow == $row} return
2200 set col [lsearch -exact [lindex $rowidlist $row] $id]
2202 puts "oops: drawline: id $id not on row $row"
2208 set o [lindex $rowoffsets $row $col]
2211 # changing direction
2212 set x [xc $row $col]
2214 lappend coords $x $y
2220 set x [xc $row $col]
2222 lappend coords $x $y
2224 # draw the link to the first child as part of this line
2226 set child [lindex $displayorder $row]
2227 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2229 set x [xc $row $ccol]
2231 if {$ccol < $col - 1} {
2232 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2233 } elseif {$ccol > $col + 1} {
2234 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2236 lappend coords $x $y
2239 if {[llength $coords] < 4} return
2241 # This line has an arrow at the lower end: check if the arrow is
2242 # on a diagonal segment, and if so, work around the Tk 8.4
2243 # refusal to draw arrows on diagonal lines.
2244 set x0 [lindex $coords 0]
2245 set x1 [lindex $coords 2]
2247 set y0 [lindex $coords 1]
2248 set y1 [lindex $coords 3]
2249 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2250 # we have a nearby vertical segment, just trim off the diag bit
2251 set coords [lrange $coords 2 end]
2253 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2254 set xi [expr {$x0 - $slope * $linespc / 2}]
2255 set yi [expr {$y0 - $linespc / 2}]
2256 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2260 set arrow [expr {2 * ($i > 0) + $downarrow}]
2261 set arrow [lindex {none first last both} $arrow]
2262 set t [$canv create line $coords -width [linewidth $id] \
2263 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2268 proc drawparentlinks {id row col olds} {
2269 global rowidlist canv colormap
2271 set row2 [expr {$row + 1}]
2272 set x [xc $row $col]
2275 set ids [lindex $rowidlist $row2]
2276 # rmx = right-most X coord used
2279 set i [lsearch -exact $ids $p]
2281 puts "oops, parent $p of $id not in list"
2284 set x2 [xc $row2 $i]
2288 set ranges [rowranges $p]
2289 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2290 && $row2 < [lindex $ranges 1]} {
2291 # drawlineseg will do this one for us
2295 # should handle duplicated parents here...
2296 set coords [list $x $y]
2297 if {$i < $col - 1} {
2298 lappend coords [xc $row [expr {$i + 1}]] $y
2299 } elseif {$i > $col + 1} {
2300 lappend coords [xc $row [expr {$i - 1}]] $y
2302 lappend coords $x2 $y2
2303 set t [$canv create line $coords -width [linewidth $p] \
2304 -fill $colormap($p) -tags lines.$p]
2311 proc drawlines {id} {
2312 global colormap canv
2314 global children iddrawn commitrow rowidlist curview
2316 $canv delete lines.$id
2317 set nr [expr {[llength [rowranges $id]] / 2}]
2318 for {set i 0} {$i < $nr} {incr i} {
2319 if {[info exists idrangedrawn($id,$i)]} {
2323 foreach child $children($curview,$id) {
2324 if {[info exists iddrawn($child)]} {
2325 set row $commitrow($curview,$child)
2326 set col [lsearch -exact [lindex $rowidlist $row] $child]
2328 drawparentlinks $child $row $col [list $id]
2334 proc drawcmittext {id row col rmx} {
2335 global linespc canv canv2 canv3 canvy0
2336 global commitlisted commitinfo rowidlist
2337 global rowtextx idpos idtags idheads idotherrefs
2338 global linehtag linentag linedtag
2339 global mainfont canvxmax
2340 global hlview commitrow highlightedrows
2342 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2343 set x [xc $row $col]
2345 set orad [expr {$linespc / 3}]
2346 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2347 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2348 -fill $ofill -outline black -width 1]
2350 $canv bind $t <1> {selcanvline {} %x %y}
2351 set xt [xc $row [llength [lindex $rowidlist $row]]]
2355 set rowtextx($row) $xt
2356 set idpos($id) [list $x $xt $y]
2357 if {[info exists idtags($id)] || [info exists idheads($id)]
2358 || [info exists idotherrefs($id)]} {
2359 set xt [drawtags $id $x $xt $y]
2361 set headline [lindex $commitinfo($id) 0]
2362 set name [lindex $commitinfo($id) 1]
2363 set date [lindex $commitinfo($id) 2]
2364 set date [formatdate $date]
2366 if {[info exists hlview] && [info exists commitrow($hlview,$id)]} {
2368 lappend highlightedrows $row
2370 set linehtag($row) [$canv create text $xt $y -anchor w \
2371 -text $headline -font $font]
2372 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2373 set linentag($row) [$canv2 create text 3 $y -anchor w \
2374 -text $name -font $mainfont]
2375 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2376 -text $date -font $mainfont]
2377 set xr [expr {$xt + [font measure $mainfont $headline]}]
2378 if {$xr > $canvxmax} {
2384 proc drawcmitrow {row} {
2385 global displayorder rowidlist
2386 global idrangedrawn iddrawn
2387 global commitinfo parentlist numcommits
2389 if {$row >= $numcommits} return
2390 foreach id [lindex $rowidlist $row] {
2391 if {$id eq {}} continue
2393 foreach {s e} [rowranges $id] {
2395 if {$row < $s} continue
2398 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2400 set idrangedrawn($id,$i) 1
2407 set id [lindex $displayorder $row]
2408 if {[info exists iddrawn($id)]} return
2409 set col [lsearch -exact [lindex $rowidlist $row] $id]
2411 puts "oops, row $row id $id not in list"
2414 if {![info exists commitinfo($id)]} {
2418 set olds [lindex $parentlist $row]
2420 set rmx [drawparentlinks $id $row $col $olds]
2424 drawcmittext $id $row $col $rmx
2428 proc drawfrac {f0 f1} {
2429 global numcommits canv
2432 set ymax [lindex [$canv cget -scrollregion] 3]
2433 if {$ymax eq {} || $ymax == 0} return
2434 set y0 [expr {int($f0 * $ymax)}]
2435 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2439 set y1 [expr {int($f1 * $ymax)}]
2440 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2441 if {$endrow >= $numcommits} {
2442 set endrow [expr {$numcommits - 1}]
2444 for {} {$row <= $endrow} {incr row} {
2449 proc drawvisible {} {
2451 eval drawfrac [$canv yview]
2454 proc clear_display {} {
2455 global iddrawn idrangedrawn
2458 catch {unset iddrawn}
2459 catch {unset idrangedrawn}
2462 proc findcrossings {id} {
2463 global rowidlist parentlist numcommits rowoffsets displayorder
2467 foreach {s e} [rowranges $id] {
2468 if {$e >= $numcommits} {
2469 set e [expr {$numcommits - 1}]
2471 if {$e <= $s} continue
2472 set x [lsearch -exact [lindex $rowidlist $e] $id]
2474 puts "findcrossings: oops, no [shortids $id] in row $e"
2477 for {set row $e} {[incr row -1] >= $s} {} {
2478 set olds [lindex $parentlist $row]
2479 set kid [lindex $displayorder $row]
2480 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2481 if {$kidx < 0} continue
2482 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2484 set px [lsearch -exact $nextrow $p]
2485 if {$px < 0} continue
2486 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2487 if {[lsearch -exact $ccross $p] >= 0} continue
2488 if {$x == $px + ($kidx < $px? -1: 1)} {
2490 } elseif {[lsearch -exact $cross $p] < 0} {
2495 set inc [lindex $rowoffsets $row $x]
2496 if {$inc eq {}} break
2500 return [concat $ccross {{}} $cross]
2503 proc assigncolor {id} {
2504 global colormap colors nextcolor
2505 global commitrow parentlist children children curview
2507 if {[info exists colormap($id)]} return
2508 set ncolors [llength $colors]
2509 if {[info exists children($curview,$id)]} {
2510 set kids $children($curview,$id)
2514 if {[llength $kids] == 1} {
2515 set child [lindex $kids 0]
2516 if {[info exists colormap($child)]
2517 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2518 set colormap($id) $colormap($child)
2524 foreach x [findcrossings $id] {
2526 # delimiter between corner crossings and other crossings
2527 if {[llength $badcolors] >= $ncolors - 1} break
2528 set origbad $badcolors
2530 if {[info exists colormap($x)]
2531 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2532 lappend badcolors $colormap($x)
2535 if {[llength $badcolors] >= $ncolors} {
2536 set badcolors $origbad
2538 set origbad $badcolors
2539 if {[llength $badcolors] < $ncolors - 1} {
2540 foreach child $kids {
2541 if {[info exists colormap($child)]
2542 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2543 lappend badcolors $colormap($child)
2545 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2546 if {[info exists colormap($p)]
2547 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2548 lappend badcolors $colormap($p)
2552 if {[llength $badcolors] >= $ncolors} {
2553 set badcolors $origbad
2556 for {set i 0} {$i <= $ncolors} {incr i} {
2557 set c [lindex $colors $nextcolor]
2558 if {[incr nextcolor] >= $ncolors} {
2561 if {[lsearch -exact $badcolors $c]} break
2563 set colormap($id) $c
2566 proc bindline {t id} {
2569 $canv bind $t <Enter> "lineenter %x %y $id"
2570 $canv bind $t <Motion> "linemotion %x %y $id"
2571 $canv bind $t <Leave> "lineleave $id"
2572 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2575 proc drawtags {id x xt y1} {
2576 global idtags idheads idotherrefs
2577 global linespc lthickness
2578 global canv mainfont commitrow rowtextx curview
2583 if {[info exists idtags($id)]} {
2584 set marks $idtags($id)
2585 set ntags [llength $marks]
2587 if {[info exists idheads($id)]} {
2588 set marks [concat $marks $idheads($id)]
2589 set nheads [llength $idheads($id)]
2591 if {[info exists idotherrefs($id)]} {
2592 set marks [concat $marks $idotherrefs($id)]
2598 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2599 set yt [expr {$y1 - 0.5 * $linespc}]
2600 set yb [expr {$yt + $linespc - 1}]
2603 foreach tag $marks {
2604 set wid [font measure $mainfont $tag]
2607 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2609 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2610 -width $lthickness -fill black -tags tag.$id]
2612 foreach tag $marks x $xvals wid $wvals {
2613 set xl [expr {$x + $delta}]
2614 set xr [expr {$x + $delta + $wid + $lthickness}]
2615 if {[incr ntags -1] >= 0} {
2617 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2618 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2619 -width 1 -outline black -fill yellow -tags tag.$id]
2620 $canv bind $t <1> [list showtag $tag 1]
2621 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2623 # draw a head or other ref
2624 if {[incr nheads -1] >= 0} {
2629 set xl [expr {$xl - $delta/2}]
2630 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2631 -width 1 -outline black -fill $col -tags tag.$id
2632 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2633 set rwid [font measure $mainfont $remoteprefix]
2634 set xi [expr {$x + 1}]
2635 set yti [expr {$yt + 1}]
2636 set xri [expr {$x + $rwid}]
2637 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2638 -width 0 -fill "#ffddaa" -tags tag.$id
2641 set t [$canv create text $xl $y1 -anchor w -text $tag \
2642 -font $mainfont -tags tag.$id]
2644 $canv bind $t <1> [list showtag $tag 1]
2650 proc xcoord {i level ln} {
2651 global canvx0 xspc1 xspc2
2653 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2654 if {$i > 0 && $i == $level} {
2655 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2656 } elseif {$i > $level} {
2657 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2662 proc show_status {msg} {
2663 global canv mainfont
2666 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2669 proc finishcommits {} {
2670 global commitidx phase curview
2671 global canv mainfont ctext maincursor textcursor
2672 global findinprogress pending_select
2674 if {$commitidx($curview) > 0} {
2677 show_status "No commits selected"
2680 catch {unset pending_select}
2683 # Don't change the text pane cursor if it is currently the hand cursor,
2684 # showing that we are over a sha1 ID link.
2685 proc settextcursor {c} {
2686 global ctext curtextcursor
2688 if {[$ctext cget -cursor] == $curtextcursor} {
2689 $ctext config -cursor $c
2691 set curtextcursor $c
2694 proc nowbusy {what} {
2697 if {[array names isbusy] eq {}} {
2698 . config -cursor watch
2704 proc notbusy {what} {
2705 global isbusy maincursor textcursor
2707 catch {unset isbusy($what)}
2708 if {[array names isbusy] eq {}} {
2709 . config -cursor $maincursor
2710 settextcursor $textcursor
2717 global canvy0 numcommits linespc
2718 global rowlaidout commitidx curview
2719 global pending_select
2722 layoutrows $rowlaidout $commitidx($curview) 1
2724 optimize_rows $row 0 $commitidx($curview)
2725 showstuff $commitidx($curview)
2726 if {[info exists pending_select]} {
2730 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2731 #puts "overall $drawmsecs ms for $numcommits commits"
2734 proc findmatches {f} {
2735 global findtype foundstring foundstrlen
2736 if {$findtype == "Regexp"} {
2737 set matches [regexp -indices -all -inline $foundstring $f]
2739 if {$findtype == "IgnCase"} {
2740 set str [string tolower $f]
2746 while {[set j [string first $foundstring $str $i]] >= 0} {
2747 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2748 set i [expr {$j + $foundstrlen}]
2755 global findtype findloc findstring markedmatches commitinfo
2756 global numcommits displayorder linehtag linentag linedtag
2757 global mainfont canv canv2 canv3 selectedline
2758 global matchinglines foundstring foundstrlen matchstring
2764 set matchinglines {}
2765 if {$findloc == "Pickaxe"} {
2769 if {$findtype == "IgnCase"} {
2770 set foundstring [string tolower $findstring]
2772 set foundstring $findstring
2774 set foundstrlen [string length $findstring]
2775 if {$foundstrlen == 0} return
2776 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2777 set matchstring "*$matchstring*"
2778 if {$findloc == "Files"} {
2782 if {![info exists selectedline]} {
2785 set oldsel $selectedline
2788 set fldtypes {Headline Author Date Committer CDate Comment}
2790 foreach id $displayorder {
2791 set d $commitdata($id)
2793 if {$findtype == "Regexp"} {
2794 set doesmatch [regexp $foundstring $d]
2795 } elseif {$findtype == "IgnCase"} {
2796 set doesmatch [string match -nocase $matchstring $d]
2798 set doesmatch [string match $matchstring $d]
2800 if {!$doesmatch} continue
2801 if {![info exists commitinfo($id)]} {
2804 set info $commitinfo($id)
2806 foreach f $info ty $fldtypes {
2807 if {$findloc != "All fields" && $findloc != $ty} {
2810 set matches [findmatches $f]
2811 if {$matches == {}} continue
2813 if {$ty == "Headline"} {
2815 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2816 } elseif {$ty == "Author"} {
2818 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
2819 } elseif {$ty == "Date"} {
2821 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2825 lappend matchinglines $l
2826 if {!$didsel && $l > $oldsel} {
2832 if {$matchinglines == {}} {
2834 } elseif {!$didsel} {
2835 findselectline [lindex $matchinglines 0]
2839 proc findselectline {l} {
2840 global findloc commentend ctext
2842 if {$findloc == "All fields" || $findloc == "Comments"} {
2843 # highlight the matches in the comments
2844 set f [$ctext get 1.0 $commentend]
2845 set matches [findmatches $f]
2846 foreach match $matches {
2847 set start [lindex $match 0]
2848 set end [expr {[lindex $match 1] + 1}]
2849 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2854 proc findnext {restart} {
2855 global matchinglines selectedline
2856 if {![info exists matchinglines]} {
2862 if {![info exists selectedline]} return
2863 foreach l $matchinglines {
2864 if {$l > $selectedline} {
2873 global matchinglines selectedline
2874 if {![info exists matchinglines]} {
2878 if {![info exists selectedline]} return
2880 foreach l $matchinglines {
2881 if {$l >= $selectedline} break
2885 findselectline $prev
2891 proc findlocchange {name ix op} {
2892 global findloc findtype findtypemenu
2893 if {$findloc == "Pickaxe"} {
2899 $findtypemenu entryconf 1 -state $state
2900 $findtypemenu entryconf 2 -state $state
2903 proc stopfindproc {{done 0}} {
2904 global findprocpid findprocfile findids
2905 global ctext findoldcursor phase maincursor textcursor
2906 global findinprogress
2908 catch {unset findids}
2909 if {[info exists findprocpid]} {
2911 catch {exec kill $findprocpid}
2913 catch {close $findprocfile}
2916 catch {unset findinprogress}
2920 proc findpatches {} {
2921 global findstring selectedline numcommits
2922 global findprocpid findprocfile
2923 global finddidsel ctext displayorder findinprogress
2924 global findinsertpos
2926 if {$numcommits == 0} return
2928 # make a list of all the ids to search, starting at the one
2929 # after the selected line (if any)
2930 if {[info exists selectedline]} {
2936 for {set i 0} {$i < $numcommits} {incr i} {
2937 if {[incr l] >= $numcommits} {
2940 append inputids [lindex $displayorder $l] "\n"
2944 set f [open [list | git diff-tree --stdin -s -r -S$findstring \
2947 error_popup "Error starting search process: $err"
2951 set findinsertpos end
2953 set findprocpid [pid $f]
2954 fconfigure $f -blocking 0
2955 fileevent $f readable readfindproc
2958 set findinprogress 1
2961 proc readfindproc {} {
2962 global findprocfile finddidsel
2963 global commitrow matchinglines findinsertpos curview
2965 set n [gets $findprocfile line]
2967 if {[eof $findprocfile]} {
2975 if {![regexp {^[0-9a-f]{40}} $line id]} {
2976 error_popup "Can't parse git diff-tree output: $line"
2980 if {![info exists commitrow($curview,$id)]} {
2981 puts stderr "spurious id: $id"
2984 set l $commitrow($curview,$id)
2988 proc insertmatch {l id} {
2989 global matchinglines findinsertpos finddidsel
2991 if {$findinsertpos == "end"} {
2992 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2993 set matchinglines [linsert $matchinglines 0 $l]
2996 lappend matchinglines $l
2999 set matchinglines [linsert $matchinglines $findinsertpos $l]
3010 global selectedline numcommits displayorder ctext
3011 global ffileline finddidsel parentlist
3012 global findinprogress findstartline findinsertpos
3013 global treediffs fdiffid fdiffsneeded fdiffpos
3014 global findmergefiles
3016 if {$numcommits == 0} return
3018 if {[info exists selectedline]} {
3019 set l [expr {$selectedline + 1}]
3024 set findstartline $l
3028 set id [lindex $displayorder $l]
3029 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3030 if {![info exists treediffs($id)]} {
3031 append diffsneeded "$id\n"
3032 lappend fdiffsneeded $id
3035 if {[incr l] >= $numcommits} {
3038 if {$l == $findstartline} break
3041 # start off a git diff-tree process if needed
3042 if {$diffsneeded ne {}} {
3044 set df [open [list | git diff-tree -r --stdin << $diffsneeded] r]
3046 error_popup "Error starting search process: $err"
3049 catch {unset fdiffid}
3051 fconfigure $df -blocking 0
3052 fileevent $df readable [list readfilediffs $df]
3056 set findinsertpos end
3057 set id [lindex $displayorder $l]
3059 set findinprogress 1
3064 proc readfilediffs {df} {
3065 global findid fdiffid fdiffs
3067 set n [gets $df line]
3071 if {[catch {close $df} err]} {
3074 error_popup "Error in git diff-tree: $err"
3075 } elseif {[info exists findid]} {
3079 error_popup "Couldn't find diffs for $id"
3084 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3085 # start of a new string of diffs
3089 } elseif {[string match ":*" $line]} {
3090 lappend fdiffs [lindex $line 5]
3094 proc donefilediff {} {
3095 global fdiffid fdiffs treediffs findid
3096 global fdiffsneeded fdiffpos
3098 if {[info exists fdiffid]} {
3099 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3100 && $fdiffpos < [llength $fdiffsneeded]} {
3101 # git diff-tree doesn't output anything for a commit
3102 # which doesn't change anything
3103 set nullid [lindex $fdiffsneeded $fdiffpos]
3104 set treediffs($nullid) {}
3105 if {[info exists findid] && $nullid eq $findid} {
3113 if {![info exists treediffs($fdiffid)]} {
3114 set treediffs($fdiffid) $fdiffs
3116 if {[info exists findid] && $fdiffid eq $findid} {
3124 global findid treediffs parentlist
3125 global ffileline findstartline finddidsel
3126 global displayorder numcommits matchinglines findinprogress
3127 global findmergefiles
3131 set id [lindex $displayorder $l]
3132 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3133 if {![info exists treediffs($id)]} {
3139 foreach f $treediffs($id) {
3140 set x [findmatches $f]
3150 if {[incr l] >= $numcommits} {
3153 if {$l == $findstartline} break
3161 # mark a commit as matching by putting a yellow background
3162 # behind the headline
3163 proc markheadline {l id} {
3164 global canv mainfont linehtag
3167 set bbox [$canv bbox $linehtag($l)]
3168 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3172 # mark the bits of a headline, author or date that match a find string
3173 proc markmatches {canv l str tag matches font} {
3174 set bbox [$canv bbox $tag]
3175 set x0 [lindex $bbox 0]
3176 set y0 [lindex $bbox 1]
3177 set y1 [lindex $bbox 3]
3178 foreach match $matches {
3179 set start [lindex $match 0]
3180 set end [lindex $match 1]
3181 if {$start > $end} continue
3182 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3183 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3184 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3185 [expr {$x0+$xlen+2}] $y1 \
3186 -outline {} -tags matches -fill yellow]
3191 proc unmarkmatches {} {
3192 global matchinglines findids
3193 allcanvs delete matches
3194 catch {unset matchinglines}
3195 catch {unset findids}
3198 proc selcanvline {w x y} {
3199 global canv canvy0 ctext linespc
3201 set ymax [lindex [$canv cget -scrollregion] 3]
3202 if {$ymax == {}} return
3203 set yfrac [lindex [$canv yview] 0]
3204 set y [expr {$y + $yfrac * $ymax}]
3205 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3210 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3216 proc commit_descriptor {p} {
3218 if {![info exists commitinfo($p)]} {
3222 if {[llength $commitinfo($p)] > 1} {
3223 set l [lindex $commitinfo($p) 0]
3228 # append some text to the ctext widget, and make any SHA1 ID
3229 # that we know about be a clickable link.
3230 proc appendwithlinks {text tags} {
3231 global ctext commitrow linknum curview
3233 set start [$ctext index "end - 1c"]
3234 $ctext insert end $text $tags
3235 $ctext insert end "\n"
3236 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3240 set linkid [string range $text $s $e]
3241 if {![info exists commitrow($curview,$linkid)]} continue
3243 $ctext tag add link "$start + $s c" "$start + $e c"
3244 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3245 $ctext tag bind link$linknum <1> \
3246 [list selectline $commitrow($curview,$linkid) 1]
3249 $ctext tag conf link -foreground blue -underline 1
3250 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3251 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3254 proc viewnextline {dir} {
3258 set ymax [lindex [$canv cget -scrollregion] 3]
3259 set wnow [$canv yview]
3260 set wtop [expr {[lindex $wnow 0] * $ymax}]
3261 set newtop [expr {$wtop + $dir * $linespc}]
3264 } elseif {$newtop > $ymax} {
3267 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3270 proc selectline {l isnew} {
3271 global canv canv2 canv3 ctext commitinfo selectedline
3272 global displayorder linehtag linentag linedtag
3273 global canvy0 linespc parentlist childlist
3274 global currentid sha1entry
3275 global commentend idtags linknum
3276 global mergemax numcommits pending_select
3279 catch {unset pending_select}
3282 if {$l < 0 || $l >= $numcommits} return
3283 set y [expr {$canvy0 + $l * $linespc}]
3284 set ymax [lindex [$canv cget -scrollregion] 3]
3285 set ytop [expr {$y - $linespc - 1}]
3286 set ybot [expr {$y + $linespc + 1}]
3287 set wnow [$canv yview]
3288 set wtop [expr {[lindex $wnow 0] * $ymax}]
3289 set wbot [expr {[lindex $wnow 1] * $ymax}]
3290 set wh [expr {$wbot - $wtop}]
3292 if {$ytop < $wtop} {
3293 if {$ybot < $wtop} {
3294 set newtop [expr {$y - $wh / 2.0}]
3297 if {$newtop > $wtop - $linespc} {
3298 set newtop [expr {$wtop - $linespc}]
3301 } elseif {$ybot > $wbot} {
3302 if {$ytop > $wbot} {
3303 set newtop [expr {$y - $wh / 2.0}]
3305 set newtop [expr {$ybot - $wh}]
3306 if {$newtop < $wtop + $linespc} {
3307 set newtop [expr {$wtop + $linespc}]
3311 if {$newtop != $wtop} {
3315 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3319 if {![info exists linehtag($l)]} return
3321 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3322 -tags secsel -fill [$canv cget -selectbackground]]
3324 $canv2 delete secsel
3325 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3326 -tags secsel -fill [$canv2 cget -selectbackground]]
3328 $canv3 delete secsel
3329 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3330 -tags secsel -fill [$canv3 cget -selectbackground]]
3334 addtohistory [list selectline $l 0]
3339 set id [lindex $displayorder $l]
3341 $sha1entry delete 0 end
3342 $sha1entry insert 0 $id
3343 $sha1entry selection from 0
3344 $sha1entry selection to end
3346 $ctext conf -state normal
3347 $ctext delete 0.0 end
3349 set info $commitinfo($id)
3350 set date [formatdate [lindex $info 2]]
3351 $ctext insert end "Author: [lindex $info 1] $date\n"
3352 set date [formatdate [lindex $info 4]]
3353 $ctext insert end "Committer: [lindex $info 3] $date\n"
3354 if {[info exists idtags($id)]} {
3355 $ctext insert end "Tags:"
3356 foreach tag $idtags($id) {
3357 $ctext insert end " $tag"
3359 $ctext insert end "\n"
3363 set olds [lindex $parentlist $l]
3364 if {[llength $olds] > 1} {
3367 if {$np >= $mergemax} {
3372 $ctext insert end "Parent: " $tag
3373 appendwithlinks [commit_descriptor $p] {}
3378 append headers "Parent: [commit_descriptor $p]\n"
3382 foreach c [lindex $childlist $l] {
3383 append headers "Child: [commit_descriptor $c]\n"
3386 # make anything that looks like a SHA1 ID be a clickable link
3387 appendwithlinks $headers {}
3388 appendwithlinks [lindex $info 5] {comment}
3390 $ctext tag delete Comments
3391 $ctext tag remove found 1.0 end
3392 $ctext conf -state disabled
3393 set commentend [$ctext index "end - 1c"]
3395 init_flist "Comments"
3396 if {$cmitmode eq "tree"} {
3398 } elseif {[llength $olds] <= 1} {
3405 proc selfirstline {} {
3410 proc sellastline {} {
3413 set l [expr {$numcommits - 1}]
3417 proc selnextline {dir} {
3419 if {![info exists selectedline]} return
3420 set l [expr {$selectedline + $dir}]
3425 proc selnextpage {dir} {
3426 global canv linespc selectedline numcommits
3428 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3432 allcanvs yview scroll [expr {$dir * $lpp}] units
3434 if {![info exists selectedline]} return
3435 set l [expr {$selectedline + $dir * $lpp}]
3438 } elseif {$l >= $numcommits} {
3439 set l [expr $numcommits - 1]
3445 proc unselectline {} {
3446 global selectedline currentid
3448 catch {unset selectedline}
3449 catch {unset currentid}
3450 allcanvs delete secsel
3453 proc reselectline {} {
3456 if {[info exists selectedline]} {
3457 selectline $selectedline 0
3461 proc addtohistory {cmd} {
3462 global history historyindex curview
3464 set elt [list $curview $cmd]
3465 if {$historyindex > 0
3466 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3470 if {$historyindex < [llength $history]} {
3471 set history [lreplace $history $historyindex end $elt]
3473 lappend history $elt
3476 if {$historyindex > 1} {
3477 .ctop.top.bar.leftbut conf -state normal
3479 .ctop.top.bar.leftbut conf -state disabled
3481 .ctop.top.bar.rightbut conf -state disabled
3487 set view [lindex $elt 0]
3488 set cmd [lindex $elt 1]
3489 if {$curview != $view} {
3496 global history historyindex
3498 if {$historyindex > 1} {
3499 incr historyindex -1
3500 godo [lindex $history [expr {$historyindex - 1}]]
3501 .ctop.top.bar.rightbut conf -state normal
3503 if {$historyindex <= 1} {
3504 .ctop.top.bar.leftbut conf -state disabled
3509 global history historyindex
3511 if {$historyindex < [llength $history]} {
3512 set cmd [lindex $history $historyindex]
3515 .ctop.top.bar.leftbut conf -state normal
3517 if {$historyindex >= [llength $history]} {
3518 .ctop.top.bar.rightbut conf -state disabled
3523 global treefilelist treeidlist diffids diffmergeid treepending
3526 catch {unset diffmergeid}
3527 if {![info exists treefilelist($id)]} {
3528 if {![info exists treepending]} {
3529 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3533 set treefilelist($id) {}
3534 set treeidlist($id) {}
3535 fconfigure $gtf -blocking 0
3536 fileevent $gtf readable [list gettreeline $gtf $id]
3543 proc gettreeline {gtf id} {
3544 global treefilelist treeidlist treepending cmitmode diffids
3546 while {[gets $gtf line] >= 0} {
3547 if {[lindex $line 1] ne "blob"} continue
3548 set sha1 [lindex $line 2]
3549 set fname [lindex $line 3]
3550 lappend treefilelist($id) $fname
3551 lappend treeidlist($id) $sha1
3553 if {![eof $gtf]} return
3556 if {$cmitmode ne "tree"} {
3557 if {![info exists diffmergeid]} {
3558 gettreediffs $diffids
3560 } elseif {$id ne $diffids} {
3568 global treefilelist treeidlist diffids
3569 global ctext commentend
3571 set i [lsearch -exact $treefilelist($diffids) $f]
3573 puts "oops, $f not in list for id $diffids"
3576 set blob [lindex $treeidlist($diffids) $i]
3577 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
3578 puts "oops, error reading blob $blob: $err"
3581 fconfigure $bf -blocking 0
3582 fileevent $bf readable [list getblobline $bf $diffids]
3583 $ctext config -state normal
3584 $ctext delete $commentend end
3585 $ctext insert end "\n"
3586 $ctext insert end "$f\n" filesep
3587 $ctext config -state disabled
3588 $ctext yview $commentend
3591 proc getblobline {bf id} {
3592 global diffids cmitmode ctext
3594 if {$id ne $diffids || $cmitmode ne "tree"} {
3598 $ctext config -state normal
3599 while {[gets $bf line] >= 0} {
3600 $ctext insert end "$line\n"
3603 # delete last newline
3604 $ctext delete "end - 2c" "end - 1c"
3607 $ctext config -state disabled
3610 proc mergediff {id l} {
3611 global diffmergeid diffopts mdifffd
3617 # this doesn't seem to actually affect anything...
3618 set env(GIT_DIFF_OPTS) $diffopts
3619 set cmd [concat | git diff-tree --no-commit-id --cc $id]
3620 if {[catch {set mdf [open $cmd r]} err]} {
3621 error_popup "Error getting merge diffs: $err"
3624 fconfigure $mdf -blocking 0
3625 set mdifffd($id) $mdf
3626 set np [llength [lindex $parentlist $l]]
3627 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3628 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3631 proc getmergediffline {mdf id np} {
3632 global diffmergeid ctext cflist nextupdate mergemax
3633 global difffilestart mdifffd
3635 set n [gets $mdf line]
3642 if {![info exists diffmergeid] || $id != $diffmergeid
3643 || $mdf != $mdifffd($id)} {
3646 $ctext conf -state normal
3647 if {[regexp {^diff --cc (.*)} $line match fname]} {
3648 # start of a new file
3649 $ctext insert end "\n"
3650 set here [$ctext index "end - 1c"]
3651 lappend difffilestart $here
3652 add_flist [list $fname]
3653 set l [expr {(78 - [string length $fname]) / 2}]
3654 set pad [string range "----------------------------------------" 1 $l]
3655 $ctext insert end "$pad $fname $pad\n" filesep
3656 } elseif {[regexp {^@@} $line]} {
3657 $ctext insert end "$line\n" hunksep
3658 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3661 # parse the prefix - one ' ', '-' or '+' for each parent
3666 for {set j 0} {$j < $np} {incr j} {
3667 set c [string range $line $j $j]
3670 } elseif {$c == "-"} {
3672 } elseif {$c == "+"} {
3681 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3682 # line doesn't appear in result, parents in $minuses have the line
3683 set num [lindex $minuses 0]
3684 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3685 # line appears in result, parents in $pluses don't have the line
3686 lappend tags mresult
3687 set num [lindex $spaces 0]
3690 if {$num >= $mergemax} {
3695 $ctext insert end "$line\n" $tags
3697 $ctext conf -state disabled
3698 if {[clock clicks -milliseconds] >= $nextupdate} {
3700 fileevent $mdf readable {}
3702 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3706 proc startdiff {ids} {
3707 global treediffs diffids treepending diffmergeid
3710 catch {unset diffmergeid}
3711 if {![info exists treediffs($ids)]} {
3712 if {![info exists treepending]} {
3720 proc addtocflist {ids} {
3721 global treediffs cflist
3722 add_flist $treediffs($ids)
3726 proc gettreediffs {ids} {
3727 global treediff treepending
3728 set treepending $ids
3731 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
3733 fconfigure $gdtf -blocking 0
3734 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3737 proc gettreediffline {gdtf ids} {
3738 global treediff treediffs treepending diffids diffmergeid
3741 set n [gets $gdtf line]
3743 if {![eof $gdtf]} return
3745 set treediffs($ids) $treediff
3747 if {$cmitmode eq "tree"} {
3749 } elseif {$ids != $diffids} {
3750 if {![info exists diffmergeid]} {
3751 gettreediffs $diffids
3758 set file [lindex $line 5]
3759 lappend treediff $file
3762 proc getblobdiffs {ids} {
3763 global diffopts blobdifffd diffids env curdifftag curtagstart
3764 global nextupdate diffinhdr treediffs
3766 set env(GIT_DIFF_OPTS) $diffopts
3767 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
3768 if {[catch {set bdf [open $cmd r]} err]} {
3769 puts "error getting diffs: $err"
3773 fconfigure $bdf -blocking 0
3774 set blobdifffd($ids) $bdf
3775 set curdifftag Comments
3777 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3778 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3781 proc setinlist {var i val} {
3784 while {[llength [set $var]] < $i} {
3787 if {[llength [set $var]] == $i} {
3794 proc getblobdiffline {bdf ids} {
3795 global diffids blobdifffd ctext curdifftag curtagstart
3796 global diffnexthead diffnextnote difffilestart
3797 global nextupdate diffinhdr treediffs
3799 set n [gets $bdf line]
3803 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3804 $ctext tag add $curdifftag $curtagstart end
3809 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3812 $ctext conf -state normal
3813 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3814 # start of a new file
3815 $ctext insert end "\n"
3816 $ctext tag add $curdifftag $curtagstart end
3817 set here [$ctext index "end - 1c"]
3818 set curtagstart $here
3820 set i [lsearch -exact $treediffs($ids) $fname]
3822 setinlist difffilestart $i $here
3824 if {$newname ne $fname} {
3825 set i [lsearch -exact $treediffs($ids) $newname]
3827 setinlist difffilestart $i $here
3830 set curdifftag "f:$fname"
3831 $ctext tag delete $curdifftag
3832 set l [expr {(78 - [string length $header]) / 2}]
3833 set pad [string range "----------------------------------------" 1 $l]
3834 $ctext insert end "$pad $header $pad\n" filesep
3836 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3838 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3840 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3841 $line match f1l f1c f2l f2c rest]} {
3842 $ctext insert end "$line\n" hunksep
3845 set x [string range $line 0 0]
3846 if {$x == "-" || $x == "+"} {
3847 set tag [expr {$x == "+"}]
3848 $ctext insert end "$line\n" d$tag
3849 } elseif {$x == " "} {
3850 $ctext insert end "$line\n"
3851 } elseif {$diffinhdr || $x == "\\"} {
3852 # e.g. "\ No newline at end of file"
3853 $ctext insert end "$line\n" filesep
3855 # Something else we don't recognize
3856 if {$curdifftag != "Comments"} {
3857 $ctext insert end "\n"
3858 $ctext tag add $curdifftag $curtagstart end
3859 set curtagstart [$ctext index "end - 1c"]
3860 set curdifftag Comments
3862 $ctext insert end "$line\n" filesep
3865 $ctext conf -state disabled
3866 if {[clock clicks -milliseconds] >= $nextupdate} {
3868 fileevent $bdf readable {}
3870 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3875 global difffilestart ctext
3876 set here [$ctext index @0,0]
3877 foreach loc $difffilestart {
3878 if {[$ctext compare $loc > $here]} {
3885 global linespc charspc canvx0 canvy0 mainfont
3886 global xspc1 xspc2 lthickness
3888 set linespc [font metrics $mainfont -linespace]
3889 set charspc [font measure $mainfont "m"]
3890 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3891 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3892 set lthickness [expr {int($linespc / 9) + 1}]
3893 set xspc1(0) $linespc
3901 set ymax [lindex [$canv cget -scrollregion] 3]
3902 if {$ymax eq {} || $ymax == 0} return
3903 set span [$canv yview]
3906 allcanvs yview moveto [lindex $span 0]
3908 if {[info exists selectedline]} {
3909 selectline $selectedline 0
3913 proc incrfont {inc} {
3914 global mainfont textfont ctext canv phase
3915 global stopped entries
3917 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3918 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3920 $ctext conf -font $textfont
3921 $ctext tag conf filesep -font [concat $textfont bold]
3922 foreach e $entries {
3923 $e conf -font $mainfont
3925 if {$phase eq "getcommits"} {
3926 $canv itemconf textitems -font $mainfont
3932 global sha1entry sha1string
3933 if {[string length $sha1string] == 40} {
3934 $sha1entry delete 0 end
3938 proc sha1change {n1 n2 op} {
3939 global sha1string currentid sha1but
3940 if {$sha1string == {}
3941 || ([info exists currentid] && $sha1string == $currentid)} {
3946 if {[$sha1but cget -state] == $state} return
3947 if {$state == "normal"} {
3948 $sha1but conf -state normal -relief raised -text "Goto: "
3950 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3954 proc gotocommit {} {
3955 global sha1string currentid commitrow tagids headids
3956 global displayorder numcommits curview
3958 if {$sha1string == {}
3959 || ([info exists currentid] && $sha1string == $currentid)} return
3960 if {[info exists tagids($sha1string)]} {
3961 set id $tagids($sha1string)
3962 } elseif {[info exists headids($sha1string)]} {
3963 set id $headids($sha1string)
3965 set id [string tolower $sha1string]
3966 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3968 foreach i $displayorder {
3969 if {[string match $id* $i]} {
3973 if {$matches ne {}} {
3974 if {[llength $matches] > 1} {
3975 error_popup "Short SHA1 id $id is ambiguous"
3978 set id [lindex $matches 0]
3982 if {[info exists commitrow($curview,$id)]} {
3983 selectline $commitrow($curview,$id) 1
3986 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3991 error_popup "$type $sha1string is not known"
3994 proc lineenter {x y id} {
3995 global hoverx hovery hoverid hovertimer
3996 global commitinfo canv
3998 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4002 if {[info exists hovertimer]} {
4003 after cancel $hovertimer
4005 set hovertimer [after 500 linehover]
4009 proc linemotion {x y id} {
4010 global hoverx hovery hoverid hovertimer
4012 if {[info exists hoverid] && $id == $hoverid} {
4015 if {[info exists hovertimer]} {
4016 after cancel $hovertimer
4018 set hovertimer [after 500 linehover]
4022 proc lineleave {id} {
4023 global hoverid hovertimer canv
4025 if {[info exists hoverid] && $id == $hoverid} {
4027 if {[info exists hovertimer]} {
4028 after cancel $hovertimer
4036 global hoverx hovery hoverid hovertimer
4037 global canv linespc lthickness
4038 global commitinfo mainfont
4040 set text [lindex $commitinfo($hoverid) 0]
4041 set ymax [lindex [$canv cget -scrollregion] 3]
4042 if {$ymax == {}} return
4043 set yfrac [lindex [$canv yview] 0]
4044 set x [expr {$hoverx + 2 * $linespc}]
4045 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4046 set x0 [expr {$x - 2 * $lthickness}]
4047 set y0 [expr {$y - 2 * $lthickness}]
4048 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4049 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4050 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4051 -fill \#ffff80 -outline black -width 1 -tags hover]
4053 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4057 proc clickisonarrow {id y} {
4060 set ranges [rowranges $id]
4061 set thresh [expr {2 * $lthickness + 6}]
4062 set n [expr {[llength $ranges] - 1}]
4063 for {set i 1} {$i < $n} {incr i} {
4064 set row [lindex $ranges $i]
4065 if {abs([yc $row] - $y) < $thresh} {
4072 proc arrowjump {id n y} {
4075 # 1 <-> 2, 3 <-> 4, etc...
4076 set n [expr {(($n - 1) ^ 1) + 1}]
4077 set row [lindex [rowranges $id] $n]
4079 set ymax [lindex [$canv cget -scrollregion] 3]
4080 if {$ymax eq {} || $ymax <= 0} return
4081 set view [$canv yview]
4082 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4083 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4087 allcanvs yview moveto $yfrac
4090 proc lineclick {x y id isnew} {
4091 global ctext commitinfo children canv thickerline curview
4093 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4098 # draw this line thicker than normal
4102 set ymax [lindex [$canv cget -scrollregion] 3]
4103 if {$ymax eq {}} return
4104 set yfrac [lindex [$canv yview] 0]
4105 set y [expr {$y + $yfrac * $ymax}]
4107 set dirn [clickisonarrow $id $y]
4109 arrowjump $id $dirn $y
4114 addtohistory [list lineclick $x $y $id 0]
4116 # fill the details pane with info about this line
4117 $ctext conf -state normal
4118 $ctext delete 0.0 end
4119 $ctext tag conf link -foreground blue -underline 1
4120 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4121 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4122 $ctext insert end "Parent:\t"
4123 $ctext insert end $id [list link link0]
4124 $ctext tag bind link0 <1> [list selbyid $id]
4125 set info $commitinfo($id)
4126 $ctext insert end "\n\t[lindex $info 0]\n"
4127 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4128 set date [formatdate [lindex $info 2]]
4129 $ctext insert end "\tDate:\t$date\n"
4130 set kids $children($curview,$id)
4132 $ctext insert end "\nChildren:"
4134 foreach child $kids {
4136 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4137 set info $commitinfo($child)
4138 $ctext insert end "\n\t"
4139 $ctext insert end $child [list link link$i]
4140 $ctext tag bind link$i <1> [list selbyid $child]
4141 $ctext insert end "\n\t[lindex $info 0]"
4142 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4143 set date [formatdate [lindex $info 2]]
4144 $ctext insert end "\n\tDate:\t$date\n"
4147 $ctext conf -state disabled
4151 proc normalline {} {
4153 if {[info exists thickerline]} {
4161 global commitrow curview
4162 if {[info exists commitrow($curview,$id)]} {
4163 selectline $commitrow($curview,$id) 1
4169 if {![info exists startmstime]} {
4170 set startmstime [clock clicks -milliseconds]
4172 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4175 proc rowmenu {x y id} {
4176 global rowctxmenu commitrow selectedline rowmenuid curview
4178 if {![info exists selectedline]
4179 || $commitrow($curview,$id) eq $selectedline} {
4184 $rowctxmenu entryconfigure 0 -state $state
4185 $rowctxmenu entryconfigure 1 -state $state
4186 $rowctxmenu entryconfigure 2 -state $state
4188 tk_popup $rowctxmenu $x $y
4191 proc diffvssel {dirn} {
4192 global rowmenuid selectedline displayorder
4194 if {![info exists selectedline]} return
4196 set oldid [lindex $displayorder $selectedline]
4197 set newid $rowmenuid
4199 set oldid $rowmenuid
4200 set newid [lindex $displayorder $selectedline]
4202 addtohistory [list doseldiff $oldid $newid]
4203 doseldiff $oldid $newid
4206 proc doseldiff {oldid newid} {
4210 $ctext conf -state normal
4211 $ctext delete 0.0 end
4213 $ctext insert end "From "
4214 $ctext tag conf link -foreground blue -underline 1
4215 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4216 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4217 $ctext tag bind link0 <1> [list selbyid $oldid]
4218 $ctext insert end $oldid [list link link0]
4219 $ctext insert end "\n "
4220 $ctext insert end [lindex $commitinfo($oldid) 0]
4221 $ctext insert end "\n\nTo "
4222 $ctext tag bind link1 <1> [list selbyid $newid]
4223 $ctext insert end $newid [list link link1]
4224 $ctext insert end "\n "
4225 $ctext insert end [lindex $commitinfo($newid) 0]
4226 $ctext insert end "\n"
4227 $ctext conf -state disabled
4228 $ctext tag delete Comments
4229 $ctext tag remove found 1.0 end
4230 startdiff [list $oldid $newid]
4234 global rowmenuid currentid commitinfo patchtop patchnum
4236 if {![info exists currentid]} return
4237 set oldid $currentid
4238 set oldhead [lindex $commitinfo($oldid) 0]
4239 set newid $rowmenuid
4240 set newhead [lindex $commitinfo($newid) 0]
4243 catch {destroy $top}
4245 label $top.title -text "Generate patch"
4246 grid $top.title - -pady 10
4247 label $top.from -text "From:"
4248 entry $top.fromsha1 -width 40 -relief flat
4249 $top.fromsha1 insert 0 $oldid
4250 $top.fromsha1 conf -state readonly
4251 grid $top.from $top.fromsha1 -sticky w
4252 entry $top.fromhead -width 60 -relief flat
4253 $top.fromhead insert 0 $oldhead
4254 $top.fromhead conf -state readonly
4255 grid x $top.fromhead -sticky w
4256 label $top.to -text "To:"
4257 entry $top.tosha1 -width 40 -relief flat
4258 $top.tosha1 insert 0 $newid
4259 $top.tosha1 conf -state readonly
4260 grid $top.to $top.tosha1 -sticky w
4261 entry $top.tohead -width 60 -relief flat
4262 $top.tohead insert 0 $newhead
4263 $top.tohead conf -state readonly
4264 grid x $top.tohead -sticky w
4265 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4266 grid $top.rev x -pady 10
4267 label $top.flab -text "Output file:"
4268 entry $top.fname -width 60
4269 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4271 grid $top.flab $top.fname -sticky w
4273 button $top.buts.gen -text "Generate" -command mkpatchgo
4274 button $top.buts.can -text "Cancel" -command mkpatchcan
4275 grid $top.buts.gen $top.buts.can
4276 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4277 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4278 grid $top.buts - -pady 10 -sticky ew
4282 proc mkpatchrev {} {
4285 set oldid [$patchtop.fromsha1 get]
4286 set oldhead [$patchtop.fromhead get]
4287 set newid [$patchtop.tosha1 get]
4288 set newhead [$patchtop.tohead get]
4289 foreach e [list fromsha1 fromhead tosha1 tohead] \
4290 v [list $newid $newhead $oldid $oldhead] {
4291 $patchtop.$e conf -state normal
4292 $patchtop.$e delete 0 end
4293 $patchtop.$e insert 0 $v
4294 $patchtop.$e conf -state readonly
4301 set oldid [$patchtop.fromsha1 get]
4302 set newid [$patchtop.tosha1 get]
4303 set fname [$patchtop.fname get]
4304 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4305 error_popup "Error creating patch: $err"
4307 catch {destroy $patchtop}
4311 proc mkpatchcan {} {
4314 catch {destroy $patchtop}
4319 global rowmenuid mktagtop commitinfo
4323 catch {destroy $top}
4325 label $top.title -text "Create tag"
4326 grid $top.title - -pady 10
4327 label $top.id -text "ID:"
4328 entry $top.sha1 -width 40 -relief flat
4329 $top.sha1 insert 0 $rowmenuid
4330 $top.sha1 conf -state readonly
4331 grid $top.id $top.sha1 -sticky w
4332 entry $top.head -width 60 -relief flat
4333 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4334 $top.head conf -state readonly
4335 grid x $top.head -sticky w
4336 label $top.tlab -text "Tag name:"
4337 entry $top.tag -width 60
4338 grid $top.tlab $top.tag -sticky w
4340 button $top.buts.gen -text "Create" -command mktaggo
4341 button $top.buts.can -text "Cancel" -command mktagcan
4342 grid $top.buts.gen $top.buts.can
4343 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4344 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4345 grid $top.buts - -pady 10 -sticky ew
4350 global mktagtop env tagids idtags
4352 set id [$mktagtop.sha1 get]
4353 set tag [$mktagtop.tag get]
4355 error_popup "No tag name specified"
4358 if {[info exists tagids($tag)]} {
4359 error_popup "Tag \"$tag\" already exists"
4364 set fname [file join $dir "refs/tags" $tag]
4365 set f [open $fname w]
4369 error_popup "Error creating tag: $err"
4373 set tagids($tag) $id
4374 lappend idtags($id) $tag
4378 proc redrawtags {id} {
4379 global canv linehtag commitrow idpos selectedline curview
4381 if {![info exists commitrow($curview,$id)]} return
4382 drawcmitrow $commitrow($curview,$id)
4383 $canv delete tag.$id
4384 set xt [eval drawtags $id $idpos($id)]
4385 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4386 if {[info exists selectedline]
4387 && $selectedline == $commitrow($curview,$id)} {
4388 selectline $selectedline 0
4395 catch {destroy $mktagtop}
4404 proc writecommit {} {
4405 global rowmenuid wrcomtop commitinfo wrcomcmd
4407 set top .writecommit
4409 catch {destroy $top}
4411 label $top.title -text "Write commit to file"
4412 grid $top.title - -pady 10
4413 label $top.id -text "ID:"
4414 entry $top.sha1 -width 40 -relief flat
4415 $top.sha1 insert 0 $rowmenuid
4416 $top.sha1 conf -state readonly
4417 grid $top.id $top.sha1 -sticky w
4418 entry $top.head -width 60 -relief flat
4419 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4420 $top.head conf -state readonly
4421 grid x $top.head -sticky w
4422 label $top.clab -text "Command:"
4423 entry $top.cmd -width 60 -textvariable wrcomcmd
4424 grid $top.clab $top.cmd -sticky w -pady 10
4425 label $top.flab -text "Output file:"
4426 entry $top.fname -width 60
4427 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4428 grid $top.flab $top.fname -sticky w
4430 button $top.buts.gen -text "Write" -command wrcomgo
4431 button $top.buts.can -text "Cancel" -command wrcomcan
4432 grid $top.buts.gen $top.buts.can
4433 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4434 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4435 grid $top.buts - -pady 10 -sticky ew
4442 set id [$wrcomtop.sha1 get]
4443 set cmd "echo $id | [$wrcomtop.cmd get]"
4444 set fname [$wrcomtop.fname get]
4445 if {[catch {exec sh -c $cmd >$fname &} err]} {
4446 error_popup "Error writing commit: $err"
4448 catch {destroy $wrcomtop}
4455 catch {destroy $wrcomtop}
4459 proc listrefs {id} {
4460 global idtags idheads idotherrefs
4463 if {[info exists idtags($id)]} {
4467 if {[info exists idheads($id)]} {
4471 if {[info exists idotherrefs($id)]} {
4472 set z $idotherrefs($id)
4474 return [list $x $y $z]
4477 proc rereadrefs {} {
4478 global idtags idheads idotherrefs
4480 set refids [concat [array names idtags] \
4481 [array names idheads] [array names idotherrefs]]
4482 foreach id $refids {
4483 if {![info exists ref($id)]} {
4484 set ref($id) [listrefs $id]
4488 set refids [lsort -unique [concat $refids [array names idtags] \
4489 [array names idheads] [array names idotherrefs]]]
4490 foreach id $refids {
4491 set v [listrefs $id]
4492 if {![info exists ref($id)] || $ref($id) != $v} {
4498 proc showtag {tag isnew} {
4499 global ctext tagcontents tagids linknum
4502 addtohistory [list showtag $tag 0]
4504 $ctext conf -state normal
4505 $ctext delete 0.0 end
4507 if {[info exists tagcontents($tag)]} {
4508 set text $tagcontents($tag)
4510 set text "Tag: $tag\nId: $tagids($tag)"
4512 appendwithlinks $text {}
4513 $ctext conf -state disabled
4524 global maxwidth maxgraphpct diffopts findmergefiles
4525 global oldprefs prefstop
4529 if {[winfo exists $top]} {
4533 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4534 set oldprefs($v) [set $v]
4537 wm title $top "Gitk preferences"
4538 label $top.ldisp -text "Commit list display options"
4539 grid $top.ldisp - -sticky w -pady 10
4540 label $top.spacer -text " "
4541 label $top.maxwidthl -text "Maximum graph width (lines)" \
4543 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4544 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4545 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4547 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4548 grid x $top.maxpctl $top.maxpct -sticky w
4549 checkbutton $top.findm -variable findmergefiles
4550 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4552 grid $top.findm $top.findml - -sticky w
4553 label $top.ddisp -text "Diff display options"
4554 grid $top.ddisp - -sticky w -pady 10
4555 label $top.diffoptl -text "Options for diff program" \
4557 entry $top.diffopt -width 20 -textvariable diffopts
4558 grid x $top.diffoptl $top.diffopt -sticky w
4560 button $top.buts.ok -text "OK" -command prefsok
4561 button $top.buts.can -text "Cancel" -command prefscan
4562 grid $top.buts.ok $top.buts.can
4563 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4564 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4565 grid $top.buts - - -pady 10 -sticky ew
4569 global maxwidth maxgraphpct diffopts findmergefiles
4570 global oldprefs prefstop
4572 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4573 set $v $oldprefs($v)
4575 catch {destroy $prefstop}
4580 global maxwidth maxgraphpct
4581 global oldprefs prefstop
4583 catch {destroy $prefstop}
4585 if {$maxwidth != $oldprefs(maxwidth)
4586 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4591 proc formatdate {d} {
4592 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4595 # This list of encoding names and aliases is distilled from
4596 # http://www.iana.org/assignments/character-sets.
4597 # Not all of them are supported by Tcl.
4598 set encoding_aliases {
4599 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4600 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4601 { ISO-10646-UTF-1 csISO10646UTF1 }
4602 { ISO_646.basic:1983 ref csISO646basic1983 }
4603 { INVARIANT csINVARIANT }
4604 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4605 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4606 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4607 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4608 { NATS-DANO iso-ir-9-1 csNATSDANO }
4609 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4610 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4611 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4612 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4613 { ISO-2022-KR csISO2022KR }
4615 { ISO-2022-JP csISO2022JP }
4616 { ISO-2022-JP-2 csISO2022JP2 }
4617 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4619 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4620 { IT iso-ir-15 ISO646-IT csISO15Italian }
4621 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4622 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4623 { greek7-old iso-ir-18 csISO18Greek7Old }
4624 { latin-greek iso-ir-19 csISO19LatinGreek }
4625 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4626 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4627 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4628 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4629 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4630 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4631 { INIS iso-ir-49 csISO49INIS }
4632 { INIS-8 iso-ir-50 csISO50INIS8 }
4633 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4634 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4635 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4636 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4637 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4638 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4640 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4641 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4642 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4643 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4644 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4645 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4646 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4647 { greek7 iso-ir-88 csISO88Greek7 }
4648 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4649 { iso-ir-90 csISO90 }
4650 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4651 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4652 csISO92JISC62991984b }
4653 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4654 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4655 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4656 csISO95JIS62291984handadd }
4657 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4658 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4659 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4660 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4662 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4663 { T.61-7bit iso-ir-102 csISO102T617bit }
4664 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4665 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4666 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4667 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4668 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4669 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4670 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4671 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4672 arabic csISOLatinArabic }
4673 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4674 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4675 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4676 greek greek8 csISOLatinGreek }
4677 { T.101-G2 iso-ir-128 csISO128T101G2 }
4678 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4680 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4681 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4682 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4683 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4684 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4685 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4686 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4687 csISOLatinCyrillic }
4688 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4689 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4690 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4691 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4692 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4693 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4694 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4695 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4696 { ISO_10367-box iso-ir-155 csISO10367Box }
4697 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4698 { latin-lap lap iso-ir-158 csISO158Lap }
4699 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4700 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4703 { JIS_X0201 X0201 csHalfWidthKatakana }
4704 { KSC5636 ISO646-KR csKSC5636 }
4705 { ISO-10646-UCS-2 csUnicode }
4706 { ISO-10646-UCS-4 csUCS4 }
4707 { DEC-MCS dec csDECMCS }
4708 { hp-roman8 roman8 r8 csHPRoman8 }
4709 { macintosh mac csMacintosh }
4710 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4712 { IBM038 EBCDIC-INT cp038 csIBM038 }
4713 { IBM273 CP273 csIBM273 }
4714 { IBM274 EBCDIC-BE CP274 csIBM274 }
4715 { IBM275 EBCDIC-BR cp275 csIBM275 }
4716 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4717 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4718 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4719 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4720 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4721 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4722 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4723 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4724 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4725 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4726 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4727 { IBM437 cp437 437 csPC8CodePage437 }
4728 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4729 { IBM775 cp775 csPC775Baltic }
4730 { IBM850 cp850 850 csPC850Multilingual }
4731 { IBM851 cp851 851 csIBM851 }
4732 { IBM852 cp852 852 csPCp852 }
4733 { IBM855 cp855 855 csIBM855 }
4734 { IBM857 cp857 857 csIBM857 }
4735 { IBM860 cp860 860 csIBM860 }
4736 { IBM861 cp861 861 cp-is csIBM861 }
4737 { IBM862 cp862 862 csPC862LatinHebrew }
4738 { IBM863 cp863 863 csIBM863 }
4739 { IBM864 cp864 csIBM864 }
4740 { IBM865 cp865 865 csIBM865 }
4741 { IBM866 cp866 866 csIBM866 }
4742 { IBM868 CP868 cp-ar csIBM868 }
4743 { IBM869 cp869 869 cp-gr csIBM869 }
4744 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4745 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4746 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4747 { IBM891 cp891 csIBM891 }
4748 { IBM903 cp903 csIBM903 }
4749 { IBM904 cp904 904 csIBBM904 }
4750 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4751 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4752 { IBM1026 CP1026 csIBM1026 }
4753 { EBCDIC-AT-DE csIBMEBCDICATDE }
4754 { EBCDIC-AT-DE-A csEBCDICATDEA }
4755 { EBCDIC-CA-FR csEBCDICCAFR }
4756 { EBCDIC-DK-NO csEBCDICDKNO }
4757 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4758 { EBCDIC-FI-SE csEBCDICFISE }
4759 { EBCDIC-FI-SE-A csEBCDICFISEA }
4760 { EBCDIC-FR csEBCDICFR }
4761 { EBCDIC-IT csEBCDICIT }
4762 { EBCDIC-PT csEBCDICPT }
4763 { EBCDIC-ES csEBCDICES }
4764 { EBCDIC-ES-A csEBCDICESA }
4765 { EBCDIC-ES-S csEBCDICESS }
4766 { EBCDIC-UK csEBCDICUK }
4767 { EBCDIC-US csEBCDICUS }
4768 { UNKNOWN-8BIT csUnknown8BiT }
4769 { MNEMONIC csMnemonic }
4774 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4775 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4776 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4777 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4778 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4779 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4780 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4781 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4782 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4783 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4784 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4785 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4786 { IBM1047 IBM-1047 }
4787 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4788 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4789 { UNICODE-1-1 csUnicode11 }
4792 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4793 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4795 { ISO-8859-15 ISO_8859-15 Latin-9 }
4796 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4797 { GBK CP936 MS936 windows-936 }
4798 { JIS_Encoding csJISEncoding }
4799 { Shift_JIS MS_Kanji csShiftJIS }
4800 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4802 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4803 { ISO-10646-UCS-Basic csUnicodeASCII }
4804 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4805 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4806 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4807 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4808 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4809 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4810 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4811 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4812 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4813 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4814 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4815 { Ventura-US csVenturaUS }
4816 { Ventura-International csVenturaInternational }
4817 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4818 { PC8-Turkish csPC8Turkish }
4819 { IBM-Symbols csIBMSymbols }
4820 { IBM-Thai csIBMThai }
4821 { HP-Legal csHPLegal }
4822 { HP-Pi-font csHPPiFont }
4823 { HP-Math8 csHPMath8 }
4824 { Adobe-Symbol-Encoding csHPPSMath }
4825 { HP-DeskTop csHPDesktop }
4826 { Ventura-Math csVenturaMath }
4827 { Microsoft-Publishing csMicrosoftPublishing }
4828 { Windows-31J csWindows31J }
4833 proc tcl_encoding {enc} {
4834 global encoding_aliases
4835 set names [encoding names]
4836 set lcnames [string tolower $names]
4837 set enc [string tolower $enc]
4838 set i [lsearch -exact $lcnames $enc]
4840 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4841 if {[regsub {^iso[-_]} $enc iso encx]} {
4842 set i [lsearch -exact $lcnames $encx]
4846 foreach l $encoding_aliases {
4847 set ll [string tolower $l]
4848 if {[lsearch -exact $ll $enc] < 0} continue
4849 # look through the aliases for one that tcl knows about
4851 set i [lsearch -exact $lcnames $e]
4853 if {[regsub {^iso[-_]} $e iso ex]} {
4854 set i [lsearch -exact $lcnames $ex]
4863 return [lindex $names $i]
4870 set diffopts "-U 5 -p"
4871 set wrcomcmd "git diff-tree --stdin -p --pretty"
4875 set gitencoding [exec git repo-config --get i18n.commitencoding]
4877 if {$gitencoding == ""} {
4878 set gitencoding "utf-8"
4880 set tclencoding [tcl_encoding $gitencoding]
4881 if {$tclencoding == {}} {
4882 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4885 set mainfont {Helvetica 9}
4886 set textfont {Courier 9}
4887 set uifont {Helvetica 9 bold}
4888 set findmergefiles 0
4896 set flistmode "flat"
4897 set cmitmode "patch"
4898 set wrapcomment "none"
4900 set colors {green red blue magenta darkgrey brown orange}
4902 catch {source ~/.gitk}
4904 font create optionfont -family sans-serif -size -12
4908 switch -regexp -- $arg {
4910 "^-d" { set datemode 1 }
4912 lappend revtreeargs $arg
4917 # check that we can find a .git directory somewhere...
4919 if {![file isdirectory $gitdir]} {
4920 show_error . "Cannot find the git directory \"$gitdir\"."
4924 set cmdline_files {}
4925 set i [lsearch -exact $revtreeargs "--"]
4927 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
4928 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
4929 } elseif {$revtreeargs ne {}} {
4931 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
4932 set cmdline_files [split $f "\n"]
4933 set n [llength $cmdline_files]
4934 set revtreeargs [lrange $revtreeargs 0 end-$n]
4936 # unfortunately we get both stdout and stderr in $err,
4937 # so look for "fatal:".
4938 set i [string first "fatal:" $err]
4940 set err [string range $err [expr {$i + 6}] end]
4942 show_error . "Bad arguments to gitk:\n$err"
4955 set selectedhlview {}
4968 if {$cmdline_files ne {} || $revtreeargs ne {}} {
4969 # create a view for the files/dirs specified on the command line
4973 set viewname(1) "Command line"
4974 set viewfiles(1) $cmdline_files
4975 set viewargs(1) $revtreeargs
4978 .bar.view entryconf 2 -state normal
4979 .bar.view entryconf 3 -state normal
4982 if {[info exists permviews]} {
4983 foreach v $permviews {
4986 set viewname($n) [lindex $v 0]
4987 set viewfiles($n) [lindex $v 1]
4988 set viewargs($n) [lindex $v 2]