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 revtreeargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
27 set commitidx
($view) 0
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
73 $canv create text
3 3 -anchor nw
-text "Reading commits..." \
74 -font $mainfont -tags textitems
77 proc getcommitlines
{fd view
} {
78 global commitlisted nextupdate
79 global leftover commfd
80 global displayorder commitidx commitrow commitdata
81 global parentlist childlist children curview hlview
82 global vparentlist vchildlist vdisporder vcmitlisted
86 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 after idle finishcommits
97 if {[string range
$err 0 4] == "usage"} {
99 "Gitk: error reading commits: bad arguments to git-rev-list.\
100 (Note: arguments to gitk are passed to git-rev-list\
101 to allow selection of commits to be displayed.)"
103 set err
"Error reading commits: $err"
111 set i
[string first
"\0" $stuff $start]
113 append leftover
($view) [string range
$stuff $start end
]
117 set cmit
$leftover($view)
118 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
119 set leftover
($view) {}
121 set cmit
[string range
$stuff $start [expr {$i - 1}]]
123 set start
[expr {$i + 1}]
124 set j
[string first
"\n" $cmit]
128 set ids
[string range
$cmit 0 [expr {$j - 1}]]
129 if {[string range
$ids 0 0] == "-"} {
131 set ids
[string range
$ids 1 end
]
135 if {[string length
$id] != 40} {
143 if {[string length
$shortcmit] > 80} {
144 set shortcmit
"[string range $shortcmit 0 80]..."
146 error_popup
"Can't parse git-rev-list output: {$shortcmit}"
149 set id
[lindex
$ids 0]
151 set olds
[lrange
$ids 1 end
]
154 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
155 lappend children
($view,$p) $id
162 if {![info exists children
($view,$id)]} {
163 set children
($view,$id) {}
165 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
166 set commitrow
($view,$id) $commitidx($view)
167 incr commitidx
($view)
168 if {$view == $curview} {
169 lappend parentlist
$olds
170 lappend childlist
$children($view,$id)
171 lappend displayorder
$id
172 lappend commitlisted
$listed
174 lappend vparentlist
($view) $olds
175 lappend vchildlist
($view) $children($view,$id)
176 lappend vdisporder
($view) $id
177 lappend vcmitlisted
($view) $listed
182 if {$view == $curview} {
184 } elseif
{[info exists hlview
] && $view == $hlview} {
188 if {[clock clicks
-milliseconds] >= $nextupdate} {
194 global commfd nextupdate numcommits ncmupdate
196 foreach v
[array names commfd
] {
197 fileevent
$commfd($v) readable
{}
200 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
201 if {$numcommits < 100} {
202 set ncmupdate
[expr {$numcommits + 1}]
203 } elseif
{$numcommits < 10000} {
204 set ncmupdate
[expr {$numcommits + 10}]
206 set ncmupdate
[expr {$numcommits + 100}]
208 foreach v
[array names commfd
] {
210 fileevent
$fd readable
[list getcommitlines
$fd $v]
214 proc readcommit
{id
} {
215 if {[catch
{set contents
[exec git-cat-file commit
$id]}]} return
216 parsecommit
$id $contents 0
219 proc updatecommits
{} {
220 global viewdata curview revtreeargs phase displayorder
221 global children commitrow
228 foreach id
$displayorder {
229 catch
{unset children
($n,$id)}
230 catch
{unset commitrow
($n,$id)}
233 catch
{unset viewdata
($n)}
238 proc parsecommit
{id contents listed
} {
239 global commitinfo cdate
248 set hdrend
[string first
"\n\n" $contents]
250 # should never happen...
251 set hdrend
[string length
$contents]
253 set header
[string range
$contents 0 [expr {$hdrend - 1}]]
254 set comment
[string range
$contents [expr {$hdrend + 2}] end
]
255 foreach line
[split $header "\n"] {
256 set tag
[lindex
$line 0]
257 if {$tag == "author"} {
258 set audate
[lindex
$line end-1
]
259 set auname
[lrange
$line 1 end-2
]
260 } elseif
{$tag == "committer"} {
261 set comdate
[lindex
$line end-1
]
262 set comname
[lrange
$line 1 end-2
]
266 # take the first line of the comment as the headline
267 set i
[string first
"\n" $comment]
269 set headline
[string trim
[string range
$comment 0 $i]]
271 set headline
$comment
274 # git-rev-list indents the comment by 4 spaces;
275 # if we got this via git-cat-file, add the indentation
277 foreach line
[split $comment "\n"] {
278 append newcomment
" "
279 append newcomment
$line
280 append newcomment
"\n"
282 set comment
$newcomment
284 if {$comdate != {}} {
285 set cdate
($id) $comdate
287 set commitinfo
($id) [list
$headline $auname $audate \
288 $comname $comdate $comment]
291 proc getcommit
{id
} {
292 global commitdata commitinfo
294 if {[info exists commitdata
($id)]} {
295 parsecommit
$id $commitdata($id) 1
298 if {![info exists commitinfo
($id)]} {
299 set commitinfo
($id) {"No commit information available"}
306 global tagids idtags headids idheads tagcontents
307 global otherrefids idotherrefs
309 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
312 set refd
[open
[list | git ls-remote
[gitdir
]] r
]
313 while {0 <= [set n
[gets
$refd line
]]} {
314 if {![regexp
{^
([0-9a-f]{40}) refs
/([^^
]*)$
} $line \
318 if {[regexp
{^remotes
/.
*/HEAD$
} $path match
]} {
321 if {![regexp
{^
(tags|heads
)/(.
*)$
} $path match
type name
]} {
325 if {[regexp
{^remotes
/} $path match
]} {
328 if {$type == "tags"} {
329 set tagids
($name) $id
330 lappend idtags
($id) $name
335 set commit
[exec git-rev-parse
"$id^0"]
336 if {"$commit" != "$id"} {
337 set tagids
($name) $commit
338 lappend idtags
($commit) $name
342 set tagcontents
($name) [exec git-cat-file tag
"$id"]
344 } elseif
{ $type == "heads" } {
345 set headids
($name) $id
346 lappend idheads
($id) $name
348 set otherrefids
($name) $id
349 lappend idotherrefs
($id) $name
355 proc error_popup msg
{
359 message
$w.m
-text $msg -justify center
-aspect 400
360 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
361 button
$w.ok
-text OK
-command "destroy $w"
362 pack
$w.ok
-side bottom
-fill x
363 bind $w <Visibility
> "grab $w; focus $w"
364 bind $w <Key-Return
> "destroy $w"
369 global canv canv2 canv3 linespc charspc ctext cflist
370 global textfont mainfont uifont
371 global findtype findtypemenu findloc findstring fstring geometry
372 global entries sha1entry sha1string sha1but
373 global maincursor textcursor curtextcursor
374 global rowctxmenu mergemax
377 .bar add cascade
-label "File" -menu .bar.
file
378 .bar configure
-font $uifont
380 .bar.
file add
command -label "Update" -command updatecommits
381 .bar.
file add
command -label "Reread references" -command rereadrefs
382 .bar.
file add
command -label "Quit" -command doquit
383 .bar.
file configure
-font $uifont
385 .bar add cascade
-label "Edit" -menu .bar.edit
386 .bar.edit add
command -label "Preferences" -command doprefs
387 .bar.edit configure
-font $uifont
389 menu .bar.view
-font $uifont
390 menu .bar.view.hl
-font $uifont -tearoff 0
391 .bar add cascade
-label "View" -menu .bar.view
392 .bar.view add
command -label "New view..." -command {newview
0}
393 .bar.view add
command -label "Edit view..." -command editview \
395 .bar.view add
command -label "Delete view" -command delview
-state disabled
396 .bar.view add cascade
-label "Highlight" -menu .bar.view.hl
397 .bar.view add separator
398 .bar.view add radiobutton
-label "All files" -command {showview
0} \
399 -variable selectedview
-value 0
400 .bar.view.hl add
command -label "New view..." -command {newview
1}
401 .bar.view.hl add
command -label "Remove" -command delhighlight \
403 .bar.view.hl add separator
406 .bar add cascade
-label "Help" -menu .bar.
help
407 .bar.
help add
command -label "About gitk" -command about
408 .bar.
help add
command -label "Key bindings" -command keys
409 .bar.
help configure
-font $uifont
410 . configure
-menu .bar
412 if {![info exists geometry
(canv1
)]} {
413 set geometry
(canv1
) [expr {45 * $charspc}]
414 set geometry
(canv2
) [expr {30 * $charspc}]
415 set geometry
(canv3
) [expr {15 * $charspc}]
416 set geometry
(canvh
) [expr {25 * $linespc + 4}]
417 set geometry
(ctextw
) 80
418 set geometry
(ctexth
) 30
419 set geometry
(cflistw
) 30
421 panedwindow .ctop
-orient vertical
422 if {[info exists geometry
(width
)]} {
423 .ctop conf
-width $geometry(width
) -height $geometry(height
)
424 set texth
[expr {$geometry(height
) - $geometry(canvh
) - 56}]
425 set geometry
(ctexth
) [expr {($texth - 8) /
426 [font metrics
$textfont -linespace]}]
430 pack .ctop.top.bar
-side bottom
-fill x
431 set cscroll .ctop.top.csb
432 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
433 pack
$cscroll -side right
-fill y
434 panedwindow .ctop.top.clist
-orient horizontal
-sashpad 0 -handlesize 4
435 pack .ctop.top.clist
-side top
-fill both
-expand 1
437 set canv .ctop.top.clist.canv
438 canvas
$canv -height $geometry(canvh
) -width $geometry(canv1
) \
440 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
441 .ctop.top.clist add
$canv
442 set canv2 .ctop.top.clist.canv2
443 canvas
$canv2 -height $geometry(canvh
) -width $geometry(canv2
) \
444 -bg white
-bd 0 -yscrollincr $linespc
445 .ctop.top.clist add
$canv2
446 set canv3 .ctop.top.clist.canv3
447 canvas
$canv3 -height $geometry(canvh
) -width $geometry(canv3
) \
448 -bg white
-bd 0 -yscrollincr $linespc
449 .ctop.top.clist add
$canv3
450 bind .ctop.top.clist
<Configure
> {resizeclistpanes
%W
%w
}
452 set sha1entry .ctop.top.bar.sha1
453 set entries
$sha1entry
454 set sha1but .ctop.top.bar.sha1label
455 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
456 -command gotocommit
-width 8 -font $uifont
457 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
458 pack .ctop.top.bar.sha1label
-side left
459 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
460 trace add variable sha1string
write sha1change
461 pack
$sha1entry -side left
-pady 2
463 image create bitmap bm-left
-data {
464 #define left_width 16
465 #define left_height 16
466 static unsigned char left_bits
[] = {
467 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
468 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
469 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
471 image create bitmap bm-right
-data {
472 #define right_width 16
473 #define right_height 16
474 static unsigned char right_bits
[] = {
475 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
476 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
477 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
479 button .ctop.top.bar.leftbut
-image bm-left
-command goback \
480 -state disabled
-width 26
481 pack .ctop.top.bar.leftbut
-side left
-fill y
482 button .ctop.top.bar.rightbut
-image bm-right
-command goforw \
483 -state disabled
-width 26
484 pack .ctop.top.bar.rightbut
-side left
-fill y
486 button .ctop.top.bar.findbut
-text "Find" -command dofind
-font $uifont
487 pack .ctop.top.bar.findbut
-side left
489 set fstring .ctop.top.bar.findstring
490 lappend entries
$fstring
491 entry
$fstring -width 30 -font $textfont -textvariable findstring
-font $textfont
492 pack
$fstring -side left
-expand 1 -fill x
494 set findtypemenu
[tk_optionMenu .ctop.top.bar.findtype \
495 findtype Exact IgnCase Regexp
]
496 .ctop.top.bar.findtype configure
-font $uifont
497 .ctop.top.bar.findtype.menu configure
-font $uifont
498 set findloc
"All fields"
499 tk_optionMenu .ctop.top.bar.findloc findloc
"All fields" Headline \
500 Comments Author Committer Files Pickaxe
501 .ctop.top.bar.findloc configure
-font $uifont
502 .ctop.top.bar.findloc.menu configure
-font $uifont
504 pack .ctop.top.bar.findloc
-side right
505 pack .ctop.top.bar.findtype
-side right
506 # for making sure type==Exact whenever loc==Pickaxe
507 trace add variable findloc
write findlocchange
509 panedwindow .ctop.cdet
-orient horizontal
511 frame .ctop.cdet.left
512 set ctext .ctop.cdet.left.ctext
513 text
$ctext -bg white
-state disabled
-font $textfont \
514 -width $geometry(ctextw
) -height $geometry(ctexth
) \
515 -yscrollcommand scrolltext
-wrap none
516 scrollbar .ctop.cdet.left.sb
-command "$ctext yview"
517 pack .ctop.cdet.left.sb
-side right
-fill y
518 pack
$ctext -side left
-fill both
-expand 1
519 .ctop.cdet add .ctop.cdet.left
521 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
522 $ctext tag conf hunksep
-fore blue
523 $ctext tag conf d0
-fore red
524 $ctext tag conf d1
-fore "#00a000"
525 $ctext tag conf m0
-fore red
526 $ctext tag conf m1
-fore blue
527 $ctext tag conf m2
-fore green
528 $ctext tag conf m3
-fore purple
529 $ctext tag conf
m4 -fore brown
530 $ctext tag conf m5
-fore "#009090"
531 $ctext tag conf m6
-fore magenta
532 $ctext tag conf m7
-fore "#808000"
533 $ctext tag conf m8
-fore "#009000"
534 $ctext tag conf m9
-fore "#ff0080"
535 $ctext tag conf m10
-fore cyan
536 $ctext tag conf m11
-fore "#b07070"
537 $ctext tag conf m12
-fore "#70b0f0"
538 $ctext tag conf m13
-fore "#70f0b0"
539 $ctext tag conf m14
-fore "#f0b070"
540 $ctext tag conf m15
-fore "#ff70b0"
541 $ctext tag conf mmax
-fore darkgrey
543 $ctext tag conf mresult
-font [concat
$textfont bold
]
544 $ctext tag conf msep
-font [concat
$textfont bold
]
545 $ctext tag conf found
-back yellow
547 frame .ctop.cdet.right
548 frame .ctop.cdet.right.mode
549 radiobutton .ctop.cdet.right.mode.
patch -text "Patch" \
550 -command reselectline
-variable cmitmode
-value "patch"
551 radiobutton .ctop.cdet.right.mode.tree
-text "Tree" \
552 -command reselectline
-variable cmitmode
-value "tree"
553 grid .ctop.cdet.right.mode.
patch .ctop.cdet.right.mode.tree
-sticky ew
554 pack .ctop.cdet.right.mode
-side top
-fill x
555 set cflist .ctop.cdet.right.cfiles
556 set indent
[font measure
$mainfont "nn"]
557 text
$cflist -width $geometry(cflistw
) -background white
-font $mainfont \
558 -tabs [list
$indent [expr {2 * $indent}]] \
559 -yscrollcommand ".ctop.cdet.right.sb set" \
560 -cursor [. cget
-cursor] \
561 -spacing1 1 -spacing3 1
562 scrollbar .ctop.cdet.right.sb
-command "$cflist yview"
563 pack .ctop.cdet.right.sb
-side right
-fill y
564 pack
$cflist -side left
-fill both
-expand 1
565 $cflist tag configure highlight
-background yellow
566 .ctop.cdet add .ctop.cdet.right
567 bind .ctop.cdet
<Configure
> {resizecdetpanes
%W
%w
}
569 pack .ctop
-side top
-fill both
-expand 1
571 bindall
<1> {selcanvline
%W
%x
%y
}
572 #bindall <B1-Motion> {selcanvline %W %x %y}
573 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
574 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
575 bindall
<2> "canvscan mark %W %x %y"
576 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
577 bindkey
<Home
> selfirstline
578 bindkey
<End
> sellastline
579 bind .
<Key-Up
> "selnextline -1"
580 bind .
<Key-Down
> "selnextline 1"
581 bindkey
<Key-Right
> "goforw"
582 bindkey
<Key-Left
> "goback"
583 bind .
<Key-Prior
> "selnextpage -1"
584 bind .
<Key-Next
> "selnextpage 1"
585 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
586 bind .
<Control-End
> "allcanvs yview moveto 1.0"
587 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
588 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
589 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
590 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
591 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
592 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
593 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
594 bindkey p
"selnextline -1"
595 bindkey n
"selnextline 1"
598 bindkey i
"selnextline -1"
599 bindkey k
"selnextline 1"
602 bindkey b
"$ctext yview scroll -1 pages"
603 bindkey d
"$ctext yview scroll 18 units"
604 bindkey u
"$ctext yview scroll -18 units"
605 bindkey
/ {findnext
1}
606 bindkey
<Key-Return
> {findnext
0}
609 bind .
<Control-q
> doquit
610 bind .
<Control-f
> dofind
611 bind .
<Control-g
> {findnext
0}
612 bind .
<Control-r
> findprev
613 bind .
<Control-equal
> {incrfont
1}
614 bind .
<Control-KP_Add
> {incrfont
1}
615 bind .
<Control-minus
> {incrfont
-1}
616 bind .
<Control-KP_Subtract
> {incrfont
-1}
617 bind .
<Destroy
> {savestuff
%W
}
618 bind .
<Button-1
> "click %W"
619 bind $fstring <Key-Return
> dofind
620 bind $sha1entry <Key-Return
> gotocommit
621 bind $sha1entry <<PasteSelection>> clearsha1
622 bind $cflist <1> {sel_flist %W %x %y; break}
623 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
624 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
626 set maincursor [. cget -cursor]
627 set textcursor [$ctext cget -cursor]
628 set curtextcursor $textcursor
630 set rowctxmenu .rowctxmenu
631 menu $rowctxmenu -tearoff 0
632 $rowctxmenu add command -label "Diff this -> selected" \
633 -command {diffvssel 0}
634 $rowctxmenu add command -label "Diff selected -> this" \
635 -command {diffvssel 1}
636 $rowctxmenu add command -label "Make patch" -command mkpatch
637 $rowctxmenu add command -label "Create tag" -command mktag
638 $rowctxmenu add command -label "Write commit to file" -command writecommit
641 # mouse-2 makes all windows scan vertically, but only the one
642 # the cursor is in scans horizontally
643 proc canvscan {op w x y} {
644 global canv canv2 canv3
645 foreach c [list $canv $canv2 $canv3] {
654 proc scrollcanv {cscroll f0 f1} {
659 # when we make a key binding for the toplevel, make sure
660 # it doesn't get triggered when that key is pressed in the
661 # find string entry widget.
662 proc bindkey {ev script} {
665 set escript [bind Entry $ev]
666 if {$escript == {}} {
667 set escript [bind Entry <Key>]
670 bind $e $ev "$escript; break"
674 # set the focus back to the toplevel for any click outside
685 global canv canv2 canv3 ctext cflist mainfont textfont uifont
686 global stuffsaved findmergefiles maxgraphpct
688 global viewname viewfiles viewperm nextviewnum
691 if {$stuffsaved} return
692 if {![winfo viewable .]} return
694 set f [open "~/.gitk-new" w]
695 puts $f [list set mainfont $mainfont]
696 puts $f [list set textfont $textfont]
697 puts $f [list set uifont $uifont]
698 puts $f [list set findmergefiles $findmergefiles]
699 puts $f [list set maxgraphpct $maxgraphpct]
700 puts $f [list set maxwidth $maxwidth]
701 puts $f [list set cmitmode $cmitmode]
702 puts $f "set geometry(width) [winfo width .ctop]"
703 puts $f "set geometry(height) [winfo height .ctop]"
704 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
705 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
706 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
707 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
708 set wid [expr {([winfo width $ctext] - 8) \
709 / [font measure $textfont "0"]}]
710 puts $f "set geometry(ctextw) $wid"
711 set wid [expr {([winfo width $cflist] - 11) \
712 / [font measure [$cflist cget -font] "0"]}]
713 puts $f "set geometry(cflistw) $wid"
714 puts -nonewline $f "set permviews {"
715 for {set v 0} {$v < $nextviewnum} {incr v} {
717 puts $f "{[list $viewname($v) $viewfiles($v)]}"
722 file rename -force "~/.gitk-new" "~/.gitk"
727 proc resizeclistpanes {win w} {
729 if {[info exists oldwidth($win)]} {
730 set s0 [$win sash coord 0]
731 set s1 [$win sash coord 1]
733 set sash0 [expr {int($w/2 - 2)}]
734 set sash1 [expr {int($w*5/6 - 2)}]
736 set factor [expr {1.0 * $w / $oldwidth($win)}]
737 set sash0 [expr {int($factor * [lindex $s0 0])}]
738 set sash1 [expr {int($factor * [lindex $s1 0])}]
742 if {$sash1 < $sash0 + 20} {
743 set sash1 [expr {$sash0 + 20}]
745 if {$sash1 > $w - 10} {
746 set sash1 [expr {$w - 10}]
747 if {$sash0 > $sash1 - 20} {
748 set sash0 [expr {$sash1 - 20}]
752 $win sash place 0 $sash0 [lindex $s0 1]
753 $win sash place 1 $sash1 [lindex $s1 1]
755 set oldwidth($win) $w
758 proc resizecdetpanes {win w} {
760 if {[info exists oldwidth($win)]} {
761 set s0 [$win sash coord 0]
763 set sash0 [expr {int($w*3/4 - 2)}]
765 set factor [expr {1.0 * $w / $oldwidth($win)}]
766 set sash0 [expr {int($factor * [lindex $s0 0])}]
770 if {$sash0 > $w - 15} {
771 set sash0 [expr {$w - 15}]
774 $win sash place 0 $sash0 [lindex $s0 1]
776 set oldwidth($win) $w
780 global canv canv2 canv3
786 proc bindall {event action} {
787 global canv canv2 canv3
788 bind $canv $event $action
789 bind $canv2 $event $action
790 bind $canv3 $event $action
795 if {[winfo exists $w]} {
800 wm title $w "About gitk"
802 Gitk - a commit viewer for git
804 Copyright © 2005-2006 Paul Mackerras
806 Use and redistribute under the terms of the GNU General Public License} \
807 -justify center -aspect 400
808 pack $w.m -side top -fill x -padx 20 -pady 20
809 button $w.ok -text Close -command "destroy $w"
810 pack $w.ok -side bottom
815 if {[winfo exists $w]} {
820 wm title $w "Gitk key bindings"
825 <Home> Move to first commit
826 <End> Move to last commit
827 <Up>, p, i Move up one commit
828 <Down>, n, k Move down one commit
829 <Left>, z, j Go back in history list
830 <Right>, x, l Go forward in history list
831 <PageUp> Move up one page in commit list
832 <PageDown> Move down one page in commit list
833 <Ctrl-Home> Scroll to top of commit list
834 <Ctrl-End> Scroll to bottom of commit list
835 <Ctrl-Up> Scroll commit list up one line
836 <Ctrl-Down> Scroll commit list down one line
837 <Ctrl-PageUp> Scroll commit list up one page
838 <Ctrl-PageDown> Scroll commit list down one page
839 <Delete>, b Scroll diff view up one page
840 <Backspace> Scroll diff view up one page
841 <Space> Scroll diff view down one page
842 u Scroll diff view up 18 lines
843 d Scroll diff view down 18 lines
845 <Ctrl-G> Move to next find hit
846 <Ctrl-R> Move to previous find hit
847 <Return> Move to next find hit
848 / Move to next find hit, or redo find
849 ? Move to previous find hit
850 f Scroll diff view to next file
851 <Ctrl-KP+> Increase font size
852 <Ctrl-plus> Increase font size
853 <Ctrl-KP-> Decrease font size
854 <Ctrl-minus> Decrease font size
856 -justify left -bg white -border 2 -relief sunken
857 pack $w.m -side top -fill both
858 button $w.ok -text Close -command "destroy $w"
859 pack $w.ok -side bottom
862 # Procedures for manipulating the file list window at the
863 # bottom right of the overall window.
865 proc treeview {w l openlevs} {
866 global treecontents treediropen treeheight treeparent treeindex
876 set treecontents() {}
877 $w conf -state normal
879 while {[string range $f 0 $prefixend] ne $prefix} {
880 if {$lev <= $openlevs} {
881 $w mark set e:$treeindex($prefix) "end -1c"
882 $w mark gravity e:$treeindex($prefix) left
884 set treeheight($prefix) $ht
885 incr ht [lindex $htstack end]
886 set htstack [lreplace $htstack end end]
887 set prefixend [lindex $prefendstack end]
888 set prefendstack [lreplace $prefendstack end end]
889 set prefix [string range $prefix 0 $prefixend]
892 set tail [string range $f [expr {$prefixend+1}] end]
893 while {[set slash [string first "/" $tail]] >= 0} {
896 lappend prefendstack $prefixend
897 incr prefixend [expr {$slash + 1}]
898 set d [string range $tail 0 $slash]
899 lappend treecontents($prefix) $d
900 set oldprefix $prefix
902 set treecontents($prefix) {}
903 set treeindex($prefix) [incr ix]
904 set treeparent($prefix) $oldprefix
905 set tail [string range $tail [expr {$slash+1}] end]
906 if {$lev <= $openlevs} {
908 set treediropen($prefix) [expr {$lev < $openlevs}]
909 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
910 $w mark set d:$ix "end -1c"
911 $w mark gravity d:$ix left
913 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
915 $w image create end -align center -image $bm -padx 1 \
918 $w mark set s:$ix "end -1c"
919 $w mark gravity s:$ix left
924 if {$lev <= $openlevs} {
927 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
931 lappend treecontents($prefix) $tail
934 while {$htstack ne {}} {
935 set treeheight($prefix) $ht
936 incr ht [lindex $htstack end]
937 set htstack [lreplace $htstack end end]
939 $w conf -state disabled
943 global treeheight treecontents
948 foreach e $treecontents($prefix) {
953 if {[string index $e end] eq "/"} {
954 set n $treeheight($prefix$e)
966 proc treeclosedir {w dir} {
967 global treediropen treeheight treeparent treeindex
969 set ix $treeindex($dir)
970 $w conf -state normal
971 $w delete s:$ix e:$ix
972 set treediropen($dir) 0
973 $w image configure a:$ix -image tri-rt
974 $w conf -state disabled
975 set n [expr {1 - $treeheight($dir)}]
977 incr treeheight($dir) $n
978 set dir $treeparent($dir)
982 proc treeopendir {w dir} {
983 global treediropen treeheight treeparent treecontents treeindex
985 set ix $treeindex($dir)
986 $w conf -state normal
987 $w image configure a:$ix -image tri-dn
988 $w mark set e:$ix s:$ix
989 $w mark gravity e:$ix right
992 set n [llength $treecontents($dir)]
993 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
996 incr treeheight($x) $n
998 foreach e $treecontents($dir) {
999 if {[string index $e end] eq "/"} {
1001 set iy $treeindex($de)
1002 $w mark set d:$iy e:$ix
1003 $w mark gravity d:$iy left
1004 $w insert e:$ix $str
1005 set treediropen($de) 0
1006 $w image create e:$ix -align center -image tri-rt -padx 1 \
1009 $w mark set s:$iy e:$ix
1010 $w mark gravity s:$iy left
1011 set treeheight($de) 1
1013 $w insert e:$ix $str
1017 $w mark gravity e:$ix left
1018 $w conf -state disabled
1019 set treediropen($dir) 1
1020 set top [lindex [split [$w index @0,0] .] 0]
1021 set ht [$w cget -height]
1022 set l [lindex [split [$w index s:$ix] .] 0]
1025 } elseif {$l + $n + 1 > $top + $ht} {
1026 set top [expr {$l + $n + 2 - $ht}]
1034 proc treeclick {w x y} {
1035 global treediropen cmitmode ctext cflist cflist_top
1037 if {$cmitmode ne "tree"} return
1038 if {![info exists cflist_top]} return
1039 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1040 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1041 $cflist tag add highlight $l.0 "$l.0 lineend"
1047 set e [linetoelt $l]
1048 if {[string index $e end] ne "/"} {
1050 } elseif {$treediropen($e)} {
1057 proc setfilelist {id} {
1058 global treefilelist cflist
1060 treeview $cflist $treefilelist($id) 0
1063 image create bitmap tri-rt -background black -foreground blue -data {
1064 #define tri-rt_width 13
1065 #define tri-rt_height 13
1066 static unsigned char tri-rt_bits[] = {
1067 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1068 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1071 #define tri-rt-mask_width 13
1072 #define tri-rt-mask_height 13
1073 static unsigned char tri-rt-mask_bits[] = {
1074 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1075 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1078 image create bitmap tri-dn -background black -foreground blue -data {
1079 #define tri-dn_width 13
1080 #define tri-dn_height 13
1081 static unsigned char tri-dn_bits[] = {
1082 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1083 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1086 #define tri-dn-mask_width 13
1087 #define tri-dn-mask_height 13
1088 static unsigned char tri-dn-mask_bits[] = {
1089 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1090 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1094 proc init_flist {first} {
1095 global cflist cflist_top cflist_bot selectedline difffilestart
1097 $cflist conf -state normal
1098 $cflist delete 0.0 end
1100 $cflist insert end $first
1103 $cflist tag add highlight 1.0 "1.0 lineend"
1105 catch {unset cflist_top}
1107 $cflist conf -state disabled
1108 set difffilestart {}
1111 proc add_flist {fl} {
1112 global flistmode cflist
1114 $cflist conf -state normal
1115 if {$flistmode eq "flat"} {
1117 $cflist insert end "\n$f"
1120 $cflist conf -state disabled
1123 proc sel_flist {w x y} {
1124 global flistmode ctext difffilestart cflist cflist_top cmitmode
1126 if {$cmitmode eq "tree"} return
1127 if {![info exists cflist_top]} return
1128 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1132 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1137 proc scrolltext {f0 f1} {
1140 .ctop.cdet.left.sb set $f0 $f1
1141 if {[info exists cflist_top]} {
1142 highlight_flist $cflist_top
1146 # Given an index $tl in the $ctext window, this works out which line
1147 # of the $cflist window displays the filename whose patch is shown
1148 # at the given point in the $ctext window. $ll is a hint about which
1149 # line it might be, and is used as the starting point of the search.
1150 proc ctext_index {tl ll} {
1151 global ctext difffilestart
1153 while {$ll >= 2 && [$ctext compare $tl < \
1154 [lindex $difffilestart [expr {$ll - 2}]]]} {
1157 set nfiles [llength $difffilestart]
1158 while {$ll - 1 < $nfiles && [$ctext compare $tl >= \
1159 [lindex $difffilestart [expr {$ll - 1}]]]} {
1165 proc highlight_flist {ll} {
1166 global ctext cflist cflist_top cflist_bot difffilestart
1168 if {![info exists difffilestart] || [llength $difffilestart] == 0} return
1169 set ll [ctext_index [$ctext index @0,1] $ll]
1174 set y [expr {[winfo height $ctext] - 2}]
1175 set lb [ctext_index [$ctext index @0,$y] $lb]
1176 if {$ll != $cflist_top || $lb != $cflist_bot} {
1177 $cflist tag remove highlight $cflist_top.0 "$cflist_bot.0 lineend"
1178 for {set l $ll} {$l <= $lb} {incr l} {
1179 $cflist tag add highlight $l.0 "$l.0 lineend"
1186 # Code to implement multiple views
1188 proc newview {ishighlight} {
1189 global nextviewnum newviewname newviewperm uifont newishighlight
1191 set newishighlight $ishighlight
1193 if {[winfo exists $top]} {
1197 set newviewname($nextviewnum) "View $nextviewnum"
1198 set newviewperm($nextviewnum) 0
1199 vieweditor $top $nextviewnum "Gitk view definition"
1204 global viewname viewperm newviewname newviewperm
1206 set top .gitkvedit-$curview
1207 if {[winfo exists $top]} {
1211 set newviewname($curview) $viewname($curview)
1212 set newviewperm($curview) $viewperm($curview)
1213 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1216 proc vieweditor {top n title} {
1217 global newviewname newviewperm viewfiles
1221 wm title $top $title
1222 label $top.nl -text "Name" -font $uifont
1223 entry $top.name -width 20 -textvariable newviewname($n)
1224 grid $top.nl $top.name -sticky w -pady 5
1225 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1226 grid $top.perm - -pady 5 -sticky w
1227 message $top.l -aspect 500 -font $uifont \
1228 -text "Enter files and directories to include, one per line:"
1229 grid $top.l - -sticky w
1230 text $top.t -width 40 -height 10 -background white
1231 if {[info exists viewfiles($n)]} {
1232 foreach f $viewfiles($n) {
1233 $top.t insert end $f
1234 $top.t insert end "\n"
1236 $top.t delete {end - 1c} end
1237 $top.t mark set insert 0.0
1239 grid $top.t - -sticky w -padx 5
1241 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1242 button $top.buts.can -text "Cancel" -command [list destroy $top]
1243 grid $top.buts.ok $top.buts.can
1244 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1245 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1246 grid $top.buts - -pady 10 -sticky ew
1250 proc doviewmenu {m first cmd op args} {
1251 set nmenu [$m index end]
1252 for {set i $first} {$i <= $nmenu} {incr i} {
1253 if {[$m entrycget $i -command] eq $cmd} {
1254 eval $m $op $i $args
1260 proc allviewmenus {n op args} {
1261 doviewmenu .bar.view 6 [list showview $n] $op $args
1262 doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
1265 proc newviewok {top n} {
1266 global nextviewnum newviewperm newviewname newishighlight
1267 global viewname viewfiles viewperm selectedview curview
1270 foreach f [split [$top.t get 0.0 end] "\n"] {
1271 set ft [string trim $f]
1276 if {![info exists viewfiles($n)]} {
1277 # creating a new view
1279 set viewname($n) $newviewname($n)
1280 set viewperm($n) $newviewperm($n)
1281 set viewfiles($n) $files
1283 if {!$newishighlight} {
1284 after idle showview $n
1286 after idle addhighlight $n
1289 # editing an existing view
1290 set viewperm($n) $newviewperm($n)
1291 if {$newviewname($n) ne $viewname($n)} {
1292 set viewname($n) $newviewname($n)
1293 allviewmenus $n entryconf -label $viewname($n)
1295 if {$files ne $viewfiles($n)} {
1296 set viewfiles($n) $files
1297 if {$curview == $n} {
1298 after idle updatecommits
1302 catch {destroy $top}
1306 global curview viewdata viewperm
1308 if {$curview == 0} return
1309 allviewmenus $curview delete
1310 set viewdata($curview) {}
1311 set viewperm($curview) 0
1315 proc addviewmenu {n} {
1318 .bar.view add radiobutton -label $viewname($n) \
1319 -command [list showview $n] -variable selectedview -value $n
1320 .bar.view.hl add radiobutton -label $viewname($n) \
1321 -command [list addhighlight $n] -variable selectedhlview -value $n
1324 proc flatten {var} {
1328 foreach i [array names $var] {
1329 lappend ret $i [set $var\($i\)]
1334 proc unflatten {var l} {
1344 global curview viewdata viewfiles
1345 global displayorder parentlist childlist rowidlist rowoffsets
1346 global colormap rowtextx commitrow nextcolor canvxmax
1347 global numcommits rowrangelist commitlisted idrowranges
1348 global selectedline currentid canv canvy0
1349 global matchinglines treediffs
1350 global pending_select phase
1351 global commitidx rowlaidout rowoptim linesegends
1352 global commfd nextupdate
1353 global selectedview hlview selectedhlview
1354 global vparentlist vchildlist vdisporder vcmitlisted
1356 if {$n == $curview} return
1358 if {[info exists selectedline]} {
1359 set selid $currentid
1360 set y [yc $selectedline]
1361 set ymax [lindex [$canv cget -scrollregion] 3]
1362 set span [$canv yview]
1363 set ytop [expr {[lindex $span 0] * $ymax}]
1364 set ybot [expr {[lindex $span 1] * $ymax}]
1365 if {$ytop < $y && $y < $ybot} {
1366 set yscreen [expr {$y - $ytop}]
1368 set yscreen [expr {($ybot - $ytop) / 2}]
1374 if {$curview >= 0} {
1375 set vparentlist($curview) $parentlist
1376 set vchildlist($curview) $childlist
1377 set vdisporder($curview) $displayorder
1378 set vcmitlisted($curview) $commitlisted
1380 set viewdata($curview) \
1381 [list $phase $rowidlist $rowoffsets $rowrangelist \
1382 [flatten idrowranges] [flatten idinlist] \
1383 $rowlaidout $rowoptim $numcommits $linesegends]
1384 } elseif {![info exists viewdata($curview)]
1385 || [lindex $viewdata($curview) 0] ne {}} {
1386 set viewdata($curview) \
1387 [list {} $rowidlist $rowoffsets $rowrangelist]
1390 catch {unset matchinglines}
1391 catch {unset treediffs}
1396 set selectedhlview -1
1397 .bar.view entryconf 1 -state [expr {$n == 0? "disabled": "normal"}]
1398 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1399 catch {unset hlview}
1400 .bar.view.hl entryconf 1 -state disabled
1402 if {![info exists viewdata($n)]} {
1403 set pending_select $selid
1409 set phase [lindex $v 0]
1410 set displayorder $vdisporder($n)
1411 set parentlist $vparentlist($n)
1412 set childlist $vchildlist($n)
1413 set commitlisted $vcmitlisted($n)
1414 set rowidlist [lindex $v 1]
1415 set rowoffsets [lindex $v 2]
1416 set rowrangelist [lindex $v 3]
1418 set numcommits [llength $displayorder]
1419 catch {unset idrowranges}
1421 unflatten idrowranges [lindex $v 4]
1422 unflatten idinlist [lindex $v 5]
1423 set rowlaidout [lindex $v 6]
1424 set rowoptim [lindex $v 7]
1425 set numcommits [lindex $v 8]
1426 set linesegends [lindex $v 9]
1429 catch {unset colormap}
1430 catch {unset rowtextx}
1432 set canvxmax [$canv cget -width]
1438 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1439 set row $commitrow($n,$selid)
1440 # try to get the selected row in the same position on the screen
1441 set ymax [lindex [$canv cget -scrollregion] 3]
1442 set ytop [expr {[yc $row] - $yscreen}]
1446 set yf [expr {$ytop * 1.0 / $ymax}]
1448 allcanvs yview moveto $yf
1452 if {$phase eq "getcommits"} {
1454 $canv create text 3 3 -anchor nw -text "Reading commits..." \
1455 -font $mainfont -tags textitems
1457 if {[info exists commfd($n)]} {
1465 proc addhighlight {n} {
1466 global hlview curview viewdata highlighted highlightedrows
1467 global selectedhlview
1469 if {[info exists hlview]} {
1473 set selectedhlview $n
1474 .bar.view.hl entryconf 1 -state normal
1475 set highlighted($n) 0
1476 set highlightedrows {}
1477 if {$n != $curview && ![info exists viewdata($n)]} {
1478 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1479 set vparentlist($n) {}
1480 set vchildlist($n) {}
1481 set vdisporder($n) {}
1482 set vcmitlisted($n) {}
1489 proc delhighlight {} {
1490 global hlview highlightedrows canv linehtag mainfont
1491 global selectedhlview selectedline
1493 if {![info exists hlview]} return
1495 set selectedhlview {}
1496 .bar.view.hl entryconf 1 -state disabled
1497 foreach l $highlightedrows {
1498 $canv itemconf $linehtag($l) -font $mainfont
1499 if {$l == $selectedline} {
1501 set t [eval $canv create rect [$canv bbox $linehtag($l)] \
1502 -outline {{}} -tags secsel \
1503 -fill [$canv cget -selectbackground]]
1509 proc highlightmore {} {
1510 global hlview highlighted commitidx highlightedrows linehtag mainfont
1511 global displayorder vdisporder curview canv commitrow selectedline
1513 set font [concat $mainfont bold]
1514 set max $commitidx($hlview)
1515 if {$hlview == $curview} {
1516 set disp $displayorder
1518 set disp $vdisporder($hlview)
1520 for {set i $highlighted($hlview)} {$i < $max} {incr i} {
1521 set id [lindex $disp $i]
1522 if {[info exists commitrow($curview,$id)]} {
1523 set row $commitrow($curview,$id)
1524 if {[info exists linehtag($row)]} {
1525 $canv itemconf $linehtag($row) -font $font
1526 lappend highlightedrows $row
1527 if {$row == $selectedline} {
1529 set t [eval $canv create rect \
1530 [$canv bbox $linehtag($row)] \
1531 -outline {{}} -tags secsel \
1532 -fill [$canv cget -selectbackground]]
1538 set highlighted($hlview) $max
1541 # Graph layout functions
1543 proc shortids {ids} {
1546 if {[llength $id] > 1} {
1547 lappend res [shortids $id]
1548 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1549 lappend res [string range $id 0 7]
1557 proc incrange {l x o} {
1560 set e [lindex $l $x]
1562 lset l $x [expr {$e + $o}]
1571 for {} {$n > 0} {incr n -1} {
1577 proc usedinrange {id l1 l2} {
1578 global children commitrow childlist curview
1580 if {[info exists commitrow($curview,$id)]} {
1581 set r $commitrow($curview,$id)
1582 if {$l1 <= $r && $r <= $l2} {
1583 return [expr {$r - $l1 + 1}]
1585 set kids [lindex $childlist $r]
1587 set kids $children($curview,$id)
1590 set r $commitrow($curview,$c)
1591 if {$l1 <= $r && $r <= $l2} {
1592 return [expr {$r - $l1 + 1}]
1598 proc sanity {row {full 0}} {
1599 global rowidlist rowoffsets
1602 set ids [lindex $rowidlist $row]
1605 if {$id eq {}} continue
1606 if {$col < [llength $ids] - 1 &&
1607 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1608 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1610 set o [lindex $rowoffsets $row $col]
1616 if {[lindex $rowidlist $y $x] != $id} {
1617 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1618 puts " id=[shortids $id] check started at row $row"
1619 for {set i $row} {$i >= $y} {incr i -1} {
1620 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1625 set o [lindex $rowoffsets $y $x]
1630 proc makeuparrow {oid x y z} {
1631 global rowidlist rowoffsets uparrowlen idrowranges
1633 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1636 set off0 [lindex $rowoffsets $y]
1637 for {set x0 $x} {1} {incr x0} {
1638 if {$x0 >= [llength $off0]} {
1639 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1642 set z [lindex $off0 $x0]
1648 set z [expr {$x0 - $x}]
1649 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1650 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1652 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1653 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1654 lappend idrowranges($oid) $y
1657 proc initlayout {} {
1658 global rowidlist rowoffsets displayorder commitlisted
1659 global rowlaidout rowoptim
1660 global idinlist rowchk rowrangelist idrowranges
1661 global numcommits canvxmax canv
1663 global parentlist childlist children
1664 global colormap rowtextx
1676 catch {unset idinlist}
1677 catch {unset rowchk}
1680 set canvxmax [$canv cget -width]
1681 catch {unset colormap}
1682 catch {unset rowtextx}
1683 catch {unset idrowranges}
1687 proc setcanvscroll {} {
1688 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1690 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1691 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1692 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1693 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1696 proc visiblerows {} {
1697 global canv numcommits linespc
1699 set ymax [lindex [$canv cget -scrollregion] 3]
1700 if {$ymax eq {} || $ymax == 0} return
1702 set y0 [expr {int([lindex $f 0] * $ymax)}]
1703 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1707 set y1 [expr {int([lindex $f 1] * $ymax)}]
1708 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1709 if {$r1 >= $numcommits} {
1710 set r1 [expr {$numcommits - 1}]
1712 return [list $r0 $r1]
1715 proc layoutmore {} {
1716 global rowlaidout rowoptim commitidx numcommits optim_delay
1717 global uparrowlen curview
1720 set rowlaidout [layoutrows $row $commitidx($curview) 0]
1721 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1722 if {$orow > $rowoptim} {
1723 optimize_rows $rowoptim 0 $orow
1726 set canshow [expr {$rowoptim - $optim_delay}]
1727 if {$canshow > $numcommits} {
1732 proc showstuff {canshow} {
1733 global numcommits commitrow pending_select selectedline
1734 global linesegends idrowranges idrangedrawn curview
1736 if {$numcommits == 0} {
1738 set phase "incrdraw"
1742 set numcommits $canshow
1744 set rows [visiblerows]
1745 set r0 [lindex $rows 0]
1746 set r1 [lindex $rows 1]
1748 for {set r $row} {$r < $canshow} {incr r} {
1749 foreach id [lindex $linesegends [expr {$r+1}]] {
1751 foreach {s e} [rowranges $id] {
1753 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1754 && ![info exists idrangedrawn($id,$i)]} {
1756 set idrangedrawn($id,$i) 1
1761 if {$canshow > $r1} {
1764 while {$row < $canshow} {
1768 if {[info exists pending_select] &&
1769 [info exists commitrow($curview,$pending_select)] &&
1770 $commitrow($curview,$pending_select) < $numcommits} {
1771 selectline $commitrow($curview,$pending_select) 1
1773 if {![info exists selectedline] && ![info exists pending_select]} {
1778 proc layoutrows {row endrow last} {
1779 global rowidlist rowoffsets displayorder
1780 global uparrowlen downarrowlen maxwidth mingaplen
1781 global childlist parentlist
1782 global idrowranges linesegends
1783 global commitidx curview
1784 global idinlist rowchk rowrangelist
1786 set idlist [lindex $rowidlist $row]
1787 set offs [lindex $rowoffsets $row]
1788 while {$row < $endrow} {
1789 set id [lindex $displayorder $row]
1792 foreach p [lindex $parentlist $row] {
1793 if {![info exists idinlist($p)]} {
1795 } elseif {!$idinlist($p)} {
1800 set nev [expr {[llength $idlist] + [llength $newolds]
1801 + [llength $oldolds] - $maxwidth + 1}]
1804 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
1805 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1806 set i [lindex $idlist $x]
1807 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1808 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1809 [expr {$row + $uparrowlen + $mingaplen}]]
1811 set idlist [lreplace $idlist $x $x]
1812 set offs [lreplace $offs $x $x]
1813 set offs [incrange $offs $x 1]
1815 set rm1 [expr {$row - 1}]
1817 lappend idrowranges($i) $rm1
1818 if {[incr nev -1] <= 0} break
1821 set rowchk($id) [expr {$row + $r}]
1824 lset rowidlist $row $idlist
1825 lset rowoffsets $row $offs
1827 lappend linesegends $lse
1828 set col [lsearch -exact $idlist $id]
1830 set col [llength $idlist]
1832 lset rowidlist $row $idlist
1834 if {[lindex $childlist $row] ne {}} {
1835 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1839 lset rowoffsets $row $offs
1841 makeuparrow $id $col $row $z
1847 if {[info exists idrowranges($id)]} {
1848 set ranges $idrowranges($id)
1850 unset idrowranges($id)
1852 lappend rowrangelist $ranges
1854 set offs [ntimes [llength $idlist] 0]
1855 set l [llength $newolds]
1856 set idlist [eval lreplace \$idlist $col $col $newolds]
1859 set offs [lrange $offs 0 [expr {$col - 1}]]
1860 foreach x $newolds {
1865 set tmp [expr {[llength $idlist] - [llength $offs]}]
1867 set offs [concat $offs [ntimes $tmp $o]]
1872 foreach i $newolds {
1874 set idrowranges($i) $row
1877 foreach oid $oldolds {
1878 set idinlist($oid) 1
1879 set idlist [linsert $idlist $col $oid]
1880 set offs [linsert $offs $col $o]
1881 makeuparrow $oid $col $row $o
1884 lappend rowidlist $idlist
1885 lappend rowoffsets $offs
1890 proc addextraid {id row} {
1891 global displayorder commitrow commitinfo
1892 global commitidx commitlisted
1893 global parentlist childlist children curview
1895 incr commitidx($curview)
1896 lappend displayorder $id
1897 lappend commitlisted 0
1898 lappend parentlist {}
1899 set commitrow($curview,$id) $row
1901 if {![info exists commitinfo($id)]} {
1902 set commitinfo($id) {"No commit information available"}
1904 if {![info exists children($curview,$id)]} {
1905 set children($curview,$id) {}
1907 lappend childlist $children($curview,$id)
1910 proc layouttail {} {
1911 global rowidlist rowoffsets idinlist commitidx curview
1912 global idrowranges rowrangelist
1914 set row $commitidx($curview)
1915 set idlist [lindex $rowidlist $row]
1916 while {$idlist ne {}} {
1917 set col [expr {[llength $idlist] - 1}]
1918 set id [lindex $idlist $col]
1921 lappend idrowranges($id) $row
1922 lappend rowrangelist $idrowranges($id)
1923 unset idrowranges($id)
1925 set offs [ntimes $col 0]
1926 set idlist [lreplace $idlist $col $col]
1927 lappend rowidlist $idlist
1928 lappend rowoffsets $offs
1931 foreach id [array names idinlist] {
1933 lset rowidlist $row [list $id]
1934 lset rowoffsets $row 0
1935 makeuparrow $id 0 $row 0
1936 lappend idrowranges($id) $row
1937 lappend rowrangelist $idrowranges($id)
1938 unset idrowranges($id)
1940 lappend rowidlist {}
1941 lappend rowoffsets {}
1945 proc insert_pad {row col npad} {
1946 global rowidlist rowoffsets
1948 set pad [ntimes $npad {}]
1949 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1950 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1951 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1954 proc optimize_rows {row col endrow} {
1955 global rowidlist rowoffsets idrowranges displayorder
1957 for {} {$row < $endrow} {incr row} {
1958 set idlist [lindex $rowidlist $row]
1959 set offs [lindex $rowoffsets $row]
1961 for {} {$col < [llength $offs]} {incr col} {
1962 if {[lindex $idlist $col] eq {}} {
1966 set z [lindex $offs $col]
1967 if {$z eq {}} continue
1969 set x0 [expr {$col + $z}]
1970 set y0 [expr {$row - 1}]
1971 set z0 [lindex $rowoffsets $y0 $x0]
1973 set id [lindex $idlist $col]
1974 set ranges [rowranges $id]
1975 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1979 if {$z < -1 || ($z < 0 && $isarrow)} {
1980 set npad [expr {-1 - $z + $isarrow}]
1981 set offs [incrange $offs $col $npad]
1982 insert_pad $y0 $x0 $npad
1984 optimize_rows $y0 $x0 $row
1986 set z [lindex $offs $col]
1987 set x0 [expr {$col + $z}]
1988 set z0 [lindex $rowoffsets $y0 $x0]
1989 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1990 set npad [expr {$z - 1 + $isarrow}]
1991 set y1 [expr {$row + 1}]
1992 set offs2 [lindex $rowoffsets $y1]
1996 if {$z eq {} || $x1 + $z < $col} continue
1997 if {$x1 + $z > $col} {
2000 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2003 set pad [ntimes $npad {}]
2004 set idlist [eval linsert \$idlist $col $pad]
2005 set tmp [eval linsert \$offs $col $pad]
2007 set offs [incrange $tmp $col [expr {-$npad}]]
2008 set z [lindex $offs $col]
2011 if {$z0 eq {} && !$isarrow} {
2012 # this line links to its first child on row $row-2
2013 set rm2 [expr {$row - 2}]
2014 set id [lindex $displayorder $rm2]
2015 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2017 set z0 [expr {$xc - $x0}]
2020 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2021 insert_pad $y0 $x0 1
2022 set offs [incrange $offs $col 1]
2023 optimize_rows $y0 [expr {$x0 + 1}] $row
2028 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2029 set o [lindex $offs $col]
2031 # check if this is the link to the first child
2032 set id [lindex $idlist $col]
2033 set ranges [rowranges $id]
2034 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2035 # it is, work out offset to child
2036 set y0 [expr {$row - 1}]
2037 set id [lindex $displayorder $y0]
2038 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2040 set o [expr {$x0 - $col}]
2044 if {$o eq {} || $o <= 0} break
2046 if {$o ne {} && [incr col] < [llength $idlist]} {
2047 set y1 [expr {$row + 1}]
2048 set offs2 [lindex $rowoffsets $y1]
2052 if {$z eq {} || $x1 + $z < $col} continue
2053 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2056 set idlist [linsert $idlist $col {}]
2057 set tmp [linsert $offs $col {}]
2059 set offs [incrange $tmp $col -1]
2062 lset rowidlist $row $idlist
2063 lset rowoffsets $row $offs
2069 global canvx0 linespc
2070 return [expr {$canvx0 + $col * $linespc}]
2074 global canvy0 linespc
2075 return [expr {$canvy0 + $row * $linespc}]
2078 proc linewidth {id} {
2079 global thickerline lthickness
2082 if {[info exists thickerline] && $id eq $thickerline} {
2083 set wid [expr {2 * $lthickness}]
2088 proc rowranges {id} {
2089 global phase idrowranges commitrow rowlaidout rowrangelist curview
2093 ([info exists commitrow($curview,$id)]
2094 && $commitrow($curview,$id) < $rowlaidout)} {
2095 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2096 } elseif {[info exists idrowranges($id)]} {
2097 set ranges $idrowranges($id)
2102 proc drawlineseg {id i} {
2103 global rowoffsets rowidlist
2105 global canv colormap linespc
2106 global numcommits commitrow curview
2108 set ranges [rowranges $id]
2110 if {[info exists commitrow($curview,$id)]
2111 && $commitrow($curview,$id) < $numcommits} {
2112 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2116 set startrow [lindex $ranges [expr {2 * $i}]]
2117 set row [lindex $ranges [expr {2 * $i + 1}]]
2118 if {$startrow == $row} return
2121 set col [lsearch -exact [lindex $rowidlist $row] $id]
2123 puts "oops: drawline: id $id not on row $row"
2129 set o [lindex $rowoffsets $row $col]
2132 # changing direction
2133 set x [xc $row $col]
2135 lappend coords $x $y
2141 set x [xc $row $col]
2143 lappend coords $x $y
2145 # draw the link to the first child as part of this line
2147 set child [lindex $displayorder $row]
2148 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2150 set x [xc $row $ccol]
2152 if {$ccol < $col - 1} {
2153 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2154 } elseif {$ccol > $col + 1} {
2155 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2157 lappend coords $x $y
2160 if {[llength $coords] < 4} return
2162 # This line has an arrow at the lower end: check if the arrow is
2163 # on a diagonal segment, and if so, work around the Tk 8.4
2164 # refusal to draw arrows on diagonal lines.
2165 set x0 [lindex $coords 0]
2166 set x1 [lindex $coords 2]
2168 set y0 [lindex $coords 1]
2169 set y1 [lindex $coords 3]
2170 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2171 # we have a nearby vertical segment, just trim off the diag bit
2172 set coords [lrange $coords 2 end]
2174 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2175 set xi [expr {$x0 - $slope * $linespc / 2}]
2176 set yi [expr {$y0 - $linespc / 2}]
2177 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2181 set arrow [expr {2 * ($i > 0) + $downarrow}]
2182 set arrow [lindex {none first last both} $arrow]
2183 set t [$canv create line $coords -width [linewidth $id] \
2184 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2189 proc drawparentlinks {id row col olds} {
2190 global rowidlist canv colormap
2192 set row2 [expr {$row + 1}]
2193 set x [xc $row $col]
2196 set ids [lindex $rowidlist $row2]
2197 # rmx = right-most X coord used
2200 set i [lsearch -exact $ids $p]
2202 puts "oops, parent $p of $id not in list"
2205 set x2 [xc $row2 $i]
2209 set ranges [rowranges $p]
2210 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2211 && $row2 < [lindex $ranges 1]} {
2212 # drawlineseg will do this one for us
2216 # should handle duplicated parents here...
2217 set coords [list $x $y]
2218 if {$i < $col - 1} {
2219 lappend coords [xc $row [expr {$i + 1}]] $y
2220 } elseif {$i > $col + 1} {
2221 lappend coords [xc $row [expr {$i - 1}]] $y
2223 lappend coords $x2 $y2
2224 set t [$canv create line $coords -width [linewidth $p] \
2225 -fill $colormap($p) -tags lines.$p]
2232 proc drawlines {id} {
2233 global colormap canv
2235 global children iddrawn commitrow rowidlist curview
2237 $canv delete lines.$id
2238 set nr [expr {[llength [rowranges $id]] / 2}]
2239 for {set i 0} {$i < $nr} {incr i} {
2240 if {[info exists idrangedrawn($id,$i)]} {
2244 foreach child $children($curview,$id) {
2245 if {[info exists iddrawn($child)]} {
2246 set row $commitrow($curview,$child)
2247 set col [lsearch -exact [lindex $rowidlist $row] $child]
2249 drawparentlinks $child $row $col [list $id]
2255 proc drawcmittext {id row col rmx} {
2256 global linespc canv canv2 canv3 canvy0
2257 global commitlisted commitinfo rowidlist
2258 global rowtextx idpos idtags idheads idotherrefs
2259 global linehtag linentag linedtag
2260 global mainfont canvxmax
2261 global hlview commitrow highlightedrows
2263 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2264 set x [xc $row $col]
2266 set orad [expr {$linespc / 3}]
2267 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2268 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2269 -fill $ofill -outline black -width 1]
2271 $canv bind $t <1> {selcanvline {} %x %y}
2272 set xt [xc $row [llength [lindex $rowidlist $row]]]
2276 set rowtextx($row) $xt
2277 set idpos($id) [list $x $xt $y]
2278 if {[info exists idtags($id)] || [info exists idheads($id)]
2279 || [info exists idotherrefs($id)]} {
2280 set xt [drawtags $id $x $xt $y]
2282 set headline [lindex $commitinfo($id) 0]
2283 set name [lindex $commitinfo($id) 1]
2284 set date [lindex $commitinfo($id) 2]
2285 set date [formatdate $date]
2287 if {[info exists hlview] && [info exists commitrow($hlview,$id)]} {
2289 lappend highlightedrows $row
2291 set linehtag($row) [$canv create text $xt $y -anchor w \
2292 -text $headline -font $font]
2293 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2294 set linentag($row) [$canv2 create text 3 $y -anchor w \
2295 -text $name -font $mainfont]
2296 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2297 -text $date -font $mainfont]
2298 set xr [expr {$xt + [font measure $mainfont $headline]}]
2299 if {$xr > $canvxmax} {
2305 proc drawcmitrow {row} {
2306 global displayorder rowidlist
2307 global idrangedrawn iddrawn
2308 global commitinfo parentlist numcommits
2310 if {$row >= $numcommits} return
2311 foreach id [lindex $rowidlist $row] {
2312 if {$id eq {}} continue
2314 foreach {s e} [rowranges $id] {
2316 if {$row < $s} continue
2319 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2321 set idrangedrawn($id,$i) 1
2328 set id [lindex $displayorder $row]
2329 if {[info exists iddrawn($id)]} return
2330 set col [lsearch -exact [lindex $rowidlist $row] $id]
2332 puts "oops, row $row id $id not in list"
2335 if {![info exists commitinfo($id)]} {
2339 set olds [lindex $parentlist $row]
2341 set rmx [drawparentlinks $id $row $col $olds]
2345 drawcmittext $id $row $col $rmx
2349 proc drawfrac {f0 f1} {
2350 global numcommits canv
2353 set ymax [lindex [$canv cget -scrollregion] 3]
2354 if {$ymax eq {} || $ymax == 0} return
2355 set y0 [expr {int($f0 * $ymax)}]
2356 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2360 set y1 [expr {int($f1 * $ymax)}]
2361 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2362 if {$endrow >= $numcommits} {
2363 set endrow [expr {$numcommits - 1}]
2365 for {} {$row <= $endrow} {incr row} {
2370 proc drawvisible {} {
2372 eval drawfrac [$canv yview]
2375 proc clear_display {} {
2376 global iddrawn idrangedrawn
2379 catch {unset iddrawn}
2380 catch {unset idrangedrawn}
2383 proc findcrossings {id} {
2384 global rowidlist parentlist numcommits rowoffsets displayorder
2388 foreach {s e} [rowranges $id] {
2389 if {$e >= $numcommits} {
2390 set e [expr {$numcommits - 1}]
2392 if {$e <= $s} continue
2393 set x [lsearch -exact [lindex $rowidlist $e] $id]
2395 puts "findcrossings: oops, no [shortids $id] in row $e"
2398 for {set row $e} {[incr row -1] >= $s} {} {
2399 set olds [lindex $parentlist $row]
2400 set kid [lindex $displayorder $row]
2401 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2402 if {$kidx < 0} continue
2403 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2405 set px [lsearch -exact $nextrow $p]
2406 if {$px < 0} continue
2407 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2408 if {[lsearch -exact $ccross $p] >= 0} continue
2409 if {$x == $px + ($kidx < $px? -1: 1)} {
2411 } elseif {[lsearch -exact $cross $p] < 0} {
2416 set inc [lindex $rowoffsets $row $x]
2417 if {$inc eq {}} break
2421 return [concat $ccross {{}} $cross]
2424 proc assigncolor {id} {
2425 global colormap colors nextcolor
2426 global commitrow parentlist children children curview
2428 if {[info exists colormap($id)]} return
2429 set ncolors [llength $colors]
2430 if {[info exists children($curview,$id)]} {
2431 set kids $children($curview,$id)
2435 if {[llength $kids] == 1} {
2436 set child [lindex $kids 0]
2437 if {[info exists colormap($child)]
2438 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2439 set colormap($id) $colormap($child)
2445 foreach x [findcrossings $id] {
2447 # delimiter between corner crossings and other crossings
2448 if {[llength $badcolors] >= $ncolors - 1} break
2449 set origbad $badcolors
2451 if {[info exists colormap($x)]
2452 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2453 lappend badcolors $colormap($x)
2456 if {[llength $badcolors] >= $ncolors} {
2457 set badcolors $origbad
2459 set origbad $badcolors
2460 if {[llength $badcolors] < $ncolors - 1} {
2461 foreach child $kids {
2462 if {[info exists colormap($child)]
2463 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2464 lappend badcolors $colormap($child)
2466 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2467 if {[info exists colormap($p)]
2468 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2469 lappend badcolors $colormap($p)
2473 if {[llength $badcolors] >= $ncolors} {
2474 set badcolors $origbad
2477 for {set i 0} {$i <= $ncolors} {incr i} {
2478 set c [lindex $colors $nextcolor]
2479 if {[incr nextcolor] >= $ncolors} {
2482 if {[lsearch -exact $badcolors $c]} break
2484 set colormap($id) $c
2487 proc bindline {t id} {
2490 $canv bind $t <Enter> "lineenter %x %y $id"
2491 $canv bind $t <Motion> "linemotion %x %y $id"
2492 $canv bind $t <Leave> "lineleave $id"
2493 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2496 proc drawtags {id x xt y1} {
2497 global idtags idheads idotherrefs
2498 global linespc lthickness
2499 global canv mainfont commitrow rowtextx curview
2504 if {[info exists idtags($id)]} {
2505 set marks $idtags($id)
2506 set ntags [llength $marks]
2508 if {[info exists idheads($id)]} {
2509 set marks [concat $marks $idheads($id)]
2510 set nheads [llength $idheads($id)]
2512 if {[info exists idotherrefs($id)]} {
2513 set marks [concat $marks $idotherrefs($id)]
2519 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2520 set yt [expr {$y1 - 0.5 * $linespc}]
2521 set yb [expr {$yt + $linespc - 1}]
2524 foreach tag $marks {
2525 set wid [font measure $mainfont $tag]
2528 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2530 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2531 -width $lthickness -fill black -tags tag.$id]
2533 foreach tag $marks x $xvals wid $wvals {
2534 set xl [expr {$x + $delta}]
2535 set xr [expr {$x + $delta + $wid + $lthickness}]
2536 if {[incr ntags -1] >= 0} {
2538 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2539 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2540 -width 1 -outline black -fill yellow -tags tag.$id]
2541 $canv bind $t <1> [list showtag $tag 1]
2542 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2544 # draw a head or other ref
2545 if {[incr nheads -1] >= 0} {
2550 set xl [expr {$xl - $delta/2}]
2551 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2552 -width 1 -outline black -fill $col -tags tag.$id
2553 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2554 set rwid [font measure $mainfont $remoteprefix]
2555 set xi [expr {$x + 1}]
2556 set yti [expr {$yt + 1}]
2557 set xri [expr {$x + $rwid}]
2558 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2559 -width 0 -fill "#ffddaa" -tags tag.$id
2562 set t [$canv create text $xl $y1 -anchor w -text $tag \
2563 -font $mainfont -tags tag.$id]
2565 $canv bind $t <1> [list showtag $tag 1]
2571 proc xcoord {i level ln} {
2572 global canvx0 xspc1 xspc2
2574 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2575 if {$i > 0 && $i == $level} {
2576 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2577 } elseif {$i > $level} {
2578 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2583 proc finishcommits {} {
2584 global commitidx phase curview
2585 global canv mainfont ctext maincursor textcursor
2586 global findinprogress pending_select
2588 if {$commitidx($curview) > 0} {
2592 $canv create text 3 3 -anchor nw -text "No commits selected" \
2593 -font $mainfont -tags textitems
2596 catch {unset pending_select}
2599 # Don't change the text pane cursor if it is currently the hand cursor,
2600 # showing that we are over a sha1 ID link.
2601 proc settextcursor {c} {
2602 global ctext curtextcursor
2604 if {[$ctext cget -cursor] == $curtextcursor} {
2605 $ctext config -cursor $c
2607 set curtextcursor $c
2610 proc nowbusy {what} {
2613 if {[array names isbusy] eq {}} {
2614 . config -cursor watch
2620 proc notbusy {what} {
2621 global isbusy maincursor textcursor
2623 catch {unset isbusy($what)}
2624 if {[array names isbusy] eq {}} {
2625 . config -cursor $maincursor
2626 settextcursor $textcursor
2633 global canvy0 numcommits linespc
2634 global rowlaidout commitidx curview
2635 global pending_select
2638 layoutrows $rowlaidout $commitidx($curview) 1
2640 optimize_rows $row 0 $commitidx($curview)
2641 showstuff $commitidx($curview)
2642 if {[info exists pending_select]} {
2646 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2647 #puts "overall $drawmsecs ms for $numcommits commits"
2650 proc findmatches {f} {
2651 global findtype foundstring foundstrlen
2652 if {$findtype == "Regexp"} {
2653 set matches [regexp -indices -all -inline $foundstring $f]
2655 if {$findtype == "IgnCase"} {
2656 set str [string tolower $f]
2662 while {[set j [string first $foundstring $str $i]] >= 0} {
2663 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2664 set i [expr {$j + $foundstrlen}]
2671 global findtype findloc findstring markedmatches commitinfo
2672 global numcommits displayorder linehtag linentag linedtag
2673 global mainfont canv canv2 canv3 selectedline
2674 global matchinglines foundstring foundstrlen matchstring
2680 set matchinglines {}
2681 if {$findloc == "Pickaxe"} {
2685 if {$findtype == "IgnCase"} {
2686 set foundstring [string tolower $findstring]
2688 set foundstring $findstring
2690 set foundstrlen [string length $findstring]
2691 if {$foundstrlen == 0} return
2692 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2693 set matchstring "*$matchstring*"
2694 if {$findloc == "Files"} {
2698 if {![info exists selectedline]} {
2701 set oldsel $selectedline
2704 set fldtypes {Headline Author Date Committer CDate Comment}
2706 foreach id $displayorder {
2707 set d $commitdata($id)
2709 if {$findtype == "Regexp"} {
2710 set doesmatch [regexp $foundstring $d]
2711 } elseif {$findtype == "IgnCase"} {
2712 set doesmatch [string match -nocase $matchstring $d]
2714 set doesmatch [string match $matchstring $d]
2716 if {!$doesmatch} continue
2717 if {![info exists commitinfo($id)]} {
2720 set info $commitinfo($id)
2722 foreach f $info ty $fldtypes {
2723 if {$findloc != "All fields" && $findloc != $ty} {
2726 set matches [findmatches $f]
2727 if {$matches == {}} continue
2729 if {$ty == "Headline"} {
2731 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2732 } elseif {$ty == "Author"} {
2734 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
2735 } elseif {$ty == "Date"} {
2737 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2741 lappend matchinglines $l
2742 if {!$didsel && $l > $oldsel} {
2748 if {$matchinglines == {}} {
2750 } elseif {!$didsel} {
2751 findselectline [lindex $matchinglines 0]
2755 proc findselectline {l} {
2756 global findloc commentend ctext
2758 if {$findloc == "All fields" || $findloc == "Comments"} {
2759 # highlight the matches in the comments
2760 set f [$ctext get 1.0 $commentend]
2761 set matches [findmatches $f]
2762 foreach match $matches {
2763 set start [lindex $match 0]
2764 set end [expr {[lindex $match 1] + 1}]
2765 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2770 proc findnext {restart} {
2771 global matchinglines selectedline
2772 if {![info exists matchinglines]} {
2778 if {![info exists selectedline]} return
2779 foreach l $matchinglines {
2780 if {$l > $selectedline} {
2789 global matchinglines selectedline
2790 if {![info exists matchinglines]} {
2794 if {![info exists selectedline]} return
2796 foreach l $matchinglines {
2797 if {$l >= $selectedline} break
2801 findselectline $prev
2807 proc findlocchange {name ix op} {
2808 global findloc findtype findtypemenu
2809 if {$findloc == "Pickaxe"} {
2815 $findtypemenu entryconf 1 -state $state
2816 $findtypemenu entryconf 2 -state $state
2819 proc stopfindproc {{done 0}} {
2820 global findprocpid findprocfile findids
2821 global ctext findoldcursor phase maincursor textcursor
2822 global findinprogress
2824 catch {unset findids}
2825 if {[info exists findprocpid]} {
2827 catch {exec kill $findprocpid}
2829 catch {close $findprocfile}
2832 catch {unset findinprogress}
2836 proc findpatches {} {
2837 global findstring selectedline numcommits
2838 global findprocpid findprocfile
2839 global finddidsel ctext displayorder findinprogress
2840 global findinsertpos
2842 if {$numcommits == 0} return
2844 # make a list of all the ids to search, starting at the one
2845 # after the selected line (if any)
2846 if {[info exists selectedline]} {
2852 for {set i 0} {$i < $numcommits} {incr i} {
2853 if {[incr l] >= $numcommits} {
2856 append inputids [lindex $displayorder $l] "\n"
2860 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2863 error_popup "Error starting search process: $err"
2867 set findinsertpos end
2869 set findprocpid [pid $f]
2870 fconfigure $f -blocking 0
2871 fileevent $f readable readfindproc
2874 set findinprogress 1
2877 proc readfindproc {} {
2878 global findprocfile finddidsel
2879 global commitrow matchinglines findinsertpos curview
2881 set n [gets $findprocfile line]
2883 if {[eof $findprocfile]} {
2891 if {![regexp {^[0-9a-f]{40}} $line id]} {
2892 error_popup "Can't parse git-diff-tree output: $line"
2896 if {![info exists commitrow($curview,$id)]} {
2897 puts stderr "spurious id: $id"
2900 set l $commitrow($curview,$id)
2904 proc insertmatch {l id} {
2905 global matchinglines findinsertpos finddidsel
2907 if {$findinsertpos == "end"} {
2908 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2909 set matchinglines [linsert $matchinglines 0 $l]
2912 lappend matchinglines $l
2915 set matchinglines [linsert $matchinglines $findinsertpos $l]
2926 global selectedline numcommits displayorder ctext
2927 global ffileline finddidsel parentlist
2928 global findinprogress findstartline findinsertpos
2929 global treediffs fdiffid fdiffsneeded fdiffpos
2930 global findmergefiles
2932 if {$numcommits == 0} return
2934 if {[info exists selectedline]} {
2935 set l [expr {$selectedline + 1}]
2940 set findstartline $l
2944 set id [lindex $displayorder $l]
2945 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2946 if {![info exists treediffs($id)]} {
2947 append diffsneeded "$id\n"
2948 lappend fdiffsneeded $id
2951 if {[incr l] >= $numcommits} {
2954 if {$l == $findstartline} break
2957 # start off a git-diff-tree process if needed
2958 if {$diffsneeded ne {}} {
2960 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2962 error_popup "Error starting search process: $err"
2965 catch {unset fdiffid}
2967 fconfigure $df -blocking 0
2968 fileevent $df readable [list readfilediffs $df]
2972 set findinsertpos end
2973 set id [lindex $displayorder $l]
2975 set findinprogress 1
2980 proc readfilediffs {df} {
2981 global findid fdiffid fdiffs
2983 set n [gets $df line]
2987 if {[catch {close $df} err]} {
2990 error_popup "Error in git-diff-tree: $err"
2991 } elseif {[info exists findid]} {
2995 error_popup "Couldn't find diffs for $id"
3000 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3001 # start of a new string of diffs
3005 } elseif {[string match ":*" $line]} {
3006 lappend fdiffs [lindex $line 5]
3010 proc donefilediff {} {
3011 global fdiffid fdiffs treediffs findid
3012 global fdiffsneeded fdiffpos
3014 if {[info exists fdiffid]} {
3015 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3016 && $fdiffpos < [llength $fdiffsneeded]} {
3017 # git-diff-tree doesn't output anything for a commit
3018 # which doesn't change anything
3019 set nullid [lindex $fdiffsneeded $fdiffpos]
3020 set treediffs($nullid) {}
3021 if {[info exists findid] && $nullid eq $findid} {
3029 if {![info exists treediffs($fdiffid)]} {
3030 set treediffs($fdiffid) $fdiffs
3032 if {[info exists findid] && $fdiffid eq $findid} {
3040 global findid treediffs parentlist
3041 global ffileline findstartline finddidsel
3042 global displayorder numcommits matchinglines findinprogress
3043 global findmergefiles
3047 set id [lindex $displayorder $l]
3048 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3049 if {![info exists treediffs($id)]} {
3055 foreach f $treediffs($id) {
3056 set x [findmatches $f]
3066 if {[incr l] >= $numcommits} {
3069 if {$l == $findstartline} break
3077 # mark a commit as matching by putting a yellow background
3078 # behind the headline
3079 proc markheadline {l id} {
3080 global canv mainfont linehtag
3083 set bbox [$canv bbox $linehtag($l)]
3084 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3088 # mark the bits of a headline, author or date that match a find string
3089 proc markmatches {canv l str tag matches font} {
3090 set bbox [$canv bbox $tag]
3091 set x0 [lindex $bbox 0]
3092 set y0 [lindex $bbox 1]
3093 set y1 [lindex $bbox 3]
3094 foreach match $matches {
3095 set start [lindex $match 0]
3096 set end [lindex $match 1]
3097 if {$start > $end} continue
3098 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3099 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3100 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3101 [expr {$x0+$xlen+2}] $y1 \
3102 -outline {} -tags matches -fill yellow]
3107 proc unmarkmatches {} {
3108 global matchinglines findids
3109 allcanvs delete matches
3110 catch {unset matchinglines}
3111 catch {unset findids}
3114 proc selcanvline {w x y} {
3115 global canv canvy0 ctext linespc
3117 set ymax [lindex [$canv cget -scrollregion] 3]
3118 if {$ymax == {}} return
3119 set yfrac [lindex [$canv yview] 0]
3120 set y [expr {$y + $yfrac * $ymax}]
3121 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3126 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3132 proc commit_descriptor {p} {
3135 if {[info exists commitinfo($p)]} {
3136 set l [lindex $commitinfo($p) 0]
3141 # append some text to the ctext widget, and make any SHA1 ID
3142 # that we know about be a clickable link.
3143 proc appendwithlinks {text} {
3144 global ctext commitrow linknum curview
3146 set start [$ctext index "end - 1c"]
3147 $ctext insert end $text
3148 $ctext insert end "\n"
3149 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3153 set linkid [string range $text $s $e]
3154 if {![info exists commitrow($curview,$linkid)]} continue
3156 $ctext tag add link "$start + $s c" "$start + $e c"
3157 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3158 $ctext tag bind link$linknum <1> \
3159 [list selectline $commitrow($curview,$linkid) 1]
3162 $ctext tag conf link -foreground blue -underline 1
3163 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3164 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3167 proc viewnextline {dir} {
3171 set ymax [lindex [$canv cget -scrollregion] 3]
3172 set wnow [$canv yview]
3173 set wtop [expr {[lindex $wnow 0] * $ymax}]
3174 set newtop [expr {$wtop + $dir * $linespc}]
3177 } elseif {$newtop > $ymax} {
3180 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3183 proc selectline {l isnew} {
3184 global canv canv2 canv3 ctext commitinfo selectedline
3185 global displayorder linehtag linentag linedtag
3186 global canvy0 linespc parentlist childlist
3187 global currentid sha1entry
3188 global commentend idtags linknum
3189 global mergemax numcommits pending_select
3192 catch {unset pending_select}
3195 if {$l < 0 || $l >= $numcommits} return
3196 set y [expr {$canvy0 + $l * $linespc}]
3197 set ymax [lindex [$canv cget -scrollregion] 3]
3198 set ytop [expr {$y - $linespc - 1}]
3199 set ybot [expr {$y + $linespc + 1}]
3200 set wnow [$canv yview]
3201 set wtop [expr {[lindex $wnow 0] * $ymax}]
3202 set wbot [expr {[lindex $wnow 1] * $ymax}]
3203 set wh [expr {$wbot - $wtop}]
3205 if {$ytop < $wtop} {
3206 if {$ybot < $wtop} {
3207 set newtop [expr {$y - $wh / 2.0}]
3210 if {$newtop > $wtop - $linespc} {
3211 set newtop [expr {$wtop - $linespc}]
3214 } elseif {$ybot > $wbot} {
3215 if {$ytop > $wbot} {
3216 set newtop [expr {$y - $wh / 2.0}]
3218 set newtop [expr {$ybot - $wh}]
3219 if {$newtop < $wtop + $linespc} {
3220 set newtop [expr {$wtop + $linespc}]
3224 if {$newtop != $wtop} {
3228 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3232 if {![info exists linehtag($l)]} return
3234 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3235 -tags secsel -fill [$canv cget -selectbackground]]
3237 $canv2 delete secsel
3238 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3239 -tags secsel -fill [$canv2 cget -selectbackground]]
3241 $canv3 delete secsel
3242 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3243 -tags secsel -fill [$canv3 cget -selectbackground]]
3247 addtohistory [list selectline $l 0]
3252 set id [lindex $displayorder $l]
3254 $sha1entry delete 0 end
3255 $sha1entry insert 0 $id
3256 $sha1entry selection from 0
3257 $sha1entry selection to end
3259 $ctext conf -state normal
3260 $ctext delete 0.0 end
3262 set info $commitinfo($id)
3263 set date [formatdate [lindex $info 2]]
3264 $ctext insert end "Author: [lindex $info 1] $date\n"
3265 set date [formatdate [lindex $info 4]]
3266 $ctext insert end "Committer: [lindex $info 3] $date\n"
3267 if {[info exists idtags($id)]} {
3268 $ctext insert end "Tags:"
3269 foreach tag $idtags($id) {
3270 $ctext insert end " $tag"
3272 $ctext insert end "\n"
3276 set olds [lindex $parentlist $l]
3277 if {[llength $olds] > 1} {
3280 if {$np >= $mergemax} {
3285 $ctext insert end "Parent: " $tag
3286 appendwithlinks [commit_descriptor $p]
3291 append comment "Parent: [commit_descriptor $p]\n"
3295 foreach c [lindex $childlist $l] {
3296 append comment "Child: [commit_descriptor $c]\n"
3299 append comment [lindex $info 5]
3301 # make anything that looks like a SHA1 ID be a clickable link
3302 appendwithlinks $comment
3304 $ctext tag delete Comments
3305 $ctext tag remove found 1.0 end
3306 $ctext conf -state disabled
3307 set commentend [$ctext index "end - 1c"]
3309 init_flist "Comments"
3310 if {$cmitmode eq "tree"} {
3312 } elseif {[llength $olds] <= 1} {
3319 proc selfirstline {} {
3324 proc sellastline {} {
3327 set l [expr {$numcommits - 1}]
3331 proc selnextline {dir} {
3333 if {![info exists selectedline]} return
3334 set l [expr {$selectedline + $dir}]
3339 proc selnextpage {dir} {
3340 global canv linespc selectedline numcommits
3342 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3346 allcanvs yview scroll [expr {$dir * $lpp}] units
3347 if {![info exists selectedline]} return
3348 set l [expr {$selectedline + $dir * $lpp}]
3351 } elseif {$l >= $numcommits} {
3352 set l [expr $numcommits - 1]
3358 proc unselectline {} {
3359 global selectedline currentid
3361 catch {unset selectedline}
3362 catch {unset currentid}
3363 allcanvs delete secsel
3366 proc reselectline {} {
3369 if {[info exists selectedline]} {
3370 selectline $selectedline 0
3374 proc addtohistory {cmd} {
3375 global history historyindex curview
3377 set elt [list $curview $cmd]
3378 if {$historyindex > 0
3379 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3383 if {$historyindex < [llength $history]} {
3384 set history [lreplace $history $historyindex end $elt]
3386 lappend history $elt
3389 if {$historyindex > 1} {
3390 .ctop.top.bar.leftbut conf -state normal
3392 .ctop.top.bar.leftbut conf -state disabled
3394 .ctop.top.bar.rightbut conf -state disabled
3400 set view [lindex $elt 0]
3401 set cmd [lindex $elt 1]
3402 if {$curview != $view} {
3409 global history historyindex
3411 if {$historyindex > 1} {
3412 incr historyindex -1
3413 godo [lindex $history [expr {$historyindex - 1}]]
3414 .ctop.top.bar.rightbut conf -state normal
3416 if {$historyindex <= 1} {
3417 .ctop.top.bar.leftbut conf -state disabled
3422 global history historyindex
3424 if {$historyindex < [llength $history]} {
3425 set cmd [lindex $history $historyindex]
3428 .ctop.top.bar.leftbut conf -state normal
3430 if {$historyindex >= [llength $history]} {
3431 .ctop.top.bar.rightbut conf -state disabled
3436 global treefilelist treeidlist diffids diffmergeid treepending
3439 catch {unset diffmergeid}
3440 if {![info exists treefilelist($id)]} {
3441 if {![info exists treepending]} {
3442 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3446 set treefilelist($id) {}
3447 set treeidlist($id) {}
3448 fconfigure $gtf -blocking 0
3449 fileevent $gtf readable [list gettreeline $gtf $id]
3456 proc gettreeline {gtf id} {
3457 global treefilelist treeidlist treepending cmitmode diffids
3459 while {[gets $gtf line] >= 0} {
3460 if {[lindex $line 1] ne "blob"} continue
3461 set sha1 [lindex $line 2]
3462 set fname [lindex $line 3]
3463 lappend treefilelist($id) $fname
3464 lappend treeidlist($id) $sha1
3466 if {![eof $gtf]} return
3469 if {$cmitmode ne "tree"} {
3470 if {![info exists diffmergeid]} {
3471 gettreediffs $diffids
3473 } elseif {$id ne $diffids} {
3481 global treefilelist treeidlist diffids
3482 global ctext commentend
3484 set i [lsearch -exact $treefilelist($diffids) $f]
3486 puts "oops, $f not in list for id $diffids"
3489 set blob [lindex $treeidlist($diffids) $i]
3490 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3491 puts "oops, error reading blob $blob: $err"
3494 fconfigure $bf -blocking 0
3495 fileevent $bf readable [list getblobline $bf $diffids]
3496 $ctext config -state normal
3497 $ctext delete $commentend end
3498 $ctext insert end "\n"
3499 $ctext insert end "$f\n" filesep
3500 $ctext config -state disabled
3501 $ctext yview $commentend
3504 proc getblobline {bf id} {
3505 global diffids cmitmode ctext
3507 if {$id ne $diffids || $cmitmode ne "tree"} {
3511 $ctext config -state normal
3512 while {[gets $bf line] >= 0} {
3513 $ctext insert end "$line\n"
3516 # delete last newline
3517 $ctext delete "end - 2c" "end - 1c"
3520 $ctext config -state disabled
3523 proc mergediff {id l} {
3524 global diffmergeid diffopts mdifffd
3530 # this doesn't seem to actually affect anything...
3531 set env(GIT_DIFF_OPTS) $diffopts
3532 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3533 if {[catch {set mdf [open $cmd r]} err]} {
3534 error_popup "Error getting merge diffs: $err"
3537 fconfigure $mdf -blocking 0
3538 set mdifffd($id) $mdf
3539 set np [llength [lindex $parentlist $l]]
3540 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3541 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3544 proc getmergediffline {mdf id np} {
3545 global diffmergeid ctext cflist nextupdate mergemax
3546 global difffilestart mdifffd
3548 set n [gets $mdf line]
3555 if {![info exists diffmergeid] || $id != $diffmergeid
3556 || $mdf != $mdifffd($id)} {
3559 $ctext conf -state normal
3560 if {[regexp {^diff --cc (.*)} $line match fname]} {
3561 # start of a new file
3562 $ctext insert end "\n"
3563 set here [$ctext index "end - 1c"]
3564 $ctext mark set f:$fname $here
3565 $ctext mark gravity f:$fname left
3566 lappend difffilestart $here
3567 add_flist [list $fname]
3568 set l [expr {(78 - [string length $fname]) / 2}]
3569 set pad [string range "----------------------------------------" 1 $l]
3570 $ctext insert end "$pad $fname $pad\n" filesep
3571 } elseif {[regexp {^@@} $line]} {
3572 $ctext insert end "$line\n" hunksep
3573 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3576 # parse the prefix - one ' ', '-' or '+' for each parent
3581 for {set j 0} {$j < $np} {incr j} {
3582 set c [string range $line $j $j]
3585 } elseif {$c == "-"} {
3587 } elseif {$c == "+"} {
3596 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3597 # line doesn't appear in result, parents in $minuses have the line
3598 set num [lindex $minuses 0]
3599 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3600 # line appears in result, parents in $pluses don't have the line
3601 lappend tags mresult
3602 set num [lindex $spaces 0]
3605 if {$num >= $mergemax} {
3610 $ctext insert end "$line\n" $tags
3612 $ctext conf -state disabled
3613 if {[clock clicks -milliseconds] >= $nextupdate} {
3615 fileevent $mdf readable {}
3617 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3621 proc startdiff {ids} {
3622 global treediffs diffids treepending diffmergeid
3625 catch {unset diffmergeid}
3626 if {![info exists treediffs($ids)]} {
3627 if {![info exists treepending]} {
3635 proc addtocflist {ids} {
3636 global treediffs cflist
3637 add_flist $treediffs($ids)
3641 proc gettreediffs {ids} {
3642 global treediff treepending
3643 set treepending $ids
3646 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3648 fconfigure $gdtf -blocking 0
3649 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3652 proc gettreediffline {gdtf ids} {
3653 global treediff treediffs treepending diffids diffmergeid
3656 set n [gets $gdtf line]
3658 if {![eof $gdtf]} return
3660 set treediffs($ids) $treediff
3662 if {$cmitmode eq "tree"} {
3664 } elseif {$ids != $diffids} {
3665 if {![info exists diffmergeid]} {
3666 gettreediffs $diffids
3673 set file [lindex $line 5]
3674 lappend treediff $file
3677 proc getblobdiffs {ids} {
3678 global diffopts blobdifffd diffids env curdifftag curtagstart
3679 global nextupdate diffinhdr treediffs
3681 set env(GIT_DIFF_OPTS) $diffopts
3682 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3683 if {[catch {set bdf [open $cmd r]} err]} {
3684 puts "error getting diffs: $err"
3688 fconfigure $bdf -blocking 0
3689 set blobdifffd($ids) $bdf
3690 set curdifftag Comments
3692 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3693 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3696 proc getblobdiffline {bdf ids} {
3697 global diffids blobdifffd ctext curdifftag curtagstart
3698 global diffnexthead diffnextnote difffilestart
3699 global nextupdate diffinhdr treediffs
3701 set n [gets $bdf line]
3705 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3706 $ctext tag add $curdifftag $curtagstart end
3711 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3714 $ctext conf -state normal
3715 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3716 # start of a new file
3717 $ctext insert end "\n"
3718 $ctext tag add $curdifftag $curtagstart end
3719 set here [$ctext index "end - 1c"]
3720 set curtagstart $here
3722 lappend difffilestart $here
3723 $ctext mark set f:$fname $here
3724 $ctext mark gravity f:$fname left
3725 if {$newname != $fname} {
3726 $ctext mark set f:$newfname $here
3727 $ctext mark gravity f:$newfname left
3729 set curdifftag "f:$fname"
3730 $ctext tag delete $curdifftag
3731 set l [expr {(78 - [string length $header]) / 2}]
3732 set pad [string range "----------------------------------------" 1 $l]
3733 $ctext insert end "$pad $header $pad\n" filesep
3735 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3737 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3739 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3740 $line match f1l f1c f2l f2c rest]} {
3741 $ctext insert end "$line\n" hunksep
3744 set x [string range $line 0 0]
3745 if {$x == "-" || $x == "+"} {
3746 set tag [expr {$x == "+"}]
3747 $ctext insert end "$line\n" d$tag
3748 } elseif {$x == " "} {
3749 $ctext insert end "$line\n"
3750 } elseif {$diffinhdr || $x == "\\"} {
3751 # e.g. "\ No newline at end of file"
3752 $ctext insert end "$line\n" filesep
3754 # Something else we don't recognize
3755 if {$curdifftag != "Comments"} {
3756 $ctext insert end "\n"
3757 $ctext tag add $curdifftag $curtagstart end
3758 set curtagstart [$ctext index "end - 1c"]
3759 set curdifftag Comments
3761 $ctext insert end "$line\n" filesep
3764 $ctext conf -state disabled
3765 if {[clock clicks -milliseconds] >= $nextupdate} {
3767 fileevent $bdf readable {}
3769 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3774 global difffilestart ctext
3775 set here [$ctext index @0,0]
3776 foreach loc $difffilestart {
3777 if {[$ctext compare $loc > $here]} {
3784 global linespc charspc canvx0 canvy0 mainfont
3785 global xspc1 xspc2 lthickness
3787 set linespc [font metrics $mainfont -linespace]
3788 set charspc [font measure $mainfont "m"]
3789 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3790 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3791 set lthickness [expr {int($linespc / 9) + 1}]
3792 set xspc1(0) $linespc
3800 set ymax [lindex [$canv cget -scrollregion] 3]
3801 if {$ymax eq {} || $ymax == 0} return
3802 set span [$canv yview]
3805 allcanvs yview moveto [lindex $span 0]
3807 if {[info exists selectedline]} {
3808 selectline $selectedline 0
3812 proc incrfont {inc} {
3813 global mainfont textfont ctext canv phase
3814 global stopped entries
3816 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3817 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3819 $ctext conf -font $textfont
3820 $ctext tag conf filesep -font [concat $textfont bold]
3821 foreach e $entries {
3822 $e conf -font $mainfont
3824 if {$phase eq "getcommits"} {
3825 $canv itemconf textitems -font $mainfont
3831 global sha1entry sha1string
3832 if {[string length $sha1string] == 40} {
3833 $sha1entry delete 0 end
3837 proc sha1change {n1 n2 op} {
3838 global sha1string currentid sha1but
3839 if {$sha1string == {}
3840 || ([info exists currentid] && $sha1string == $currentid)} {
3845 if {[$sha1but cget -state] == $state} return
3846 if {$state == "normal"} {
3847 $sha1but conf -state normal -relief raised -text "Goto: "
3849 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3853 proc gotocommit {} {
3854 global sha1string currentid commitrow tagids headids
3855 global displayorder numcommits curview
3857 if {$sha1string == {}
3858 || ([info exists currentid] && $sha1string == $currentid)} return
3859 if {[info exists tagids($sha1string)]} {
3860 set id $tagids($sha1string)
3861 } elseif {[info exists headids($sha1string)]} {
3862 set id $headids($sha1string)
3864 set id [string tolower $sha1string]
3865 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3867 foreach i $displayorder {
3868 if {[string match $id* $i]} {
3872 if {$matches ne {}} {
3873 if {[llength $matches] > 1} {
3874 error_popup "Short SHA1 id $id is ambiguous"
3877 set id [lindex $matches 0]
3881 if {[info exists commitrow($curview,$id)]} {
3882 selectline $commitrow($curview,$id) 1
3885 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3890 error_popup "$type $sha1string is not known"
3893 proc lineenter {x y id} {
3894 global hoverx hovery hoverid hovertimer
3895 global commitinfo canv
3897 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3901 if {[info exists hovertimer]} {
3902 after cancel $hovertimer
3904 set hovertimer [after 500 linehover]
3908 proc linemotion {x y id} {
3909 global hoverx hovery hoverid hovertimer
3911 if {[info exists hoverid] && $id == $hoverid} {
3914 if {[info exists hovertimer]} {
3915 after cancel $hovertimer
3917 set hovertimer [after 500 linehover]
3921 proc lineleave {id} {
3922 global hoverid hovertimer canv
3924 if {[info exists hoverid] && $id == $hoverid} {
3926 if {[info exists hovertimer]} {
3927 after cancel $hovertimer
3935 global hoverx hovery hoverid hovertimer
3936 global canv linespc lthickness
3937 global commitinfo mainfont
3939 set text [lindex $commitinfo($hoverid) 0]
3940 set ymax [lindex [$canv cget -scrollregion] 3]
3941 if {$ymax == {}} return
3942 set yfrac [lindex [$canv yview] 0]
3943 set x [expr {$hoverx + 2 * $linespc}]
3944 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3945 set x0 [expr {$x - 2 * $lthickness}]
3946 set y0 [expr {$y - 2 * $lthickness}]
3947 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3948 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3949 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3950 -fill \#ffff80 -outline black -width 1 -tags hover]
3952 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3956 proc clickisonarrow {id y} {
3959 set ranges [rowranges $id]
3960 set thresh [expr {2 * $lthickness + 6}]
3961 set n [expr {[llength $ranges] - 1}]
3962 for {set i 1} {$i < $n} {incr i} {
3963 set row [lindex $ranges $i]
3964 if {abs([yc $row] - $y) < $thresh} {
3971 proc arrowjump {id n y} {
3974 # 1 <-> 2, 3 <-> 4, etc...
3975 set n [expr {(($n - 1) ^ 1) + 1}]
3976 set row [lindex [rowranges $id] $n]
3978 set ymax [lindex [$canv cget -scrollregion] 3]
3979 if {$ymax eq {} || $ymax <= 0} return
3980 set view [$canv yview]
3981 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3982 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3986 allcanvs yview moveto $yfrac
3989 proc lineclick {x y id isnew} {
3990 global ctext commitinfo children canv thickerline curview
3992 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3997 # draw this line thicker than normal
4001 set ymax [lindex [$canv cget -scrollregion] 3]
4002 if {$ymax eq {}} return
4003 set yfrac [lindex [$canv yview] 0]
4004 set y [expr {$y + $yfrac * $ymax}]
4006 set dirn [clickisonarrow $id $y]
4008 arrowjump $id $dirn $y
4013 addtohistory [list lineclick $x $y $id 0]
4015 # fill the details pane with info about this line
4016 $ctext conf -state normal
4017 $ctext delete 0.0 end
4018 $ctext tag conf link -foreground blue -underline 1
4019 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4020 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4021 $ctext insert end "Parent:\t"
4022 $ctext insert end $id [list link link0]
4023 $ctext tag bind link0 <1> [list selbyid $id]
4024 set info $commitinfo($id)
4025 $ctext insert end "\n\t[lindex $info 0]\n"
4026 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4027 set date [formatdate [lindex $info 2]]
4028 $ctext insert end "\tDate:\t$date\n"
4029 set kids $children($curview,$id)
4031 $ctext insert end "\nChildren:"
4033 foreach child $kids {
4035 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4036 set info $commitinfo($child)
4037 $ctext insert end "\n\t"
4038 $ctext insert end $child [list link link$i]
4039 $ctext tag bind link$i <1> [list selbyid $child]
4040 $ctext insert end "\n\t[lindex $info 0]"
4041 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4042 set date [formatdate [lindex $info 2]]
4043 $ctext insert end "\n\tDate:\t$date\n"
4046 $ctext conf -state disabled
4050 proc normalline {} {
4052 if {[info exists thickerline]} {
4060 global commitrow curview
4061 if {[info exists commitrow($curview,$id)]} {
4062 selectline $commitrow($curview,$id) 1
4068 if {![info exists startmstime]} {
4069 set startmstime [clock clicks -milliseconds]
4071 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4074 proc rowmenu {x y id} {
4075 global rowctxmenu commitrow selectedline rowmenuid curview
4077 if {![info exists selectedline]
4078 || $commitrow($curview,$id) eq $selectedline} {
4083 $rowctxmenu entryconfigure 0 -state $state
4084 $rowctxmenu entryconfigure 1 -state $state
4085 $rowctxmenu entryconfigure 2 -state $state
4087 tk_popup $rowctxmenu $x $y
4090 proc diffvssel {dirn} {
4091 global rowmenuid selectedline displayorder
4093 if {![info exists selectedline]} return
4095 set oldid [lindex $displayorder $selectedline]
4096 set newid $rowmenuid
4098 set oldid $rowmenuid
4099 set newid [lindex $displayorder $selectedline]
4101 addtohistory [list doseldiff $oldid $newid]
4102 doseldiff $oldid $newid
4105 proc doseldiff {oldid newid} {
4109 $ctext conf -state normal
4110 $ctext delete 0.0 end
4112 $ctext insert end "From "
4113 $ctext tag conf link -foreground blue -underline 1
4114 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4115 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4116 $ctext tag bind link0 <1> [list selbyid $oldid]
4117 $ctext insert end $oldid [list link link0]
4118 $ctext insert end "\n "
4119 $ctext insert end [lindex $commitinfo($oldid) 0]
4120 $ctext insert end "\n\nTo "
4121 $ctext tag bind link1 <1> [list selbyid $newid]
4122 $ctext insert end $newid [list link link1]
4123 $ctext insert end "\n "
4124 $ctext insert end [lindex $commitinfo($newid) 0]
4125 $ctext insert end "\n"
4126 $ctext conf -state disabled
4127 $ctext tag delete Comments
4128 $ctext tag remove found 1.0 end
4129 startdiff [list $oldid $newid]
4133 global rowmenuid currentid commitinfo patchtop patchnum
4135 if {![info exists currentid]} return
4136 set oldid $currentid
4137 set oldhead [lindex $commitinfo($oldid) 0]
4138 set newid $rowmenuid
4139 set newhead [lindex $commitinfo($newid) 0]
4142 catch {destroy $top}
4144 label $top.title -text "Generate patch"
4145 grid $top.title - -pady 10
4146 label $top.from -text "From:"
4147 entry $top.fromsha1 -width 40 -relief flat
4148 $top.fromsha1 insert 0 $oldid
4149 $top.fromsha1 conf -state readonly
4150 grid $top.from $top.fromsha1 -sticky w
4151 entry $top.fromhead -width 60 -relief flat
4152 $top.fromhead insert 0 $oldhead
4153 $top.fromhead conf -state readonly
4154 grid x $top.fromhead -sticky w
4155 label $top.to -text "To:"
4156 entry $top.tosha1 -width 40 -relief flat
4157 $top.tosha1 insert 0 $newid
4158 $top.tosha1 conf -state readonly
4159 grid $top.to $top.tosha1 -sticky w
4160 entry $top.tohead -width 60 -relief flat
4161 $top.tohead insert 0 $newhead
4162 $top.tohead conf -state readonly
4163 grid x $top.tohead -sticky w
4164 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4165 grid $top.rev x -pady 10
4166 label $top.flab -text "Output file:"
4167 entry $top.fname -width 60
4168 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4170 grid $top.flab $top.fname -sticky w
4172 button $top.buts.gen -text "Generate" -command mkpatchgo
4173 button $top.buts.can -text "Cancel" -command mkpatchcan
4174 grid $top.buts.gen $top.buts.can
4175 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4176 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4177 grid $top.buts - -pady 10 -sticky ew
4181 proc mkpatchrev {} {
4184 set oldid [$patchtop.fromsha1 get]
4185 set oldhead [$patchtop.fromhead get]
4186 set newid [$patchtop.tosha1 get]
4187 set newhead [$patchtop.tohead get]
4188 foreach e [list fromsha1 fromhead tosha1 tohead] \
4189 v [list $newid $newhead $oldid $oldhead] {
4190 $patchtop.$e conf -state normal
4191 $patchtop.$e delete 0 end
4192 $patchtop.$e insert 0 $v
4193 $patchtop.$e conf -state readonly
4200 set oldid [$patchtop.fromsha1 get]
4201 set newid [$patchtop.tosha1 get]
4202 set fname [$patchtop.fname get]
4203 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4204 error_popup "Error creating patch: $err"
4206 catch {destroy $patchtop}
4210 proc mkpatchcan {} {
4213 catch {destroy $patchtop}
4218 global rowmenuid mktagtop commitinfo
4222 catch {destroy $top}
4224 label $top.title -text "Create tag"
4225 grid $top.title - -pady 10
4226 label $top.id -text "ID:"
4227 entry $top.sha1 -width 40 -relief flat
4228 $top.sha1 insert 0 $rowmenuid
4229 $top.sha1 conf -state readonly
4230 grid $top.id $top.sha1 -sticky w
4231 entry $top.head -width 60 -relief flat
4232 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4233 $top.head conf -state readonly
4234 grid x $top.head -sticky w
4235 label $top.tlab -text "Tag name:"
4236 entry $top.tag -width 60
4237 grid $top.tlab $top.tag -sticky w
4239 button $top.buts.gen -text "Create" -command mktaggo
4240 button $top.buts.can -text "Cancel" -command mktagcan
4241 grid $top.buts.gen $top.buts.can
4242 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4243 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4244 grid $top.buts - -pady 10 -sticky ew
4249 global mktagtop env tagids idtags
4251 set id [$mktagtop.sha1 get]
4252 set tag [$mktagtop.tag get]
4254 error_popup "No tag name specified"
4257 if {[info exists tagids($tag)]} {
4258 error_popup "Tag \"$tag\" already exists"
4263 set fname [file join $dir "refs/tags" $tag]
4264 set f [open $fname w]
4268 error_popup "Error creating tag: $err"
4272 set tagids($tag) $id
4273 lappend idtags($id) $tag
4277 proc redrawtags {id} {
4278 global canv linehtag commitrow idpos selectedline curview
4280 if {![info exists commitrow($curview,$id)]} return
4281 drawcmitrow $commitrow($curview,$id)
4282 $canv delete tag.$id
4283 set xt [eval drawtags $id $idpos($id)]
4284 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4285 if {[info exists selectedline]
4286 && $selectedline == $commitrow($curview,$id)} {
4287 selectline $selectedline 0
4294 catch {destroy $mktagtop}
4303 proc writecommit {} {
4304 global rowmenuid wrcomtop commitinfo wrcomcmd
4306 set top .writecommit
4308 catch {destroy $top}
4310 label $top.title -text "Write commit to file"
4311 grid $top.title - -pady 10
4312 label $top.id -text "ID:"
4313 entry $top.sha1 -width 40 -relief flat
4314 $top.sha1 insert 0 $rowmenuid
4315 $top.sha1 conf -state readonly
4316 grid $top.id $top.sha1 -sticky w
4317 entry $top.head -width 60 -relief flat
4318 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4319 $top.head conf -state readonly
4320 grid x $top.head -sticky w
4321 label $top.clab -text "Command:"
4322 entry $top.cmd -width 60 -textvariable wrcomcmd
4323 grid $top.clab $top.cmd -sticky w -pady 10
4324 label $top.flab -text "Output file:"
4325 entry $top.fname -width 60
4326 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4327 grid $top.flab $top.fname -sticky w
4329 button $top.buts.gen -text "Write" -command wrcomgo
4330 button $top.buts.can -text "Cancel" -command wrcomcan
4331 grid $top.buts.gen $top.buts.can
4332 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4333 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4334 grid $top.buts - -pady 10 -sticky ew
4341 set id [$wrcomtop.sha1 get]
4342 set cmd "echo $id | [$wrcomtop.cmd get]"
4343 set fname [$wrcomtop.fname get]
4344 if {[catch {exec sh -c $cmd >$fname &} err]} {
4345 error_popup "Error writing commit: $err"
4347 catch {destroy $wrcomtop}
4354 catch {destroy $wrcomtop}
4358 proc listrefs {id} {
4359 global idtags idheads idotherrefs
4362 if {[info exists idtags($id)]} {
4366 if {[info exists idheads($id)]} {
4370 if {[info exists idotherrefs($id)]} {
4371 set z $idotherrefs($id)
4373 return [list $x $y $z]
4376 proc rereadrefs {} {
4377 global idtags idheads idotherrefs
4379 set refids [concat [array names idtags] \
4380 [array names idheads] [array names idotherrefs]]
4381 foreach id $refids {
4382 if {![info exists ref($id)]} {
4383 set ref($id) [listrefs $id]
4387 set refids [lsort -unique [concat $refids [array names idtags] \
4388 [array names idheads] [array names idotherrefs]]]
4389 foreach id $refids {
4390 set v [listrefs $id]
4391 if {![info exists ref($id)] || $ref($id) != $v} {
4397 proc showtag {tag isnew} {
4398 global ctext tagcontents tagids linknum
4401 addtohistory [list showtag $tag 0]
4403 $ctext conf -state normal
4404 $ctext delete 0.0 end
4406 if {[info exists tagcontents($tag)]} {
4407 set text $tagcontents($tag)
4409 set text "Tag: $tag\nId: $tagids($tag)"
4411 appendwithlinks $text
4412 $ctext conf -state disabled
4423 global maxwidth maxgraphpct diffopts findmergefiles
4424 global oldprefs prefstop
4428 if {[winfo exists $top]} {
4432 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4433 set oldprefs($v) [set $v]
4436 wm title $top "Gitk preferences"
4437 label $top.ldisp -text "Commit list display options"
4438 grid $top.ldisp - -sticky w -pady 10
4439 label $top.spacer -text " "
4440 label $top.maxwidthl -text "Maximum graph width (lines)" \
4442 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4443 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4444 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4446 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4447 grid x $top.maxpctl $top.maxpct -sticky w
4448 checkbutton $top.findm -variable findmergefiles
4449 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4451 grid $top.findm $top.findml - -sticky w
4452 label $top.ddisp -text "Diff display options"
4453 grid $top.ddisp - -sticky w -pady 10
4454 label $top.diffoptl -text "Options for diff program" \
4456 entry $top.diffopt -width 20 -textvariable diffopts
4457 grid x $top.diffoptl $top.diffopt -sticky w
4459 button $top.buts.ok -text "OK" -command prefsok
4460 button $top.buts.can -text "Cancel" -command prefscan
4461 grid $top.buts.ok $top.buts.can
4462 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4463 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4464 grid $top.buts - - -pady 10 -sticky ew
4468 global maxwidth maxgraphpct diffopts findmergefiles
4469 global oldprefs prefstop
4471 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4472 set $v $oldprefs($v)
4474 catch {destroy $prefstop}
4479 global maxwidth maxgraphpct
4480 global oldprefs prefstop
4482 catch {destroy $prefstop}
4484 if {$maxwidth != $oldprefs(maxwidth)
4485 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4490 proc formatdate {d} {
4491 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4494 # This list of encoding names and aliases is distilled from
4495 # http://www.iana.org/assignments/character-sets.
4496 # Not all of them are supported by Tcl.
4497 set encoding_aliases {
4498 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4499 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4500 { ISO-10646-UTF-1 csISO10646UTF1 }
4501 { ISO_646.basic:1983 ref csISO646basic1983 }
4502 { INVARIANT csINVARIANT }
4503 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4504 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4505 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4506 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4507 { NATS-DANO iso-ir-9-1 csNATSDANO }
4508 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4509 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4510 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4511 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4512 { ISO-2022-KR csISO2022KR }
4514 { ISO-2022-JP csISO2022JP }
4515 { ISO-2022-JP-2 csISO2022JP2 }
4516 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4518 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4519 { IT iso-ir-15 ISO646-IT csISO15Italian }
4520 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4521 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4522 { greek7-old iso-ir-18 csISO18Greek7Old }
4523 { latin-greek iso-ir-19 csISO19LatinGreek }
4524 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4525 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4526 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4527 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4528 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4529 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4530 { INIS iso-ir-49 csISO49INIS }
4531 { INIS-8 iso-ir-50 csISO50INIS8 }
4532 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4533 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4534 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4535 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4536 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4537 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4539 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4540 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4541 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4542 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4543 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4544 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4545 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4546 { greek7 iso-ir-88 csISO88Greek7 }
4547 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4548 { iso-ir-90 csISO90 }
4549 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4550 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4551 csISO92JISC62991984b }
4552 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4553 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4554 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4555 csISO95JIS62291984handadd }
4556 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4557 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4558 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4559 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4561 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4562 { T.61-7bit iso-ir-102 csISO102T617bit }
4563 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4564 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4565 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4566 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4567 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4568 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4569 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4570 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4571 arabic csISOLatinArabic }
4572 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4573 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4574 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4575 greek greek8 csISOLatinGreek }
4576 { T.101-G2 iso-ir-128 csISO128T101G2 }
4577 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4579 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4580 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4581 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4582 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4583 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4584 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4585 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4586 csISOLatinCyrillic }
4587 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4588 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4589 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4590 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4591 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4592 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4593 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4594 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4595 { ISO_10367-box iso-ir-155 csISO10367Box }
4596 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4597 { latin-lap lap iso-ir-158 csISO158Lap }
4598 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4599 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4602 { JIS_X0201 X0201 csHalfWidthKatakana }
4603 { KSC5636 ISO646-KR csKSC5636 }
4604 { ISO-10646-UCS-2 csUnicode }
4605 { ISO-10646-UCS-4 csUCS4 }
4606 { DEC-MCS dec csDECMCS }
4607 { hp-roman8 roman8 r8 csHPRoman8 }
4608 { macintosh mac csMacintosh }
4609 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4611 { IBM038 EBCDIC-INT cp038 csIBM038 }
4612 { IBM273 CP273 csIBM273 }
4613 { IBM274 EBCDIC-BE CP274 csIBM274 }
4614 { IBM275 EBCDIC-BR cp275 csIBM275 }
4615 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4616 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4617 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4618 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4619 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4620 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4621 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4622 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4623 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4624 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4625 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4626 { IBM437 cp437 437 csPC8CodePage437 }
4627 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4628 { IBM775 cp775 csPC775Baltic }
4629 { IBM850 cp850 850 csPC850Multilingual }
4630 { IBM851 cp851 851 csIBM851 }
4631 { IBM852 cp852 852 csPCp852 }
4632 { IBM855 cp855 855 csIBM855 }
4633 { IBM857 cp857 857 csIBM857 }
4634 { IBM860 cp860 860 csIBM860 }
4635 { IBM861 cp861 861 cp-is csIBM861 }
4636 { IBM862 cp862 862 csPC862LatinHebrew }
4637 { IBM863 cp863 863 csIBM863 }
4638 { IBM864 cp864 csIBM864 }
4639 { IBM865 cp865 865 csIBM865 }
4640 { IBM866 cp866 866 csIBM866 }
4641 { IBM868 CP868 cp-ar csIBM868 }
4642 { IBM869 cp869 869 cp-gr csIBM869 }
4643 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4644 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4645 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4646 { IBM891 cp891 csIBM891 }
4647 { IBM903 cp903 csIBM903 }
4648 { IBM904 cp904 904 csIBBM904 }
4649 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4650 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4651 { IBM1026 CP1026 csIBM1026 }
4652 { EBCDIC-AT-DE csIBMEBCDICATDE }
4653 { EBCDIC-AT-DE-A csEBCDICATDEA }
4654 { EBCDIC-CA-FR csEBCDICCAFR }
4655 { EBCDIC-DK-NO csEBCDICDKNO }
4656 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4657 { EBCDIC-FI-SE csEBCDICFISE }
4658 { EBCDIC-FI-SE-A csEBCDICFISEA }
4659 { EBCDIC-FR csEBCDICFR }
4660 { EBCDIC-IT csEBCDICIT }
4661 { EBCDIC-PT csEBCDICPT }
4662 { EBCDIC-ES csEBCDICES }
4663 { EBCDIC-ES-A csEBCDICESA }
4664 { EBCDIC-ES-S csEBCDICESS }
4665 { EBCDIC-UK csEBCDICUK }
4666 { EBCDIC-US csEBCDICUS }
4667 { UNKNOWN-8BIT csUnknown8BiT }
4668 { MNEMONIC csMnemonic }
4673 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4674 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4675 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4676 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4677 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4678 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4679 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4680 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4681 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4682 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4683 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4684 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4685 { IBM1047 IBM-1047 }
4686 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4687 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4688 { UNICODE-1-1 csUnicode11 }
4691 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4692 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4694 { ISO-8859-15 ISO_8859-15 Latin-9 }
4695 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4696 { GBK CP936 MS936 windows-936 }
4697 { JIS_Encoding csJISEncoding }
4698 { Shift_JIS MS_Kanji csShiftJIS }
4699 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4701 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4702 { ISO-10646-UCS-Basic csUnicodeASCII }
4703 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4704 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4705 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4706 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4707 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4708 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4709 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4710 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4711 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4712 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4713 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4714 { Ventura-US csVenturaUS }
4715 { Ventura-International csVenturaInternational }
4716 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4717 { PC8-Turkish csPC8Turkish }
4718 { IBM-Symbols csIBMSymbols }
4719 { IBM-Thai csIBMThai }
4720 { HP-Legal csHPLegal }
4721 { HP-Pi-font csHPPiFont }
4722 { HP-Math8 csHPMath8 }
4723 { Adobe-Symbol-Encoding csHPPSMath }
4724 { HP-DeskTop csHPDesktop }
4725 { Ventura-Math csVenturaMath }
4726 { Microsoft-Publishing csMicrosoftPublishing }
4727 { Windows-31J csWindows31J }
4732 proc tcl_encoding {enc} {
4733 global encoding_aliases
4734 set names [encoding names]
4735 set lcnames [string tolower $names]
4736 set enc [string tolower $enc]
4737 set i [lsearch -exact $lcnames $enc]
4739 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4740 if {[regsub {^iso[-_]} $enc iso encx]} {
4741 set i [lsearch -exact $lcnames $encx]
4745 foreach l $encoding_aliases {
4746 set ll [string tolower $l]
4747 if {[lsearch -exact $ll $enc] < 0} continue
4748 # look through the aliases for one that tcl knows about
4750 set i [lsearch -exact $lcnames $e]
4752 if {[regsub {^iso[-_]} $e iso ex]} {
4753 set i [lsearch -exact $lcnames $ex]
4762 return [lindex $names $i]
4769 set diffopts "-U 5 -p"
4770 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4774 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4776 if {$gitencoding == ""} {
4777 set gitencoding "utf-8"
4779 set tclencoding [tcl_encoding $gitencoding]
4780 if {$tclencoding == {}} {
4781 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4784 set mainfont {Helvetica 9}
4785 set textfont {Courier 9}
4786 set uifont {Helvetica 9 bold}
4787 set findmergefiles 0
4795 set flistmode "flat"
4796 set cmitmode "patch"
4798 set colors {green red blue magenta darkgrey brown orange}
4800 catch {source ~/.gitk}
4802 font create optionfont -family sans-serif -size -12
4806 switch -regexp -- $arg {
4808 "^-d" { set datemode 1 }
4810 lappend revtreeargs $arg
4815 # check that we can find a .git directory somewhere...
4817 if {![file isdirectory $gitdir]} {
4818 error_popup "Cannot find the git directory \"$gitdir\"."
4830 set selectedhlview {}
4841 set cmdline_files {}
4843 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4844 set cmdline_files [split $fileargs "\n"]
4845 set n [llength $cmdline_files]
4846 set revtreeargs [lrange $revtreeargs 0 end-$n]
4848 if {[lindex $revtreeargs end] eq "--"} {
4849 set revtreeargs [lrange $revtreeargs 0 end-1]
4852 if {$cmdline_files ne {}} {
4853 # create a view for the files/dirs specified on the command line
4857 set viewname(1) "Command line"
4858 set viewfiles(1) $cmdline_files
4861 .bar.view entryconf 1 -state normal
4862 .bar.view entryconf 2 -state normal
4865 if {[info exists permviews]} {
4866 foreach v $permviews {
4869 set viewname($n) [lindex $v 0]
4870 set viewfiles($n) [lindex $v 1]