2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005-2006 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
)]} {
15 return [exec git rev-parse
--git-dir]
19 proc start_rev_list
{view
} {
20 global startmsecs nextupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs
[clock clicks
-milliseconds]
25 set nextupdate
[expr {$startmsecs + 100}]
26 set commitidx
($view) 0
27 set args
$viewargs($view)
28 if {$viewfiles($view) ne
{}} {
29 set args
[concat
$args "--" $viewfiles($view)]
31 set order
"--topo-order"
33 set order
"--date-order"
36 set fd
[open
[concat | git rev-list
--header $order \
37 --parents --boundary --default HEAD
$args] r
]
39 puts stderr
"Error executing git rev-list: $err"
43 set leftover
($view) {}
44 fconfigure
$fd -blocking 0 -translation lf
45 if {$tclencoding != {}} {
46 fconfigure
$fd -encoding $tclencoding
48 fileevent
$fd readable
[list getcommitlines
$fd $view]
52 proc stop_rev_list
{} {
55 if {![info exists commfd
($curview)]} return
56 set fd
$commfd($curview)
62 unset commfd
($curview)
66 global phase canv mainfont curview
70 start_rev_list
$curview
71 show_status
"Reading commits..."
74 proc getcommitlines
{fd view
} {
75 global commitlisted nextupdate
76 global leftover commfd
77 global displayorder commitidx commitrow commitdata
78 global parentlist childlist children curview hlview
79 global vparentlist vchildlist vdisporder vcmitlisted
81 set stuff
[read $fd 500000]
83 if {![eof
$fd]} return
87 # set it blocking so we wait for the process to terminate
88 fconfigure
$fd -blocking 1
89 if {[catch
{close
$fd} err
]} {
91 if {$view != $curview} {
92 set fv
" for the \"$viewname($view)\" view"
94 if {[string range
$err 0 4] == "usage"} {
95 set err
"Gitk: error reading commits$fv:\
96 bad arguments to git rev-list."
97 if {$viewname($view) eq
"Command line"} {
99 " (Note: arguments to gitk are passed to git rev-list\
100 to allow selection of commits to be displayed.)"
103 set err
"Error reading commits$fv: $err"
107 if {$view == $curview} {
108 after idle finishcommits
115 set i
[string first
"\0" $stuff $start]
117 append leftover
($view) [string range
$stuff $start end
]
121 set cmit
$leftover($view)
122 append cmit
[string range
$stuff 0 [expr {$i - 1}]]
123 set leftover
($view) {}
125 set cmit
[string range
$stuff $start [expr {$i - 1}]]
127 set start
[expr {$i + 1}]
128 set j
[string first
"\n" $cmit]
132 set ids
[string range
$cmit 0 [expr {$j - 1}]]
133 if {[string range
$ids 0 0] == "-"} {
135 set ids
[string range
$ids 1 end
]
139 if {[string length
$id] != 40} {
147 if {[string length
$shortcmit] > 80} {
148 set shortcmit
"[string range $shortcmit 0 80]..."
150 error_popup
"Can't parse git rev-list output: {$shortcmit}"
153 set id
[lindex
$ids 0]
155 set olds
[lrange
$ids 1 end
]
158 if {$i == 0 ||
[lsearch
-exact $olds $p] >= $i} {
159 lappend children
($view,$p) $id
166 if {![info exists children
($view,$id)]} {
167 set children
($view,$id) {}
169 set commitdata
($id) [string range
$cmit [expr {$j + 1}] end
]
170 set commitrow
($view,$id) $commitidx($view)
171 incr commitidx
($view)
172 if {$view == $curview} {
173 lappend parentlist
$olds
174 lappend childlist
$children($view,$id)
175 lappend displayorder
$id
176 lappend commitlisted
$listed
178 lappend vparentlist
($view) $olds
179 lappend vchildlist
($view) $children($view,$id)
180 lappend vdisporder
($view) $id
181 lappend vcmitlisted
($view) $listed
186 if {$view == $curview} {
187 while {[layoutmore
$nextupdate]} doupdate
188 } elseif
{[info exists hlview
] && $view == $hlview} {
192 if {[clock clicks
-milliseconds] >= $nextupdate} {
198 global commfd nextupdate numcommits
200 foreach v
[array names commfd
] {
201 fileevent
$commfd($v) readable
{}
204 set nextupdate
[expr {[clock clicks
-milliseconds] + 100}]
205 foreach v
[array names commfd
] {
207 fileevent
$fd readable
[list getcommitlines
$fd $v]
211 proc readcommit
{id
} {
212 if {[catch
{set contents
[exec git cat-file commit
$id]}]} return
213 parsecommit
$id $contents 0
216 proc updatecommits
{} {
217 global viewdata curview phase displayorder
218 global children commitrow selectedline thickerline
225 foreach id
$displayorder {
226 catch
{unset children
($n,$id)}
227 catch
{unset commitrow
($n,$id)}
230 catch
{unset selectedline
}
231 catch
{unset thickerline
}
232 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 mainhead
309 foreach v
{tagids idtags headids idheads otherrefids idotherrefs
} {
312 set refd
[open
[list | git show-ref
] 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 set thehead
[exec git symbolic-ref HEAD
]
356 if {[string match
"refs/heads/*" $thehead]} {
357 set mainhead
[string range
$thehead 11 end
]
362 proc show_error
{w top msg
} {
363 message
$w.m
-text $msg -justify center
-aspect 400
364 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
365 button
$w.ok
-text OK
-command "destroy $top"
366 pack
$w.ok
-side bottom
-fill x
367 bind $top <Visibility
> "grab $top; focus $top"
368 bind $top <Key-Return
> "destroy $top"
372 proc error_popup msg
{
376 show_error
$w $w $msg
379 proc confirm_popup msg
{
385 message
$w.m
-text $msg -justify center
-aspect 400
386 pack
$w.m
-side top
-fill x
-padx 20 -pady 20
387 button
$w.ok
-text OK
-command "set confirm_ok 1; destroy $w"
388 pack
$w.ok
-side left
-fill x
389 button
$w.cancel
-text Cancel
-command "destroy $w"
390 pack
$w.cancel
-side right
-fill x
391 bind $w <Visibility
> "grab $w; focus $w"
397 global canv canv2 canv3 linespc charspc ctext cflist
398 global textfont mainfont uifont
399 global findtype findtypemenu findloc findstring fstring geometry
400 global entries sha1entry sha1string sha1but
401 global maincursor textcursor curtextcursor
402 global rowctxmenu mergemax wrapcomment
403 global highlight_files gdttype
404 global searchstring sstring
405 global bgcolor fgcolor bglist fglist diffcolors
409 .bar add cascade
-label "File" -menu .bar.
file
410 .bar configure
-font $uifont
412 .bar.
file add
command -label "Update" -command updatecommits
413 .bar.
file add
command -label "Reread references" -command rereadrefs
414 .bar.
file add
command -label "Quit" -command doquit
415 .bar.
file configure
-font $uifont
417 .bar add cascade
-label "Edit" -menu .bar.edit
418 .bar.edit add
command -label "Preferences" -command doprefs
419 .bar.edit configure
-font $uifont
421 menu .bar.view
-font $uifont
422 .bar add cascade
-label "View" -menu .bar.view
423 .bar.view add
command -label "New view..." -command {newview
0}
424 .bar.view add
command -label "Edit view..." -command editview \
426 .bar.view add
command -label "Delete view" -command delview
-state disabled
427 .bar.view add separator
428 .bar.view add radiobutton
-label "All files" -command {showview
0} \
429 -variable selectedview
-value 0
432 .bar add cascade
-label "Help" -menu .bar.
help
433 .bar.
help add
command -label "About gitk" -command about
434 .bar.
help add
command -label "Key bindings" -command keys
435 .bar.
help configure
-font $uifont
436 . configure
-menu .bar
438 # the gui has upper and lower half, parts of a paned window.
439 panedwindow .ctop
-orient vertical
441 # possibly use assumed geometry
442 if {![info exists geometry
(pwsash0
)]} {
443 set geometry
(topheight
) [expr {15 * $linespc}]
444 set geometry
(topwidth
) [expr {80 * $charspc}]
445 set geometry
(botheight
) [expr {15 * $linespc}]
446 set geometry
(botwidth
) [expr {50 * $charspc}]
447 set geometry
(pwsash0
) "[expr {40 * $charspc}] 2"
448 set geometry
(pwsash1
) "[expr {60 * $charspc}] 2"
451 # the upper half will have a paned window, a scroll bar to the right, and some stuff below
452 frame .tf
-height $geometry(topheight
) -width $geometry(topwidth
)
454 panedwindow .tf.histframe.pwclist
-orient horizontal
-sashpad 0 -handlesize 4
456 # create three canvases
457 set cscroll .tf.histframe.csb
458 set canv .tf.histframe.pwclist.canv
460 -background $bgcolor -bd 0 \
461 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
462 .tf.histframe.pwclist add
$canv
463 set canv2 .tf.histframe.pwclist.canv2
465 -background $bgcolor -bd 0 -yscrollincr $linespc
466 .tf.histframe.pwclist add
$canv2
467 set canv3 .tf.histframe.pwclist.canv3
469 -background $bgcolor -bd 0 -yscrollincr $linespc
470 .tf.histframe.pwclist add
$canv3
471 eval .tf.histframe.pwclist sash place
0 $geometry(pwsash0
)
472 eval .tf.histframe.pwclist sash place
1 $geometry(pwsash1
)
474 # a scroll bar to rule them
475 scrollbar
$cscroll -command {allcanvs yview
} -highlightthickness 0
476 pack
$cscroll -side right
-fill y
477 bind .tf.histframe.pwclist
<Configure
> {resizeclistpanes
%W
%w
}
478 lappend bglist
$canv $canv2 $canv3
479 pack .tf.histframe.pwclist
-fill both
-expand 1 -side left
481 # we have two button bars at bottom of top frame. Bar 1
483 frame .tf.lbar
-height 15
485 set sha1entry .tf.bar.sha1
486 set entries
$sha1entry
487 set sha1but .tf.bar.sha1label
488 button
$sha1but -text "SHA1 ID: " -state disabled
-relief flat \
489 -command gotocommit
-width 8 -font $uifont
490 $sha1but conf
-disabledforeground [$sha1but cget
-foreground]
491 pack .tf.bar.sha1label
-side left
492 entry
$sha1entry -width 40 -font $textfont -textvariable sha1string
493 trace add variable sha1string
write sha1change
494 pack
$sha1entry -side left
-pady 2
496 image create bitmap bm-left
-data {
497 #define left_width 16
498 #define left_height 16
499 static unsigned char left_bits
[] = {
500 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
501 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
502 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
504 image create bitmap bm-right
-data {
505 #define right_width 16
506 #define right_height 16
507 static unsigned char right_bits
[] = {
508 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
509 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
510 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
512 button .tf.bar.leftbut
-image bm-left
-command goback \
513 -state disabled
-width 26
514 pack .tf.bar.leftbut
-side left
-fill y
515 button .tf.bar.rightbut
-image bm-right
-command goforw \
516 -state disabled
-width 26
517 pack .tf.bar.rightbut
-side left
-fill y
519 button .tf.bar.findbut
-text "Find" -command dofind
-font $uifont
520 pack .tf.bar.findbut
-side left
522 set fstring .tf.bar.findstring
523 lappend entries
$fstring
524 entry
$fstring -width 30 -font $textfont -textvariable findstring
525 trace add variable findstring
write find_change
526 pack
$fstring -side left
-expand 1 -fill x
-in .tf.bar
528 set findtypemenu
[tk_optionMenu .tf.bar.findtype \
529 findtype Exact IgnCase Regexp
]
530 trace add variable findtype
write find_change
531 .tf.bar.findtype configure
-font $uifont
532 .tf.bar.findtype.menu configure
-font $uifont
533 set findloc
"All fields"
534 tk_optionMenu .tf.bar.findloc findloc
"All fields" Headline \
535 Comments Author Committer
536 trace add variable findloc
write find_change
537 .tf.bar.findloc configure
-font $uifont
538 .tf.bar.findloc.menu configure
-font $uifont
539 pack .tf.bar.findloc
-side right
540 pack .tf.bar.findtype
-side right
542 # build up the bottom bar of upper window
543 label .tf.lbar.flabel
-text "Highlight: Commits " \
545 pack .tf.lbar.flabel
-side left
-fill y
546 set gdttype
"touching paths:"
547 set gm
[tk_optionMenu .tf.lbar.gdttype gdttype
"touching paths:" \
548 "adding/removing string:"]
549 trace add variable gdttype
write hfiles_change
550 $gm conf
-font $uifont
551 .tf.lbar.gdttype conf
-font $uifont
552 pack .tf.lbar.gdttype
-side left
-fill y
553 entry .tf.lbar.fent
-width 25 -font $textfont \
554 -textvariable highlight_files
555 trace add variable highlight_files
write hfiles_change
556 lappend entries .tf.lbar.fent
557 pack .tf.lbar.fent
-side left
-fill x
-expand 1
558 label .tf.lbar.vlabel
-text " OR in view" -font $uifont
559 pack .tf.lbar.vlabel
-side left
-fill y
560 global viewhlmenu selectedhlview
561 set viewhlmenu
[tk_optionMenu .tf.lbar.vhl selectedhlview None
]
562 $viewhlmenu entryconf None
-command delvhighlight
563 $viewhlmenu conf
-font $uifont
564 .tf.lbar.vhl conf
-font $uifont
565 pack .tf.lbar.vhl
-side left
-fill y
566 label .tf.lbar.rlabel
-text " OR " -font $uifont
567 pack .tf.lbar.rlabel
-side left
-fill y
568 global highlight_related
569 set m
[tk_optionMenu .tf.lbar.relm highlight_related None \
570 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
571 $m conf
-font $uifont
572 .tf.lbar.relm conf
-font $uifont
573 trace add variable highlight_related
write vrel_change
574 pack .tf.lbar.relm
-side left
-fill y
576 # Finish putting the upper half of the viewer together
577 pack .tf.lbar
-in .tf
-side bottom
-fill x
578 pack .tf.bar
-in .tf
-side bottom
-fill x
579 pack .tf.histframe
-fill both
-side top
-expand 1
581 .ctop paneconfigure .tf
-height $geometry(topheight
)
582 .ctop paneconfigure .tf
-width $geometry(topwidth
)
584 # now build up the bottom
585 panedwindow .pwbottom
-orient horizontal
587 # lower left, a text box over search bar, scroll bar to the right
588 # if we know window height, then that will set the lower text height, otherwise
589 # we set lower text height which will drive window height
590 if {[info exists geometry
(main
)]} {
591 frame .bleft
-width $geometry(botwidth
)
593 frame .bleft
-width $geometry(botwidth
) -height $geometry(botheight
)
597 button .bleft.top.search
-text "Search" -command dosearch \
599 pack .bleft.top.search
-side left
-padx 5
600 set sstring .bleft.top.sstring
601 entry
$sstring -width 20 -font $textfont -textvariable searchstring
602 lappend entries
$sstring
603 trace add variable searchstring
write incrsearch
604 pack
$sstring -side left
-expand 1 -fill x
605 set ctext .bleft.ctext
606 text
$ctext -background $bgcolor -foreground $fgcolor \
607 -state disabled
-font $textfont \
608 -yscrollcommand scrolltext
-wrap none
609 scrollbar .bleft.sb
-command "$ctext yview"
610 pack .bleft.top
-side top
-fill x
611 pack .bleft.sb
-side right
-fill y
612 pack
$ctext -side left
-fill both
-expand 1
613 lappend bglist
$ctext
614 lappend fglist
$ctext
616 $ctext tag conf comment
-wrap $wrapcomment
617 $ctext tag conf filesep
-font [concat
$textfont bold
] -back "#aaaaaa"
618 $ctext tag conf hunksep
-fore [lindex
$diffcolors 2]
619 $ctext tag conf d0
-fore [lindex
$diffcolors 0]
620 $ctext tag conf d1
-fore [lindex
$diffcolors 1]
621 $ctext tag conf m0
-fore red
622 $ctext tag conf m1
-fore blue
623 $ctext tag conf m2
-fore green
624 $ctext tag conf m3
-fore purple
625 $ctext tag conf
m4 -fore brown
626 $ctext tag conf m5
-fore "#009090"
627 $ctext tag conf m6
-fore magenta
628 $ctext tag conf m7
-fore "#808000"
629 $ctext tag conf m8
-fore "#009000"
630 $ctext tag conf m9
-fore "#ff0080"
631 $ctext tag conf m10
-fore cyan
632 $ctext tag conf m11
-fore "#b07070"
633 $ctext tag conf m12
-fore "#70b0f0"
634 $ctext tag conf m13
-fore "#70f0b0"
635 $ctext tag conf m14
-fore "#f0b070"
636 $ctext tag conf m15
-fore "#ff70b0"
637 $ctext tag conf mmax
-fore darkgrey
639 $ctext tag conf mresult
-font [concat
$textfont bold
]
640 $ctext tag conf msep
-font [concat
$textfont bold
]
641 $ctext tag conf found
-back yellow
644 .pwbottom paneconfigure .bleft
-width $geometry(botwidth
)
649 radiobutton .bright.mode.
patch -text "Patch" \
650 -command reselectline
-variable cmitmode
-value "patch"
651 radiobutton .bright.mode.tree
-text "Tree" \
652 -command reselectline
-variable cmitmode
-value "tree"
653 grid .bright.mode.
patch .bright.mode.tree
-sticky ew
654 pack .bright.mode
-side top
-fill x
655 set cflist .bright.cfiles
656 set indent
[font measure
$mainfont "nn"]
658 -background $bgcolor -foreground $fgcolor \
660 -tabs [list
$indent [expr {2 * $indent}]] \
661 -yscrollcommand ".bright.sb set" \
662 -cursor [. cget
-cursor] \
663 -spacing1 1 -spacing3 1
664 lappend bglist
$cflist
665 lappend fglist
$cflist
666 scrollbar .bright.sb
-command "$cflist yview"
667 pack .bright.sb
-side right
-fill y
668 pack
$cflist -side left
-fill both
-expand 1
669 $cflist tag configure highlight \
670 -background [$cflist cget
-selectbackground]
671 $cflist tag configure bold
-font [concat
$mainfont bold
]
673 .pwbottom add .bright
676 # restore window position if known
677 if {[info exists geometry
(main
)]} {
678 wm geometry .
"$geometry(main)"
681 bind .pwbottom
<Configure
> {resizecdetpanes
%W
%w
}
682 pack .ctop
-fill both
-expand 1
683 bindall
<1> {selcanvline
%W
%x
%y
}
684 #bindall <B1-Motion> {selcanvline %W %x %y}
685 bindall
<ButtonRelease-4
> "allcanvs yview scroll -5 units"
686 bindall
<ButtonRelease-5
> "allcanvs yview scroll 5 units"
687 bindall
<2> "canvscan mark %W %x %y"
688 bindall
<B2-Motion
> "canvscan dragto %W %x %y"
689 bindkey
<Home
> selfirstline
690 bindkey
<End
> sellastline
691 bind .
<Key-Up
> "selnextline -1"
692 bind .
<Key-Down
> "selnextline 1"
693 bind .
<Shift-Key-Up
> "next_highlight -1"
694 bind .
<Shift-Key-Down
> "next_highlight 1"
695 bindkey
<Key-Right
> "goforw"
696 bindkey
<Key-Left
> "goback"
697 bind .
<Key-Prior
> "selnextpage -1"
698 bind .
<Key-Next
> "selnextpage 1"
699 bind .
<Control-Home
> "allcanvs yview moveto 0.0"
700 bind .
<Control-End
> "allcanvs yview moveto 1.0"
701 bind .
<Control-Key-Up
> "allcanvs yview scroll -1 units"
702 bind .
<Control-Key-Down
> "allcanvs yview scroll 1 units"
703 bind .
<Control-Key-Prior
> "allcanvs yview scroll -1 pages"
704 bind .
<Control-Key-Next
> "allcanvs yview scroll 1 pages"
705 bindkey
<Key-Delete
> "$ctext yview scroll -1 pages"
706 bindkey
<Key-BackSpace
> "$ctext yview scroll -1 pages"
707 bindkey
<Key-space
> "$ctext yview scroll 1 pages"
708 bindkey p
"selnextline -1"
709 bindkey n
"selnextline 1"
712 bindkey i
"selnextline -1"
713 bindkey k
"selnextline 1"
716 bindkey b
"$ctext yview scroll -1 pages"
717 bindkey d
"$ctext yview scroll 18 units"
718 bindkey u
"$ctext yview scroll -18 units"
719 bindkey
/ {findnext
1}
720 bindkey
<Key-Return
> {findnext
0}
723 bind .
<Control-q
> doquit
724 bind .
<Control-f
> dofind
725 bind .
<Control-g
> {findnext
0}
726 bind .
<Control-r
> dosearchback
727 bind .
<Control-s
> dosearch
728 bind .
<Control-equal
> {incrfont
1}
729 bind .
<Control-KP_Add
> {incrfont
1}
730 bind .
<Control-minus
> {incrfont
-1}
731 bind .
<Control-KP_Subtract
> {incrfont
-1}
732 wm protocol . WM_DELETE_WINDOW doquit
733 bind .
<Button-1
> "click %W"
734 bind $fstring <Key-Return
> dofind
735 bind $sha1entry <Key-Return
> gotocommit
736 bind $sha1entry <<PasteSelection>> clearsha1
737 bind $cflist <1> {sel_flist %W %x %y; break}
738 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
739 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
741 set maincursor [. cget -cursor]
742 set textcursor [$ctext cget -cursor]
743 set curtextcursor $textcursor
745 set rowctxmenu .rowctxmenu
746 menu $rowctxmenu -tearoff 0
747 $rowctxmenu add command -label "Diff this -> selected" \
748 -command {diffvssel 0}
749 $rowctxmenu add command -label "Diff selected -> this" \
750 -command {diffvssel 1}
751 $rowctxmenu add command -label "Make patch" -command mkpatch
752 $rowctxmenu add command -label "Create tag" -command mktag
753 $rowctxmenu add command -label "Write commit to file" -command writecommit
754 $rowctxmenu add command -label "Create new branch" -command mkbranch
755 $rowctxmenu add command -label "Cherry-pick this commit" \
758 set headctxmenu .headctxmenu
759 menu $headctxmenu -tearoff 0
760 $headctxmenu add command -label "Check out this branch" \
762 $headctxmenu add command -label "Remove this branch" \
766 # mouse-2 makes all windows scan vertically, but only the one
767 # the cursor is in scans horizontally
768 proc canvscan {op w x y} {
769 global canv canv2 canv3
770 foreach c [list $canv $canv2 $canv3] {
779 proc scrollcanv {cscroll f0 f1} {
785 # when we make a key binding for the toplevel, make sure
786 # it doesn't get triggered when that key is pressed in the
787 # find string entry widget.
788 proc bindkey {ev script} {
791 set escript [bind Entry $ev]
792 if {$escript == {}} {
793 set escript [bind Entry <Key>]
796 bind $e $ev "$escript; break"
800 # set the focus back to the toplevel for any click outside
811 global canv canv2 canv3 ctext cflist mainfont textfont uifont
812 global stuffsaved findmergefiles maxgraphpct
813 global maxwidth showneartags
814 global viewname viewfiles viewargs viewperm nextviewnum
815 global cmitmode wrapcomment
816 global colors bgcolor fgcolor diffcolors
818 if {$stuffsaved} return
819 if {![winfo viewable .]} return
821 set f [open "~/.gitk-new" w]
822 puts $f [list set mainfont $mainfont]
823 puts $f [list set textfont $textfont]
824 puts $f [list set uifont $uifont]
825 puts $f [list set findmergefiles $findmergefiles]
826 puts $f [list set maxgraphpct $maxgraphpct]
827 puts $f [list set maxwidth $maxwidth]
828 puts $f [list set cmitmode $cmitmode]
829 puts $f [list set wrapcomment $wrapcomment]
830 puts $f [list set showneartags $showneartags]
831 puts $f [list set bgcolor $bgcolor]
832 puts $f [list set fgcolor $fgcolor]
833 puts $f [list set colors $colors]
834 puts $f [list set diffcolors $diffcolors]
836 puts $f "set geometry(main) [wm geometry .]"
837 puts $f "set geometry(topwidth) [winfo width .tf]"
838 puts $f "set geometry(topheight) [winfo height .tf]"
839 puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
840 puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
841 puts $f "set geometry(botwidth) [winfo width .bleft]"
842 puts $f "set geometry(botheight) [winfo height .bleft]"
844 puts -nonewline $f "set permviews {"
845 for {set v 0} {$v < $nextviewnum} {incr v} {
847 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
852 catch {file delete "~/.gitk"}
853 file rename -force "~/.gitk-new" "~/.gitk"
858 proc resizeclistpanes {win w} {
860 if {[info exists oldwidth($win)]} {
861 set s0 [$win sash coord 0]
862 set s1 [$win sash coord 1]
864 set sash0 [expr {int($w/2 - 2)}]
865 set sash1 [expr {int($w*5/6 - 2)}]
867 set factor [expr {1.0 * $w / $oldwidth($win)}]
868 set sash0 [expr {int($factor * [lindex $s0 0])}]
869 set sash1 [expr {int($factor * [lindex $s1 0])}]
873 if {$sash1 < $sash0 + 20} {
874 set sash1 [expr {$sash0 + 20}]
876 if {$sash1 > $w - 10} {
877 set sash1 [expr {$w - 10}]
878 if {$sash0 > $sash1 - 20} {
879 set sash0 [expr {$sash1 - 20}]
883 $win sash place 0 $sash0 [lindex $s0 1]
884 $win sash place 1 $sash1 [lindex $s1 1]
886 set oldwidth($win) $w
889 proc resizecdetpanes {win w} {
891 if {[info exists oldwidth($win)]} {
892 set s0 [$win sash coord 0]
894 set sash0 [expr {int($w*3/4 - 2)}]
896 set factor [expr {1.0 * $w / $oldwidth($win)}]
897 set sash0 [expr {int($factor * [lindex $s0 0])}]
901 if {$sash0 > $w - 15} {
902 set sash0 [expr {$w - 15}]
905 $win sash place 0 $sash0 [lindex $s0 1]
907 set oldwidth($win) $w
911 global canv canv2 canv3
917 proc bindall {event action} {
918 global canv canv2 canv3
919 bind $canv $event $action
920 bind $canv2 $event $action
921 bind $canv3 $event $action
926 if {[winfo exists $w]} {
931 wm title $w "About gitk"
933 Gitk - a commit viewer for git
935 Copyright © 2005-2006 Paul Mackerras
937 Use and redistribute under the terms of the GNU General Public License} \
938 -justify center -aspect 400
939 pack $w.m -side top -fill x -padx 20 -pady 20
940 button $w.ok -text Close -command "destroy $w"
941 pack $w.ok -side bottom
946 if {[winfo exists $w]} {
951 wm title $w "Gitk key bindings"
956 <Home> Move to first commit
957 <End> Move to last commit
958 <Up>, p, i Move up one commit
959 <Down>, n, k Move down one commit
960 <Left>, z, j Go back in history list
961 <Right>, x, l Go forward in history list
962 <PageUp> Move up one page in commit list
963 <PageDown> Move down one page in commit list
964 <Ctrl-Home> Scroll to top of commit list
965 <Ctrl-End> Scroll to bottom of commit list
966 <Ctrl-Up> Scroll commit list up one line
967 <Ctrl-Down> Scroll commit list down one line
968 <Ctrl-PageUp> Scroll commit list up one page
969 <Ctrl-PageDown> Scroll commit list down one page
970 <Shift-Up> Move to previous highlighted line
971 <Shift-Down> Move to next highlighted line
972 <Delete>, b Scroll diff view up one page
973 <Backspace> Scroll diff view up one page
974 <Space> Scroll diff view down one page
975 u Scroll diff view up 18 lines
976 d Scroll diff view down 18 lines
978 <Ctrl-G> Move to next find hit
979 <Return> Move to next find hit
980 / Move to next find hit, or redo find
981 ? Move to previous find hit
982 f Scroll diff view to next file
983 <Ctrl-S> Search for next hit in diff view
984 <Ctrl-R> Search for previous hit in diff view
985 <Ctrl-KP+> Increase font size
986 <Ctrl-plus> Increase font size
987 <Ctrl-KP-> Decrease font size
988 <Ctrl-minus> Decrease font size
990 -justify left -bg white -border 2 -relief sunken
991 pack $w.m -side top -fill both
992 button $w.ok -text Close -command "destroy $w"
993 pack $w.ok -side bottom
996 # Procedures for manipulating the file list window at the
997 # bottom right of the overall window.
999 proc treeview {w l openlevs} {
1000 global treecontents treediropen treeheight treeparent treeindex
1010 set treecontents() {}
1011 $w conf -state normal
1013 while {[string range $f 0 $prefixend] ne $prefix} {
1014 if {$lev <= $openlevs} {
1015 $w mark set e:$treeindex($prefix) "end -1c"
1016 $w mark gravity e:$treeindex($prefix) left
1018 set treeheight($prefix) $ht
1019 incr ht [lindex $htstack end]
1020 set htstack [lreplace $htstack end end]
1021 set prefixend [lindex $prefendstack end]
1022 set prefendstack [lreplace $prefendstack end end]
1023 set prefix [string range $prefix 0 $prefixend]
1026 set tail [string range $f [expr {$prefixend+1}] end]
1027 while {[set slash [string first "/" $tail]] >= 0} {
1030 lappend prefendstack $prefixend
1031 incr prefixend [expr {$slash + 1}]
1032 set d [string range $tail 0 $slash]
1033 lappend treecontents($prefix) $d
1034 set oldprefix $prefix
1036 set treecontents($prefix) {}
1037 set treeindex($prefix) [incr ix]
1038 set treeparent($prefix) $oldprefix
1039 set tail [string range $tail [expr {$slash+1}] end]
1040 if {$lev <= $openlevs} {
1042 set treediropen($prefix) [expr {$lev < $openlevs}]
1043 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1044 $w mark set d:$ix "end -1c"
1045 $w mark gravity d:$ix left
1047 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1049 $w image create end -align center -image $bm -padx 1 \
1051 $w insert end $d [highlight_tag $prefix]
1052 $w mark set s:$ix "end -1c"
1053 $w mark gravity s:$ix left
1058 if {$lev <= $openlevs} {
1061 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1063 $w insert end $tail [highlight_tag $f]
1065 lappend treecontents($prefix) $tail
1068 while {$htstack ne {}} {
1069 set treeheight($prefix) $ht
1070 incr ht [lindex $htstack end]
1071 set htstack [lreplace $htstack end end]
1073 $w conf -state disabled
1076 proc linetoelt {l} {
1077 global treeheight treecontents
1082 foreach e $treecontents($prefix) {
1087 if {[string index $e end] eq "/"} {
1088 set n $treeheight($prefix$e)
1100 proc highlight_tree {y prefix} {
1101 global treeheight treecontents cflist
1103 foreach e $treecontents($prefix) {
1105 if {[highlight_tag $path] ne {}} {
1106 $cflist tag add bold $y.0 "$y.0 lineend"
1109 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1110 set y [highlight_tree $y $path]
1116 proc treeclosedir {w dir} {
1117 global treediropen treeheight treeparent treeindex
1119 set ix $treeindex($dir)
1120 $w conf -state normal
1121 $w delete s:$ix e:$ix
1122 set treediropen($dir) 0
1123 $w image configure a:$ix -image tri-rt
1124 $w conf -state disabled
1125 set n [expr {1 - $treeheight($dir)}]
1126 while {$dir ne {}} {
1127 incr treeheight($dir) $n
1128 set dir $treeparent($dir)
1132 proc treeopendir {w dir} {
1133 global treediropen treeheight treeparent treecontents treeindex
1135 set ix $treeindex($dir)
1136 $w conf -state normal
1137 $w image configure a:$ix -image tri-dn
1138 $w mark set e:$ix s:$ix
1139 $w mark gravity e:$ix right
1142 set n [llength $treecontents($dir)]
1143 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1146 incr treeheight($x) $n
1148 foreach e $treecontents($dir) {
1150 if {[string index $e end] eq "/"} {
1151 set iy $treeindex($de)
1152 $w mark set d:$iy e:$ix
1153 $w mark gravity d:$iy left
1154 $w insert e:$ix $str
1155 set treediropen($de) 0
1156 $w image create e:$ix -align center -image tri-rt -padx 1 \
1158 $w insert e:$ix $e [highlight_tag $de]
1159 $w mark set s:$iy e:$ix
1160 $w mark gravity s:$iy left
1161 set treeheight($de) 1
1163 $w insert e:$ix $str
1164 $w insert e:$ix $e [highlight_tag $de]
1167 $w mark gravity e:$ix left
1168 $w conf -state disabled
1169 set treediropen($dir) 1
1170 set top [lindex [split [$w index @0,0] .] 0]
1171 set ht [$w cget -height]
1172 set l [lindex [split [$w index s:$ix] .] 0]
1175 } elseif {$l + $n + 1 > $top + $ht} {
1176 set top [expr {$l + $n + 2 - $ht}]
1184 proc treeclick {w x y} {
1185 global treediropen cmitmode ctext cflist cflist_top
1187 if {$cmitmode ne "tree"} return
1188 if {![info exists cflist_top]} return
1189 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1190 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1191 $cflist tag add highlight $l.0 "$l.0 lineend"
1197 set e [linetoelt $l]
1198 if {[string index $e end] ne "/"} {
1200 } elseif {$treediropen($e)} {
1207 proc setfilelist {id} {
1208 global treefilelist cflist
1210 treeview $cflist $treefilelist($id) 0
1213 image create bitmap tri-rt -background black -foreground blue -data {
1214 #define tri-rt_width 13
1215 #define tri-rt_height 13
1216 static unsigned char tri-rt_bits[] = {
1217 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1218 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1221 #define tri-rt-mask_width 13
1222 #define tri-rt-mask_height 13
1223 static unsigned char tri-rt-mask_bits[] = {
1224 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1225 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1228 image create bitmap tri-dn -background black -foreground blue -data {
1229 #define tri-dn_width 13
1230 #define tri-dn_height 13
1231 static unsigned char tri-dn_bits[] = {
1232 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1233 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1236 #define tri-dn-mask_width 13
1237 #define tri-dn-mask_height 13
1238 static unsigned char tri-dn-mask_bits[] = {
1239 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1240 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1244 proc init_flist {first} {
1245 global cflist cflist_top selectedline difffilestart
1247 $cflist conf -state normal
1248 $cflist delete 0.0 end
1250 $cflist insert end $first
1252 $cflist tag add highlight 1.0 "1.0 lineend"
1254 catch {unset cflist_top}
1256 $cflist conf -state disabled
1257 set difffilestart {}
1260 proc highlight_tag {f} {
1261 global highlight_paths
1263 foreach p $highlight_paths {
1264 if {[string match $p $f]} {
1271 proc highlight_filelist {} {
1272 global cmitmode cflist
1274 $cflist conf -state normal
1275 if {$cmitmode ne "tree"} {
1276 set end [lindex [split [$cflist index end] .] 0]
1277 for {set l 2} {$l < $end} {incr l} {
1278 set line [$cflist get $l.0 "$l.0 lineend"]
1279 if {[highlight_tag $line] ne {}} {
1280 $cflist tag add bold $l.0 "$l.0 lineend"
1286 $cflist conf -state disabled
1289 proc unhighlight_filelist {} {
1292 $cflist conf -state normal
1293 $cflist tag remove bold 1.0 end
1294 $cflist conf -state disabled
1297 proc add_flist {fl} {
1300 $cflist conf -state normal
1302 $cflist insert end "\n"
1303 $cflist insert end $f [highlight_tag $f]
1305 $cflist conf -state disabled
1308 proc sel_flist {w x y} {
1309 global ctext difffilestart cflist cflist_top cmitmode
1311 if {$cmitmode eq "tree"} return
1312 if {![info exists cflist_top]} return
1313 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1314 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1315 $cflist tag add highlight $l.0 "$l.0 lineend"
1320 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1324 # Functions for adding and removing shell-type quoting
1326 proc shellquote {str} {
1327 if {![string match "*\['\"\\ \t]*" $str]} {
1330 if {![string match "*\['\"\\]*" $str]} {
1333 if {![string match "*'*" $str]} {
1336 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1339 proc shellarglist {l} {
1345 append str [shellquote $a]
1350 proc shelldequote {str} {
1355 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1356 append ret [string range $str $used end]
1357 set used [string length $str]
1360 set first [lindex $first 0]
1361 set ch [string index $str $first]
1362 if {$first > $used} {
1363 append ret [string range $str $used [expr {$first - 1}]]
1366 if {$ch eq " " || $ch eq "\t"} break
1369 set first [string first "'" $str $used]
1371 error "unmatched single-quote"
1373 append ret [string range $str $used [expr {$first - 1}]]
1378 if {$used >= [string length $str]} {
1379 error "trailing backslash"
1381 append ret [string index $str $used]
1386 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1387 error "unmatched double-quote"
1389 set first [lindex $first 0]
1390 set ch [string index $str $first]
1391 if {$first > $used} {
1392 append ret [string range $str $used [expr {$first - 1}]]
1395 if {$ch eq "\""} break
1397 append ret [string index $str $used]
1401 return [list $used $ret]
1404 proc shellsplit {str} {
1407 set str [string trimleft $str]
1408 if {$str eq {}} break
1409 set dq [shelldequote $str]
1410 set n [lindex $dq 0]
1411 set word [lindex $dq 1]
1412 set str [string range $str $n end]
1418 # Code to implement multiple views
1420 proc newview {ishighlight} {
1421 global nextviewnum newviewname newviewperm uifont newishighlight
1422 global newviewargs revtreeargs
1424 set newishighlight $ishighlight
1426 if {[winfo exists $top]} {
1430 set newviewname($nextviewnum) "View $nextviewnum"
1431 set newviewperm($nextviewnum) 0
1432 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1433 vieweditor $top $nextviewnum "Gitk view definition"
1438 global viewname viewperm newviewname newviewperm
1439 global viewargs newviewargs
1441 set top .gitkvedit-$curview
1442 if {[winfo exists $top]} {
1446 set newviewname($curview) $viewname($curview)
1447 set newviewperm($curview) $viewperm($curview)
1448 set newviewargs($curview) [shellarglist $viewargs($curview)]
1449 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1452 proc vieweditor {top n title} {
1453 global newviewname newviewperm viewfiles
1457 wm title $top $title
1458 label $top.nl -text "Name" -font $uifont
1459 entry $top.name -width 20 -textvariable newviewname($n)
1460 grid $top.nl $top.name -sticky w -pady 5
1461 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1462 grid $top.perm - -pady 5 -sticky w
1463 message $top.al -aspect 1000 -font $uifont \
1464 -text "Commits to include (arguments to git rev-list):"
1465 grid $top.al - -sticky w -pady 5
1466 entry $top.args -width 50 -textvariable newviewargs($n) \
1468 grid $top.args - -sticky ew -padx 5
1469 message $top.l -aspect 1000 -font $uifont \
1470 -text "Enter files and directories to include, one per line:"
1471 grid $top.l - -sticky w
1472 text $top.t -width 40 -height 10 -background white
1473 if {[info exists viewfiles($n)]} {
1474 foreach f $viewfiles($n) {
1475 $top.t insert end $f
1476 $top.t insert end "\n"
1478 $top.t delete {end - 1c} end
1479 $top.t mark set insert 0.0
1481 grid $top.t - -sticky ew -padx 5
1483 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1484 button $top.buts.can -text "Cancel" -command [list destroy $top]
1485 grid $top.buts.ok $top.buts.can
1486 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1487 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1488 grid $top.buts - -pady 10 -sticky ew
1492 proc doviewmenu {m first cmd op argv} {
1493 set nmenu [$m index end]
1494 for {set i $first} {$i <= $nmenu} {incr i} {
1495 if {[$m entrycget $i -command] eq $cmd} {
1496 eval $m $op $i $argv
1502 proc allviewmenus {n op args} {
1505 doviewmenu .bar.view 5 [list showview $n] $op $args
1506 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1509 proc newviewok {top n} {
1510 global nextviewnum newviewperm newviewname newishighlight
1511 global viewname viewfiles viewperm selectedview curview
1512 global viewargs newviewargs viewhlmenu
1515 set newargs [shellsplit $newviewargs($n)]
1517 error_popup "Error in commit selection arguments: $err"
1523 foreach f [split [$top.t get 0.0 end] "\n"] {
1524 set ft [string trim $f]
1529 if {![info exists viewfiles($n)]} {
1530 # creating a new view
1532 set viewname($n) $newviewname($n)
1533 set viewperm($n) $newviewperm($n)
1534 set viewfiles($n) $files
1535 set viewargs($n) $newargs
1537 if {!$newishighlight} {
1538 after idle showview $n
1540 after idle addvhighlight $n
1543 # editing an existing view
1544 set viewperm($n) $newviewperm($n)
1545 if {$newviewname($n) ne $viewname($n)} {
1546 set viewname($n) $newviewname($n)
1547 doviewmenu .bar.view 5 [list showview $n] \
1548 entryconf [list -label $viewname($n)]
1549 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1550 entryconf [list -label $viewname($n) -value $viewname($n)]
1552 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1553 set viewfiles($n) $files
1554 set viewargs($n) $newargs
1555 if {$curview == $n} {
1556 after idle updatecommits
1560 catch {destroy $top}
1564 global curview viewdata viewperm hlview selectedhlview
1566 if {$curview == 0} return
1567 if {[info exists hlview] && $hlview == $curview} {
1568 set selectedhlview None
1571 allviewmenus $curview delete
1572 set viewdata($curview) {}
1573 set viewperm($curview) 0
1577 proc addviewmenu {n} {
1578 global viewname viewhlmenu
1580 .bar.view add radiobutton -label $viewname($n) \
1581 -command [list showview $n] -variable selectedview -value $n
1582 $viewhlmenu add radiobutton -label $viewname($n) \
1583 -command [list addvhighlight $n] -variable selectedhlview
1586 proc flatten {var} {
1590 foreach i [array names $var] {
1591 lappend ret $i [set $var\($i\)]
1596 proc unflatten {var l} {
1606 global curview viewdata viewfiles
1607 global displayorder parentlist childlist rowidlist rowoffsets
1608 global colormap rowtextx commitrow nextcolor canvxmax
1609 global numcommits rowrangelist commitlisted idrowranges
1610 global selectedline currentid canv canvy0
1611 global matchinglines treediffs
1612 global pending_select phase
1613 global commitidx rowlaidout rowoptim linesegends
1614 global commfd nextupdate
1616 global vparentlist vchildlist vdisporder vcmitlisted
1617 global hlview selectedhlview
1619 if {$n == $curview} return
1621 if {[info exists selectedline]} {
1622 set selid $currentid
1623 set y [yc $selectedline]
1624 set ymax [lindex [$canv cget -scrollregion] 3]
1625 set span [$canv yview]
1626 set ytop [expr {[lindex $span 0] * $ymax}]
1627 set ybot [expr {[lindex $span 1] * $ymax}]
1628 if {$ytop < $y && $y < $ybot} {
1629 set yscreen [expr {$y - $ytop}]
1631 set yscreen [expr {($ybot - $ytop) / 2}]
1637 if {$curview >= 0} {
1638 set vparentlist($curview) $parentlist
1639 set vchildlist($curview) $childlist
1640 set vdisporder($curview) $displayorder
1641 set vcmitlisted($curview) $commitlisted
1643 set viewdata($curview) \
1644 [list $phase $rowidlist $rowoffsets $rowrangelist \
1645 [flatten idrowranges] [flatten idinlist] \
1646 $rowlaidout $rowoptim $numcommits $linesegends]
1647 } elseif {![info exists viewdata($curview)]
1648 || [lindex $viewdata($curview) 0] ne {}} {
1649 set viewdata($curview) \
1650 [list {} $rowidlist $rowoffsets $rowrangelist]
1653 catch {unset matchinglines}
1654 catch {unset treediffs}
1656 if {[info exists hlview] && $hlview == $n} {
1658 set selectedhlview None
1663 .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
1664 .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
1666 if {![info exists viewdata($n)]} {
1667 set pending_select $selid
1673 set phase [lindex $v 0]
1674 set displayorder $vdisporder($n)
1675 set parentlist $vparentlist($n)
1676 set childlist $vchildlist($n)
1677 set commitlisted $vcmitlisted($n)
1678 set rowidlist [lindex $v 1]
1679 set rowoffsets [lindex $v 2]
1680 set rowrangelist [lindex $v 3]
1682 set numcommits [llength $displayorder]
1683 catch {unset idrowranges}
1685 unflatten idrowranges [lindex $v 4]
1686 unflatten idinlist [lindex $v 5]
1687 set rowlaidout [lindex $v 6]
1688 set rowoptim [lindex $v 7]
1689 set numcommits [lindex $v 8]
1690 set linesegends [lindex $v 9]
1693 catch {unset colormap}
1694 catch {unset rowtextx}
1696 set canvxmax [$canv cget -width]
1702 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1703 set row $commitrow($n,$selid)
1704 # try to get the selected row in the same position on the screen
1705 set ymax [lindex [$canv cget -scrollregion] 3]
1706 set ytop [expr {[yc $row] - $yscreen}]
1710 set yf [expr {$ytop * 1.0 / $ymax}]
1712 allcanvs yview moveto $yf
1716 if {$phase eq "getcommits"} {
1717 show_status "Reading commits..."
1719 if {[info exists commfd($n)]} {
1724 } elseif {$numcommits == 0} {
1725 show_status "No commits selected"
1729 # Stuff relating to the highlighting facility
1731 proc ishighlighted {row} {
1732 global vhighlights fhighlights nhighlights rhighlights
1734 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1735 return $nhighlights($row)
1737 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1738 return $vhighlights($row)
1740 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1741 return $fhighlights($row)
1743 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1744 return $rhighlights($row)
1749 proc bolden {row font} {
1750 global canv linehtag selectedline boldrows
1752 lappend boldrows $row
1753 $canv itemconf $linehtag($row) -font $font
1754 if {[info exists selectedline] && $row == $selectedline} {
1756 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1757 -outline {{}} -tags secsel \
1758 -fill [$canv cget -selectbackground]]
1763 proc bolden_name {row font} {
1764 global canv2 linentag selectedline boldnamerows
1766 lappend boldnamerows $row
1767 $canv2 itemconf $linentag($row) -font $font
1768 if {[info exists selectedline] && $row == $selectedline} {
1769 $canv2 delete secsel
1770 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1771 -outline {{}} -tags secsel \
1772 -fill [$canv2 cget -selectbackground]]
1778 global mainfont boldrows
1781 foreach row $boldrows {
1782 if {![ishighlighted $row]} {
1783 bolden $row $mainfont
1785 lappend stillbold $row
1788 set boldrows $stillbold
1791 proc addvhighlight {n} {
1792 global hlview curview viewdata vhl_done vhighlights commitidx
1794 if {[info exists hlview]} {
1798 if {$n != $curview && ![info exists viewdata($n)]} {
1799 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1800 set vparentlist($n) {}
1801 set vchildlist($n) {}
1802 set vdisporder($n) {}
1803 set vcmitlisted($n) {}
1806 set vhl_done $commitidx($hlview)
1807 if {$vhl_done > 0} {
1812 proc delvhighlight {} {
1813 global hlview vhighlights
1815 if {![info exists hlview]} return
1817 catch {unset vhighlights}
1821 proc vhighlightmore {} {
1822 global hlview vhl_done commitidx vhighlights
1823 global displayorder vdisporder curview mainfont
1825 set font [concat $mainfont bold]
1826 set max $commitidx($hlview)
1827 if {$hlview == $curview} {
1828 set disp $displayorder
1830 set disp $vdisporder($hlview)
1832 set vr [visiblerows]
1833 set r0 [lindex $vr 0]
1834 set r1 [lindex $vr 1]
1835 for {set i $vhl_done} {$i < $max} {incr i} {
1836 set id [lindex $disp $i]
1837 if {[info exists commitrow($curview,$id)]} {
1838 set row $commitrow($curview,$id)
1839 if {$r0 <= $row && $row <= $r1} {
1840 if {![highlighted $row]} {
1843 set vhighlights($row) 1
1850 proc askvhighlight {row id} {
1851 global hlview vhighlights commitrow iddrawn mainfont
1853 if {[info exists commitrow($hlview,$id)]} {
1854 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1855 bolden $row [concat $mainfont bold]
1857 set vhighlights($row) 1
1859 set vhighlights($row) 0
1863 proc hfiles_change {name ix op} {
1864 global highlight_files filehighlight fhighlights fh_serial
1865 global mainfont highlight_paths
1867 if {[info exists filehighlight]} {
1868 # delete previous highlights
1869 catch {close $filehighlight}
1871 catch {unset fhighlights}
1873 unhighlight_filelist
1875 set highlight_paths {}
1876 after cancel do_file_hl $fh_serial
1878 if {$highlight_files ne {}} {
1879 after 300 do_file_hl $fh_serial
1883 proc makepatterns {l} {
1886 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1887 if {[string index $ee end] eq "/"} {
1897 proc do_file_hl {serial} {
1898 global highlight_files filehighlight highlight_paths gdttype fhl_list
1900 if {$gdttype eq "touching paths:"} {
1901 if {[catch {set paths [shellsplit $highlight_files]}]} return
1902 set highlight_paths [makepatterns $paths]
1904 set gdtargs [concat -- $paths]
1906 set gdtargs [list "-S$highlight_files"]
1908 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1909 set filehighlight [open $cmd r+]
1910 fconfigure $filehighlight -blocking 0
1911 fileevent $filehighlight readable readfhighlight
1917 proc flushhighlights {} {
1918 global filehighlight fhl_list
1920 if {[info exists filehighlight]} {
1922 puts $filehighlight ""
1923 flush $filehighlight
1927 proc askfilehighlight {row id} {
1928 global filehighlight fhighlights fhl_list
1930 lappend fhl_list $id
1931 set fhighlights($row) -1
1932 puts $filehighlight $id
1935 proc readfhighlight {} {
1936 global filehighlight fhighlights commitrow curview mainfont iddrawn
1939 while {[gets $filehighlight line] >= 0} {
1940 set line [string trim $line]
1941 set i [lsearch -exact $fhl_list $line]
1942 if {$i < 0} continue
1943 for {set j 0} {$j < $i} {incr j} {
1944 set id [lindex $fhl_list $j]
1945 if {[info exists commitrow($curview,$id)]} {
1946 set fhighlights($commitrow($curview,$id)) 0
1949 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1950 if {$line eq {}} continue
1951 if {![info exists commitrow($curview,$line)]} continue
1952 set row $commitrow($curview,$line)
1953 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1954 bolden $row [concat $mainfont bold]
1956 set fhighlights($row) 1
1958 if {[eof $filehighlight]} {
1960 puts "oops, git-diff-tree died"
1961 catch {close $filehighlight}
1967 proc find_change {name ix op} {
1968 global nhighlights mainfont boldnamerows
1969 global findstring findpattern findtype
1971 # delete previous highlights, if any
1972 foreach row $boldnamerows {
1973 bolden_name $row $mainfont
1976 catch {unset nhighlights}
1978 if {$findtype ne "Regexp"} {
1979 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1981 set findpattern "*$e*"
1986 proc askfindhighlight {row id} {
1987 global nhighlights commitinfo iddrawn mainfont
1988 global findstring findtype findloc findpattern
1990 if {![info exists commitinfo($id)]} {
1993 set info $commitinfo($id)
1995 set fldtypes {Headline Author Date Committer CDate Comments}
1996 foreach f $info ty $fldtypes {
1997 if {$findloc ne "All fields" && $findloc ne $ty} {
2000 if {$findtype eq "Regexp"} {
2001 set doesmatch [regexp $findstring $f]
2002 } elseif {$findtype eq "IgnCase"} {
2003 set doesmatch [string match -nocase $findpattern $f]
2005 set doesmatch [string match $findpattern $f]
2008 if {$ty eq "Author"} {
2015 if {[info exists iddrawn($id)]} {
2016 if {$isbold && ![ishighlighted $row]} {
2017 bolden $row [concat $mainfont bold]
2020 bolden_name $row [concat $mainfont bold]
2023 set nhighlights($row) $isbold
2026 proc vrel_change {name ix op} {
2027 global highlight_related
2030 if {$highlight_related ne "None"} {
2031 after idle drawvisible
2035 # prepare for testing whether commits are descendents or ancestors of a
2036 proc rhighlight_sel {a} {
2037 global descendent desc_todo ancestor anc_todo
2038 global highlight_related rhighlights
2040 catch {unset descendent}
2041 set desc_todo [list $a]
2042 catch {unset ancestor}
2043 set anc_todo [list $a]
2044 if {$highlight_related ne "None"} {
2046 after idle drawvisible
2050 proc rhighlight_none {} {
2053 catch {unset rhighlights}
2057 proc is_descendent {a} {
2058 global curview children commitrow descendent desc_todo
2061 set la $commitrow($v,$a)
2065 for {set i 0} {$i < [llength $todo]} {incr i} {
2066 set do [lindex $todo $i]
2067 if {$commitrow($v,$do) < $la} {
2068 lappend leftover $do
2071 foreach nk $children($v,$do) {
2072 if {![info exists descendent($nk)]} {
2073 set descendent($nk) 1
2081 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2085 set descendent($a) 0
2086 set desc_todo $leftover
2089 proc is_ancestor {a} {
2090 global curview parentlist commitrow ancestor anc_todo
2093 set la $commitrow($v,$a)
2097 for {set i 0} {$i < [llength $todo]} {incr i} {
2098 set do [lindex $todo $i]
2099 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2100 lappend leftover $do
2103 foreach np [lindex $parentlist $commitrow($v,$do)] {
2104 if {![info exists ancestor($np)]} {
2113 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2118 set anc_todo $leftover
2121 proc askrelhighlight {row id} {
2122 global descendent highlight_related iddrawn mainfont rhighlights
2123 global selectedline ancestor
2125 if {![info exists selectedline]} return
2127 if {$highlight_related eq "Descendent" ||
2128 $highlight_related eq "Not descendent"} {
2129 if {![info exists descendent($id)]} {
2132 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2135 } elseif {$highlight_related eq "Ancestor" ||
2136 $highlight_related eq "Not ancestor"} {
2137 if {![info exists ancestor($id)]} {
2140 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2144 if {[info exists iddrawn($id)]} {
2145 if {$isbold && ![ishighlighted $row]} {
2146 bolden $row [concat $mainfont bold]
2149 set rhighlights($row) $isbold
2152 proc next_hlcont {} {
2153 global fhl_row fhl_dirn displayorder numcommits
2154 global vhighlights fhighlights nhighlights rhighlights
2155 global hlview filehighlight findstring highlight_related
2157 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2160 if {$row < 0 || $row >= $numcommits} {
2165 set id [lindex $displayorder $row]
2166 if {[info exists hlview]} {
2167 if {![info exists vhighlights($row)]} {
2168 askvhighlight $row $id
2170 if {$vhighlights($row) > 0} break
2172 if {$findstring ne {}} {
2173 if {![info exists nhighlights($row)]} {
2174 askfindhighlight $row $id
2176 if {$nhighlights($row) > 0} break
2178 if {$highlight_related ne "None"} {
2179 if {![info exists rhighlights($row)]} {
2180 askrelhighlight $row $id
2182 if {$rhighlights($row) > 0} break
2184 if {[info exists filehighlight]} {
2185 if {![info exists fhighlights($row)]} {
2186 # ask for a few more while we're at it...
2188 for {set n 0} {$n < 100} {incr n} {
2189 if {![info exists fhighlights($r)]} {
2190 askfilehighlight $r [lindex $displayorder $r]
2193 if {$r < 0 || $r >= $numcommits} break
2197 if {$fhighlights($row) < 0} {
2201 if {$fhighlights($row) > 0} break
2209 proc next_highlight {dirn} {
2210 global selectedline fhl_row fhl_dirn
2211 global hlview filehighlight findstring highlight_related
2213 if {![info exists selectedline]} return
2214 if {!([info exists hlview] || $findstring ne {} ||
2215 $highlight_related ne "None" || [info exists filehighlight])} return
2216 set fhl_row [expr {$selectedline + $dirn}]
2221 proc cancel_next_highlight {} {
2227 # Graph layout functions
2229 proc shortids {ids} {
2232 if {[llength $id] > 1} {
2233 lappend res [shortids $id]
2234 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2235 lappend res [string range $id 0 7]
2243 proc incrange {l x o} {
2246 set e [lindex $l $x]
2248 lset l $x [expr {$e + $o}]
2257 for {} {$n > 0} {incr n -1} {
2263 proc usedinrange {id l1 l2} {
2264 global children commitrow childlist curview
2266 if {[info exists commitrow($curview,$id)]} {
2267 set r $commitrow($curview,$id)
2268 if {$l1 <= $r && $r <= $l2} {
2269 return [expr {$r - $l1 + 1}]
2271 set kids [lindex $childlist $r]
2273 set kids $children($curview,$id)
2276 set r $commitrow($curview,$c)
2277 if {$l1 <= $r && $r <= $l2} {
2278 return [expr {$r - $l1 + 1}]
2284 proc sanity {row {full 0}} {
2285 global rowidlist rowoffsets
2288 set ids [lindex $rowidlist $row]
2291 if {$id eq {}} continue
2292 if {$col < [llength $ids] - 1 &&
2293 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2294 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2296 set o [lindex $rowoffsets $row $col]
2302 if {[lindex $rowidlist $y $x] != $id} {
2303 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2304 puts " id=[shortids $id] check started at row $row"
2305 for {set i $row} {$i >= $y} {incr i -1} {
2306 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2311 set o [lindex $rowoffsets $y $x]
2316 proc makeuparrow {oid x y z} {
2317 global rowidlist rowoffsets uparrowlen idrowranges
2319 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2322 set off0 [lindex $rowoffsets $y]
2323 for {set x0 $x} {1} {incr x0} {
2324 if {$x0 >= [llength $off0]} {
2325 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2328 set z [lindex $off0 $x0]
2334 set z [expr {$x0 - $x}]
2335 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2336 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2338 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2339 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2340 lappend idrowranges($oid) $y
2343 proc initlayout {} {
2344 global rowidlist rowoffsets displayorder commitlisted
2345 global rowlaidout rowoptim
2346 global idinlist rowchk rowrangelist idrowranges
2347 global numcommits canvxmax canv
2349 global parentlist childlist children
2350 global colormap rowtextx
2362 catch {unset idinlist}
2363 catch {unset rowchk}
2366 set canvxmax [$canv cget -width]
2367 catch {unset colormap}
2368 catch {unset rowtextx}
2369 catch {unset idrowranges}
2373 proc setcanvscroll {} {
2374 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2376 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2377 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2378 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2379 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2382 proc visiblerows {} {
2383 global canv numcommits linespc
2385 set ymax [lindex [$canv cget -scrollregion] 3]
2386 if {$ymax eq {} || $ymax == 0} return
2388 set y0 [expr {int([lindex $f 0] * $ymax)}]
2389 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2393 set y1 [expr {int([lindex $f 1] * $ymax)}]
2394 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2395 if {$r1 >= $numcommits} {
2396 set r1 [expr {$numcommits - 1}]
2398 return [list $r0 $r1]
2401 proc layoutmore {tmax} {
2402 global rowlaidout rowoptim commitidx numcommits optim_delay
2403 global uparrowlen curview
2406 if {$rowoptim - $optim_delay > $numcommits} {
2407 showstuff [expr {$rowoptim - $optim_delay}]
2408 } elseif {$rowlaidout - $uparrowlen - 1 > $rowoptim} {
2409 set nr [expr {$rowlaidout - $uparrowlen - 1 - $rowoptim}]
2413 optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2415 } elseif {$commitidx($curview) > $rowlaidout} {
2416 set nr [expr {$commitidx($curview) - $rowlaidout}]
2417 # may need to increase this threshold if uparrowlen or
2418 # mingaplen are increased...
2423 set rowlaidout [layoutrows $row [expr {$row + $nr}] 0]
2424 if {$rowlaidout == $row} {
2430 if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2436 proc showstuff {canshow} {
2437 global numcommits commitrow pending_select selectedline
2438 global linesegends idrowranges idrangedrawn curview
2440 if {$numcommits == 0} {
2442 set phase "incrdraw"
2446 set numcommits $canshow
2448 set rows [visiblerows]
2449 set r0 [lindex $rows 0]
2450 set r1 [lindex $rows 1]
2452 for {set r $row} {$r < $canshow} {incr r} {
2453 foreach id [lindex $linesegends [expr {$r+1}]] {
2455 foreach {s e} [rowranges $id] {
2457 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2458 && ![info exists idrangedrawn($id,$i)]} {
2460 set idrangedrawn($id,$i) 1
2465 if {$canshow > $r1} {
2468 while {$row < $canshow} {
2472 if {[info exists pending_select] &&
2473 [info exists commitrow($curview,$pending_select)] &&
2474 $commitrow($curview,$pending_select) < $numcommits} {
2475 selectline $commitrow($curview,$pending_select) 1
2477 if {![info exists selectedline] && ![info exists pending_select]} {
2482 proc layoutrows {row endrow last} {
2483 global rowidlist rowoffsets displayorder
2484 global uparrowlen downarrowlen maxwidth mingaplen
2485 global childlist parentlist
2486 global idrowranges linesegends
2487 global commitidx curview
2488 global idinlist rowchk rowrangelist
2490 set idlist [lindex $rowidlist $row]
2491 set offs [lindex $rowoffsets $row]
2492 while {$row < $endrow} {
2493 set id [lindex $displayorder $row]
2496 foreach p [lindex $parentlist $row] {
2497 if {![info exists idinlist($p)]} {
2499 } elseif {!$idinlist($p)} {
2504 set nev [expr {[llength $idlist] + [llength $newolds]
2505 + [llength $oldolds] - $maxwidth + 1}]
2508 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2509 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2510 set i [lindex $idlist $x]
2511 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2512 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2513 [expr {$row + $uparrowlen + $mingaplen}]]
2515 set idlist [lreplace $idlist $x $x]
2516 set offs [lreplace $offs $x $x]
2517 set offs [incrange $offs $x 1]
2519 set rm1 [expr {$row - 1}]
2521 lappend idrowranges($i) $rm1
2522 if {[incr nev -1] <= 0} break
2525 set rowchk($id) [expr {$row + $r}]
2528 lset rowidlist $row $idlist
2529 lset rowoffsets $row $offs
2531 lappend linesegends $lse
2532 set col [lsearch -exact $idlist $id]
2534 set col [llength $idlist]
2536 lset rowidlist $row $idlist
2538 if {[lindex $childlist $row] ne {}} {
2539 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2543 lset rowoffsets $row $offs
2545 makeuparrow $id $col $row $z
2551 if {[info exists idrowranges($id)]} {
2552 set ranges $idrowranges($id)
2554 unset idrowranges($id)
2556 lappend rowrangelist $ranges
2558 set offs [ntimes [llength $idlist] 0]
2559 set l [llength $newolds]
2560 set idlist [eval lreplace \$idlist $col $col $newolds]
2563 set offs [lrange $offs 0 [expr {$col - 1}]]
2564 foreach x $newolds {
2569 set tmp [expr {[llength $idlist] - [llength $offs]}]
2571 set offs [concat $offs [ntimes $tmp $o]]
2576 foreach i $newolds {
2578 set idrowranges($i) $row
2581 foreach oid $oldolds {
2582 set idinlist($oid) 1
2583 set idlist [linsert $idlist $col $oid]
2584 set offs [linsert $offs $col $o]
2585 makeuparrow $oid $col $row $o
2588 lappend rowidlist $idlist
2589 lappend rowoffsets $offs
2594 proc addextraid {id row} {
2595 global displayorder commitrow commitinfo
2596 global commitidx commitlisted
2597 global parentlist childlist children curview
2599 incr commitidx($curview)
2600 lappend displayorder $id
2601 lappend commitlisted 0
2602 lappend parentlist {}
2603 set commitrow($curview,$id) $row
2605 if {![info exists commitinfo($id)]} {
2606 set commitinfo($id) {"No commit information available"}
2608 if {![info exists children($curview,$id)]} {
2609 set children($curview,$id) {}
2611 lappend childlist $children($curview,$id)
2614 proc layouttail {} {
2615 global rowidlist rowoffsets idinlist commitidx curview
2616 global idrowranges rowrangelist
2618 set row $commitidx($curview)
2619 set idlist [lindex $rowidlist $row]
2620 while {$idlist ne {}} {
2621 set col [expr {[llength $idlist] - 1}]
2622 set id [lindex $idlist $col]
2625 lappend idrowranges($id) $row
2626 lappend rowrangelist $idrowranges($id)
2627 unset idrowranges($id)
2629 set offs [ntimes $col 0]
2630 set idlist [lreplace $idlist $col $col]
2631 lappend rowidlist $idlist
2632 lappend rowoffsets $offs
2635 foreach id [array names idinlist] {
2637 lset rowidlist $row [list $id]
2638 lset rowoffsets $row 0
2639 makeuparrow $id 0 $row 0
2640 lappend idrowranges($id) $row
2641 lappend rowrangelist $idrowranges($id)
2642 unset idrowranges($id)
2644 lappend rowidlist {}
2645 lappend rowoffsets {}
2649 proc insert_pad {row col npad} {
2650 global rowidlist rowoffsets
2652 set pad [ntimes $npad {}]
2653 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2654 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2655 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2658 proc optimize_rows {row col endrow} {
2659 global rowidlist rowoffsets idrowranges displayorder
2661 for {} {$row < $endrow} {incr row} {
2662 set idlist [lindex $rowidlist $row]
2663 set offs [lindex $rowoffsets $row]
2665 for {} {$col < [llength $offs]} {incr col} {
2666 if {[lindex $idlist $col] eq {}} {
2670 set z [lindex $offs $col]
2671 if {$z eq {}} continue
2673 set x0 [expr {$col + $z}]
2674 set y0 [expr {$row - 1}]
2675 set z0 [lindex $rowoffsets $y0 $x0]
2677 set id [lindex $idlist $col]
2678 set ranges [rowranges $id]
2679 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2683 if {$z < -1 || ($z < 0 && $isarrow)} {
2684 set npad [expr {-1 - $z + $isarrow}]
2685 set offs [incrange $offs $col $npad]
2686 insert_pad $y0 $x0 $npad
2688 optimize_rows $y0 $x0 $row
2690 set z [lindex $offs $col]
2691 set x0 [expr {$col + $z}]
2692 set z0 [lindex $rowoffsets $y0 $x0]
2693 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2694 set npad [expr {$z - 1 + $isarrow}]
2695 set y1 [expr {$row + 1}]
2696 set offs2 [lindex $rowoffsets $y1]
2700 if {$z eq {} || $x1 + $z < $col} continue
2701 if {$x1 + $z > $col} {
2704 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2707 set pad [ntimes $npad {}]
2708 set idlist [eval linsert \$idlist $col $pad]
2709 set tmp [eval linsert \$offs $col $pad]
2711 set offs [incrange $tmp $col [expr {-$npad}]]
2712 set z [lindex $offs $col]
2715 if {$z0 eq {} && !$isarrow} {
2716 # this line links to its first child on row $row-2
2717 set rm2 [expr {$row - 2}]
2718 set id [lindex $displayorder $rm2]
2719 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2721 set z0 [expr {$xc - $x0}]
2724 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2725 insert_pad $y0 $x0 1
2726 set offs [incrange $offs $col 1]
2727 optimize_rows $y0 [expr {$x0 + 1}] $row
2732 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2733 set o [lindex $offs $col]
2735 # check if this is the link to the first child
2736 set id [lindex $idlist $col]
2737 set ranges [rowranges $id]
2738 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2739 # it is, work out offset to child
2740 set y0 [expr {$row - 1}]
2741 set id [lindex $displayorder $y0]
2742 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2744 set o [expr {$x0 - $col}]
2748 if {$o eq {} || $o <= 0} break
2750 if {$o ne {} && [incr col] < [llength $idlist]} {
2751 set y1 [expr {$row + 1}]
2752 set offs2 [lindex $rowoffsets $y1]
2756 if {$z eq {} || $x1 + $z < $col} continue
2757 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2760 set idlist [linsert $idlist $col {}]
2761 set tmp [linsert $offs $col {}]
2763 set offs [incrange $tmp $col -1]
2766 lset rowidlist $row $idlist
2767 lset rowoffsets $row $offs
2773 global canvx0 linespc
2774 return [expr {$canvx0 + $col * $linespc}]
2778 global canvy0 linespc
2779 return [expr {$canvy0 + $row * $linespc}]
2782 proc linewidth {id} {
2783 global thickerline lthickness
2786 if {[info exists thickerline] && $id eq $thickerline} {
2787 set wid [expr {2 * $lthickness}]
2792 proc rowranges {id} {
2793 global phase idrowranges commitrow rowlaidout rowrangelist curview
2797 ([info exists commitrow($curview,$id)]
2798 && $commitrow($curview,$id) < $rowlaidout)} {
2799 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2800 } elseif {[info exists idrowranges($id)]} {
2801 set ranges $idrowranges($id)
2806 proc drawlineseg {id i} {
2807 global rowoffsets rowidlist
2809 global canv colormap linespc
2810 global numcommits commitrow curview
2812 set ranges [rowranges $id]
2814 if {[info exists commitrow($curview,$id)]
2815 && $commitrow($curview,$id) < $numcommits} {
2816 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2820 set startrow [lindex $ranges [expr {2 * $i}]]
2821 set row [lindex $ranges [expr {2 * $i + 1}]]
2822 if {$startrow == $row} return
2825 set col [lsearch -exact [lindex $rowidlist $row] $id]
2827 puts "oops: drawline: id $id not on row $row"
2833 set o [lindex $rowoffsets $row $col]
2836 # changing direction
2837 set x [xc $row $col]
2839 lappend coords $x $y
2845 set x [xc $row $col]
2847 lappend coords $x $y
2849 # draw the link to the first child as part of this line
2851 set child [lindex $displayorder $row]
2852 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2854 set x [xc $row $ccol]
2856 if {$ccol < $col - 1} {
2857 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2858 } elseif {$ccol > $col + 1} {
2859 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2861 lappend coords $x $y
2864 if {[llength $coords] < 4} return
2866 # This line has an arrow at the lower end: check if the arrow is
2867 # on a diagonal segment, and if so, work around the Tk 8.4
2868 # refusal to draw arrows on diagonal lines.
2869 set x0 [lindex $coords 0]
2870 set x1 [lindex $coords 2]
2872 set y0 [lindex $coords 1]
2873 set y1 [lindex $coords 3]
2874 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2875 # we have a nearby vertical segment, just trim off the diag bit
2876 set coords [lrange $coords 2 end]
2878 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2879 set xi [expr {$x0 - $slope * $linespc / 2}]
2880 set yi [expr {$y0 - $linespc / 2}]
2881 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2885 set arrow [expr {2 * ($i > 0) + $downarrow}]
2886 set arrow [lindex {none first last both} $arrow]
2887 set t [$canv create line $coords -width [linewidth $id] \
2888 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2893 proc drawparentlinks {id row col olds} {
2894 global rowidlist canv colormap
2896 set row2 [expr {$row + 1}]
2897 set x [xc $row $col]
2900 set ids [lindex $rowidlist $row2]
2901 # rmx = right-most X coord used
2904 set i [lsearch -exact $ids $p]
2906 puts "oops, parent $p of $id not in list"
2909 set x2 [xc $row2 $i]
2913 set ranges [rowranges $p]
2914 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2915 && $row2 < [lindex $ranges 1]} {
2916 # drawlineseg will do this one for us
2920 # should handle duplicated parents here...
2921 set coords [list $x $y]
2922 if {$i < $col - 1} {
2923 lappend coords [xc $row [expr {$i + 1}]] $y
2924 } elseif {$i > $col + 1} {
2925 lappend coords [xc $row [expr {$i - 1}]] $y
2927 lappend coords $x2 $y2
2928 set t [$canv create line $coords -width [linewidth $p] \
2929 -fill $colormap($p) -tags lines.$p]
2936 proc drawlines {id} {
2937 global colormap canv
2939 global children iddrawn commitrow rowidlist curview
2941 $canv delete lines.$id
2942 set nr [expr {[llength [rowranges $id]] / 2}]
2943 for {set i 0} {$i < $nr} {incr i} {
2944 if {[info exists idrangedrawn($id,$i)]} {
2948 foreach child $children($curview,$id) {
2949 if {[info exists iddrawn($child)]} {
2950 set row $commitrow($curview,$child)
2951 set col [lsearch -exact [lindex $rowidlist $row] $child]
2953 drawparentlinks $child $row $col [list $id]
2959 proc drawcmittext {id row col rmx} {
2960 global linespc canv canv2 canv3 canvy0 fgcolor
2961 global commitlisted commitinfo rowidlist
2962 global rowtextx idpos idtags idheads idotherrefs
2963 global linehtag linentag linedtag
2964 global mainfont canvxmax boldrows boldnamerows fgcolor
2966 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2967 set x [xc $row $col]
2969 set orad [expr {$linespc / 3}]
2970 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2971 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2972 -fill $ofill -outline $fgcolor -width 1 -tags circle]
2974 $canv bind $t <1> {selcanvline {} %x %y}
2975 set xt [xc $row [llength [lindex $rowidlist $row]]]
2979 set rowtextx($row) $xt
2980 set idpos($id) [list $x $xt $y]
2981 if {[info exists idtags($id)] || [info exists idheads($id)]
2982 || [info exists idotherrefs($id)]} {
2983 set xt [drawtags $id $x $xt $y]
2985 set headline [lindex $commitinfo($id) 0]
2986 set name [lindex $commitinfo($id) 1]
2987 set date [lindex $commitinfo($id) 2]
2988 set date [formatdate $date]
2991 set isbold [ishighlighted $row]
2993 lappend boldrows $row
2996 lappend boldnamerows $row
3000 set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3001 -text $headline -font $font -tags text]
3002 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3003 set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3004 -text $name -font $nfont -tags text]
3005 set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3006 -text $date -font $mainfont -tags text]
3007 set xr [expr {$xt + [font measure $mainfont $headline]}]
3008 if {$xr > $canvxmax} {
3014 proc drawcmitrow {row} {
3015 global displayorder rowidlist
3016 global idrangedrawn iddrawn
3017 global commitinfo parentlist numcommits
3018 global filehighlight fhighlights findstring nhighlights
3019 global hlview vhighlights
3020 global highlight_related rhighlights
3022 if {$row >= $numcommits} return
3023 foreach id [lindex $rowidlist $row] {
3024 if {$id eq {}} continue
3026 foreach {s e} [rowranges $id] {
3028 if {$row < $s} continue
3031 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
3033 set idrangedrawn($id,$i) 1
3040 set id [lindex $displayorder $row]
3041 if {[info exists hlview] && ![info exists vhighlights($row)]} {
3042 askvhighlight $row $id
3044 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3045 askfilehighlight $row $id
3047 if {$findstring ne {} && ![info exists nhighlights($row)]} {
3048 askfindhighlight $row $id
3050 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3051 askrelhighlight $row $id
3053 if {[info exists iddrawn($id)]} return
3054 set col [lsearch -exact [lindex $rowidlist $row] $id]
3056 puts "oops, row $row id $id not in list"
3059 if {![info exists commitinfo($id)]} {
3063 set olds [lindex $parentlist $row]
3065 set rmx [drawparentlinks $id $row $col $olds]
3069 drawcmittext $id $row $col $rmx
3073 proc drawfrac {f0 f1} {
3074 global numcommits canv
3077 set ymax [lindex [$canv cget -scrollregion] 3]
3078 if {$ymax eq {} || $ymax == 0} return
3079 set y0 [expr {int($f0 * $ymax)}]
3080 set row [expr {int(($y0 - 3) / $linespc) - 1}]
3084 set y1 [expr {int($f1 * $ymax)}]
3085 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3086 if {$endrow >= $numcommits} {
3087 set endrow [expr {$numcommits - 1}]
3089 for {} {$row <= $endrow} {incr row} {
3094 proc drawvisible {} {
3096 eval drawfrac [$canv yview]
3099 proc clear_display {} {
3100 global iddrawn idrangedrawn
3101 global vhighlights fhighlights nhighlights rhighlights
3104 catch {unset iddrawn}
3105 catch {unset idrangedrawn}
3106 catch {unset vhighlights}
3107 catch {unset fhighlights}
3108 catch {unset nhighlights}
3109 catch {unset rhighlights}
3112 proc findcrossings {id} {
3113 global rowidlist parentlist numcommits rowoffsets displayorder
3117 foreach {s e} [rowranges $id] {
3118 if {$e >= $numcommits} {
3119 set e [expr {$numcommits - 1}]
3121 if {$e <= $s} continue
3122 set x [lsearch -exact [lindex $rowidlist $e] $id]
3124 puts "findcrossings: oops, no [shortids $id] in row $e"
3127 for {set row $e} {[incr row -1] >= $s} {} {
3128 set olds [lindex $parentlist $row]
3129 set kid [lindex $displayorder $row]
3130 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3131 if {$kidx < 0} continue
3132 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3134 set px [lsearch -exact $nextrow $p]
3135 if {$px < 0} continue
3136 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3137 if {[lsearch -exact $ccross $p] >= 0} continue
3138 if {$x == $px + ($kidx < $px? -1: 1)} {
3140 } elseif {[lsearch -exact $cross $p] < 0} {
3145 set inc [lindex $rowoffsets $row $x]
3146 if {$inc eq {}} break
3150 return [concat $ccross {{}} $cross]
3153 proc assigncolor {id} {
3154 global colormap colors nextcolor
3155 global commitrow parentlist children children curview
3157 if {[info exists colormap($id)]} return
3158 set ncolors [llength $colors]
3159 if {[info exists children($curview,$id)]} {
3160 set kids $children($curview,$id)
3164 if {[llength $kids] == 1} {
3165 set child [lindex $kids 0]
3166 if {[info exists colormap($child)]
3167 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3168 set colormap($id) $colormap($child)
3174 foreach x [findcrossings $id] {
3176 # delimiter between corner crossings and other crossings
3177 if {[llength $badcolors] >= $ncolors - 1} break
3178 set origbad $badcolors
3180 if {[info exists colormap($x)]
3181 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3182 lappend badcolors $colormap($x)
3185 if {[llength $badcolors] >= $ncolors} {
3186 set badcolors $origbad
3188 set origbad $badcolors
3189 if {[llength $badcolors] < $ncolors - 1} {
3190 foreach child $kids {
3191 if {[info exists colormap($child)]
3192 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3193 lappend badcolors $colormap($child)
3195 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3196 if {[info exists colormap($p)]
3197 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3198 lappend badcolors $colormap($p)
3202 if {[llength $badcolors] >= $ncolors} {
3203 set badcolors $origbad
3206 for {set i 0} {$i <= $ncolors} {incr i} {
3207 set c [lindex $colors $nextcolor]
3208 if {[incr nextcolor] >= $ncolors} {
3211 if {[lsearch -exact $badcolors $c]} break
3213 set colormap($id) $c
3216 proc bindline {t id} {
3219 $canv bind $t <Enter> "lineenter %x %y $id"
3220 $canv bind $t <Motion> "linemotion %x %y $id"
3221 $canv bind $t <Leave> "lineleave $id"
3222 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3225 proc drawtags {id x xt y1} {
3226 global idtags idheads idotherrefs mainhead
3227 global linespc lthickness
3228 global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3233 if {[info exists idtags($id)]} {
3234 set marks $idtags($id)
3235 set ntags [llength $marks]
3237 if {[info exists idheads($id)]} {
3238 set marks [concat $marks $idheads($id)]
3239 set nheads [llength $idheads($id)]
3241 if {[info exists idotherrefs($id)]} {
3242 set marks [concat $marks $idotherrefs($id)]
3248 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3249 set yt [expr {$y1 - 0.5 * $linespc}]
3250 set yb [expr {$yt + $linespc - 1}]
3254 foreach tag $marks {
3256 if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3257 set wid [font measure [concat $mainfont bold] $tag]
3259 set wid [font measure $mainfont $tag]
3263 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3265 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3266 -width $lthickness -fill black -tags tag.$id]
3268 foreach tag $marks x $xvals wid $wvals {
3269 set xl [expr {$x + $delta}]
3270 set xr [expr {$x + $delta + $wid + $lthickness}]
3272 if {[incr ntags -1] >= 0} {
3274 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3275 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3276 -width 1 -outline black -fill yellow -tags tag.$id]
3277 $canv bind $t <1> [list showtag $tag 1]
3278 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3280 # draw a head or other ref
3281 if {[incr nheads -1] >= 0} {
3283 if {$tag eq $mainhead} {
3289 set xl [expr {$xl - $delta/2}]
3290 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3291 -width 1 -outline black -fill $col -tags tag.$id
3292 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3293 set rwid [font measure $mainfont $remoteprefix]
3294 set xi [expr {$x + 1}]
3295 set yti [expr {$yt + 1}]
3296 set xri [expr {$x + $rwid}]
3297 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3298 -width 0 -fill "#ffddaa" -tags tag.$id
3301 set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3302 -font $font -tags [list tag.$id text]]
3304 $canv bind $t <1> [list showtag $tag 1]
3305 } elseif {$nheads >= 0} {
3306 $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3312 proc xcoord {i level ln} {
3313 global canvx0 xspc1 xspc2
3315 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3316 if {$i > 0 && $i == $level} {
3317 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3318 } elseif {$i > $level} {
3319 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3324 proc show_status {msg} {
3325 global canv mainfont fgcolor
3328 $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3329 -tags text -fill $fgcolor
3332 proc finishcommits {} {
3333 global commitidx phase curview
3334 global pending_select
3336 if {$commitidx($curview) > 0} {
3339 show_status "No commits selected"
3342 catch {unset pending_select}
3345 # Insert a new commit as the child of the commit on row $row.
3346 # The new commit will be displayed on row $row and the commits
3347 # on that row and below will move down one row.
3348 proc insertrow {row newcmit} {
3349 global displayorder parentlist childlist commitlisted
3350 global commitrow curview rowidlist rowoffsets numcommits
3351 global rowrangelist idrowranges rowlaidout rowoptim numcommits
3352 global linesegends selectedline
3354 if {$row >= $numcommits} {
3355 puts "oops, inserting new row $row but only have $numcommits rows"
3358 set p [lindex $displayorder $row]
3359 set displayorder [linsert $displayorder $row $newcmit]
3360 set parentlist [linsert $parentlist $row $p]
3361 set kids [lindex $childlist $row]
3362 lappend kids $newcmit
3363 lset childlist $row $kids
3364 set childlist [linsert $childlist $row {}]
3365 set commitlisted [linsert $commitlisted $row 1]
3366 set l [llength $displayorder]
3367 for {set r $row} {$r < $l} {incr r} {
3368 set id [lindex $displayorder $r]
3369 set commitrow($curview,$id) $r
3372 set idlist [lindex $rowidlist $row]
3373 set offs [lindex $rowoffsets $row]
3376 if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3382 if {[llength $kids] == 1} {
3383 set col [lsearch -exact $idlist $p]
3384 lset idlist $col $newcmit
3386 set col [llength $idlist]
3387 lappend idlist $newcmit
3389 lset rowoffsets $row $offs
3391 set rowidlist [linsert $rowidlist $row $idlist]
3392 set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3394 set rowrangelist [linsert $rowrangelist $row {}]
3395 set l [llength $rowrangelist]
3396 for {set r 0} {$r < $l} {incr r} {
3397 set ranges [lindex $rowrangelist $r]
3398 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3402 lappend newranges [expr {$x + 1}]
3404 lappend newranges $x
3407 lset rowrangelist $r $newranges
3410 if {[llength $kids] > 1} {
3411 set rp1 [expr {$row + 1}]
3412 set ranges [lindex $rowrangelist $rp1]
3413 if {$ranges eq {}} {
3414 set ranges [list $row $rp1]
3415 } elseif {[lindex $ranges end-1] == $rp1} {
3416 lset ranges end-1 $row
3418 lset rowrangelist $rp1 $ranges
3420 foreach id [array names idrowranges] {
3421 set ranges $idrowranges($id)
3422 if {$ranges ne {} && [lindex $ranges end] >= $row} {
3426 lappend newranges [expr {$x + 1}]
3428 lappend newranges $x
3431 set idrowranges($id) $newranges
3435 set linesegends [linsert $linesegends $row {}]
3441 if {[info exists selectedline] && $selectedline >= $row} {
3447 # Don't change the text pane cursor if it is currently the hand cursor,
3448 # showing that we are over a sha1 ID link.
3449 proc settextcursor {c} {
3450 global ctext curtextcursor
3452 if {[$ctext cget -cursor] == $curtextcursor} {
3453 $ctext config -cursor $c
3455 set curtextcursor $c
3458 proc nowbusy {what} {
3461 if {[array names isbusy] eq {}} {
3462 . config -cursor watch
3468 proc notbusy {what} {
3469 global isbusy maincursor textcursor
3471 catch {unset isbusy($what)}
3472 if {[array names isbusy] eq {}} {
3473 . config -cursor $maincursor
3474 settextcursor $textcursor
3480 global rowlaidout commitidx curview
3481 global pending_select
3484 layoutrows $rowlaidout $commitidx($curview) 1
3486 optimize_rows $row 0 $commitidx($curview)
3487 showstuff $commitidx($curview)
3488 if {[info exists pending_select]} {
3492 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3494 #puts "overall $drawmsecs ms for $numcommits commits"
3497 proc findmatches {f} {
3498 global findtype foundstring foundstrlen
3499 if {$findtype == "Regexp"} {
3500 set matches [regexp -indices -all -inline $foundstring $f]
3502 if {$findtype == "IgnCase"} {
3503 set str [string tolower $f]
3509 while {[set j [string first $foundstring $str $i]] >= 0} {
3510 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3511 set i [expr {$j + $foundstrlen}]
3518 global findtype findloc findstring markedmatches commitinfo
3519 global numcommits displayorder linehtag linentag linedtag
3520 global mainfont canv canv2 canv3 selectedline
3521 global matchinglines foundstring foundstrlen matchstring
3526 cancel_next_highlight
3528 set matchinglines {}
3529 if {$findtype == "IgnCase"} {
3530 set foundstring [string tolower $findstring]
3532 set foundstring $findstring
3534 set foundstrlen [string length $findstring]
3535 if {$foundstrlen == 0} return
3536 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3537 set matchstring "*$matchstring*"
3538 if {![info exists selectedline]} {
3541 set oldsel $selectedline
3544 set fldtypes {Headline Author Date Committer CDate Comments}
3546 foreach id $displayorder {
3547 set d $commitdata($id)
3549 if {$findtype == "Regexp"} {
3550 set doesmatch [regexp $foundstring $d]
3551 } elseif {$findtype == "IgnCase"} {
3552 set doesmatch [string match -nocase $matchstring $d]
3554 set doesmatch [string match $matchstring $d]
3556 if {!$doesmatch} continue
3557 if {![info exists commitinfo($id)]} {
3560 set info $commitinfo($id)
3562 foreach f $info ty $fldtypes {
3563 if {$findloc != "All fields" && $findloc != $ty} {
3566 set matches [findmatches $f]
3567 if {$matches == {}} continue
3569 if {$ty == "Headline"} {
3571 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3572 } elseif {$ty == "Author"} {
3574 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3575 } elseif {$ty == "Date"} {
3577 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3581 lappend matchinglines $l
3582 if {!$didsel && $l > $oldsel} {
3588 if {$matchinglines == {}} {
3590 } elseif {!$didsel} {
3591 findselectline [lindex $matchinglines 0]
3595 proc findselectline {l} {
3596 global findloc commentend ctext
3598 if {$findloc == "All fields" || $findloc == "Comments"} {
3599 # highlight the matches in the comments
3600 set f [$ctext get 1.0 $commentend]
3601 set matches [findmatches $f]
3602 foreach match $matches {
3603 set start [lindex $match 0]
3604 set end [expr {[lindex $match 1] + 1}]
3605 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3610 proc findnext {restart} {
3611 global matchinglines selectedline
3612 if {![info exists matchinglines]} {
3618 if {![info exists selectedline]} return
3619 foreach l $matchinglines {
3620 if {$l > $selectedline} {
3629 global matchinglines selectedline
3630 if {![info exists matchinglines]} {
3634 if {![info exists selectedline]} return
3636 foreach l $matchinglines {
3637 if {$l >= $selectedline} break
3641 findselectline $prev
3647 proc stopfindproc {{done 0}} {
3648 global findprocpid findprocfile findids
3649 global ctext findoldcursor phase maincursor textcursor
3650 global findinprogress
3652 catch {unset findids}
3653 if {[info exists findprocpid]} {
3655 catch {exec kill $findprocpid}
3657 catch {close $findprocfile}
3660 catch {unset findinprogress}
3664 # mark a commit as matching by putting a yellow background
3665 # behind the headline
3666 proc markheadline {l id} {
3667 global canv mainfont linehtag
3670 set bbox [$canv bbox $linehtag($l)]
3671 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3675 # mark the bits of a headline, author or date that match a find string
3676 proc markmatches {canv l str tag matches font} {
3677 set bbox [$canv bbox $tag]
3678 set x0 [lindex $bbox 0]
3679 set y0 [lindex $bbox 1]
3680 set y1 [lindex $bbox 3]
3681 foreach match $matches {
3682 set start [lindex $match 0]
3683 set end [lindex $match 1]
3684 if {$start > $end} continue
3685 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3686 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3687 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3688 [expr {$x0+$xlen+2}] $y1 \
3689 -outline {} -tags matches -fill yellow]
3694 proc unmarkmatches {} {
3695 global matchinglines findids
3696 allcanvs delete matches
3697 catch {unset matchinglines}
3698 catch {unset findids}
3701 proc selcanvline {w x y} {
3702 global canv canvy0 ctext linespc
3704 set ymax [lindex [$canv cget -scrollregion] 3]
3705 if {$ymax == {}} return
3706 set yfrac [lindex [$canv yview] 0]
3707 set y [expr {$y + $yfrac * $ymax}]
3708 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3713 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3719 proc commit_descriptor {p} {
3721 if {![info exists commitinfo($p)]} {
3725 if {[llength $commitinfo($p)] > 1} {
3726 set l [lindex $commitinfo($p) 0]
3731 # append some text to the ctext widget, and make any SHA1 ID
3732 # that we know about be a clickable link.
3733 proc appendwithlinks {text tags} {
3734 global ctext commitrow linknum curview
3736 set start [$ctext index "end - 1c"]
3737 $ctext insert end $text $tags
3738 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3742 set linkid [string range $text $s $e]
3743 if {![info exists commitrow($curview,$linkid)]} continue
3745 $ctext tag add link "$start + $s c" "$start + $e c"
3746 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3747 $ctext tag bind link$linknum <1> \
3748 [list selectline $commitrow($curview,$linkid) 1]
3751 $ctext tag conf link -foreground blue -underline 1
3752 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3753 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3756 proc viewnextline {dir} {
3760 set ymax [lindex [$canv cget -scrollregion] 3]
3761 set wnow [$canv yview]
3762 set wtop [expr {[lindex $wnow 0] * $ymax}]
3763 set newtop [expr {$wtop + $dir * $linespc}]
3766 } elseif {$newtop > $ymax} {
3769 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3772 # add a list of tag or branch names at position pos
3773 # returns the number of names inserted
3774 proc appendrefs {pos tags var} {
3775 global ctext commitrow linknum curview $var
3777 if {[catch {$ctext index $pos}]} {
3780 set tags [lsort $tags]
3783 set id [set $var\($tag\)]
3786 $ctext insert $pos $sep
3787 $ctext insert $pos $tag $lk
3788 $ctext tag conf $lk -foreground blue
3789 if {[info exists commitrow($curview,$id)]} {
3790 $ctext tag bind $lk <1> \
3791 [list selectline $commitrow($curview,$id) 1]
3792 $ctext tag conf $lk -underline 1
3793 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3794 $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3798 return [llength $tags]
3801 proc taglist {ids} {
3806 foreach tag $idtags($id) {
3813 # called when we have finished computing the nearby tags
3814 proc dispneartags {} {
3815 global selectedline currentid ctext anc_tags desc_tags showneartags
3818 if {![info exists selectedline] || !$showneartags} return
3820 $ctext conf -state normal
3821 if {[info exists desc_heads($id)]} {
3822 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3823 $ctext insert "branch -2c" "es"
3826 if {[info exists anc_tags($id)]} {
3827 appendrefs follows [taglist $anc_tags($id)] tagids
3829 if {[info exists desc_tags($id)]} {
3830 appendrefs precedes [taglist $desc_tags($id)] tagids
3832 $ctext conf -state disabled
3835 proc selectline {l isnew} {
3836 global canv canv2 canv3 ctext commitinfo selectedline
3837 global displayorder linehtag linentag linedtag
3838 global canvy0 linespc parentlist childlist
3839 global currentid sha1entry
3840 global commentend idtags linknum
3841 global mergemax numcommits pending_select
3842 global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3844 catch {unset pending_select}
3847 cancel_next_highlight
3848 if {$l < 0 || $l >= $numcommits} return
3849 set y [expr {$canvy0 + $l * $linespc}]
3850 set ymax [lindex [$canv cget -scrollregion] 3]
3851 set ytop [expr {$y - $linespc - 1}]
3852 set ybot [expr {$y + $linespc + 1}]
3853 set wnow [$canv yview]
3854 set wtop [expr {[lindex $wnow 0] * $ymax}]
3855 set wbot [expr {[lindex $wnow 1] * $ymax}]
3856 set wh [expr {$wbot - $wtop}]
3858 if {$ytop < $wtop} {
3859 if {$ybot < $wtop} {
3860 set newtop [expr {$y - $wh / 2.0}]
3863 if {$newtop > $wtop - $linespc} {
3864 set newtop [expr {$wtop - $linespc}]
3867 } elseif {$ybot > $wbot} {
3868 if {$ytop > $wbot} {
3869 set newtop [expr {$y - $wh / 2.0}]
3871 set newtop [expr {$ybot - $wh}]
3872 if {$newtop < $wtop + $linespc} {
3873 set newtop [expr {$wtop + $linespc}]
3877 if {$newtop != $wtop} {
3881 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3885 if {![info exists linehtag($l)]} return
3887 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3888 -tags secsel -fill [$canv cget -selectbackground]]
3890 $canv2 delete secsel
3891 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3892 -tags secsel -fill [$canv2 cget -selectbackground]]
3894 $canv3 delete secsel
3895 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3896 -tags secsel -fill [$canv3 cget -selectbackground]]
3900 addtohistory [list selectline $l 0]
3905 set id [lindex $displayorder $l]
3907 $sha1entry delete 0 end
3908 $sha1entry insert 0 $id
3909 $sha1entry selection from 0
3910 $sha1entry selection to end
3913 $ctext conf -state normal
3916 set info $commitinfo($id)
3917 set date [formatdate [lindex $info 2]]
3918 $ctext insert end "Author: [lindex $info 1] $date\n"
3919 set date [formatdate [lindex $info 4]]
3920 $ctext insert end "Committer: [lindex $info 3] $date\n"
3921 if {[info exists idtags($id)]} {
3922 $ctext insert end "Tags:"
3923 foreach tag $idtags($id) {
3924 $ctext insert end " $tag"
3926 $ctext insert end "\n"
3930 set olds [lindex $parentlist $l]
3931 if {[llength $olds] > 1} {
3934 if {$np >= $mergemax} {
3939 $ctext insert end "Parent: " $tag
3940 appendwithlinks [commit_descriptor $p] {}
3945 append headers "Parent: [commit_descriptor $p]"
3949 foreach c [lindex $childlist $l] {
3950 append headers "Child: [commit_descriptor $c]"
3953 # make anything that looks like a SHA1 ID be a clickable link
3954 appendwithlinks $headers {}
3955 if {$showneartags} {
3956 if {![info exists allcommits]} {
3959 $ctext insert end "Branch: "
3960 $ctext mark set branch "end -1c"
3961 $ctext mark gravity branch left
3962 if {[info exists desc_heads($id)]} {
3963 if {[appendrefs branch $desc_heads($id) headids] > 1} {
3964 # turn "Branch" into "Branches"
3965 $ctext insert "branch -2c" "es"
3968 $ctext insert end "\nFollows: "
3969 $ctext mark set follows "end -1c"
3970 $ctext mark gravity follows left
3971 if {[info exists anc_tags($id)]} {
3972 appendrefs follows [taglist $anc_tags($id)] tagids
3974 $ctext insert end "\nPrecedes: "
3975 $ctext mark set precedes "end -1c"
3976 $ctext mark gravity precedes left
3977 if {[info exists desc_tags($id)]} {
3978 appendrefs precedes [taglist $desc_tags($id)] tagids
3980 $ctext insert end "\n"
3982 $ctext insert end "\n"
3983 appendwithlinks [lindex $info 5] {comment}
3985 $ctext tag delete Comments
3986 $ctext tag remove found 1.0 end
3987 $ctext conf -state disabled
3988 set commentend [$ctext index "end - 1c"]
3990 init_flist "Comments"
3991 if {$cmitmode eq "tree"} {
3993 } elseif {[llength $olds] <= 1} {
4000 proc selfirstline {} {
4005 proc sellastline {} {
4008 set l [expr {$numcommits - 1}]
4012 proc selnextline {dir} {
4014 if {![info exists selectedline]} return
4015 set l [expr {$selectedline + $dir}]
4020 proc selnextpage {dir} {
4021 global canv linespc selectedline numcommits
4023 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4027 allcanvs yview scroll [expr {$dir * $lpp}] units
4029 if {![info exists selectedline]} return
4030 set l [expr {$selectedline + $dir * $lpp}]
4033 } elseif {$l >= $numcommits} {
4034 set l [expr $numcommits - 1]
4040 proc unselectline {} {
4041 global selectedline currentid
4043 catch {unset selectedline}
4044 catch {unset currentid}
4045 allcanvs delete secsel
4047 cancel_next_highlight
4050 proc reselectline {} {
4053 if {[info exists selectedline]} {
4054 selectline $selectedline 0
4058 proc addtohistory {cmd} {
4059 global history historyindex curview
4061 set elt [list $curview $cmd]
4062 if {$historyindex > 0
4063 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4067 if {$historyindex < [llength $history]} {
4068 set history [lreplace $history $historyindex end $elt]
4070 lappend history $elt
4073 if {$historyindex > 1} {
4074 .tf.bar.leftbut conf -state normal
4076 .tf.bar.leftbut conf -state disabled
4078 .tf.bar.rightbut conf -state disabled
4084 set view [lindex $elt 0]
4085 set cmd [lindex $elt 1]
4086 if {$curview != $view} {
4093 global history historyindex
4095 if {$historyindex > 1} {
4096 incr historyindex -1
4097 godo [lindex $history [expr {$historyindex - 1}]]
4098 .tf.bar.rightbut conf -state normal
4100 if {$historyindex <= 1} {
4101 .tf.bar.leftbut conf -state disabled
4106 global history historyindex
4108 if {$historyindex < [llength $history]} {
4109 set cmd [lindex $history $historyindex]
4112 .tf.bar.leftbut conf -state normal
4114 if {$historyindex >= [llength $history]} {
4115 .tf.bar.rightbut conf -state disabled
4120 global treefilelist treeidlist diffids diffmergeid treepending
4123 catch {unset diffmergeid}
4124 if {![info exists treefilelist($id)]} {
4125 if {![info exists treepending]} {
4126 if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
4130 set treefilelist($id) {}
4131 set treeidlist($id) {}
4132 fconfigure $gtf -blocking 0
4133 fileevent $gtf readable [list gettreeline $gtf $id]
4140 proc gettreeline {gtf id} {
4141 global treefilelist treeidlist treepending cmitmode diffids
4143 while {[gets $gtf line] >= 0} {
4144 if {[lindex $line 1] ne "blob"} continue
4145 set sha1 [lindex $line 2]
4146 set fname [lindex $line 3]
4147 lappend treefilelist($id) $fname
4148 lappend treeidlist($id) $sha1
4150 if {![eof $gtf]} return
4153 if {$cmitmode ne "tree"} {
4154 if {![info exists diffmergeid]} {
4155 gettreediffs $diffids
4157 } elseif {$id ne $diffids} {
4165 global treefilelist treeidlist diffids
4166 global ctext commentend
4168 set i [lsearch -exact $treefilelist($diffids) $f]
4170 puts "oops, $f not in list for id $diffids"
4173 set blob [lindex $treeidlist($diffids) $i]
4174 if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4175 puts "oops, error reading blob $blob: $err"
4178 fconfigure $bf -blocking 0
4179 fileevent $bf readable [list getblobline $bf $diffids]
4180 $ctext config -state normal
4181 clear_ctext $commentend
4182 $ctext insert end "\n"
4183 $ctext insert end "$f\n" filesep
4184 $ctext config -state disabled
4185 $ctext yview $commentend
4188 proc getblobline {bf id} {
4189 global diffids cmitmode ctext
4191 if {$id ne $diffids || $cmitmode ne "tree"} {
4195 $ctext config -state normal
4196 while {[gets $bf line] >= 0} {
4197 $ctext insert end "$line\n"
4200 # delete last newline
4201 $ctext delete "end - 2c" "end - 1c"
4204 $ctext config -state disabled
4207 proc mergediff {id l} {
4208 global diffmergeid diffopts mdifffd
4214 # this doesn't seem to actually affect anything...
4215 set env(GIT_DIFF_OPTS) $diffopts
4216 set cmd [concat | git diff-tree --no-commit-id --cc $id]
4217 if {[catch {set mdf [open $cmd r]} err]} {
4218 error_popup "Error getting merge diffs: $err"
4221 fconfigure $mdf -blocking 0
4222 set mdifffd($id) $mdf
4223 set np [llength [lindex $parentlist $l]]
4224 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4225 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4228 proc getmergediffline {mdf id np} {
4229 global diffmergeid ctext cflist nextupdate mergemax
4230 global difffilestart mdifffd
4232 set n [gets $mdf line]
4239 if {![info exists diffmergeid] || $id != $diffmergeid
4240 || $mdf != $mdifffd($id)} {
4243 $ctext conf -state normal
4244 if {[regexp {^diff --cc (.*)} $line match fname]} {
4245 # start of a new file
4246 $ctext insert end "\n"
4247 set here [$ctext index "end - 1c"]
4248 lappend difffilestart $here
4249 add_flist [list $fname]
4250 set l [expr {(78 - [string length $fname]) / 2}]
4251 set pad [string range "----------------------------------------" 1 $l]
4252 $ctext insert end "$pad $fname $pad\n" filesep
4253 } elseif {[regexp {^@@} $line]} {
4254 $ctext insert end "$line\n" hunksep
4255 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4258 # parse the prefix - one ' ', '-' or '+' for each parent
4263 for {set j 0} {$j < $np} {incr j} {
4264 set c [string range $line $j $j]
4267 } elseif {$c == "-"} {
4269 } elseif {$c == "+"} {
4278 if {!$isbad && $minuses ne {} && $pluses eq {}} {
4279 # line doesn't appear in result, parents in $minuses have the line
4280 set num [lindex $minuses 0]
4281 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4282 # line appears in result, parents in $pluses don't have the line
4283 lappend tags mresult
4284 set num [lindex $spaces 0]
4287 if {$num >= $mergemax} {
4292 $ctext insert end "$line\n" $tags
4294 $ctext conf -state disabled
4295 if {[clock clicks -milliseconds] >= $nextupdate} {
4297 fileevent $mdf readable {}
4299 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4303 proc startdiff {ids} {
4304 global treediffs diffids treepending diffmergeid
4307 catch {unset diffmergeid}
4308 if {![info exists treediffs($ids)]} {
4309 if {![info exists treepending]} {
4317 proc addtocflist {ids} {
4318 global treediffs cflist
4319 add_flist $treediffs($ids)
4323 proc gettreediffs {ids} {
4324 global treediff treepending
4325 set treepending $ids
4328 {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4330 fconfigure $gdtf -blocking 0
4331 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4334 proc gettreediffline {gdtf ids} {
4335 global treediff treediffs treepending diffids diffmergeid
4338 set n [gets $gdtf line]
4340 if {![eof $gdtf]} return
4342 set treediffs($ids) $treediff
4344 if {$cmitmode eq "tree"} {
4346 } elseif {$ids != $diffids} {
4347 if {![info exists diffmergeid]} {
4348 gettreediffs $diffids
4355 set file [lindex $line 5]
4356 lappend treediff $file
4359 proc getblobdiffs {ids} {
4360 global diffopts blobdifffd diffids env curdifftag curtagstart
4361 global nextupdate diffinhdr treediffs
4363 set env(GIT_DIFF_OPTS) $diffopts
4364 set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4365 if {[catch {set bdf [open $cmd r]} err]} {
4366 puts "error getting diffs: $err"
4370 fconfigure $bdf -blocking 0
4371 set blobdifffd($ids) $bdf
4372 set curdifftag Comments
4374 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4375 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4378 proc setinlist {var i val} {
4381 while {[llength [set $var]] < $i} {
4384 if {[llength [set $var]] == $i} {
4391 proc getblobdiffline {bdf ids} {
4392 global diffids blobdifffd ctext curdifftag curtagstart
4393 global diffnexthead diffnextnote difffilestart
4394 global nextupdate diffinhdr treediffs
4396 set n [gets $bdf line]
4400 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4401 $ctext tag add $curdifftag $curtagstart end
4406 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4409 $ctext conf -state normal
4410 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4411 # start of a new file
4412 $ctext insert end "\n"
4413 $ctext tag add $curdifftag $curtagstart end
4414 set here [$ctext index "end - 1c"]
4415 set curtagstart $here
4417 set i [lsearch -exact $treediffs($ids) $fname]
4419 setinlist difffilestart $i $here
4421 if {$newname ne $fname} {
4422 set i [lsearch -exact $treediffs($ids) $newname]
4424 setinlist difffilestart $i $here
4427 set curdifftag "f:$fname"
4428 $ctext tag delete $curdifftag
4429 set l [expr {(78 - [string length $header]) / 2}]
4430 set pad [string range "----------------------------------------" 1 $l]
4431 $ctext insert end "$pad $header $pad\n" filesep
4433 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4435 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4437 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4438 $line match f1l f1c f2l f2c rest]} {
4439 $ctext insert end "$line\n" hunksep
4442 set x [string range $line 0 0]
4443 if {$x == "-" || $x == "+"} {
4444 set tag [expr {$x == "+"}]
4445 $ctext insert end "$line\n" d$tag
4446 } elseif {$x == " "} {
4447 $ctext insert end "$line\n"
4448 } elseif {$diffinhdr || $x == "\\"} {
4449 # e.g. "\ No newline at end of file"
4450 $ctext insert end "$line\n" filesep
4452 # Something else we don't recognize
4453 if {$curdifftag != "Comments"} {
4454 $ctext insert end "\n"
4455 $ctext tag add $curdifftag $curtagstart end
4456 set curtagstart [$ctext index "end - 1c"]
4457 set curdifftag Comments
4459 $ctext insert end "$line\n" filesep
4462 $ctext conf -state disabled
4463 if {[clock clicks -milliseconds] >= $nextupdate} {
4465 fileevent $bdf readable {}
4467 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4472 global difffilestart ctext
4473 set prev [lindex $difffilestart 0]
4474 set here [$ctext index @0,0]
4475 foreach loc $difffilestart {
4476 if {[$ctext compare $loc >= $here]} {
4486 global difffilestart ctext
4487 set here [$ctext index @0,0]
4488 foreach loc $difffilestart {
4489 if {[$ctext compare $loc > $here]} {
4496 proc clear_ctext {{first 1.0}} {
4497 global ctext smarktop smarkbot
4499 set l [lindex [split $first .] 0]
4500 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4503 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4506 $ctext delete $first end
4509 proc incrsearch {name ix op} {
4510 global ctext searchstring searchdirn
4512 $ctext tag remove found 1.0 end
4513 if {[catch {$ctext index anchor}]} {
4514 # no anchor set, use start of selection, or of visible area
4515 set sel [$ctext tag ranges sel]
4517 $ctext mark set anchor [lindex $sel 0]
4518 } elseif {$searchdirn eq "-forwards"} {
4519 $ctext mark set anchor @0,0
4521 $ctext mark set anchor @0,[winfo height $ctext]
4524 if {$searchstring ne {}} {
4525 set here [$ctext search $searchdirn -- $searchstring anchor]
4534 global sstring ctext searchstring searchdirn
4537 $sstring icursor end
4538 set searchdirn -forwards
4539 if {$searchstring ne {}} {
4540 set sel [$ctext tag ranges sel]
4542 set start "[lindex $sel 0] + 1c"
4543 } elseif {[catch {set start [$ctext index anchor]}]} {
4546 set match [$ctext search -count mlen -- $searchstring $start]
4547 $ctext tag remove sel 1.0 end
4553 set mend "$match + $mlen c"
4554 $ctext tag add sel $match $mend
4555 $ctext mark unset anchor
4559 proc dosearchback {} {
4560 global sstring ctext searchstring searchdirn
4563 $sstring icursor end
4564 set searchdirn -backwards
4565 if {$searchstring ne {}} {
4566 set sel [$ctext tag ranges sel]
4568 set start [lindex $sel 0]
4569 } elseif {[catch {set start [$ctext index anchor]}]} {
4570 set start @0,[winfo height $ctext]
4572 set match [$ctext search -backwards -count ml -- $searchstring $start]
4573 $ctext tag remove sel 1.0 end
4579 set mend "$match + $ml c"
4580 $ctext tag add sel $match $mend
4581 $ctext mark unset anchor
4585 proc searchmark {first last} {
4586 global ctext searchstring
4590 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4591 if {$match eq {}} break
4592 set mend "$match + $mlen c"
4593 $ctext tag add found $match $mend
4597 proc searchmarkvisible {doall} {
4598 global ctext smarktop smarkbot
4600 set topline [lindex [split [$ctext index @0,0] .] 0]
4601 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4602 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4603 # no overlap with previous
4604 searchmark $topline $botline
4605 set smarktop $topline
4606 set smarkbot $botline
4608 if {$topline < $smarktop} {
4609 searchmark $topline [expr {$smarktop-1}]
4610 set smarktop $topline
4612 if {$botline > $smarkbot} {
4613 searchmark [expr {$smarkbot+1}] $botline
4614 set smarkbot $botline
4619 proc scrolltext {f0 f1} {
4622 .bleft.sb set $f0 $f1
4623 if {$searchstring ne {}} {
4629 global linespc charspc canvx0 canvy0 mainfont
4630 global xspc1 xspc2 lthickness
4632 set linespc [font metrics $mainfont -linespace]
4633 set charspc [font measure $mainfont "m"]
4634 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4635 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4636 set lthickness [expr {int($linespc / 9) + 1}]
4637 set xspc1(0) $linespc
4645 set ymax [lindex [$canv cget -scrollregion] 3]
4646 if {$ymax eq {} || $ymax == 0} return
4647 set span [$canv yview]
4650 allcanvs yview moveto [lindex $span 0]
4652 if {[info exists selectedline]} {
4653 selectline $selectedline 0
4654 allcanvs yview moveto [lindex $span 0]
4658 proc incrfont {inc} {
4659 global mainfont textfont ctext canv phase
4660 global stopped entries
4662 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4663 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4665 $ctext conf -font $textfont
4666 $ctext tag conf filesep -font [concat $textfont bold]
4667 foreach e $entries {
4668 $e conf -font $mainfont
4670 if {$phase eq "getcommits"} {
4671 $canv itemconf textitems -font $mainfont
4677 global sha1entry sha1string
4678 if {[string length $sha1string] == 40} {
4679 $sha1entry delete 0 end
4683 proc sha1change {n1 n2 op} {
4684 global sha1string currentid sha1but
4685 if {$sha1string == {}
4686 || ([info exists currentid] && $sha1string == $currentid)} {
4691 if {[$sha1but cget -state] == $state} return
4692 if {$state == "normal"} {
4693 $sha1but conf -state normal -relief raised -text "Goto: "
4695 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4699 proc gotocommit {} {
4700 global sha1string currentid commitrow tagids headids
4701 global displayorder numcommits curview
4703 if {$sha1string == {}
4704 || ([info exists currentid] && $sha1string == $currentid)} return
4705 if {[info exists tagids($sha1string)]} {
4706 set id $tagids($sha1string)
4707 } elseif {[info exists headids($sha1string)]} {
4708 set id $headids($sha1string)
4710 set id [string tolower $sha1string]
4711 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4713 foreach i $displayorder {
4714 if {[string match $id* $i]} {
4718 if {$matches ne {}} {
4719 if {[llength $matches] > 1} {
4720 error_popup "Short SHA1 id $id is ambiguous"
4723 set id [lindex $matches 0]
4727 if {[info exists commitrow($curview,$id)]} {
4728 selectline $commitrow($curview,$id) 1
4731 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4736 error_popup "$type $sha1string is not known"
4739 proc lineenter {x y id} {
4740 global hoverx hovery hoverid hovertimer
4741 global commitinfo canv
4743 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4747 if {[info exists hovertimer]} {
4748 after cancel $hovertimer
4750 set hovertimer [after 500 linehover]
4754 proc linemotion {x y id} {
4755 global hoverx hovery hoverid hovertimer
4757 if {[info exists hoverid] && $id == $hoverid} {
4760 if {[info exists hovertimer]} {
4761 after cancel $hovertimer
4763 set hovertimer [after 500 linehover]
4767 proc lineleave {id} {
4768 global hoverid hovertimer canv
4770 if {[info exists hoverid] && $id == $hoverid} {
4772 if {[info exists hovertimer]} {
4773 after cancel $hovertimer
4781 global hoverx hovery hoverid hovertimer
4782 global canv linespc lthickness
4783 global commitinfo mainfont
4785 set text [lindex $commitinfo($hoverid) 0]
4786 set ymax [lindex [$canv cget -scrollregion] 3]
4787 if {$ymax == {}} return
4788 set yfrac [lindex [$canv yview] 0]
4789 set x [expr {$hoverx + 2 * $linespc}]
4790 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4791 set x0 [expr {$x - 2 * $lthickness}]
4792 set y0 [expr {$y - 2 * $lthickness}]
4793 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4794 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4795 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4796 -fill \#ffff80 -outline black -width 1 -tags hover]
4798 set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4803 proc clickisonarrow {id y} {
4806 set ranges [rowranges $id]
4807 set thresh [expr {2 * $lthickness + 6}]
4808 set n [expr {[llength $ranges] - 1}]
4809 for {set i 1} {$i < $n} {incr i} {
4810 set row [lindex $ranges $i]
4811 if {abs([yc $row] - $y) < $thresh} {
4818 proc arrowjump {id n y} {
4821 # 1 <-> 2, 3 <-> 4, etc...
4822 set n [expr {(($n - 1) ^ 1) + 1}]
4823 set row [lindex [rowranges $id] $n]
4825 set ymax [lindex [$canv cget -scrollregion] 3]
4826 if {$ymax eq {} || $ymax <= 0} return
4827 set view [$canv yview]
4828 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4829 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4833 allcanvs yview moveto $yfrac
4836 proc lineclick {x y id isnew} {
4837 global ctext commitinfo children canv thickerline curview
4839 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4844 # draw this line thicker than normal
4848 set ymax [lindex [$canv cget -scrollregion] 3]
4849 if {$ymax eq {}} return
4850 set yfrac [lindex [$canv yview] 0]
4851 set y [expr {$y + $yfrac * $ymax}]
4853 set dirn [clickisonarrow $id $y]
4855 arrowjump $id $dirn $y
4860 addtohistory [list lineclick $x $y $id 0]
4862 # fill the details pane with info about this line
4863 $ctext conf -state normal
4865 $ctext tag conf link -foreground blue -underline 1
4866 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4867 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4868 $ctext insert end "Parent:\t"
4869 $ctext insert end $id [list link link0]
4870 $ctext tag bind link0 <1> [list selbyid $id]
4871 set info $commitinfo($id)
4872 $ctext insert end "\n\t[lindex $info 0]\n"
4873 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4874 set date [formatdate [lindex $info 2]]
4875 $ctext insert end "\tDate:\t$date\n"
4876 set kids $children($curview,$id)
4878 $ctext insert end "\nChildren:"
4880 foreach child $kids {
4882 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4883 set info $commitinfo($child)
4884 $ctext insert end "\n\t"
4885 $ctext insert end $child [list link link$i]
4886 $ctext tag bind link$i <1> [list selbyid $child]
4887 $ctext insert end "\n\t[lindex $info 0]"
4888 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4889 set date [formatdate [lindex $info 2]]
4890 $ctext insert end "\n\tDate:\t$date\n"
4893 $ctext conf -state disabled
4897 proc normalline {} {
4899 if {[info exists thickerline]} {
4907 global commitrow curview
4908 if {[info exists commitrow($curview,$id)]} {
4909 selectline $commitrow($curview,$id) 1
4915 if {![info exists startmstime]} {
4916 set startmstime [clock clicks -milliseconds]
4918 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4921 proc rowmenu {x y id} {
4922 global rowctxmenu commitrow selectedline rowmenuid curview
4924 if {![info exists selectedline]
4925 || $commitrow($curview,$id) eq $selectedline} {
4930 $rowctxmenu entryconfigure "Diff this*" -state $state
4931 $rowctxmenu entryconfigure "Diff selected*" -state $state
4932 $rowctxmenu entryconfigure "Make patch" -state $state
4934 tk_popup $rowctxmenu $x $y
4937 proc diffvssel {dirn} {
4938 global rowmenuid selectedline displayorder
4940 if {![info exists selectedline]} return
4942 set oldid [lindex $displayorder $selectedline]
4943 set newid $rowmenuid
4945 set oldid $rowmenuid
4946 set newid [lindex $displayorder $selectedline]
4948 addtohistory [list doseldiff $oldid $newid]
4949 doseldiff $oldid $newid
4952 proc doseldiff {oldid newid} {
4956 $ctext conf -state normal
4959 $ctext insert end "From "
4960 $ctext tag conf link -foreground blue -underline 1
4961 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4962 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4963 $ctext tag bind link0 <1> [list selbyid $oldid]
4964 $ctext insert end $oldid [list link link0]
4965 $ctext insert end "\n "
4966 $ctext insert end [lindex $commitinfo($oldid) 0]
4967 $ctext insert end "\n\nTo "
4968 $ctext tag bind link1 <1> [list selbyid $newid]
4969 $ctext insert end $newid [list link link1]
4970 $ctext insert end "\n "
4971 $ctext insert end [lindex $commitinfo($newid) 0]
4972 $ctext insert end "\n"
4973 $ctext conf -state disabled
4974 $ctext tag delete Comments
4975 $ctext tag remove found 1.0 end
4976 startdiff [list $oldid $newid]
4980 global rowmenuid currentid commitinfo patchtop patchnum
4982 if {![info exists currentid]} return
4983 set oldid $currentid
4984 set oldhead [lindex $commitinfo($oldid) 0]
4985 set newid $rowmenuid
4986 set newhead [lindex $commitinfo($newid) 0]
4989 catch {destroy $top}
4991 label $top.title -text "Generate patch"
4992 grid $top.title - -pady 10
4993 label $top.from -text "From:"
4994 entry $top.fromsha1 -width 40 -relief flat
4995 $top.fromsha1 insert 0 $oldid
4996 $top.fromsha1 conf -state readonly
4997 grid $top.from $top.fromsha1 -sticky w
4998 entry $top.fromhead -width 60 -relief flat
4999 $top.fromhead insert 0 $oldhead
5000 $top.fromhead conf -state readonly
5001 grid x $top.fromhead -sticky w
5002 label $top.to -text "To:"
5003 entry $top.tosha1 -width 40 -relief flat
5004 $top.tosha1 insert 0 $newid
5005 $top.tosha1 conf -state readonly
5006 grid $top.to $top.tosha1 -sticky w
5007 entry $top.tohead -width 60 -relief flat
5008 $top.tohead insert 0 $newhead
5009 $top.tohead conf -state readonly
5010 grid x $top.tohead -sticky w
5011 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5012 grid $top.rev x -pady 10
5013 label $top.flab -text "Output file:"
5014 entry $top.fname -width 60
5015 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5017 grid $top.flab $top.fname -sticky w
5019 button $top.buts.gen -text "Generate" -command mkpatchgo
5020 button $top.buts.can -text "Cancel" -command mkpatchcan
5021 grid $top.buts.gen $top.buts.can
5022 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5023 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5024 grid $top.buts - -pady 10 -sticky ew
5028 proc mkpatchrev {} {
5031 set oldid [$patchtop.fromsha1 get]
5032 set oldhead [$patchtop.fromhead get]
5033 set newid [$patchtop.tosha1 get]
5034 set newhead [$patchtop.tohead get]
5035 foreach e [list fromsha1 fromhead tosha1 tohead] \
5036 v [list $newid $newhead $oldid $oldhead] {
5037 $patchtop.$e conf -state normal
5038 $patchtop.$e delete 0 end
5039 $patchtop.$e insert 0 $v
5040 $patchtop.$e conf -state readonly
5047 set oldid [$patchtop.fromsha1 get]
5048 set newid [$patchtop.tosha1 get]
5049 set fname [$patchtop.fname get]
5050 if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
5051 error_popup "Error creating patch: $err"
5053 catch {destroy $patchtop}
5057 proc mkpatchcan {} {
5060 catch {destroy $patchtop}
5065 global rowmenuid mktagtop commitinfo
5069 catch {destroy $top}
5071 label $top.title -text "Create tag"
5072 grid $top.title - -pady 10
5073 label $top.id -text "ID:"
5074 entry $top.sha1 -width 40 -relief flat
5075 $top.sha1 insert 0 $rowmenuid
5076 $top.sha1 conf -state readonly
5077 grid $top.id $top.sha1 -sticky w
5078 entry $top.head -width 60 -relief flat
5079 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5080 $top.head conf -state readonly
5081 grid x $top.head -sticky w
5082 label $top.tlab -text "Tag name:"
5083 entry $top.tag -width 60
5084 grid $top.tlab $top.tag -sticky w
5086 button $top.buts.gen -text "Create" -command mktaggo
5087 button $top.buts.can -text "Cancel" -command mktagcan
5088 grid $top.buts.gen $top.buts.can
5089 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5090 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5091 grid $top.buts - -pady 10 -sticky ew
5096 global mktagtop env tagids idtags
5098 set id [$mktagtop.sha1 get]
5099 set tag [$mktagtop.tag get]
5101 error_popup "No tag name specified"
5104 if {[info exists tagids($tag)]} {
5105 error_popup "Tag \"$tag\" already exists"
5110 set fname [file join $dir "refs/tags" $tag]
5111 set f [open $fname w]
5115 error_popup "Error creating tag: $err"
5119 set tagids($tag) $id
5120 lappend idtags($id) $tag
5125 proc redrawtags {id} {
5126 global canv linehtag commitrow idpos selectedline curview
5127 global mainfont canvxmax
5129 if {![info exists commitrow($curview,$id)]} return
5130 drawcmitrow $commitrow($curview,$id)
5131 $canv delete tag.$id
5132 set xt [eval drawtags $id $idpos($id)]
5133 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5134 set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5135 set xr [expr {$xt + [font measure $mainfont $text]}]
5136 if {$xr > $canvxmax} {
5140 if {[info exists selectedline]
5141 && $selectedline == $commitrow($curview,$id)} {
5142 selectline $selectedline 0
5149 catch {destroy $mktagtop}
5158 proc writecommit {} {
5159 global rowmenuid wrcomtop commitinfo wrcomcmd
5161 set top .writecommit
5163 catch {destroy $top}
5165 label $top.title -text "Write commit to file"
5166 grid $top.title - -pady 10
5167 label $top.id -text "ID:"
5168 entry $top.sha1 -width 40 -relief flat
5169 $top.sha1 insert 0 $rowmenuid
5170 $top.sha1 conf -state readonly
5171 grid $top.id $top.sha1 -sticky w
5172 entry $top.head -width 60 -relief flat
5173 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5174 $top.head conf -state readonly
5175 grid x $top.head -sticky w
5176 label $top.clab -text "Command:"
5177 entry $top.cmd -width 60 -textvariable wrcomcmd
5178 grid $top.clab $top.cmd -sticky w -pady 10
5179 label $top.flab -text "Output file:"
5180 entry $top.fname -width 60
5181 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5182 grid $top.flab $top.fname -sticky w
5184 button $top.buts.gen -text "Write" -command wrcomgo
5185 button $top.buts.can -text "Cancel" -command wrcomcan
5186 grid $top.buts.gen $top.buts.can
5187 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5188 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5189 grid $top.buts - -pady 10 -sticky ew
5196 set id [$wrcomtop.sha1 get]
5197 set cmd "echo $id | [$wrcomtop.cmd get]"
5198 set fname [$wrcomtop.fname get]
5199 if {[catch {exec sh -c $cmd >$fname &} err]} {
5200 error_popup "Error writing commit: $err"
5202 catch {destroy $wrcomtop}
5209 catch {destroy $wrcomtop}
5214 global rowmenuid mkbrtop
5217 catch {destroy $top}
5219 label $top.title -text "Create new branch"
5220 grid $top.title - -pady 10
5221 label $top.id -text "ID:"
5222 entry $top.sha1 -width 40 -relief flat
5223 $top.sha1 insert 0 $rowmenuid
5224 $top.sha1 conf -state readonly
5225 grid $top.id $top.sha1 -sticky w
5226 label $top.nlab -text "Name:"
5227 entry $top.name -width 40
5228 grid $top.nlab $top.name -sticky w
5230 button $top.buts.go -text "Create" -command [list mkbrgo $top]
5231 button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5232 grid $top.buts.go $top.buts.can
5233 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5234 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5235 grid $top.buts - -pady 10 -sticky ew
5240 global headids idheads
5242 set name [$top.name get]
5243 set id [$top.sha1 get]
5245 error_popup "Please specify a name for the new branch"
5248 catch {destroy $top}
5252 exec git branch $name $id
5258 # XXX should update list of heads displayed for selected commit
5264 proc cherrypick {} {
5265 global rowmenuid curview commitrow
5266 global mainhead desc_heads anc_tags desc_tags allparents allchildren
5268 if {[info exists desc_heads($rowmenuid)]
5269 && [lsearch -exact $desc_heads($rowmenuid) $mainhead] >= 0} {
5270 set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5271 included in branch $mainhead -- really re-apply it?"]
5276 set oldhead [exec git rev-parse HEAD]
5277 # Unfortunately git-cherry-pick writes stuff to stderr even when
5278 # no error occurs, and exec takes that as an indication of error...
5279 if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5284 set newhead [exec git rev-parse HEAD]
5285 if {$newhead eq $oldhead} {
5287 error_popup "No changes committed"
5290 set allparents($newhead) $oldhead
5291 lappend allchildren($oldhead) $newhead
5292 set desc_heads($newhead) $mainhead
5293 if {[info exists anc_tags($oldhead)]} {
5294 set anc_tags($newhead) $anc_tags($oldhead)
5296 set desc_tags($newhead) {}
5297 if {[info exists commitrow($curview,$oldhead)]} {
5298 insertrow $commitrow($curview,$oldhead) $newhead
5299 if {$mainhead ne {}} {
5300 movedhead $newhead $mainhead
5308 # context menu for a head
5309 proc headmenu {x y id head} {
5310 global headmenuid headmenuhead headctxmenu
5313 set headmenuhead $head
5314 tk_popup $headctxmenu $x $y
5318 global headmenuid headmenuhead mainhead headids
5320 # check the tree is clean first??
5321 set oldmainhead $mainhead
5325 exec git checkout $headmenuhead
5331 set mainhead $headmenuhead
5332 if {[info exists headids($oldmainhead)]} {
5333 redrawtags $headids($oldmainhead)
5335 redrawtags $headmenuid
5340 global desc_heads headmenuid headmenuhead mainhead
5341 global headids idheads
5343 set head $headmenuhead
5345 if {$head eq $mainhead} {
5346 error_popup "Cannot delete the currently checked-out branch"
5349 if {$desc_heads($id) eq $head} {
5350 # the stuff on this branch isn't on any other branch
5351 if {![confirm_popup "The commits on branch $head aren't on any other\
5352 branch.\nReally delete branch $head?"]} return
5356 if {[catch {exec git branch -D $head} err]} {
5361 removedhead $id $head
5366 # Stuff for finding nearby tags
5367 proc getallcommits {} {
5368 global allcstart allcommits allcfd allids
5371 set fd [open [concat | git rev-list --all --topo-order --parents] r]
5373 fconfigure $fd -blocking 0
5374 set allcommits "reading"
5379 proc discardallcommits {} {
5380 global allparents allchildren allcommits allcfd
5381 global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5383 if {![info exists allcommits]} return
5384 if {$allcommits eq "reading"} {
5385 catch {close $allcfd}
5387 foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5388 alldtags tagisdesc desc_heads} {
5393 proc restartgetall {fd} {
5396 fileevent $fd readable [list getallclines $fd]
5397 set allcstart [clock clicks -milliseconds]
5400 proc combine_dtags {l1 l2} {
5401 global tagisdesc notfirstd
5403 set res [lsort -unique [concat $l1 $l2]]
5404 for {set i 0} {$i < [llength $res]} {incr i} {
5405 set x [lindex $res $i]
5406 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5407 set y [lindex $res $j]
5408 if {[info exists tagisdesc($x,$y)]} {
5409 if {$tagisdesc($x,$y) > 0} {
5410 # x is a descendent of y, exclude x
5411 set res [lreplace $res $i $i]
5415 # y is a descendent of x, exclude y
5416 set res [lreplace $res $j $j]
5419 # no relation, keep going
5427 proc combine_atags {l1 l2} {
5430 set res [lsort -unique [concat $l1 $l2]]
5431 for {set i 0} {$i < [llength $res]} {incr i} {
5432 set x [lindex $res $i]
5433 for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5434 set y [lindex $res $j]
5435 if {[info exists tagisdesc($x,$y)]} {
5436 if {$tagisdesc($x,$y) < 0} {
5437 # x is an ancestor of y, exclude x
5438 set res [lreplace $res $i $i]
5442 # y is an ancestor of x, exclude y
5443 set res [lreplace $res $j $j]
5446 # no relation, keep going
5454 proc forward_pass {id children} {
5455 global idtags desc_tags idheads desc_heads alldtags tagisdesc
5459 foreach child $children {
5460 if {[info exists idtags($child)]} {
5461 set ctags [list $child]
5463 set ctags $desc_tags($child)
5467 } elseif {$ctags ne $dtags} {
5468 set dtags [combine_dtags $dtags $ctags]
5470 set cheads $desc_heads($child)
5471 if {$dheads eq {}} {
5473 } elseif {$cheads ne $dheads} {
5474 set dheads [lsort -unique [concat $dheads $cheads]]
5477 set desc_tags($id) $dtags
5478 if {[info exists idtags($id)]} {
5480 foreach tag $dtags {
5481 set adt [concat $adt $alldtags($tag)]
5483 set adt [lsort -unique $adt]
5484 set alldtags($id) $adt
5486 set tagisdesc($id,$tag) -1
5487 set tagisdesc($tag,$id) 1
5490 if {[info exists idheads($id)]} {
5491 set dheads [concat $dheads $idheads($id)]
5493 set desc_heads($id) $dheads
5496 proc getallclines {fd} {
5497 global allparents allchildren allcommits allcstart
5498 global desc_tags anc_tags idtags tagisdesc allids
5499 global idheads travindex
5501 while {[gets $fd line] >= 0} {
5502 set id [lindex $line 0]
5504 set olds [lrange $line 1 end]
5505 set allparents($id) $olds
5506 if {![info exists allchildren($id)]} {
5507 set allchildren($id) {}
5510 lappend allchildren($p) $id
5512 # compute nearest tagged descendents as we go
5513 # also compute descendent heads
5514 forward_pass $id $allchildren($id)
5515 if {[clock clicks -milliseconds] - $allcstart >= 50} {
5516 fileevent $fd readable {}
5517 after idle restartgetall $fd
5522 set travindex [llength $allids]
5523 set allcommits "traversing"
5524 after idle restartatags
5525 if {[catch {close $fd} err]} {
5526 error_popup "Error reading full commit graph: $err.\n\
5527 Results may be incomplete."
5532 # walk backward through the tree and compute nearest tagged ancestors
5533 proc restartatags {} {
5534 global allids allparents idtags anc_tags travindex
5536 set t0 [clock clicks -milliseconds]
5538 while {[incr i -1] >= 0} {
5539 set id [lindex $allids $i]
5541 foreach p $allparents($id) {
5542 if {[info exists idtags($p)]} {
5545 set ptags $anc_tags($p)
5549 } elseif {$ptags ne $atags} {
5550 set atags [combine_atags $atags $ptags]
5553 set anc_tags($id) $atags
5554 if {[clock clicks -milliseconds] - $t0 >= 50} {
5556 after idle restartatags
5560 set allcommits "done"
5566 # update the desc_tags and anc_tags arrays for a new tag just added
5567 proc addedtag {id} {
5568 global desc_tags anc_tags allparents allchildren allcommits
5569 global idtags tagisdesc alldtags
5571 if {![info exists desc_tags($id)]} return
5572 set adt $desc_tags($id)
5573 foreach t $desc_tags($id) {
5574 set adt [concat $adt $alldtags($t)]
5576 set adt [lsort -unique $adt]
5577 set alldtags($id) $adt
5579 set tagisdesc($id,$t) -1
5580 set tagisdesc($t,$id) 1
5582 if {[info exists anc_tags($id)]} {
5583 set todo $anc_tags($id)
5584 while {$todo ne {}} {
5585 set do [lindex $todo 0]
5586 set todo [lrange $todo 1 end]
5587 if {[info exists tagisdesc($id,$do)]} continue
5588 set tagisdesc($do,$id) -1
5589 set tagisdesc($id,$do) 1
5590 if {[info exists anc_tags($do)]} {
5591 set todo [concat $todo $anc_tags($do)]
5596 set lastold $desc_tags($id)
5597 set lastnew [list $id]
5600 set todo $allparents($id)
5601 while {$todo ne {}} {
5602 set do [lindex $todo 0]
5603 set todo [lrange $todo 1 end]
5604 if {![info exists desc_tags($do)]} continue
5605 if {$desc_tags($do) ne $lastold} {
5606 set lastold $desc_tags($do)
5607 set lastnew [combine_dtags $lastold [list $id]]
5610 if {$lastold eq $lastnew} continue
5611 set desc_tags($do) $lastnew
5613 if {![info exists idtags($do)]} {
5614 set todo [concat $todo $allparents($do)]
5618 if {![info exists anc_tags($id)]} return
5619 set lastold $anc_tags($id)
5620 set lastnew [list $id]
5623 set todo $allchildren($id)
5624 while {$todo ne {}} {
5625 set do [lindex $todo 0]
5626 set todo [lrange $todo 1 end]
5627 if {![info exists anc_tags($do)]} continue
5628 if {$anc_tags($do) ne $lastold} {
5629 set lastold $anc_tags($do)
5630 set lastnew [combine_atags $lastold [list $id]]
5633 if {$lastold eq $lastnew} continue
5634 set anc_tags($do) $lastnew
5636 if {![info exists idtags($do)]} {
5637 set todo [concat $todo $allchildren($do)]
5642 # update the desc_heads array for a new head just added
5643 proc addedhead {hid head} {
5644 global desc_heads allparents headids idheads
5646 set headids($head) $hid
5647 lappend idheads($hid) $head
5649 set todo [list $hid]
5650 while {$todo ne {}} {
5651 set do [lindex $todo 0]
5652 set todo [lrange $todo 1 end]
5653 if {![info exists desc_heads($do)] ||
5654 [lsearch -exact $desc_heads($do) $head] >= 0} continue
5655 set oldheads $desc_heads($do)
5656 lappend desc_heads($do) $head
5657 set heads $desc_heads($do)
5659 set p $allparents($do)
5660 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5661 $desc_heads($p) ne $oldheads} break
5663 set desc_heads($do) $heads
5665 set todo [concat $todo $p]
5669 # update the desc_heads array for a head just removed
5670 proc removedhead {hid head} {
5671 global desc_heads allparents headids idheads
5673 unset headids($head)
5674 if {$idheads($hid) eq $head} {
5677 set i [lsearch -exact $idheads($hid) $head]
5679 set idheads($hid) [lreplace $idheads($hid) $i $i]
5683 set todo [list $hid]
5684 while {$todo ne {}} {
5685 set do [lindex $todo 0]
5686 set todo [lrange $todo 1 end]
5687 if {![info exists desc_heads($do)]} continue
5688 set i [lsearch -exact $desc_heads($do) $head]
5689 if {$i < 0} continue
5690 set oldheads $desc_heads($do)
5691 set heads [lreplace $desc_heads($do) $i $i]
5693 set desc_heads($do) $heads
5694 set p $allparents($do)
5695 if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5696 $desc_heads($p) ne $oldheads} break
5699 set todo [concat $todo $p]
5703 # update things for a head moved to a child of its previous location
5704 proc movedhead {id name} {
5705 global headids idheads
5707 set oldid $headids($name)
5708 set headids($name) $id
5709 if {$idheads($oldid) eq $name} {
5710 unset idheads($oldid)
5712 set i [lsearch -exact $idheads($oldid) $name]
5714 set idheads($oldid) [lreplace $idheads($oldid) $i $i]
5717 lappend idheads($id) $name
5720 proc changedrefs {} {
5721 global desc_heads desc_tags anc_tags allcommits allids
5722 global allchildren allparents idtags travindex
5724 if {![info exists allcommits]} return
5725 catch {unset desc_heads}
5726 catch {unset desc_tags}
5727 catch {unset anc_tags}
5728 catch {unset alldtags}
5729 catch {unset tagisdesc}
5730 foreach id $allids {
5731 forward_pass $id $allchildren($id)
5733 if {$allcommits ne "reading"} {
5734 set travindex [llength $allids]
5735 if {$allcommits ne "traversing"} {
5736 set allcommits "traversing"
5737 after idle restartatags
5742 proc rereadrefs {} {
5743 global idtags idheads idotherrefs mainhead
5745 set refids [concat [array names idtags] \
5746 [array names idheads] [array names idotherrefs]]
5747 foreach id $refids {
5748 if {![info exists ref($id)]} {
5749 set ref($id) [listrefs $id]
5752 set oldmainhead $mainhead
5755 set refids [lsort -unique [concat $refids [array names idtags] \
5756 [array names idheads] [array names idotherrefs]]]
5757 foreach id $refids {
5758 set v [listrefs $id]
5759 if {![info exists ref($id)] || $ref($id) != $v ||
5760 ($id eq $oldmainhead && $id ne $mainhead) ||
5761 ($id eq $mainhead && $id ne $oldmainhead)} {
5767 proc listrefs {id} {
5768 global idtags idheads idotherrefs
5771 if {[info exists idtags($id)]} {
5775 if {[info exists idheads($id)]} {
5779 if {[info exists idotherrefs($id)]} {
5780 set z $idotherrefs($id)
5782 return [list $x $y $z]
5785 proc showtag {tag isnew} {
5786 global ctext tagcontents tagids linknum
5789 addtohistory [list showtag $tag 0]
5791 $ctext conf -state normal
5794 if {[info exists tagcontents($tag)]} {
5795 set text $tagcontents($tag)
5797 set text "Tag: $tag\nId: $tagids($tag)"
5799 appendwithlinks $text {}
5800 $ctext conf -state disabled
5812 global maxwidth maxgraphpct diffopts
5813 global oldprefs prefstop showneartags
5814 global bgcolor fgcolor ctext diffcolors
5818 if {[winfo exists $top]} {
5822 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5823 set oldprefs($v) [set $v]
5826 wm title $top "Gitk preferences"
5827 label $top.ldisp -text "Commit list display options"
5828 grid $top.ldisp - -sticky w -pady 10
5829 label $top.spacer -text " "
5830 label $top.maxwidthl -text "Maximum graph width (lines)" \
5832 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5833 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5834 label $top.maxpctl -text "Maximum graph width (% of pane)" \
5836 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5837 grid x $top.maxpctl $top.maxpct -sticky w
5839 label $top.ddisp -text "Diff display options"
5840 grid $top.ddisp - -sticky w -pady 10
5841 label $top.diffoptl -text "Options for diff program" \
5843 entry $top.diffopt -width 20 -textvariable diffopts
5844 grid x $top.diffoptl $top.diffopt -sticky w
5846 label $top.ntag.l -text "Display nearby tags" -font optionfont
5847 checkbutton $top.ntag.b -variable showneartags
5848 pack $top.ntag.b $top.ntag.l -side left
5849 grid x $top.ntag -sticky w
5851 label $top.cdisp -text "Colors: press to choose"
5852 grid $top.cdisp - -sticky w -pady 10
5853 label $top.bg -padx 40 -relief sunk -background $bgcolor
5854 button $top.bgbut -text "Background" -font optionfont \
5855 -command [list choosecolor bgcolor 0 $top.bg background setbg]
5856 grid x $top.bgbut $top.bg -sticky w
5857 label $top.fg -padx 40 -relief sunk -background $fgcolor
5858 button $top.fgbut -text "Foreground" -font optionfont \
5859 -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5860 grid x $top.fgbut $top.fg -sticky w
5861 label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5862 button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5863 -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5864 [list $ctext tag conf d0 -foreground]]
5865 grid x $top.diffoldbut $top.diffold -sticky w
5866 label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5867 button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5868 -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5869 [list $ctext tag conf d1 -foreground]]
5870 grid x $top.diffnewbut $top.diffnew -sticky w
5871 label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5872 button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5873 -command [list choosecolor diffcolors 2 $top.hunksep \
5874 "diff hunk header" \
5875 [list $ctext tag conf hunksep -foreground]]
5876 grid x $top.hunksepbut $top.hunksep -sticky w
5879 button $top.buts.ok -text "OK" -command prefsok
5880 button $top.buts.can -text "Cancel" -command prefscan
5881 grid $top.buts.ok $top.buts.can
5882 grid columnconfigure $top.buts 0 -weight 1 -uniform a
5883 grid columnconfigure $top.buts 1 -weight 1 -uniform a
5884 grid $top.buts - - -pady 10 -sticky ew
5887 proc choosecolor {v vi w x cmd} {
5890 set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5891 -title "Gitk: choose color for $x"]
5892 if {$c eq {}} return
5893 $w conf -background $c
5902 $w conf -background $c
5910 $w conf -foreground $c
5912 allcanvs itemconf text -fill $c
5913 $canv itemconf circle -outline $c
5917 global maxwidth maxgraphpct diffopts
5918 global oldprefs prefstop showneartags
5920 foreach v {maxwidth maxgraphpct diffopts showneartags} {
5921 set $v $oldprefs($v)
5923 catch {destroy $prefstop}
5928 global maxwidth maxgraphpct
5929 global oldprefs prefstop showneartags
5931 catch {destroy $prefstop}
5933 if {$maxwidth != $oldprefs(maxwidth)
5934 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5936 } elseif {$showneartags != $oldprefs(showneartags)} {
5941 proc formatdate {d} {
5942 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5945 # This list of encoding names and aliases is distilled from
5946 # http://www.iana.org/assignments/character-sets.
5947 # Not all of them are supported by Tcl.
5948 set encoding_aliases {
5949 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5950 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5951 { ISO-10646-UTF-1 csISO10646UTF1 }
5952 { ISO_646.basic:1983 ref csISO646basic1983 }
5953 { INVARIANT csINVARIANT }
5954 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5955 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5956 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5957 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5958 { NATS-DANO iso-ir-9-1 csNATSDANO }
5959 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5960 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5961 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5962 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5963 { ISO-2022-KR csISO2022KR }
5965 { ISO-2022-JP csISO2022JP }
5966 { ISO-2022-JP-2 csISO2022JP2 }
5967 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5969 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5970 { IT iso-ir-15 ISO646-IT csISO15Italian }
5971 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5972 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5973 { greek7-old iso-ir-18 csISO18Greek7Old }
5974 { latin-greek iso-ir-19 csISO19LatinGreek }
5975 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5976 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5977 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5978 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5979 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5980 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5981 { INIS iso-ir-49 csISO49INIS }
5982 { INIS-8 iso-ir-50 csISO50INIS8 }
5983 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5984 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5985 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5986 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5987 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5988 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5990 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5991 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5992 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5993 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5994 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5995 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5996 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5997 { greek7 iso-ir-88 csISO88Greek7 }
5998 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5999 { iso-ir-90 csISO90 }
6000 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
6001 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
6002 csISO92JISC62991984b }
6003 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
6004 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
6005 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
6006 csISO95JIS62291984handadd }
6007 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
6008 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
6009 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
6010 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
6012 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
6013 { T.61-7bit iso-ir-102 csISO102T617bit }
6014 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
6015 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
6016 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
6017 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
6018 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
6019 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
6020 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
6021 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
6022 arabic csISOLatinArabic }
6023 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
6024 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
6025 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
6026 greek greek8 csISOLatinGreek }
6027 { T.101-G2 iso-ir-128 csISO128T101G2 }
6028 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
6030 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
6031 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
6032 { CSN_369103 iso-ir-139 csISO139CSN369103 }
6033 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
6034 { ISO_6937-2-add iso-ir-142 csISOTextComm }
6035 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
6036 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
6037 csISOLatinCyrillic }
6038 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
6039 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
6040 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
6041 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
6042 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
6043 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
6044 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
6045 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
6046 { ISO_10367-box iso-ir-155 csISO10367Box }
6047 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
6048 { latin-lap lap iso-ir-158 csISO158Lap }
6049 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
6050 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
6053 { JIS_X0201 X0201 csHalfWidthKatakana }
6054 { KSC5636 ISO646-KR csKSC5636 }
6055 { ISO-10646-UCS-2 csUnicode }
6056 { ISO-10646-UCS-4 csUCS4 }
6057 { DEC-MCS dec csDECMCS }
6058 { hp-roman8 roman8 r8 csHPRoman8 }
6059 { macintosh mac csMacintosh }
6060 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
6062 { IBM038 EBCDIC-INT cp038 csIBM038 }
6063 { IBM273 CP273 csIBM273 }
6064 { IBM274 EBCDIC-BE CP274 csIBM274 }
6065 { IBM275 EBCDIC-BR cp275 csIBM275 }
6066 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
6067 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
6068 { IBM280 CP280 ebcdic-cp-it csIBM280 }
6069 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
6070 { IBM284 CP284 ebcdic-cp-es csIBM284 }
6071 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
6072 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
6073 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
6074 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
6075 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
6076 { IBM424 cp424 ebcdic-cp-he csIBM424 }
6077 { IBM437 cp437 437 csPC8CodePage437 }
6078 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
6079 { IBM775 cp775 csPC775Baltic }
6080 { IBM850 cp850 850 csPC850Multilingual }
6081 { IBM851 cp851 851 csIBM851 }
6082 { IBM852 cp852 852 csPCp852 }
6083 { IBM855 cp855 855 csIBM855 }
6084 { IBM857 cp857 857 csIBM857 }
6085 { IBM860 cp860 860 csIBM860 }
6086 { IBM861 cp861 861 cp-is csIBM861 }
6087 { IBM862 cp862 862 csPC862LatinHebrew }
6088 { IBM863 cp863 863 csIBM863 }
6089 { IBM864 cp864 csIBM864 }
6090 { IBM865 cp865 865 csIBM865 }
6091 { IBM866 cp866 866 csIBM866 }
6092 { IBM868 CP868 cp-ar csIBM868 }
6093 { IBM869 cp869 869 cp-gr csIBM869 }
6094 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
6095 { IBM871 CP871 ebcdic-cp-is csIBM871 }
6096 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
6097 { IBM891 cp891 csIBM891 }
6098 { IBM903 cp903 csIBM903 }
6099 { IBM904 cp904 904 csIBBM904 }
6100 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
6101 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
6102 { IBM1026 CP1026 csIBM1026 }
6103 { EBCDIC-AT-DE csIBMEBCDICATDE }
6104 { EBCDIC-AT-DE-A csEBCDICATDEA }
6105 { EBCDIC-CA-FR csEBCDICCAFR }
6106 { EBCDIC-DK-NO csEBCDICDKNO }
6107 { EBCDIC-DK-NO-A csEBCDICDKNOA }
6108 { EBCDIC-FI-SE csEBCDICFISE }
6109 { EBCDIC-FI-SE-A csEBCDICFISEA }
6110 { EBCDIC-FR csEBCDICFR }
6111 { EBCDIC-IT csEBCDICIT }
6112 { EBCDIC-PT csEBCDICPT }
6113 { EBCDIC-ES csEBCDICES }
6114 { EBCDIC-ES-A csEBCDICESA }
6115 { EBCDIC-ES-S csEBCDICESS }
6116 { EBCDIC-UK csEBCDICUK }
6117 { EBCDIC-US csEBCDICUS }
6118 { UNKNOWN-8BIT csUnknown8BiT }
6119 { MNEMONIC csMnemonic }
6124 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
6125 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
6126 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
6127 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
6128 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
6129 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
6130 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
6131 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
6132 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
6133 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
6134 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
6135 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
6136 { IBM1047 IBM-1047 }
6137 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
6138 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
6139 { UNICODE-1-1 csUnicode11 }
6142 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
6143 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
6145 { ISO-8859-15 ISO_8859-15 Latin-9 }
6146 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
6147 { GBK CP936 MS936 windows-936 }
6148 { JIS_Encoding csJISEncoding }
6149 { Shift_JIS MS_Kanji csShiftJIS }
6150 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
6152 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
6153 { ISO-10646-UCS-Basic csUnicodeASCII }
6154 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
6155 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
6156 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
6157 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
6158 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
6159 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
6160 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
6161 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
6162 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
6163 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
6164 { Adobe-Standard-Encoding csAdobeStandardEncoding }
6165 { Ventura-US csVenturaUS }
6166 { Ventura-International csVenturaInternational }
6167 { PC8-Danish-Norwegian csPC8DanishNorwegian }
6168 { PC8-Turkish csPC8Turkish }
6169 { IBM-Symbols csIBMSymbols }
6170 { IBM-Thai csIBMThai }
6171 { HP-Legal csHPLegal }
6172 { HP-Pi-font csHPPiFont }
6173 { HP-Math8 csHPMath8 }
6174 { Adobe-Symbol-Encoding csHPPSMath }
6175 { HP-DeskTop csHPDesktop }
6176 { Ventura-Math csVenturaMath }
6177 { Microsoft-Publishing csMicrosoftPublishing }
6178 { Windows-31J csWindows31J }
6183 proc tcl_encoding {enc} {
6184 global encoding_aliases
6185 set names [encoding names]
6186 set lcnames [string tolower $names]
6187 set enc [string tolower $enc]
6188 set i [lsearch -exact $lcnames $enc]
6190 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
6191 if {[regsub {^iso[-_]} $enc iso encx]} {
6192 set i [lsearch -exact $lcnames $encx]
6196 foreach l $encoding_aliases {
6197 set ll [string tolower $l]
6198 if {[lsearch -exact $ll $enc] < 0} continue
6199 # look through the aliases for one that tcl knows about
6201 set i [lsearch -exact $lcnames $e]
6203 if {[regsub {^iso[-_]} $e iso ex]} {
6204 set i [lsearch -exact $lcnames $ex]
6213 return [lindex $names $i]
6220 set diffopts "-U 5 -p"
6221 set wrcomcmd "git diff-tree --stdin -p --pretty"
6225 set gitencoding [exec git config --get i18n.commitencoding]
6227 if {$gitencoding == ""} {
6228 set gitencoding "utf-8"
6230 set tclencoding [tcl_encoding $gitencoding]
6231 if {$tclencoding == {}} {
6232 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
6235 set mainfont {Helvetica 9}
6236 set textfont {Courier 9}
6237 set uifont {Helvetica 9 bold}
6238 set findmergefiles 0
6246 set cmitmode "patch"
6247 set wrapcomment "none"
6250 set colors {green red blue magenta darkgrey brown orange}
6253 set diffcolors {red "#00a000" blue}
6255 catch {source ~/.gitk}
6257 font create optionfont -family sans-serif -size -12
6261 switch -regexp -- $arg {
6263 "^-d" { set datemode 1 }
6265 lappend revtreeargs $arg
6270 # check that we can find a .git directory somewhere...
6272 if {![file isdirectory $gitdir]} {
6273 show_error {} . "Cannot find the git directory \"$gitdir\"."
6277 set cmdline_files {}
6278 set i [lsearch -exact $revtreeargs "--"]
6280 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
6281 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
6282 } elseif {$revtreeargs ne {}} {
6284 set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
6285 set cmdline_files [split $f "\n"]
6286 set n [llength $cmdline_files]
6287 set revtreeargs [lrange $revtreeargs 0 end-$n]
6289 # unfortunately we get both stdout and stderr in $err,
6290 # so look for "fatal:".
6291 set i [string first "fatal:" $err]
6293 set err [string range $err [expr {$i + 6}] end]
6295 show_error {} . "Bad arguments to gitk:\n$err"
6304 set highlight_paths {}
6305 set searchdirn -forwards
6314 set selectedhlview None
6325 wm title . "[file tail $argv0]: [file tail [pwd]]"
6328 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6329 # create a view for the files/dirs specified on the command line
6333 set viewname(1) "Command line"
6334 set viewfiles(1) $cmdline_files
6335 set viewargs(1) $revtreeargs
6338 .bar.view entryconf Edit* -state normal
6339 .bar.view entryconf Delete* -state normal
6342 if {[info exists permviews]} {
6343 foreach v $permviews {
6346 set viewname($n) [lindex $v 0]
6347 set viewfiles($n) [lindex $v 1]
6348 set viewargs($n) [lindex $v 2]